gitkon commit [PATCH] gitk: Don't show local changes when we there is no work tree (cb8329a)
   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        } else {
2106            set yscreen [expr {($ybot - $ytop) / 2}]
2107        }
2108    } elseif {[info exists pending_select]} {
2109        set selid $pending_select
2110        unset pending_select
2111    }
2112    unselectline
2113    normalline
2114    if {$curview >= 0} {
2115        set vparentlist($curview) $parentlist
2116        set vdisporder($curview) $displayorder
2117        set vcmitlisted($curview) $commitlisted
2118        if {$phase ne {} ||
2119            ![info exists viewdata($curview)] ||
2120            [lindex $viewdata($curview) 0] ne {}} {
2121            set viewdata($curview) \
2122                [list $phase $rowidlist $rowisopt $rowfinal]
2123        }
2124    }
2125    catch {unset treediffs}
2126    clear_display
2127    if {[info exists hlview] && $hlview == $n} {
2128        unset hlview
2129        set selectedhlview [mc "None"]
2130    }
2131    catch {unset commitinterest}
2132
2133    set curview $n
2134    set selectedview $n
2135    .bar.view entryconf [mc "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
2136    .bar.view entryconf [mc "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
2137
2138    run refill_reflist
2139    if {![info exists viewdata($n)]} {
2140        if {$selid ne {}} {
2141            set pending_select $selid
2142        }
2143        getcommits
2144        return
2145    }
2146
2147    set v $viewdata($n)
2148    set phase [lindex $v 0]
2149    set displayorder $vdisporder($n)
2150    set parentlist $vparentlist($n)
2151    set commitlisted $vcmitlisted($n)
2152    set rowidlist [lindex $v 1]
2153    set rowisopt [lindex $v 2]
2154    set rowfinal [lindex $v 3]
2155    set numcommits $commitidx($n)
2156
2157    catch {unset colormap}
2158    catch {unset rowtextx}
2159    set nextcolor 0
2160    set canvxmax [$canv cget -width]
2161    set curview $n
2162    set row 0
2163    setcanvscroll
2164    set yf 0
2165    set row {}
2166    set selectfirst 0
2167    if {$selid ne {} && [info exists commitrow($n,$selid)]} {
2168        set row $commitrow($n,$selid)
2169        # try to get the selected row in the same position on the screen
2170        set ymax [lindex [$canv cget -scrollregion] 3]
2171        set ytop [expr {[yc $row] - $yscreen}]
2172        if {$ytop < 0} {
2173            set ytop 0
2174        }
2175        set yf [expr {$ytop * 1.0 / $ymax}]
2176    }
2177    allcanvs yview moveto $yf
2178    drawvisible
2179    if {$row ne {}} {
2180        selectline $row 0
2181    } elseif {$selid ne {}} {
2182        set pending_select $selid
2183    } else {
2184        set row [first_real_row]
2185        if {$row < $numcommits} {
2186            selectline $row 0
2187        } else {
2188            set selectfirst 1
2189        }
2190    }
2191    if {$phase ne {}} {
2192        if {$phase eq "getcommits"} {
2193            show_status [mc "Reading commits..."]
2194        }
2195        run chewcommits $n
2196    } elseif {$numcommits == 0} {
2197        show_status [mc "No commits selected"]
2198    }
2199}
2200
2201# Stuff relating to the highlighting facility
2202
2203proc ishighlighted {row} {
2204    global vhighlights fhighlights nhighlights rhighlights
2205
2206    if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
2207        return $nhighlights($row)
2208    }
2209    if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
2210        return $vhighlights($row)
2211    }
2212    if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
2213        return $fhighlights($row)
2214    }
2215    if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
2216        return $rhighlights($row)
2217    }
2218    return 0
2219}
2220
2221proc bolden {row font} {
2222    global canv linehtag selectedline boldrows
2223
2224    lappend boldrows $row
2225    $canv itemconf $linehtag($row) -font $font
2226    if {[info exists selectedline] && $row == $selectedline} {
2227        $canv delete secsel
2228        set t [eval $canv create rect [$canv bbox $linehtag($row)] \
2229                   -outline {{}} -tags secsel \
2230                   -fill [$canv cget -selectbackground]]
2231        $canv lower $t
2232    }
2233}
2234
2235proc bolden_name {row font} {
2236    global canv2 linentag selectedline boldnamerows
2237
2238    lappend boldnamerows $row
2239    $canv2 itemconf $linentag($row) -font $font
2240    if {[info exists selectedline] && $row == $selectedline} {
2241        $canv2 delete secsel
2242        set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
2243                   -outline {{}} -tags secsel \
2244                   -fill [$canv2 cget -selectbackground]]
2245        $canv2 lower $t
2246    }
2247}
2248
2249proc unbolden {} {
2250    global boldrows
2251
2252    set stillbold {}
2253    foreach row $boldrows {
2254        if {![ishighlighted $row]} {
2255            bolden $row mainfont
2256        } else {
2257            lappend stillbold $row
2258        }
2259    }
2260    set boldrows $stillbold
2261}
2262
2263proc addvhighlight {n} {
2264    global hlview curview viewdata vhl_done vhighlights commitidx
2265
2266    if {[info exists hlview]} {
2267        delvhighlight
2268    }
2269    set hlview $n
2270    if {$n != $curview && ![info exists viewdata($n)]} {
2271        set viewdata($n) [list getcommits {{}} 0 0 0]
2272        set vparentlist($n) {}
2273        set vdisporder($n) {}
2274        set vcmitlisted($n) {}
2275        start_rev_list $n
2276    }
2277    set vhl_done $commitidx($hlview)
2278    if {$vhl_done > 0} {
2279        drawvisible
2280    }
2281}
2282
2283proc delvhighlight {} {
2284    global hlview vhighlights
2285
2286    if {![info exists hlview]} return
2287    unset hlview
2288    catch {unset vhighlights}
2289    unbolden
2290}
2291
2292proc vhighlightmore {} {
2293    global hlview vhl_done commitidx vhighlights
2294    global displayorder vdisporder curview
2295
2296    set max $commitidx($hlview)
2297    if {$hlview == $curview} {
2298        set disp $displayorder
2299    } else {
2300        set disp $vdisporder($hlview)
2301    }
2302    set vr [visiblerows]
2303    set r0 [lindex $vr 0]
2304    set r1 [lindex $vr 1]
2305    for {set i $vhl_done} {$i < $max} {incr i} {
2306        set id [lindex $disp $i]
2307        if {[info exists commitrow($curview,$id)]} {
2308            set row $commitrow($curview,$id)
2309            if {$r0 <= $row && $row <= $r1} {
2310                if {![highlighted $row]} {
2311                    bolden $row mainfontbold
2312                }
2313                set vhighlights($row) 1
2314            }
2315        }
2316    }
2317    set vhl_done $max
2318}
2319
2320proc askvhighlight {row id} {
2321    global hlview vhighlights commitrow iddrawn
2322
2323    if {[info exists commitrow($hlview,$id)]} {
2324        if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
2325            bolden $row mainfontbold
2326        }
2327        set vhighlights($row) 1
2328    } else {
2329        set vhighlights($row) 0
2330    }
2331}
2332
2333proc hfiles_change {} {
2334    global highlight_files filehighlight fhighlights fh_serial
2335    global highlight_paths gdttype
2336
2337    if {[info exists filehighlight]} {
2338        # delete previous highlights
2339        catch {close $filehighlight}
2340        unset filehighlight
2341        catch {unset fhighlights}
2342        unbolden
2343        unhighlight_filelist
2344    }
2345    set highlight_paths {}
2346    after cancel do_file_hl $fh_serial
2347    incr fh_serial
2348    if {$highlight_files ne {}} {
2349        after 300 do_file_hl $fh_serial
2350    }
2351}
2352
2353proc gdttype_change {name ix op} {
2354    global gdttype highlight_files findstring findpattern
2355
2356    stopfinding
2357    if {$findstring ne {}} {
2358        if {$gdttype eq [mc "containing:"]} {
2359            if {$highlight_files ne {}} {
2360                set highlight_files {}
2361                hfiles_change
2362            }
2363            findcom_change
2364        } else {
2365            if {$findpattern ne {}} {
2366                set findpattern {}
2367                findcom_change
2368            }
2369            set highlight_files $findstring
2370            hfiles_change
2371        }
2372        drawvisible
2373    }
2374    # enable/disable findtype/findloc menus too
2375}
2376
2377proc find_change {name ix op} {
2378    global gdttype findstring highlight_files
2379
2380    stopfinding
2381    if {$gdttype eq [mc "containing:"]} {
2382        findcom_change
2383    } else {
2384        if {$highlight_files ne $findstring} {
2385            set highlight_files $findstring
2386            hfiles_change
2387        }
2388    }
2389    drawvisible
2390}
2391
2392proc findcom_change args {
2393    global nhighlights boldnamerows
2394    global findpattern findtype findstring gdttype
2395
2396    stopfinding
2397    # delete previous highlights, if any
2398    foreach row $boldnamerows {
2399        bolden_name $row mainfont
2400    }
2401    set boldnamerows {}
2402    catch {unset nhighlights}
2403    unbolden
2404    unmarkmatches
2405    if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
2406        set findpattern {}
2407    } elseif {$findtype eq [mc "Regexp"]} {
2408        set findpattern $findstring
2409    } else {
2410        set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
2411                   $findstring]
2412        set findpattern "*$e*"
2413    }
2414}
2415
2416proc makepatterns {l} {
2417    set ret {}
2418    foreach e $l {
2419        set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
2420        if {[string index $ee end] eq "/"} {
2421            lappend ret "$ee*"
2422        } else {
2423            lappend ret $ee
2424            lappend ret "$ee/*"
2425        }
2426    }
2427    return $ret
2428}
2429
2430proc do_file_hl {serial} {
2431    global highlight_files filehighlight highlight_paths gdttype fhl_list
2432
2433    if {$gdttype eq [mc "touching paths:"]} {
2434        if {[catch {set paths [shellsplit $highlight_files]}]} return
2435        set highlight_paths [makepatterns $paths]
2436        highlight_filelist
2437        set gdtargs [concat -- $paths]
2438    } elseif {$gdttype eq [mc "adding/removing string:"]} {
2439        set gdtargs [list "-S$highlight_files"]
2440    } else {
2441        # must be "containing:", i.e. we're searching commit info
2442        return
2443    }
2444    set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
2445    set filehighlight [open $cmd r+]
2446    fconfigure $filehighlight -blocking 0
2447    filerun $filehighlight readfhighlight
2448    set fhl_list {}
2449    drawvisible
2450    flushhighlights
2451}
2452
2453proc flushhighlights {} {
2454    global filehighlight fhl_list
2455
2456    if {[info exists filehighlight]} {
2457        lappend fhl_list {}
2458        puts $filehighlight ""
2459        flush $filehighlight
2460    }
2461}
2462
2463proc askfilehighlight {row id} {
2464    global filehighlight fhighlights fhl_list
2465
2466    lappend fhl_list $id
2467    set fhighlights($row) -1
2468    puts $filehighlight $id
2469}
2470
2471proc readfhighlight {} {
2472    global filehighlight fhighlights commitrow curview iddrawn
2473    global fhl_list find_dirn
2474
2475    if {![info exists filehighlight]} {
2476        return 0
2477    }
2478    set nr 0
2479    while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
2480        set line [string trim $line]
2481        set i [lsearch -exact $fhl_list $line]
2482        if {$i < 0} continue
2483        for {set j 0} {$j < $i} {incr j} {
2484            set id [lindex $fhl_list $j]
2485            if {[info exists commitrow($curview,$id)]} {
2486                set fhighlights($commitrow($curview,$id)) 0
2487            }
2488        }
2489        set fhl_list [lrange $fhl_list [expr {$i+1}] end]
2490        if {$line eq {}} continue
2491        if {![info exists commitrow($curview,$line)]} continue
2492        set row $commitrow($curview,$line)
2493        if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
2494            bolden $row mainfontbold
2495        }
2496        set fhighlights($row) 1
2497    }
2498    if {[eof $filehighlight]} {
2499        # strange...
2500        puts "oops, git diff-tree died"
2501        catch {close $filehighlight}
2502        unset filehighlight
2503        return 0
2504    }
2505    if {[info exists find_dirn]} {
2506        run findmore
2507    }
2508    return 1
2509}
2510
2511proc doesmatch {f} {
2512    global findtype findpattern
2513
2514    if {$findtype eq [mc "Regexp"]} {
2515        return [regexp $findpattern $f]
2516    } elseif {$findtype eq [mc "IgnCase"]} {
2517        return [string match -nocase $findpattern $f]
2518    } else {
2519        return [string match $findpattern $f]
2520    }
2521}
2522
2523proc askfindhighlight {row id} {
2524    global nhighlights commitinfo iddrawn
2525    global findloc
2526    global markingmatches
2527
2528    if {![info exists commitinfo($id)]} {
2529        getcommit $id
2530    }
2531    set info $commitinfo($id)
2532    set isbold 0
2533    set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]]
2534    foreach f $info ty $fldtypes {
2535        if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
2536            [doesmatch $f]} {
2537            if {$ty eq [mc "Author"]} {
2538                set isbold 2
2539                break
2540            }
2541            set isbold 1
2542        }
2543    }
2544    if {$isbold && [info exists iddrawn($id)]} {
2545        if {![ishighlighted $row]} {
2546            bolden $row mainfontbold
2547            if {$isbold > 1} {
2548                bolden_name $row mainfontbold
2549            }
2550        }
2551        if {$markingmatches} {
2552            markrowmatches $row $id
2553        }
2554    }
2555    set nhighlights($row) $isbold
2556}
2557
2558proc markrowmatches {row id} {
2559    global canv canv2 linehtag linentag commitinfo findloc
2560
2561    set headline [lindex $commitinfo($id) 0]
2562    set author [lindex $commitinfo($id) 1]
2563    $canv delete match$row
2564    $canv2 delete match$row
2565    if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
2566        set m [findmatches $headline]
2567        if {$m ne {}} {
2568            markmatches $canv $row $headline $linehtag($row) $m \
2569                [$canv itemcget $linehtag($row) -font] $row
2570        }
2571    }
2572    if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
2573        set m [findmatches $author]
2574        if {$m ne {}} {
2575            markmatches $canv2 $row $author $linentag($row) $m \
2576                [$canv2 itemcget $linentag($row) -font] $row
2577        }
2578    }
2579}
2580
2581proc vrel_change {name ix op} {
2582    global highlight_related
2583
2584    rhighlight_none
2585    if {$highlight_related ne [mc "None"]} {
2586        run drawvisible
2587    }
2588}
2589
2590# prepare for testing whether commits are descendents or ancestors of a
2591proc rhighlight_sel {a} {
2592    global descendent desc_todo ancestor anc_todo
2593    global highlight_related rhighlights
2594
2595    catch {unset descendent}
2596    set desc_todo [list $a]
2597    catch {unset ancestor}
2598    set anc_todo [list $a]
2599    if {$highlight_related ne [mc "None"]} {
2600        rhighlight_none
2601        run drawvisible
2602    }
2603}
2604
2605proc rhighlight_none {} {
2606    global rhighlights
2607
2608    catch {unset rhighlights}
2609    unbolden
2610}
2611
2612proc is_descendent {a} {
2613    global curview children commitrow descendent desc_todo
2614
2615    set v $curview
2616    set la $commitrow($v,$a)
2617    set todo $desc_todo
2618    set leftover {}
2619    set done 0
2620    for {set i 0} {$i < [llength $todo]} {incr i} {
2621        set do [lindex $todo $i]
2622        if {$commitrow($v,$do) < $la} {
2623            lappend leftover $do
2624            continue
2625        }
2626        foreach nk $children($v,$do) {
2627            if {![info exists descendent($nk)]} {
2628                set descendent($nk) 1
2629                lappend todo $nk
2630                if {$nk eq $a} {
2631                    set done 1
2632                }
2633            }
2634        }
2635        if {$done} {
2636            set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2637            return
2638        }
2639    }
2640    set descendent($a) 0
2641    set desc_todo $leftover
2642}
2643
2644proc is_ancestor {a} {
2645    global curview parentlist commitrow ancestor anc_todo
2646
2647    set v $curview
2648    set la $commitrow($v,$a)
2649    set todo $anc_todo
2650    set leftover {}
2651    set done 0
2652    for {set i 0} {$i < [llength $todo]} {incr i} {
2653        set do [lindex $todo $i]
2654        if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2655            lappend leftover $do
2656            continue
2657        }
2658        foreach np [lindex $parentlist $commitrow($v,$do)] {
2659            if {![info exists ancestor($np)]} {
2660                set ancestor($np) 1
2661                lappend todo $np
2662                if {$np eq $a} {
2663                    set done 1
2664                }
2665            }
2666        }
2667        if {$done} {
2668            set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2669            return
2670        }
2671    }
2672    set ancestor($a) 0
2673    set anc_todo $leftover
2674}
2675
2676proc askrelhighlight {row id} {
2677    global descendent highlight_related iddrawn rhighlights
2678    global selectedline ancestor
2679
2680    if {![info exists selectedline]} return
2681    set isbold 0
2682    if {$highlight_related eq [mc "Descendant"] ||
2683        $highlight_related eq [mc "Not descendant"]} {
2684        if {![info exists descendent($id)]} {
2685            is_descendent $id
2686        }
2687        if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
2688            set isbold 1
2689        }
2690    } elseif {$highlight_related eq [mc "Ancestor"] ||
2691              $highlight_related eq [mc "Not ancestor"]} {
2692        if {![info exists ancestor($id)]} {
2693            is_ancestor $id
2694        }
2695        if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
2696            set isbold 1
2697        }
2698    }
2699    if {[info exists iddrawn($id)]} {
2700        if {$isbold && ![ishighlighted $row]} {
2701            bolden $row mainfontbold
2702        }
2703    }
2704    set rhighlights($row) $isbold
2705}
2706
2707# Graph layout functions
2708
2709proc shortids {ids} {
2710    set res {}
2711    foreach id $ids {
2712        if {[llength $id] > 1} {
2713            lappend res [shortids $id]
2714        } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2715            lappend res [string range $id 0 7]
2716        } else {
2717            lappend res $id
2718        }
2719    }
2720    return $res
2721}
2722
2723proc ntimes {n o} {
2724    set ret {}
2725    set o [list $o]
2726    for {set mask 1} {$mask <= $n} {incr mask $mask} {
2727        if {($n & $mask) != 0} {
2728            set ret [concat $ret $o]
2729        }
2730        set o [concat $o $o]
2731    }
2732    return $ret
2733}
2734
2735# Work out where id should go in idlist so that order-token
2736# values increase from left to right
2737proc idcol {idlist id {i 0}} {
2738    global ordertok curview
2739
2740    set t $ordertok($curview,$id)
2741    if {$i >= [llength $idlist] ||
2742        $t < $ordertok($curview,[lindex $idlist $i])} {
2743        if {$i > [llength $idlist]} {
2744            set i [llength $idlist]
2745        }
2746        while {[incr i -1] >= 0 &&
2747               $t < $ordertok($curview,[lindex $idlist $i])} {}
2748        incr i
2749    } else {
2750        if {$t > $ordertok($curview,[lindex $idlist $i])} {
2751            while {[incr i] < [llength $idlist] &&
2752                   $t >= $ordertok($curview,[lindex $idlist $i])} {}
2753        }
2754    }
2755    return $i
2756}
2757
2758proc initlayout {} {
2759    global rowidlist rowisopt rowfinal displayorder commitlisted
2760    global numcommits canvxmax canv
2761    global nextcolor
2762    global parentlist
2763    global colormap rowtextx
2764    global selectfirst
2765
2766    set numcommits 0
2767    set displayorder {}
2768    set commitlisted {}
2769    set parentlist {}
2770    set nextcolor 0
2771    set rowidlist {}
2772    set rowisopt {}
2773    set rowfinal {}
2774    set canvxmax [$canv cget -width]
2775    catch {unset colormap}
2776    catch {unset rowtextx}
2777    set selectfirst 1
2778}
2779
2780proc setcanvscroll {} {
2781    global canv canv2 canv3 numcommits linespc canvxmax canvy0
2782
2783    set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2784    $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2785    $canv2 conf -scrollregion [list 0 0 0 $ymax]
2786    $canv3 conf -scrollregion [list 0 0 0 $ymax]
2787}
2788
2789proc visiblerows {} {
2790    global canv numcommits linespc
2791
2792    set ymax [lindex [$canv cget -scrollregion] 3]
2793    if {$ymax eq {} || $ymax == 0} return
2794    set f [$canv yview]
2795    set y0 [expr {int([lindex $f 0] * $ymax)}]
2796    set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2797    if {$r0 < 0} {
2798        set r0 0
2799    }
2800    set y1 [expr {int([lindex $f 1] * $ymax)}]
2801    set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2802    if {$r1 >= $numcommits} {
2803        set r1 [expr {$numcommits - 1}]
2804    }
2805    return [list $r0 $r1]
2806}
2807
2808proc layoutmore {} {
2809    global commitidx viewcomplete numcommits
2810    global uparrowlen downarrowlen mingaplen curview
2811
2812    set show $commitidx($curview)
2813    if {$show > $numcommits || $viewcomplete($curview)} {
2814        showstuff $show $viewcomplete($curview)
2815    }
2816}
2817
2818proc showstuff {canshow last} {
2819    global numcommits commitrow pending_select selectedline curview
2820    global mainheadid displayorder selectfirst
2821    global lastscrollset commitinterest
2822
2823    if {$numcommits == 0} {
2824        global phase
2825        set phase "incrdraw"
2826        allcanvs delete all
2827    }
2828    set r0 $numcommits
2829    set prev $numcommits
2830    set numcommits $canshow
2831    set t [clock clicks -milliseconds]
2832    if {$prev < 100 || $last || $t - $lastscrollset > 500} {
2833        set lastscrollset $t
2834        setcanvscroll
2835    }
2836    set rows [visiblerows]
2837    set r1 [lindex $rows 1]
2838    if {$r1 >= $canshow} {
2839        set r1 [expr {$canshow - 1}]
2840    }
2841    if {$r0 <= $r1} {
2842        drawcommits $r0 $r1
2843    }
2844    if {[info exists pending_select] &&
2845        [info exists commitrow($curview,$pending_select)] &&
2846        $commitrow($curview,$pending_select) < $numcommits} {
2847        selectline $commitrow($curview,$pending_select) 1
2848    }
2849    if {$selectfirst} {
2850        if {[info exists selectedline] || [info exists pending_select]} {
2851            set selectfirst 0
2852        } else {
2853            set l [first_real_row]
2854            selectline $l 1
2855            set selectfirst 0
2856        }
2857    }
2858}
2859
2860proc doshowlocalchanges {} {
2861    global curview mainheadid phase commitrow
2862
2863    if {[info exists commitrow($curview,$mainheadid)] &&
2864        ($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
2865        dodiffindex
2866    } elseif {$phase ne {}} {
2867        lappend commitinterest($mainheadid) {}
2868    }
2869}
2870
2871proc dohidelocalchanges {} {
2872    global localfrow localirow lserial
2873
2874    if {$localfrow >= 0} {
2875        removerow $localfrow
2876        set localfrow -1
2877        if {$localirow > 0} {
2878            incr localirow -1
2879        }
2880    }
2881    if {$localirow >= 0} {
2882        removerow $localirow
2883        set localirow -1
2884    }
2885    incr lserial
2886}
2887
2888# spawn off a process to do git diff-index --cached HEAD
2889proc dodiffindex {} {
2890    global localirow localfrow lserial showlocalchanges
2891    global isworktree
2892
2893    if {!$showlocalchanges || !$isworktree} return
2894    incr lserial
2895    set localfrow -1
2896    set localirow -1
2897    set fd [open "|git diff-index --cached HEAD" r]
2898    fconfigure $fd -blocking 0
2899    filerun $fd [list readdiffindex $fd $lserial]
2900}
2901
2902proc readdiffindex {fd serial} {
2903    global localirow commitrow mainheadid nullid2 curview
2904    global commitinfo commitdata lserial
2905
2906    set isdiff 1
2907    if {[gets $fd line] < 0} {
2908        if {![eof $fd]} {
2909            return 1
2910        }
2911        set isdiff 0
2912    }
2913    # we only need to see one line and we don't really care what it says...
2914    close $fd
2915
2916    # now see if there are any local changes not checked in to the index
2917    if {$serial == $lserial} {
2918        set fd [open "|git diff-files" r]
2919        fconfigure $fd -blocking 0
2920        filerun $fd [list readdifffiles $fd $serial]
2921    }
2922
2923    if {$isdiff && $serial == $lserial && $localirow == -1} {
2924        # add the line for the changes in the index to the graph
2925        set localirow $commitrow($curview,$mainheadid)
2926        set hl [mc "Local changes checked in to index but not committed"]
2927        set commitinfo($nullid2) [list  $hl {} {} {} {} "    $hl\n"]
2928        set commitdata($nullid2) "\n    $hl\n"
2929        insertrow $localirow $nullid2
2930    }
2931    return 0
2932}
2933
2934proc readdifffiles {fd serial} {
2935    global localirow localfrow commitrow mainheadid nullid curview
2936    global commitinfo commitdata lserial
2937
2938    set isdiff 1
2939    if {[gets $fd line] < 0} {
2940        if {![eof $fd]} {
2941            return 1
2942        }
2943        set isdiff 0
2944    }
2945    # we only need to see one line and we don't really care what it says...
2946    close $fd
2947
2948    if {$isdiff && $serial == $lserial && $localfrow == -1} {
2949        # add the line for the local diff to the graph
2950        if {$localirow >= 0} {
2951            set localfrow $localirow
2952            incr localirow
2953        } else {
2954            set localfrow $commitrow($curview,$mainheadid)
2955        }
2956        set hl [mc "Local uncommitted changes, not checked in to index"]
2957        set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
2958        set commitdata($nullid) "\n    $hl\n"
2959        insertrow $localfrow $nullid
2960    }
2961    return 0
2962}
2963
2964proc nextuse {id row} {
2965    global commitrow curview children
2966
2967    if {[info exists children($curview,$id)]} {
2968        foreach kid $children($curview,$id) {
2969            if {![info exists commitrow($curview,$kid)]} {
2970                return -1
2971            }
2972            if {$commitrow($curview,$kid) > $row} {
2973                return $commitrow($curview,$kid)
2974            }
2975        }
2976    }
2977    if {[info exists commitrow($curview,$id)]} {
2978        return $commitrow($curview,$id)
2979    }
2980    return -1
2981}
2982
2983proc prevuse {id row} {
2984    global commitrow curview children
2985
2986    set ret -1
2987    if {[info exists children($curview,$id)]} {
2988        foreach kid $children($curview,$id) {
2989            if {![info exists commitrow($curview,$kid)]} break
2990            if {$commitrow($curview,$kid) < $row} {
2991                set ret $commitrow($curview,$kid)
2992            }
2993        }
2994    }
2995    return $ret
2996}
2997
2998proc make_idlist {row} {
2999    global displayorder parentlist uparrowlen downarrowlen mingaplen
3000    global commitidx curview ordertok children commitrow
3001
3002    set r [expr {$row - $mingaplen - $downarrowlen - 1}]
3003    if {$r < 0} {
3004        set r 0
3005    }
3006    set ra [expr {$row - $downarrowlen}]
3007    if {$ra < 0} {
3008        set ra 0
3009    }
3010    set rb [expr {$row + $uparrowlen}]
3011    if {$rb > $commitidx($curview)} {
3012        set rb $commitidx($curview)
3013    }
3014    set ids {}
3015    for {} {$r < $ra} {incr r} {
3016        set nextid [lindex $displayorder [expr {$r + 1}]]
3017        foreach p [lindex $parentlist $r] {
3018            if {$p eq $nextid} continue
3019            set rn [nextuse $p $r]
3020            if {$rn >= $row &&
3021                $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
3022                lappend ids [list $ordertok($curview,$p) $p]
3023            }
3024        }
3025    }
3026    for {} {$r < $row} {incr r} {
3027        set nextid [lindex $displayorder [expr {$r + 1}]]
3028        foreach p [lindex $parentlist $r] {
3029            if {$p eq $nextid} continue
3030            set rn [nextuse $p $r]
3031            if {$rn < 0 || $rn >= $row} {
3032                lappend ids [list $ordertok($curview,$p) $p]
3033            }
3034        }
3035    }
3036    set id [lindex $displayorder $row]
3037    lappend ids [list $ordertok($curview,$id) $id]
3038    while {$r < $rb} {
3039        foreach p [lindex $parentlist $r] {
3040            set firstkid [lindex $children($curview,$p) 0]
3041            if {$commitrow($curview,$firstkid) < $row} {
3042                lappend ids [list $ordertok($curview,$p) $p]
3043            }
3044        }
3045        incr r
3046        set id [lindex $displayorder $r]
3047        if {$id ne {}} {
3048            set firstkid [lindex $children($curview,$id) 0]
3049            if {$firstkid ne {} && $commitrow($curview,$firstkid) < $row} {
3050                lappend ids [list $ordertok($curview,$id) $id]
3051            }
3052        }
3053    }
3054    set idlist {}
3055    foreach idx [lsort -unique $ids] {
3056        lappend idlist [lindex $idx 1]
3057    }
3058    return $idlist
3059}
3060
3061proc rowsequal {a b} {
3062    while {[set i [lsearch -exact $a {}]] >= 0} {
3063        set a [lreplace $a $i $i]
3064    }
3065    while {[set i [lsearch -exact $b {}]] >= 0} {
3066        set b [lreplace $b $i $i]
3067    }
3068    return [expr {$a eq $b}]
3069}
3070
3071proc makeupline {id row rend col} {
3072    global rowidlist uparrowlen downarrowlen mingaplen
3073
3074    for {set r $rend} {1} {set r $rstart} {
3075        set rstart [prevuse $id $r]
3076        if {$rstart < 0} return
3077        if {$rstart < $row} break
3078    }
3079    if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
3080        set rstart [expr {$rend - $uparrowlen - 1}]
3081    }
3082    for {set r $rstart} {[incr r] <= $row} {} {
3083        set idlist [lindex $rowidlist $r]
3084        if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
3085            set col [idcol $idlist $id $col]
3086            lset rowidlist $r [linsert $idlist $col $id]
3087            changedrow $r
3088        }
3089    }
3090}
3091
3092proc layoutrows {row endrow} {
3093    global rowidlist rowisopt rowfinal displayorder
3094    global uparrowlen downarrowlen maxwidth mingaplen
3095    global children parentlist
3096    global commitidx viewcomplete curview commitrow
3097
3098    set idlist {}
3099    if {$row > 0} {
3100        set rm1 [expr {$row - 1}]
3101        foreach id [lindex $rowidlist $rm1] {
3102            if {$id ne {}} {
3103                lappend idlist $id
3104            }
3105        }
3106        set final [lindex $rowfinal $rm1]
3107    }
3108    for {} {$row < $endrow} {incr row} {
3109        set rm1 [expr {$row - 1}]
3110        if {$rm1 < 0 || $idlist eq {}} {
3111            set idlist [make_idlist $row]
3112            set final 1
3113        } else {
3114            set id [lindex $displayorder $rm1]
3115            set col [lsearch -exact $idlist $id]
3116            set idlist [lreplace $idlist $col $col]
3117            foreach p [lindex $parentlist $rm1] {
3118                if {[lsearch -exact $idlist $p] < 0} {
3119                    set col [idcol $idlist $p $col]
3120                    set idlist [linsert $idlist $col $p]
3121                    # if not the first child, we have to insert a line going up
3122                    if {$id ne [lindex $children($curview,$p) 0]} {
3123                        makeupline $p $rm1 $row $col
3124                    }
3125                }
3126            }
3127            set id [lindex $displayorder $row]
3128            if {$row > $downarrowlen} {
3129                set termrow [expr {$row - $downarrowlen - 1}]
3130                foreach p [lindex $parentlist $termrow] {
3131                    set i [lsearch -exact $idlist $p]
3132                    if {$i < 0} continue
3133                    set nr [nextuse $p $termrow]
3134                    if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
3135                        set idlist [lreplace $idlist $i $i]
3136                    }
3137                }
3138            }
3139            set col [lsearch -exact $idlist $id]
3140            if {$col < 0} {
3141                set col [idcol $idlist $id]
3142                set idlist [linsert $idlist $col $id]
3143                if {$children($curview,$id) ne {}} {
3144                    makeupline $id $rm1 $row $col
3145                }
3146            }
3147            set r [expr {$row + $uparrowlen - 1}]
3148            if {$r < $commitidx($curview)} {
3149                set x $col
3150                foreach p [lindex $parentlist $r] {
3151                    if {[lsearch -exact $idlist $p] >= 0} continue
3152                    set fk [lindex $children($curview,$p) 0]
3153                    if {$commitrow($curview,$fk) < $row} {
3154                        set x [idcol $idlist $p $x]
3155                        set idlist [linsert $idlist $x $p]
3156                    }
3157                }
3158                if {[incr r] < $commitidx($curview)} {
3159                    set p [lindex $displayorder $r]
3160                    if {[lsearch -exact $idlist $p] < 0} {
3161                        set fk [lindex $children($curview,$p) 0]
3162                        if {$fk ne {} && $commitrow($curview,$fk) < $row} {
3163                            set x [idcol $idlist $p $x]
3164                            set idlist [linsert $idlist $x $p]
3165                        }
3166                    }
3167                }
3168            }
3169        }
3170        if {$final && !$viewcomplete($curview) &&
3171            $row + $uparrowlen + $mingaplen + $downarrowlen
3172                >= $commitidx($curview)} {
3173            set final 0
3174        }
3175        set l [llength $rowidlist]
3176        if {$row == $l} {
3177            lappend rowidlist $idlist
3178            lappend rowisopt 0
3179            lappend rowfinal $final
3180        } elseif {$row < $l} {
3181            if {![rowsequal $idlist [lindex $rowidlist $row]]} {
3182                lset rowidlist $row $idlist
3183                changedrow $row
3184            }
3185            lset rowfinal $row $final
3186        } else {
3187            set pad [ntimes [expr {$row - $l}] {}]
3188            set rowidlist [concat $rowidlist $pad]
3189            lappend rowidlist $idlist
3190            set rowfinal [concat $rowfinal $pad]
3191            lappend rowfinal $final
3192            set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
3193        }
3194    }
3195    return $row
3196}
3197
3198proc changedrow {row} {
3199    global displayorder iddrawn rowisopt need_redisplay
3200
3201    set l [llength $rowisopt]
3202    if {$row < $l} {
3203        lset rowisopt $row 0
3204        if {$row + 1 < $l} {
3205            lset rowisopt [expr {$row + 1}] 0
3206            if {$row + 2 < $l} {
3207                lset rowisopt [expr {$row + 2}] 0
3208            }
3209        }
3210    }
3211    set id [lindex $displayorder $row]
3212    if {[info exists iddrawn($id)]} {
3213        set need_redisplay 1
3214    }
3215}
3216
3217proc insert_pad {row col npad} {
3218    global rowidlist
3219
3220    set pad [ntimes $npad {}]
3221    set idlist [lindex $rowidlist $row]
3222    set bef [lrange $idlist 0 [expr {$col - 1}]]
3223    set aft [lrange $idlist $col end]
3224    set i [lsearch -exact $aft {}]
3225    if {$i > 0} {
3226        set aft [lreplace $aft $i $i]
3227    }
3228    lset rowidlist $row [concat $bef $pad $aft]
3229    changedrow $row
3230}
3231
3232proc optimize_rows {row col endrow} {
3233    global rowidlist rowisopt displayorder curview children
3234
3235    if {$row < 1} {
3236        set row 1
3237    }
3238    for {} {$row < $endrow} {incr row; set col 0} {
3239        if {[lindex $rowisopt $row]} continue
3240        set haspad 0
3241        set y0 [expr {$row - 1}]
3242        set ym [expr {$row - 2}]
3243        set idlist [lindex $rowidlist $row]
3244        set previdlist [lindex $rowidlist $y0]
3245        if {$idlist eq {} || $previdlist eq {}} continue
3246        if {$ym >= 0} {
3247            set pprevidlist [lindex $rowidlist $ym]
3248            if {$pprevidlist eq {}} continue
3249        } else {
3250            set pprevidlist {}
3251        }
3252        set x0 -1
3253        set xm -1
3254        for {} {$col < [llength $idlist]} {incr col} {
3255            set id [lindex $idlist $col]
3256            if {[lindex $previdlist $col] eq $id} continue
3257            if {$id eq {}} {
3258                set haspad 1
3259                continue
3260            }
3261            set x0 [lsearch -exact $previdlist $id]
3262            if {$x0 < 0} continue
3263            set z [expr {$x0 - $col}]
3264            set isarrow 0
3265            set z0 {}
3266            if {$ym >= 0} {
3267                set xm [lsearch -exact $pprevidlist $id]
3268                if {$xm >= 0} {
3269                    set z0 [expr {$xm - $x0}]
3270                }
3271            }
3272            if {$z0 eq {}} {
3273                # if row y0 is the first child of $id then it's not an arrow
3274                if {[lindex $children($curview,$id) 0] ne
3275                    [lindex $displayorder $y0]} {
3276                    set isarrow 1
3277                }
3278            }
3279            if {!$isarrow && $id ne [lindex $displayorder $row] &&
3280                [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
3281                set isarrow 1
3282            }
3283            # Looking at lines from this row to the previous row,
3284            # make them go straight up if they end in an arrow on
3285            # the previous row; otherwise make them go straight up
3286            # or at 45 degrees.
3287            if {$z < -1 || ($z < 0 && $isarrow)} {
3288                # Line currently goes left too much;
3289                # insert pads in the previous row, then optimize it
3290                set npad [expr {-1 - $z + $isarrow}]
3291                insert_pad $y0 $x0 $npad
3292                if {$y0 > 0} {
3293                    optimize_rows $y0 $x0 $row
3294                }
3295                set previdlist [lindex $rowidlist $y0]
3296                set x0 [lsearch -exact $previdlist $id]
3297                set z [expr {$x0 - $col}]
3298                if {$z0 ne {}} {
3299                    set pprevidlist [lindex $rowidlist $ym]
3300                    set xm [lsearch -exact $pprevidlist $id]
3301                    set z0 [expr {$xm - $x0}]
3302                }
3303            } elseif {$z > 1 || ($z > 0 && $isarrow)} {
3304                # Line currently goes right too much;
3305                # insert pads in this line
3306                set npad [expr {$z - 1 + $isarrow}]
3307                insert_pad $row $col $npad
3308                set idlist [lindex $rowidlist $row]
3309                incr col $npad
3310                set z [expr {$x0 - $col}]
3311                set haspad 1
3312            }
3313            if {$z0 eq {} && !$isarrow && $ym >= 0} {
3314                # this line links to its first child on row $row-2
3315                set id [lindex $displayorder $ym]
3316                set xc [lsearch -exact $pprevidlist $id]
3317                if {$xc >= 0} {
3318                    set z0 [expr {$xc - $x0}]
3319                }
3320            }
3321            # avoid lines jigging left then immediately right
3322            if {$z0 ne {} && $z < 0 && $z0 > 0} {
3323                insert_pad $y0 $x0 1
3324                incr x0
3325                optimize_rows $y0 $x0 $row
3326                set previdlist [lindex $rowidlist $y0]
3327            }
3328        }
3329        if {!$haspad} {
3330            # Find the first column that doesn't have a line going right
3331            for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
3332                set id [lindex $idlist $col]
3333                if {$id eq {}} break
3334                set x0 [lsearch -exact $previdlist $id]
3335                if {$x0 < 0} {
3336                    # check if this is the link to the first child
3337                    set kid [lindex $displayorder $y0]
3338                    if {[lindex $children($curview,$id) 0] eq $kid} {
3339                        # it is, work out offset to child
3340                        set x0 [lsearch -exact $previdlist $kid]
3341                    }
3342                }
3343                if {$x0 <= $col} break
3344            }
3345            # Insert a pad at that column as long as it has a line and
3346            # isn't the last column
3347            if {$x0 >= 0 && [incr col] < [llength $idlist]} {
3348                set idlist [linsert $idlist $col {}]
3349                lset rowidlist $row $idlist
3350                changedrow $row
3351            }
3352        }
3353    }
3354}
3355
3356proc xc {row col} {
3357    global canvx0 linespc
3358    return [expr {$canvx0 + $col * $linespc}]
3359}
3360
3361proc yc {row} {
3362    global canvy0 linespc
3363    return [expr {$canvy0 + $row * $linespc}]
3364}
3365
3366proc linewidth {id} {
3367    global thickerline lthickness
3368
3369    set wid $lthickness
3370    if {[info exists thickerline] && $id eq $thickerline} {
3371        set wid [expr {2 * $lthickness}]
3372    }
3373    return $wid
3374}
3375
3376proc rowranges {id} {
3377    global commitrow curview children uparrowlen downarrowlen
3378    global rowidlist
3379
3380    set kids $children($curview,$id)
3381    if {$kids eq {}} {
3382        return {}
3383    }
3384    set ret {}
3385    lappend kids $id
3386    foreach child $kids {
3387        if {![info exists commitrow($curview,$child)]} break
3388        set row $commitrow($curview,$child)
3389        if {![info exists prev]} {
3390            lappend ret [expr {$row + 1}]
3391        } else {
3392            if {$row <= $prevrow} {
3393                puts "oops children out of order [shortids $id] $row < [shortids $prev] $prevrow"
3394            }
3395            # see if the line extends the whole way from prevrow to row
3396            if {$row > $prevrow + $uparrowlen + $downarrowlen &&
3397                [lsearch -exact [lindex $rowidlist \
3398                            [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
3399                # it doesn't, see where it ends
3400                set r [expr {$prevrow + $downarrowlen}]
3401                if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3402                    while {[incr r -1] > $prevrow &&
3403                           [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3404                } else {
3405                    while {[incr r] <= $row &&
3406                           [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3407                    incr r -1
3408                }
3409                lappend ret $r
3410                # see where it starts up again
3411                set r [expr {$row - $uparrowlen}]
3412                if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
3413                    while {[incr r] < $row &&
3414                           [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
3415                } else {
3416                    while {[incr r -1] >= $prevrow &&
3417                           [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
3418                    incr r
3419                }
3420                lappend ret $r
3421            }
3422        }
3423        if {$child eq $id} {
3424            lappend ret $row
3425        }
3426        set prev $id
3427        set prevrow $row
3428    }
3429    return $ret
3430}
3431
3432proc drawlineseg {id row endrow arrowlow} {
3433    global rowidlist displayorder iddrawn linesegs
3434    global canv colormap linespc curview maxlinelen parentlist
3435
3436    set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
3437    set le [expr {$row + 1}]
3438    set arrowhigh 1
3439    while {1} {
3440        set c [lsearch -exact [lindex $rowidlist $le] $id]
3441        if {$c < 0} {
3442            incr le -1
3443            break
3444        }
3445        lappend cols $c
3446        set x [lindex $displayorder $le]
3447        if {$x eq $id} {
3448            set arrowhigh 0
3449            break
3450        }
3451        if {[info exists iddrawn($x)] || $le == $endrow} {
3452            set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
3453            if {$c >= 0} {
3454                lappend cols $c
3455                set arrowhigh 0
3456            }
3457            break
3458        }
3459        incr le
3460    }
3461    if {$le <= $row} {
3462        return $row
3463    }
3464
3465    set lines {}
3466    set i 0
3467    set joinhigh 0
3468    if {[info exists linesegs($id)]} {
3469        set lines $linesegs($id)
3470        foreach li $lines {
3471            set r0 [lindex $li 0]
3472            if {$r0 > $row} {
3473                if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
3474                    set joinhigh 1
3475                }
3476                break
3477            }
3478            incr i
3479        }
3480    }
3481    set joinlow 0
3482    if {$i > 0} {
3483        set li [lindex $lines [expr {$i-1}]]
3484        set r1 [lindex $li 1]
3485        if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
3486            set joinlow 1
3487        }
3488    }
3489
3490    set x [lindex $cols [expr {$le - $row}]]
3491    set xp [lindex $cols [expr {$le - 1 - $row}]]
3492    set dir [expr {$xp - $x}]
3493    if {$joinhigh} {
3494        set ith [lindex $lines $i 2]
3495        set coords [$canv coords $ith]
3496        set ah [$canv itemcget $ith -arrow]
3497        set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
3498        set x2 [lindex $cols [expr {$le + 1 - $row}]]
3499        if {$x2 ne {} && $x - $x2 == $dir} {
3500            set coords [lrange $coords 0 end-2]
3501        }
3502    } else {
3503        set coords [list [xc $le $x] [yc $le]]
3504    }
3505    if {$joinlow} {
3506        set itl [lindex $lines [expr {$i-1}] 2]
3507        set al [$canv itemcget $itl -arrow]
3508        set arrowlow [expr {$al eq "last" || $al eq "both"}]
3509    } elseif {$arrowlow} {
3510        if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
3511            [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
3512            set arrowlow 0
3513        }
3514    }
3515    set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
3516    for {set y $le} {[incr y -1] > $row} {} {
3517        set x $xp
3518        set xp [lindex $cols [expr {$y - 1 - $row}]]
3519        set ndir [expr {$xp - $x}]
3520        if {$dir != $ndir || $xp < 0} {
3521            lappend coords [xc $y $x] [yc $y]
3522        }
3523        set dir $ndir
3524    }
3525    if {!$joinlow} {
3526        if {$xp < 0} {
3527            # join parent line to first child
3528            set ch [lindex $displayorder $row]
3529            set xc [lsearch -exact [lindex $rowidlist $row] $ch]
3530            if {$xc < 0} {
3531                puts "oops: drawlineseg: child $ch not on row $row"
3532            } elseif {$xc != $x} {
3533                if {($arrowhigh && $le == $row + 1) || $dir == 0} {
3534                    set d [expr {int(0.5 * $linespc)}]
3535                    set x1 [xc $row $x]
3536                    if {$xc < $x} {
3537                        set x2 [expr {$x1 - $d}]
3538                    } else {
3539                        set x2 [expr {$x1 + $d}]
3540                    }
3541                    set y2 [yc $row]
3542                    set y1 [expr {$y2 + $d}]
3543                    lappend coords $x1 $y1 $x2 $y2
3544                } elseif {$xc < $x - 1} {
3545                    lappend coords [xc $row [expr {$x-1}]] [yc $row]
3546                } elseif {$xc > $x + 1} {
3547                    lappend coords [xc $row [expr {$x+1}]] [yc $row]
3548                }
3549                set x $xc
3550            }
3551            lappend coords [xc $row $x] [yc $row]
3552        } else {
3553            set xn [xc $row $xp]
3554            set yn [yc $row]
3555            lappend coords $xn $yn
3556        }
3557        if {!$joinhigh} {
3558            assigncolor $id
3559            set t [$canv create line $coords -width [linewidth $id] \
3560                       -fill $colormap($id) -tags lines.$id -arrow $arrow]
3561            $canv lower $t
3562            bindline $t $id
3563            set lines [linsert $lines $i [list $row $le $t]]
3564        } else {
3565            $canv coords $ith $coords
3566            if {$arrow ne $ah} {
3567                $canv itemconf $ith -arrow $arrow
3568            }
3569            lset lines $i 0 $row
3570        }
3571    } else {
3572        set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
3573        set ndir [expr {$xo - $xp}]
3574        set clow [$canv coords $itl]
3575        if {$dir == $ndir} {
3576            set clow [lrange $clow 2 end]
3577        }
3578        set coords [concat $coords $clow]
3579        if {!$joinhigh} {
3580            lset lines [expr {$i-1}] 1 $le
3581        } else {
3582            # coalesce two pieces
3583            $canv delete $ith
3584            set b [lindex $lines [expr {$i-1}] 0]
3585            set e [lindex $lines $i 1]
3586            set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
3587        }
3588        $canv coords $itl $coords
3589        if {$arrow ne $al} {
3590            $canv itemconf $itl -arrow $arrow
3591        }
3592    }
3593
3594    set linesegs($id) $lines
3595    return $le
3596}
3597
3598proc drawparentlinks {id row} {
3599    global rowidlist canv colormap curview parentlist
3600    global idpos linespc
3601
3602    set rowids [lindex $rowidlist $row]
3603    set col [lsearch -exact $rowids $id]
3604    if {$col < 0} return
3605    set olds [lindex $parentlist $row]
3606    set row2 [expr {$row + 1}]
3607    set x [xc $row $col]
3608    set y [yc $row]
3609    set y2 [yc $row2]
3610    set d [expr {int(0.5 * $linespc)}]
3611    set ymid [expr {$y + $d}]
3612    set ids [lindex $rowidlist $row2]
3613    # rmx = right-most X coord used
3614    set rmx 0
3615    foreach p $olds {
3616        set i [lsearch -exact $ids $p]
3617        if {$i < 0} {
3618            puts "oops, parent $p of $id not in list"
3619            continue
3620        }
3621        set x2 [xc $row2 $i]
3622        if {$x2 > $rmx} {
3623            set rmx $x2
3624        }
3625        set j [lsearch -exact $rowids $p]
3626        if {$j < 0} {
3627            # drawlineseg will do this one for us
3628            continue
3629        }
3630        assigncolor $p
3631        # should handle duplicated parents here...
3632        set coords [list $x $y]
3633        if {$i != $col} {
3634            # if attaching to a vertical segment, draw a smaller
3635            # slant for visual distinctness
3636            if {$i == $j} {
3637                if {$i < $col} {
3638                    lappend coords [expr {$x2 + $d}] $y $x2 $ymid
3639                } else {
3640                    lappend coords [expr {$x2 - $d}] $y $x2 $ymid
3641                }
3642            } elseif {$i < $col && $i < $j} {
3643                # segment slants towards us already
3644                lappend coords [xc $row $j] $y
3645            } else {
3646                if {$i < $col - 1} {
3647                    lappend coords [expr {$x2 + $linespc}] $y
3648                } elseif {$i > $col + 1} {
3649                    lappend coords [expr {$x2 - $linespc}] $y
3650                }
3651                lappend coords $x2 $y2
3652            }
3653        } else {
3654            lappend coords $x2 $y2
3655        }
3656        set t [$canv create line $coords -width [linewidth $p] \
3657                   -fill $colormap($p) -tags lines.$p]
3658        $canv lower $t
3659        bindline $t $p
3660    }
3661    if {$rmx > [lindex $idpos($id) 1]} {
3662        lset idpos($id) 1 $rmx
3663        redrawtags $id
3664    }
3665}
3666
3667proc drawlines {id} {
3668    global canv
3669
3670    $canv itemconf lines.$id -width [linewidth $id]
3671}
3672
3673proc drawcmittext {id row col} {
3674    global linespc canv canv2 canv3 canvy0 fgcolor curview
3675    global commitlisted commitinfo rowidlist parentlist
3676    global rowtextx idpos idtags idheads idotherrefs
3677    global linehtag linentag linedtag selectedline
3678    global canvxmax boldrows boldnamerows fgcolor nullid nullid2
3679
3680    # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
3681    set listed [lindex $commitlisted $row]
3682    if {$id eq $nullid} {
3683        set ofill red
3684    } elseif {$id eq $nullid2} {
3685        set ofill green
3686    } else {
3687        set ofill [expr {$listed != 0 ? $listed == 2 ? "gray" : "blue" : "white"}]
3688    }
3689    set x [xc $row $col]
3690    set y [yc $row]
3691    set orad [expr {$linespc / 3}]
3692    if {$listed <= 2} {
3693        set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
3694                   [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3695                   -fill $ofill -outline $fgcolor -width 1 -tags circle]
3696    } elseif {$listed == 3} {
3697        # triangle pointing left for left-side commits
3698        set t [$canv create polygon \
3699                   [expr {$x - $orad}] $y \
3700                   [expr {$x + $orad - 1}] [expr {$y - $orad}] \
3701                   [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
3702                   -fill $ofill -outline $fgcolor -width 1 -tags circle]
3703    } else {
3704        # triangle pointing right for right-side commits
3705        set t [$canv create polygon \
3706                   [expr {$x + $orad - 1}] $y \
3707                   [expr {$x - $orad}] [expr {$y - $orad}] \
3708                   [expr {$x - $orad}] [expr {$y + $orad - 1}] \
3709                   -fill $ofill -outline $fgcolor -width 1 -tags circle]
3710    }
3711    $canv raise $t
3712    $canv bind $t <1> {selcanvline {} %x %y}
3713    set rmx [llength [lindex $rowidlist $row]]
3714    set olds [lindex $parentlist $row]
3715    if {$olds ne {}} {
3716        set nextids [lindex $rowidlist [expr {$row + 1}]]
3717        foreach p $olds {
3718            set i [lsearch -exact $nextids $p]
3719            if {$i > $rmx} {
3720                set rmx $i
3721            }
3722        }
3723    }
3724    set xt [xc $row $rmx]
3725    set rowtextx($row) $xt
3726    set idpos($id) [list $x $xt $y]
3727    if {[info exists idtags($id)] || [info exists idheads($id)]
3728        || [info exists idotherrefs($id)]} {
3729        set xt [drawtags $id $x $xt $y]
3730    }
3731    set headline [lindex $commitinfo($id) 0]
3732    set name [lindex $commitinfo($id) 1]
3733    set date [lindex $commitinfo($id) 2]
3734    set date [formatdate $date]
3735    set font mainfont
3736    set nfont mainfont
3737    set isbold [ishighlighted $row]
3738    if {$isbold > 0} {
3739        lappend boldrows $row
3740        set font mainfontbold
3741        if {$isbold > 1} {
3742            lappend boldnamerows $row
3743            set nfont mainfontbold
3744        }
3745    }
3746    set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
3747                            -text $headline -font $font -tags text]
3748    $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
3749    set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
3750                            -text $name -font $nfont -tags text]
3751    set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
3752                            -text $date -font mainfont -tags text]
3753    if {[info exists selectedline] && $selectedline == $row} {
3754        make_secsel $row
3755    }
3756    set xr [expr {$xt + [font measure $font $headline]}]
3757    if {$xr > $canvxmax} {
3758        set canvxmax $xr
3759        setcanvscroll
3760    }
3761}
3762
3763proc drawcmitrow {row} {
3764    global displayorder rowidlist nrows_drawn
3765    global iddrawn markingmatches
3766    global commitinfo parentlist numcommits
3767    global filehighlight fhighlights findpattern nhighlights
3768    global hlview vhighlights
3769    global highlight_related rhighlights
3770
3771    if {$row >= $numcommits} return
3772
3773    set id [lindex $displayorder $row]
3774    if {[info exists hlview] && ![info exists vhighlights($row)]} {
3775        askvhighlight $row $id
3776    }
3777    if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3778        askfilehighlight $row $id
3779    }
3780    if {$findpattern ne {} && ![info exists nhighlights($row)]} {
3781        askfindhighlight $row $id
3782    }
3783    if {$highlight_related ne [mc "None"] && ![info exists rhighlights($row)]} {
3784        askrelhighlight $row $id
3785    }
3786    if {![info exists iddrawn($id)]} {
3787        set col [lsearch -exact [lindex $rowidlist $row] $id]
3788        if {$col < 0} {
3789            puts "oops, row $row id $id not in list"
3790            return
3791        }
3792        if {![info exists commitinfo($id)]} {
3793            getcommit $id
3794        }
3795        assigncolor $id
3796        drawcmittext $id $row $col
3797        set iddrawn($id) 1
3798        incr nrows_drawn
3799    }
3800    if {$markingmatches} {
3801        markrowmatches $row $id
3802    }
3803}
3804
3805proc drawcommits {row {endrow {}}} {
3806    global numcommits iddrawn displayorder curview need_redisplay
3807    global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
3808
3809    if {$row < 0} {
3810        set row 0
3811    }
3812    if {$endrow eq {}} {
3813        set endrow $row
3814    }
3815    if {$endrow >= $numcommits} {
3816        set endrow [expr {$numcommits - 1}]
3817    }
3818
3819    set rl1 [expr {$row - $downarrowlen - 3}]
3820    if {$rl1 < 0} {
3821        set rl1 0
3822    }
3823    set ro1 [expr {$row - 3}]
3824    if {$ro1 < 0} {
3825        set ro1 0
3826    }
3827    set r2 [expr {$endrow + $uparrowlen + 3}]
3828    if {$r2 > $numcommits} {
3829        set r2 $numcommits
3830    }
3831    for {set r $rl1} {$r < $r2} {incr r} {
3832        if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
3833            if {$rl1 < $r} {
3834                layoutrows $rl1 $r
3835            }
3836            set rl1 [expr {$r + 1}]
3837        }
3838    }
3839    if {$rl1 < $r} {
3840        layoutrows $rl1 $r
3841    }
3842    optimize_rows $ro1 0 $r2
3843    if {$need_redisplay || $nrows_drawn > 2000} {
3844        clear_display
3845        drawvisible
3846    }
3847
3848    # make the lines join to already-drawn rows either side
3849    set r [expr {$row - 1}]
3850    if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
3851        set r $row
3852    }
3853    set er [expr {$endrow + 1}]
3854    if {$er >= $numcommits ||
3855        ![info exists iddrawn([lindex $displayorder $er])]} {
3856        set er $endrow
3857    }
3858    for {} {$r <= $er} {incr r} {
3859        set id [lindex $displayorder $r]
3860        set wasdrawn [info exists iddrawn($id)]
3861        drawcmitrow $r
3862        if {$r == $er} break
3863        set nextid [lindex $displayorder [expr {$r + 1}]]
3864        if {$wasdrawn && [info exists iddrawn($nextid)]} continue
3865        drawparentlinks $id $r
3866
3867        set rowids [lindex $rowidlist $r]
3868        foreach lid $rowids {
3869            if {$lid eq {}} continue
3870            if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
3871            if {$lid eq $id} {
3872                # see if this is the first child of any of its parents
3873                foreach p [lindex $parentlist $r] {
3874                    if {[lsearch -exact $rowids $p] < 0} {
3875                        # make this line extend up to the child
3876                        set lineend($p) [drawlineseg $p $r $er 0]
3877                    }
3878                }
3879            } else {
3880                set lineend($lid) [drawlineseg $lid $r $er 1]
3881            }
3882        }
3883    }
3884}
3885
3886proc drawfrac {f0 f1} {
3887    global canv linespc
3888
3889    set ymax [lindex [$canv cget -scrollregion] 3]
3890    if {$ymax eq {} || $ymax == 0} return
3891    set y0 [expr {int($f0 * $ymax)}]
3892    set row [expr {int(($y0 - 3) / $linespc) - 1}]
3893    set y1 [expr {int($f1 * $ymax)}]
3894    set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3895    drawcommits $row $endrow
3896}
3897
3898proc drawvisible {} {
3899    global canv
3900    eval drawfrac [$canv yview]
3901}
3902
3903proc clear_display {} {
3904    global iddrawn linesegs need_redisplay nrows_drawn
3905    global vhighlights fhighlights nhighlights rhighlights
3906
3907    allcanvs delete all
3908    catch {unset iddrawn}
3909    catch {unset linesegs}
3910    catch {unset vhighlights}
3911    catch {unset fhighlights}
3912    catch {unset nhighlights}
3913    catch {unset rhighlights}
3914    set need_redisplay 0
3915    set nrows_drawn 0
3916}
3917
3918proc findcrossings {id} {
3919    global rowidlist parentlist numcommits displayorder
3920
3921    set cross {}
3922    set ccross {}
3923    foreach {s e} [rowranges $id] {
3924        if {$e >= $numcommits} {
3925            set e [expr {$numcommits - 1}]
3926        }
3927        if {$e <= $s} continue
3928        for {set row $e} {[incr row -1] >= $s} {} {
3929            set x [lsearch -exact [lindex $rowidlist $row] $id]
3930            if {$x < 0} break
3931            set olds [lindex $parentlist $row]
3932            set kid [lindex $displayorder $row]
3933            set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3934            if {$kidx < 0} continue
3935            set nextrow [lindex $rowidlist [expr {$row + 1}]]
3936            foreach p $olds {
3937                set px [lsearch -exact $nextrow $p]
3938                if {$px < 0} continue
3939                if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3940                    if {[lsearch -exact $ccross $p] >= 0} continue
3941                    if {$x == $px + ($kidx < $px? -1: 1)} {
3942                        lappend ccross $p
3943                    } elseif {[lsearch -exact $cross $p] < 0} {
3944                        lappend cross $p
3945                    }
3946                }
3947            }
3948        }
3949    }
3950    return [concat $ccross {{}} $cross]
3951}
3952
3953proc assigncolor {id} {
3954    global colormap colors nextcolor
3955    global commitrow parentlist children children curview
3956
3957    if {[info exists colormap($id)]} return
3958    set ncolors [llength $colors]
3959    if {[info exists children($curview,$id)]} {
3960        set kids $children($curview,$id)
3961    } else {
3962        set kids {}
3963    }
3964    if {[llength $kids] == 1} {
3965        set child [lindex $kids 0]
3966        if {[info exists colormap($child)]
3967            && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3968            set colormap($id) $colormap($child)
3969            return
3970        }
3971    }
3972    set badcolors {}
3973    set origbad {}
3974    foreach x [findcrossings $id] {
3975        if {$x eq {}} {
3976            # delimiter between corner crossings and other crossings
3977            if {[llength $badcolors] >= $ncolors - 1} break
3978            set origbad $badcolors
3979        }
3980        if {[info exists colormap($x)]
3981            && [lsearch -exact $badcolors $colormap($x)] < 0} {
3982            lappend badcolors $colormap($x)
3983        }
3984    }
3985    if {[llength $badcolors] >= $ncolors} {
3986        set badcolors $origbad
3987    }
3988    set origbad $badcolors
3989    if {[llength $badcolors] < $ncolors - 1} {
3990        foreach child $kids {
3991            if {[info exists colormap($child)]
3992                && [lsearch -exact $badcolors $colormap($child)] < 0} {
3993                lappend badcolors $colormap($child)
3994            }
3995            foreach p [lindex $parentlist $commitrow($curview,$child)] {
3996                if {[info exists colormap($p)]
3997                    && [lsearch -exact $badcolors $colormap($p)] < 0} {
3998                    lappend badcolors $colormap($p)
3999                }
4000            }
4001        }
4002        if {[llength $badcolors] >= $ncolors} {
4003            set badcolors $origbad
4004        }
4005    }
4006    for {set i 0} {$i <= $ncolors} {incr i} {
4007        set c [lindex $colors $nextcolor]
4008        if {[incr nextcolor] >= $ncolors} {
4009            set nextcolor 0
4010        }
4011        if {[lsearch -exact $badcolors $c]} break
4012    }
4013    set colormap($id) $c
4014}
4015
4016proc bindline {t id} {
4017    global canv
4018
4019    $canv bind $t <Enter> "lineenter %x %y $id"
4020    $canv bind $t <Motion> "linemotion %x %y $id"
4021    $canv bind $t <Leave> "lineleave $id"
4022    $canv bind $t <Button-1> "lineclick %x %y $id 1"
4023}
4024
4025proc drawtags {id x xt y1} {
4026    global idtags idheads idotherrefs mainhead
4027    global linespc lthickness
4028    global canv commitrow rowtextx curview fgcolor bgcolor
4029
4030    set marks {}
4031    set ntags 0
4032    set nheads 0
4033    if {[info exists idtags($id)]} {
4034        set marks $idtags($id)
4035        set ntags [llength $marks]
4036    }
4037    if {[info exists idheads($id)]} {
4038        set marks [concat $marks $idheads($id)]
4039        set nheads [llength $idheads($id)]
4040    }
4041    if {[info exists idotherrefs($id)]} {
4042        set marks [concat $marks $idotherrefs($id)]
4043    }
4044    if {$marks eq {}} {
4045        return $xt
4046    }
4047
4048    set delta [expr {int(0.5 * ($linespc - $lthickness))}]
4049    set yt [expr {$y1 - 0.5 * $linespc}]
4050    set yb [expr {$yt + $linespc - 1}]
4051    set xvals {}
4052    set wvals {}
4053    set i -1
4054    foreach tag $marks {
4055        incr i
4056        if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
4057            set wid [font measure mainfontbold $tag]
4058        } else {
4059            set wid [font measure mainfont $tag]
4060        }
4061        lappend xvals $xt
4062        lappend wvals $wid
4063        set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
4064    }
4065    set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
4066               -width $lthickness -fill black -tags tag.$id]
4067    $canv lower $t
4068    foreach tag $marks x $xvals wid $wvals {
4069        set xl [expr {$x + $delta}]
4070        set xr [expr {$x + $delta + $wid + $lthickness}]
4071        set font mainfont
4072        if {[incr ntags -1] >= 0} {
4073            # draw a tag
4074            set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
4075                       $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
4076                       -width 1 -outline black -fill yellow -tags tag.$id]
4077            $canv bind $t <1> [list showtag $tag 1]
4078            set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
4079        } else {
4080            # draw a head or other ref
4081            if {[incr nheads -1] >= 0} {
4082                set col green
4083                if {$tag eq $mainhead} {
4084                    set font mainfontbold
4085                }
4086            } else {
4087                set col "#ddddff"
4088            }
4089            set xl [expr {$xl - $delta/2}]
4090            $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
4091                -width 1 -outline black -fill $col -tags tag.$id
4092            if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
4093                set rwid [font measure mainfont $remoteprefix]
4094                set xi [expr {$x + 1}]
4095                set yti [expr {$yt + 1}]
4096                set xri [expr {$x + $rwid}]
4097                $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
4098                        -width 0 -fill "#ffddaa" -tags tag.$id
4099            }
4100        }
4101        set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
4102                   -font $font -tags [list tag.$id text]]
4103        if {$ntags >= 0} {
4104            $canv bind $t <1> [list showtag $tag 1]
4105        } elseif {$nheads >= 0} {
4106            $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
4107        }
4108    }
4109    return $xt
4110}
4111
4112proc xcoord {i level ln} {
4113    global canvx0 xspc1 xspc2
4114
4115    set x [expr {$canvx0 + $i * $xspc1($ln)}]
4116    if {$i > 0 && $i == $level} {
4117        set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
4118    } elseif {$i > $level} {
4119        set x [expr {$x + $xspc2 - $xspc1($ln)}]
4120    }
4121    return $x
4122}
4123
4124proc show_status {msg} {
4125    global canv fgcolor
4126
4127    clear_display
4128    $canv create text 3 3 -anchor nw -text $msg -font mainfont \
4129        -tags text -fill $fgcolor
4130}
4131
4132# Insert a new commit as the child of the commit on row $row.
4133# The new commit will be displayed on row $row and the commits
4134# on that row and below will move down one row.
4135proc insertrow {row newcmit} {
4136    global displayorder parentlist commitlisted children
4137    global commitrow curview rowidlist rowisopt rowfinal numcommits
4138    global numcommits
4139    global selectedline commitidx ordertok
4140
4141    if {$row >= $numcommits} {
4142        puts "oops, inserting new row $row but only have $numcommits rows"
4143        return
4144    }
4145    set p [lindex $displayorder $row]
4146    set displayorder [linsert $displayorder $row $newcmit]
4147    set parentlist [linsert $parentlist $row $p]
4148    set kids $children($curview,$p)
4149    lappend kids $newcmit
4150    set children($curview,$p) $kids
4151    set children($curview,$newcmit) {}
4152    set commitlisted [linsert $commitlisted $row 1]
4153    set l [llength $displayorder]
4154    for {set r $row} {$r < $l} {incr r} {
4155        set id [lindex $displayorder $r]
4156        set commitrow($curview,$id) $r
4157    }
4158    incr commitidx($curview)
4159    set ordertok($curview,$newcmit) $ordertok($curview,$p)
4160
4161    if {$row < [llength $rowidlist]} {
4162        set idlist [lindex $rowidlist $row]
4163        if {$idlist ne {}} {
4164            if {[llength $kids] == 1} {
4165                set col [lsearch -exact $idlist $p]
4166                lset idlist $col $newcmit
4167            } else {
4168                set col [llength $idlist]
4169                lappend idlist $newcmit
4170            }
4171        }
4172        set rowidlist [linsert $rowidlist $row $idlist]
4173        set rowisopt [linsert $rowisopt $row 0]
4174        set rowfinal [linsert $rowfinal $row [lindex $rowfinal $row]]
4175    }
4176
4177    incr numcommits
4178
4179    if {[info exists selectedline] && $selectedline >= $row} {
4180        incr selectedline
4181    }
4182    redisplay
4183}
4184
4185# Remove a commit that was inserted with insertrow on row $row.
4186proc removerow {row} {
4187    global displayorder parentlist commitlisted children
4188    global commitrow curview rowidlist rowisopt rowfinal numcommits
4189    global numcommits
4190    global linesegends selectedline commitidx
4191
4192    if {$row >= $numcommits} {
4193        puts "oops, removing row $row but only have $numcommits rows"
4194        return
4195    }
4196    set rp1 [expr {$row + 1}]
4197    set id [lindex $displayorder $row]
4198    set p [lindex $parentlist $row]
4199    set displayorder [lreplace $displayorder $row $row]
4200    set parentlist [lreplace $parentlist $row $row]
4201    set commitlisted [lreplace $commitlisted $row $row]
4202    set kids $children($curview,$p)
4203    set i [lsearch -exact $kids $id]
4204    if {$i >= 0} {
4205        set kids [lreplace $kids $i $i]
4206        set children($curview,$p) $kids
4207    }
4208    set l [llength $displayorder]
4209    for {set r $row} {$r < $l} {incr r} {
4210        set id [lindex $displayorder $r]
4211        set commitrow($curview,$id) $r
4212    }
4213    incr commitidx($curview) -1
4214
4215    if {$row < [llength $rowidlist]} {
4216        set rowidlist [lreplace $rowidlist $row $row]
4217        set rowisopt [lreplace $rowisopt $row $row]
4218        set rowfinal [lreplace $rowfinal $row $row]
4219    }
4220
4221    incr numcommits -1
4222
4223    if {[info exists selectedline] && $selectedline > $row} {
4224        incr selectedline -1
4225    }
4226    redisplay
4227}
4228
4229# Don't change the text pane cursor if it is currently the hand cursor,
4230# showing that we are over a sha1 ID link.
4231proc settextcursor {c} {
4232    global ctext curtextcursor
4233
4234    if {[$ctext cget -cursor] == $curtextcursor} {
4235        $ctext config -cursor $c
4236    }
4237    set curtextcursor $c
4238}
4239
4240proc nowbusy {what {name {}}} {
4241    global isbusy busyname statusw
4242
4243    if {[array names isbusy] eq {}} {
4244        . config -cursor watch
4245        settextcursor watch
4246    }
4247    set isbusy($what) 1
4248    set busyname($what) $name
4249    if {$name ne {}} {
4250        $statusw conf -text $name
4251    }
4252}
4253
4254proc notbusy {what} {
4255    global isbusy maincursor textcursor busyname statusw
4256
4257    catch {
4258        unset isbusy($what)
4259        if {$busyname($what) ne {} &&
4260            [$statusw cget -text] eq $busyname($what)} {
4261            $statusw conf -text {}
4262        }
4263    }
4264    if {[array names isbusy] eq {}} {
4265        . config -cursor $maincursor
4266        settextcursor $textcursor
4267    }
4268}
4269
4270proc findmatches {f} {
4271    global findtype findstring
4272    if {$findtype == [mc "Regexp"]} {
4273        set matches [regexp -indices -all -inline $findstring $f]
4274    } else {
4275        set fs $findstring
4276        if {$findtype == [mc "IgnCase"]} {
4277            set f [string tolower $f]
4278            set fs [string tolower $fs]
4279        }
4280        set matches {}
4281        set i 0
4282        set l [string length $fs]
4283        while {[set j [string first $fs $f $i]] >= 0} {
4284            lappend matches [list $j [expr {$j+$l-1}]]
4285            set i [expr {$j + $l}]
4286        }
4287    }
4288    return $matches
4289}
4290
4291proc dofind {{dirn 1} {wrap 1}} {
4292    global findstring findstartline findcurline selectedline numcommits
4293    global gdttype filehighlight fh_serial find_dirn findallowwrap
4294
4295    if {[info exists find_dirn]} {
4296        if {$find_dirn == $dirn} return
4297        stopfinding
4298    }
4299    focus .
4300    if {$findstring eq {} || $numcommits == 0} return
4301    if {![info exists selectedline]} {
4302        set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
4303    } else {
4304        set findstartline $selectedline
4305    }
4306    set findcurline $findstartline
4307    nowbusy finding [mc "Searching"]
4308    if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
4309        after cancel do_file_hl $fh_serial
4310        do_file_hl $fh_serial
4311    }
4312    set find_dirn $dirn
4313    set findallowwrap $wrap
4314    run findmore
4315}
4316
4317proc stopfinding {} {
4318    global find_dirn findcurline fprogcoord
4319
4320    if {[info exists find_dirn]} {
4321        unset find_dirn
4322        unset findcurline
4323        notbusy finding
4324        set fprogcoord 0
4325        adjustprogress
4326    }
4327}
4328
4329proc findmore {} {
4330    global commitdata commitinfo numcommits findpattern findloc
4331    global findstartline findcurline displayorder
4332    global find_dirn gdttype fhighlights fprogcoord
4333    global findallowwrap
4334
4335    if {![info exists find_dirn]} {
4336        return 0
4337    }
4338    set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
4339    set l $findcurline
4340    set moretodo 0
4341    if {$find_dirn > 0} {
4342        incr l
4343        if {$l >= $numcommits} {
4344            set l 0
4345        }
4346        if {$l <= $findstartline} {
4347            set lim [expr {$findstartline + 1}]
4348        } else {
4349            set lim $numcommits
4350            set moretodo $findallowwrap
4351        }
4352    } else {
4353        if {$l == 0} {
4354            set l $numcommits
4355        }
4356        incr l -1
4357        if {$l >= $findstartline} {
4358            set lim [expr {$findstartline - 1}]
4359        } else {
4360            set lim -1
4361            set moretodo $findallowwrap
4362        }
4363    }
4364    set n [expr {($lim - $l) * $find_dirn}]
4365    if {$n > 500} {
4366        set n 500
4367        set moretodo 1
4368    }
4369    set found 0
4370    set domore 1
4371    if {$gdttype eq [mc "containing:"]} {
4372        for {} {$n > 0} {incr n -1; incr l $find_dirn} {
4373            set id [lindex $displayorder $l]
4374            # shouldn't happen unless git log doesn't give all the commits...
4375            if {![info exists commitdata($id)]} continue
4376            if {![doesmatch $commitdata($id)]} continue
4377            if {![info exists commitinfo($id)]} {
4378                getcommit $id
4379            }
4380            set info $commitinfo($id)
4381            foreach f $info ty $fldtypes {
4382                if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4383                    [doesmatch $f]} {
4384                    set found 1
4385                    break
4386                }
4387            }
4388            if {$found} break
4389        }
4390    } else {
4391        for {} {$n > 0} {incr n -1; incr l $find_dirn} {
4392            set id [lindex $displayorder $l]
4393            if {![info exists fhighlights($l)]} {
4394                askfilehighlight $l $id
4395                if {$domore} {
4396                    set domore 0
4397                    set findcurline [expr {$l - $find_dirn}]
4398                }
4399            } elseif {$fhighlights($l)} {
4400                set found $domore
4401                break
4402            }
4403        }
4404    }
4405    if {$found || ($domore && !$moretodo)} {
4406        unset findcurline
4407        unset find_dirn
4408        notbusy finding
4409        set fprogcoord 0
4410        adjustprogress
4411        if {$found} {
4412            findselectline $l
4413        } else {
4414            bell
4415        }
4416        return 0
4417    }
4418    if {!$domore} {
4419        flushhighlights
4420    } else {
4421        set findcurline [expr {$l - $find_dirn}]
4422    }
4423    set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
4424    if {$n < 0} {
4425        incr n $numcommits
4426    }
4427    set fprogcoord [expr {$n * 1.0 / $numcommits}]
4428    adjustprogress
4429    return $domore
4430}
4431
4432proc findselectline {l} {
4433    global findloc commentend ctext findcurline markingmatches gdttype
4434
4435    set markingmatches 1
4436    set findcurline $l
4437    selectline $l 1
4438    if {$findloc == [mc "All fields"] || $findloc == [mc "Comments"]} {
4439        # highlight the matches in the comments
4440        set f [$ctext get 1.0 $commentend]
4441        set matches [findmatches $f]
4442        foreach match $matches {
4443            set start [lindex $match 0]
4444            set end [expr {[lindex $match 1] + 1}]
4445            $ctext tag add found "1.0 + $start c" "1.0 + $end c"
4446        }
4447    }
4448    drawvisible
4449}
4450
4451# mark the bits of a headline or author that match a find string
4452proc markmatches {canv l str tag matches font row} {
4453    global selectedline
4454
4455    set bbox [$canv bbox $tag]
4456    set x0 [lindex $bbox 0]
4457    set y0 [lindex $bbox 1]
4458    set y1 [lindex $bbox 3]
4459    foreach match $matches {
4460        set start [lindex $match 0]
4461        set end [lindex $match 1]
4462        if {$start > $end} continue
4463        set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
4464        set xlen [font measure $font [string range $str 0 [expr {$end}]]]
4465        set t [$canv create rect [expr {$x0+$xoff}] $y0 \
4466                   [expr {$x0+$xlen+2}] $y1 \
4467                   -outline {} -tags [list match$l matches] -fill yellow]
4468        $canv lower $t
4469        if {[info exists selectedline] && $row == $selectedline} {
4470            $canv raise $t secsel
4471        }
4472    }
4473}
4474
4475proc unmarkmatches {} {
4476    global markingmatches
4477
4478    allcanvs delete matches
4479    set markingmatches 0
4480    stopfinding
4481}
4482
4483proc selcanvline {w x y} {
4484    global canv canvy0 ctext linespc
4485    global rowtextx
4486    set ymax [lindex [$canv cget -scrollregion] 3]
4487    if {$ymax == {}} return
4488    set yfrac [lindex [$canv yview] 0]
4489    set y [expr {$y + $yfrac * $ymax}]
4490    set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
4491    if {$l < 0} {
4492        set l 0
4493    }
4494    if {$w eq $canv} {
4495        if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
4496    }
4497    unmarkmatches
4498    selectline $l 1
4499}
4500
4501proc commit_descriptor {p} {
4502    global commitinfo
4503    if {![info exists commitinfo($p)]} {
4504        getcommit $p
4505    }
4506    set l "..."
4507    if {[llength $commitinfo($p)] > 1} {
4508        set l [lindex $commitinfo($p) 0]
4509    }
4510    return "$p ($l)\n"
4511}
4512
4513# append some text to the ctext widget, and make any SHA1 ID
4514# that we know about be a clickable link.
4515proc appendwithlinks {text tags} {
4516    global ctext commitrow linknum curview pendinglinks
4517
4518    set start [$ctext index "end - 1c"]
4519    $ctext insert end $text $tags
4520    set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
4521    foreach l $links {
4522        set s [lindex $l 0]
4523        set e [lindex $l 1]
4524        set linkid [string range $text $s $e]
4525        incr e
4526        $ctext tag delete link$linknum
4527        $ctext tag add link$linknum "$start + $s c" "$start + $e c"
4528        setlink $linkid link$linknum
4529        incr linknum
4530    }
4531}
4532
4533proc setlink {id lk} {
4534    global curview commitrow ctext pendinglinks commitinterest
4535
4536    if {[info exists commitrow($curview,$id)]} {
4537        $ctext tag conf $lk -foreground blue -underline 1
4538        $ctext tag bind $lk <1> [list selectline $commitrow($curview,$id) 1]
4539        $ctext tag bind $lk <Enter> {linkcursor %W 1}
4540        $ctext tag bind $lk <Leave> {linkcursor %W -1}
4541    } else {
4542        lappend pendinglinks($id) $lk
4543        lappend commitinterest($id) {makelink %I}
4544    }
4545}
4546
4547proc makelink {id} {
4548    global pendinglinks
4549
4550    if {![info exists pendinglinks($id)]} return
4551    foreach lk $pendinglinks($id) {
4552        setlink $id $lk
4553    }
4554    unset pendinglinks($id)
4555}
4556
4557proc linkcursor {w inc} {
4558    global linkentercount curtextcursor
4559
4560    if {[incr linkentercount $inc] > 0} {
4561        $w configure -cursor hand2
4562    } else {
4563        $w configure -cursor $curtextcursor
4564        if {$linkentercount < 0} {
4565            set linkentercount 0
4566        }
4567    }
4568}
4569
4570proc viewnextline {dir} {
4571    global canv linespc
4572
4573    $canv delete hover
4574    set ymax [lindex [$canv cget -scrollregion] 3]
4575    set wnow [$canv yview]
4576    set wtop [expr {[lindex $wnow 0] * $ymax}]
4577    set newtop [expr {$wtop + $dir * $linespc}]
4578    if {$newtop < 0} {
4579        set newtop 0
4580    } elseif {$newtop > $ymax} {
4581        set newtop $ymax
4582    }
4583    allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4584}
4585
4586# add a list of tag or branch names at position pos
4587# returns the number of names inserted
4588proc appendrefs {pos ids var} {
4589    global ctext commitrow linknum curview $var maxrefs
4590
4591    if {[catch {$ctext index $pos}]} {
4592        return 0
4593    }
4594    $ctext conf -state normal
4595    $ctext delete $pos "$pos lineend"
4596    set tags {}
4597    foreach id $ids {
4598        foreach tag [set $var\($id\)] {
4599            lappend tags [list $tag $id]
4600        }
4601    }
4602    if {[llength $tags] > $maxrefs} {
4603        $ctext insert $pos "many ([llength $tags])"
4604    } else {
4605        set tags [lsort -index 0 -decreasing $tags]
4606        set sep {}
4607        foreach ti $tags {
4608            set id [lindex $ti 1]
4609            set lk link$linknum
4610            incr linknum
4611            $ctext tag delete $lk
4612            $ctext insert $pos $sep
4613            $ctext insert $pos [lindex $ti 0] $lk
4614            setlink $id $lk
4615            set sep ", "
4616        }
4617    }
4618    $ctext conf -state disabled
4619    return [llength $tags]
4620}
4621
4622# called when we have finished computing the nearby tags
4623proc dispneartags {delay} {
4624    global selectedline currentid showneartags tagphase
4625
4626    if {![info exists selectedline] || !$showneartags} return
4627    after cancel dispnexttag
4628    if {$delay} {
4629        after 200 dispnexttag
4630        set tagphase -1
4631    } else {
4632        after idle dispnexttag
4633        set tagphase 0
4634    }
4635}
4636
4637proc dispnexttag {} {
4638    global selectedline currentid showneartags tagphase ctext
4639
4640    if {![info exists selectedline] || !$showneartags} return
4641    switch -- $tagphase {
4642        0 {
4643            set dtags [desctags $currentid]
4644            if {$dtags ne {}} {
4645                appendrefs precedes $dtags idtags
4646            }
4647        }
4648        1 {
4649            set atags [anctags $currentid]
4650            if {$atags ne {}} {
4651                appendrefs follows $atags idtags
4652            }
4653        }
4654        2 {
4655            set dheads [descheads $currentid]
4656            if {$dheads ne {}} {
4657                if {[appendrefs branch $dheads idheads] > 1
4658                    && [$ctext get "branch -3c"] eq "h"} {
4659                    # turn "Branch" into "Branches"
4660                    $ctext conf -state normal
4661                    $ctext insert "branch -2c" "es"
4662                    $ctext conf -state disabled
4663                }
4664            }
4665        }
4666    }
4667    if {[incr tagphase] <= 2} {
4668        after idle dispnexttag
4669    }
4670}
4671
4672proc make_secsel {l} {
4673    global linehtag linentag linedtag canv canv2 canv3
4674
4675    if {![info exists linehtag($l)]} return
4676    $canv delete secsel
4677    set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
4678               -tags secsel -fill [$canv cget -selectbackground]]
4679    $canv lower $t
4680    $canv2 delete secsel
4681    set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
4682               -tags secsel -fill [$canv2 cget -selectbackground]]
4683    $canv2 lower $t
4684    $canv3 delete secsel
4685    set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
4686               -tags secsel -fill [$canv3 cget -selectbackground]]
4687    $canv3 lower $t
4688}
4689
4690proc selectline {l isnew} {
4691    global canv ctext commitinfo selectedline
4692    global displayorder
4693    global canvy0 linespc parentlist children curview
4694    global currentid sha1entry
4695    global commentend idtags linknum
4696    global mergemax numcommits pending_select
4697    global cmitmode showneartags allcommits
4698    global autoselect
4699
4700    catch {unset pending_select}
4701    $canv delete hover
4702    normalline
4703    unsel_reflist
4704    stopfinding
4705    if {$l < 0 || $l >= $numcommits} return
4706    set y [expr {$canvy0 + $l * $linespc}]
4707    set ymax [lindex [$canv cget -scrollregion] 3]
4708    set ytop [expr {$y - $linespc - 1}]
4709    set ybot [expr {$y + $linespc + 1}]
4710    set wnow [$canv yview]
4711    set wtop [expr {[lindex $wnow 0] * $ymax}]
4712    set wbot [expr {[lindex $wnow 1] * $ymax}]
4713    set wh [expr {$wbot - $wtop}]
4714    set newtop $wtop
4715    if {$ytop < $wtop} {
4716        if {$ybot < $wtop} {
4717            set newtop [expr {$y - $wh / 2.0}]
4718        } else {
4719            set newtop $ytop
4720            if {$newtop > $wtop - $linespc} {
4721                set newtop [expr {$wtop - $linespc}]
4722            }
4723        }
4724    } elseif {$ybot > $wbot} {
4725        if {$ytop > $wbot} {
4726            set newtop [expr {$y - $wh / 2.0}]
4727        } else {
4728            set newtop [expr {$ybot - $wh}]
4729            if {$newtop < $wtop + $linespc} {
4730                set newtop [expr {$wtop + $linespc}]
4731            }
4732        }
4733    }
4734    if {$newtop != $wtop} {
4735        if {$newtop < 0} {
4736            set newtop 0
4737        }
4738        allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
4739        drawvisible
4740    }
4741
4742    make_secsel $l
4743
4744    if {$isnew} {
4745        addtohistory [list selectline $l 0]
4746    }
4747
4748    set selectedline $l
4749
4750    set id [lindex $displayorder $l]
4751    set currentid $id
4752    $sha1entry delete 0 end
4753    $sha1entry insert 0 $id
4754    if {$autoselect} {
4755        $sha1entry selection from 0
4756        $sha1entry selection to end
4757    }
4758    rhighlight_sel $id
4759
4760    $ctext conf -state normal
4761    clear_ctext
4762    set linknum 0
4763    set info $commitinfo($id)
4764    set date [formatdate [lindex $info 2]]
4765    $ctext insert end "[mc "Author"]: [lindex $info 1]  $date\n"
4766    set date [formatdate [lindex $info 4]]
4767    $ctext insert end "[mc "Committer"]: [lindex $info 3]  $date\n"
4768    if {[info exists idtags($id)]} {
4769        $ctext insert end [mc "Tags:"]
4770        foreach tag $idtags($id) {
4771            $ctext insert end " $tag"
4772        }
4773        $ctext insert end "\n"
4774    }
4775
4776    set headers {}
4777    set olds [lindex $parentlist $l]
4778    if {[llength $olds] > 1} {
4779        set np 0
4780        foreach p $olds {
4781            if {$np >= $mergemax} {
4782                set tag mmax
4783            } else {
4784                set tag m$np
4785            }
4786            $ctext insert end "[mc "Parent"]: " $tag
4787            appendwithlinks [commit_descriptor $p] {}
4788            incr np
4789        }
4790    } else {
4791        foreach p $olds {
4792            append headers "[mc "Parent"]: [commit_descriptor $p]"
4793        }
4794    }
4795
4796    foreach c $children($curview,$id) {
4797        append headers "[mc "Child"]:  [commit_descriptor $c]"
4798    }
4799
4800    # make anything that looks like a SHA1 ID be a clickable link
4801    appendwithlinks $headers {}
4802    if {$showneartags} {
4803        if {![info exists allcommits]} {
4804            getallcommits
4805        }
4806        $ctext insert end "[mc "Branch"]: "
4807        $ctext mark set branch "end -1c"
4808        $ctext mark gravity branch left
4809        $ctext insert end "\n[mc "Follows"]: "
4810        $ctext mark set follows "end -1c"
4811        $ctext mark gravity follows left
4812        $ctext insert end "\n[mc "Precedes"]: "
4813        $ctext mark set precedes "end -1c"
4814        $ctext mark gravity precedes left
4815        $ctext insert end "\n"
4816        dispneartags 1
4817    }
4818    $ctext insert end "\n"
4819    set comment [lindex $info 5]
4820    if {[string first "\r" $comment] >= 0} {
4821        set comment [string map {"\r" "\n    "} $comment]
4822    }
4823    appendwithlinks $comment {comment}
4824
4825    $ctext tag remove found 1.0 end
4826    $ctext conf -state disabled
4827    set commentend [$ctext index "end - 1c"]
4828
4829    init_flist [mc "Comments"]
4830    if {$cmitmode eq "tree"} {
4831        gettree $id
4832    } elseif {[llength $olds] <= 1} {
4833        startdiff $id
4834    } else {
4835        mergediff $id $l
4836    }
4837}
4838
4839proc selfirstline {} {
4840    unmarkmatches
4841    selectline 0 1
4842}
4843
4844proc sellastline {} {
4845    global numcommits
4846    unmarkmatches
4847    set l [expr {$numcommits - 1}]
4848    selectline $l 1
4849}
4850
4851proc selnextline {dir} {
4852    global selectedline
4853    focus .
4854    if {![info exists selectedline]} return
4855    set l [expr {$selectedline + $dir}]
4856    unmarkmatches
4857    selectline $l 1
4858}
4859
4860proc selnextpage {dir} {
4861    global canv linespc selectedline numcommits
4862
4863    set lpp [expr {([winfo height $canv] - 2) / $linespc}]
4864    if {$lpp < 1} {
4865        set lpp 1
4866    }
4867    allcanvs yview scroll [expr {$dir * $lpp}] units
4868    drawvisible
4869    if {![info exists selectedline]} return
4870    set l [expr {$selectedline + $dir * $lpp}]
4871    if {$l < 0} {
4872        set l 0
4873    } elseif {$l >= $numcommits} {
4874        set l [expr $numcommits - 1]
4875    }
4876    unmarkmatches
4877    selectline $l 1
4878}
4879
4880proc unselectline {} {
4881    global selectedline currentid
4882
4883    catch {unset selectedline}
4884    catch {unset currentid}
4885    allcanvs delete secsel
4886    rhighlight_none
4887}
4888
4889proc reselectline {} {
4890    global selectedline
4891
4892    if {[info exists selectedline]} {
4893        selectline $selectedline 0
4894    }
4895}
4896
4897proc addtohistory {cmd} {
4898    global history historyindex curview
4899
4900    set elt [list $curview $cmd]
4901    if {$historyindex > 0
4902        && [lindex $history [expr {$historyindex - 1}]] == $elt} {
4903        return
4904    }
4905
4906    if {$historyindex < [llength $history]} {
4907        set history [lreplace $history $historyindex end $elt]
4908    } else {
4909        lappend history $elt
4910    }
4911    incr historyindex
4912    if {$historyindex > 1} {
4913        .tf.bar.leftbut conf -state normal
4914    } else {
4915        .tf.bar.leftbut conf -state disabled
4916    }
4917    .tf.bar.rightbut conf -state disabled
4918}
4919
4920proc godo {elt} {
4921    global curview
4922
4923    set view [lindex $elt 0]
4924    set cmd [lindex $elt 1]
4925    if {$curview != $view} {
4926        showview $view
4927    }
4928    eval $cmd
4929}
4930
4931proc goback {} {
4932    global history historyindex
4933    focus .
4934
4935    if {$historyindex > 1} {
4936        incr historyindex -1
4937        godo [lindex $history [expr {$historyindex - 1}]]
4938        .tf.bar.rightbut conf -state normal
4939    }
4940    if {$historyindex <= 1} {
4941        .tf.bar.leftbut conf -state disabled
4942    }
4943}
4944
4945proc goforw {} {
4946    global history historyindex
4947    focus .
4948
4949    if {$historyindex < [llength $history]} {
4950        set cmd [lindex $history $historyindex]
4951        incr historyindex
4952        godo $cmd
4953        .tf.bar.leftbut conf -state normal
4954    }
4955    if {$historyindex >= [llength $history]} {
4956        .tf.bar.rightbut conf -state disabled
4957    }
4958}
4959
4960proc gettree {id} {
4961    global treefilelist treeidlist diffids diffmergeid treepending
4962    global nullid nullid2
4963
4964    set diffids $id
4965    catch {unset diffmergeid}
4966    if {![info exists treefilelist($id)]} {
4967        if {![info exists treepending]} {
4968            if {$id eq $nullid} {
4969                set cmd [list | git ls-files]
4970            } elseif {$id eq $nullid2} {
4971                set cmd [list | git ls-files --stage -t]
4972            } else {
4973                set cmd [list | git ls-tree -r $id]
4974            }
4975            if {[catch {set gtf [open $cmd r]}]} {
4976                return
4977            }
4978            set treepending $id
4979            set treefilelist($id) {}
4980            set treeidlist($id) {}
4981            fconfigure $gtf -blocking 0
4982            filerun $gtf [list gettreeline $gtf $id]
4983        }
4984    } else {
4985        setfilelist $id
4986    }
4987}
4988
4989proc gettreeline {gtf id} {
4990    global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
4991
4992    set nl 0
4993    while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
4994        if {$diffids eq $nullid} {
4995            set fname $line
4996        } else {
4997            if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
4998            set i [string first "\t" $line]
4999            if {$i < 0} continue
5000            set sha1 [lindex $line 2]
5001            set fname [string range $line [expr {$i+1}] end]
5002            if {[string index $fname 0] eq "\""} {
5003                set fname [lindex $fname 0]
5004            }
5005            lappend treeidlist($id) $sha1
5006        }
5007        lappend treefilelist($id) $fname
5008    }
5009    if {![eof $gtf]} {
5010        return [expr {$nl >= 1000? 2: 1}]
5011    }
5012    close $gtf
5013    unset treepending
5014    if {$cmitmode ne "tree"} {
5015        if {![info exists diffmergeid]} {
5016            gettreediffs $diffids
5017        }
5018    } elseif {$id ne $diffids} {
5019        gettree $diffids
5020    } else {
5021        setfilelist $id
5022    }
5023    return 0
5024}
5025
5026proc showfile {f} {
5027    global treefilelist treeidlist diffids nullid nullid2
5028    global ctext commentend
5029
5030    set i [lsearch -exact $treefilelist($diffids) $f]
5031    if {$i < 0} {
5032        puts "oops, $f not in list for id $diffids"
5033        return
5034    }
5035    if {$diffids eq $nullid} {
5036        if {[catch {set bf [open $f r]} err]} {
5037            puts "oops, can't read $f: $err"
5038            return
5039        }
5040    } else {
5041        set blob [lindex $treeidlist($diffids) $i]
5042        if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
5043            puts "oops, error reading blob $blob: $err"
5044            return
5045        }
5046    }
5047    fconfigure $bf -blocking 0
5048    filerun $bf [list getblobline $bf $diffids]
5049    $ctext config -state normal
5050    clear_ctext $commentend
5051    $ctext insert end "\n"
5052    $ctext insert end "$f\n" filesep
5053    $ctext config -state disabled
5054    $ctext yview $commentend
5055    settabs 0
5056}
5057
5058proc getblobline {bf id} {
5059    global diffids cmitmode ctext
5060
5061    if {$id ne $diffids || $cmitmode ne "tree"} {
5062        catch {close $bf}
5063        return 0
5064    }
5065    $ctext config -state normal
5066    set nl 0
5067    while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
5068        $ctext insert end "$line\n"
5069    }
5070    if {[eof $bf]} {
5071        # delete last newline
5072        $ctext delete "end - 2c" "end - 1c"
5073        close $bf
5074        return 0
5075    }
5076    $ctext config -state disabled
5077    return [expr {$nl >= 1000? 2: 1}]
5078}
5079
5080proc mergediff {id l} {
5081    global diffmergeid mdifffd
5082    global diffids
5083    global diffcontext
5084    global parentlist
5085    global limitdiffs viewfiles curview
5086
5087    set diffmergeid $id
5088    set diffids $id
5089    # this doesn't seem to actually affect anything...
5090    set cmd [concat | git diff-tree --no-commit-id --cc -U$diffcontext $id]
5091    if {$limitdiffs && $viewfiles($curview) ne {}} {
5092        set cmd [concat $cmd -- $viewfiles($curview)]
5093    }
5094    if {[catch {set mdf [open $cmd r]} err]} {
5095        error_popup "[mc "Error getting merge diffs:"] $err"
5096        return
5097    }
5098    fconfigure $mdf -blocking 0
5099    set mdifffd($id) $mdf
5100    set np [llength [lindex $parentlist $l]]
5101    settabs $np
5102    filerun $mdf [list getmergediffline $mdf $id $np]
5103}
5104
5105proc getmergediffline {mdf id np} {
5106    global diffmergeid ctext cflist mergemax
5107    global difffilestart mdifffd
5108
5109    $ctext conf -state normal
5110    set nr 0
5111    while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
5112        if {![info exists diffmergeid] || $id != $diffmergeid
5113            || $mdf != $mdifffd($id)} {
5114            close $mdf
5115            return 0
5116        }
5117        if {[regexp {^diff --cc (.*)} $line match fname]} {
5118            # start of a new file
5119            $ctext insert end "\n"
5120            set here [$ctext index "end - 1c"]
5121            lappend difffilestart $here
5122            add_flist [list $fname]
5123            set l [expr {(78 - [string length $fname]) / 2}]
5124            set pad [string range "----------------------------------------" 1 $l]
5125            $ctext insert end "$pad $fname $pad\n" filesep
5126        } elseif {[regexp {^@@} $line]} {
5127            $ctext insert end "$line\n" hunksep
5128        } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
5129            # do nothing
5130        } else {
5131            # parse the prefix - one ' ', '-' or '+' for each parent
5132            set spaces {}
5133            set minuses {}
5134            set pluses {}
5135            set isbad 0
5136            for {set j 0} {$j < $np} {incr j} {
5137                set c [string range $line $j $j]
5138                if {$c == " "} {
5139                    lappend spaces $j
5140                } elseif {$c == "-"} {
5141                    lappend minuses $j
5142                } elseif {$c == "+"} {
5143                    lappend pluses $j
5144                } else {
5145                    set isbad 1
5146                    break
5147                }
5148            }
5149            set tags {}
5150            set num {}
5151            if {!$isbad && $minuses ne {} && $pluses eq {}} {
5152                # line doesn't appear in result, parents in $minuses have the line
5153                set num [lindex $minuses 0]
5154            } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
5155                # line appears in result, parents in $pluses don't have the line
5156                lappend tags mresult
5157                set num [lindex $spaces 0]
5158            }
5159            if {$num ne {}} {
5160                if {$num >= $mergemax} {
5161                    set num "max"
5162                }
5163                lappend tags m$num
5164            }
5165            $ctext insert end "$line\n" $tags
5166        }
5167    }
5168    $ctext conf -state disabled
5169    if {[eof $mdf]} {
5170        close $mdf
5171        return 0
5172    }
5173    return [expr {$nr >= 1000? 2: 1}]
5174}
5175
5176proc startdiff {ids} {
5177    global treediffs diffids treepending diffmergeid nullid nullid2
5178
5179    settabs 1
5180    set diffids $ids
5181    catch {unset diffmergeid}
5182    if {![info exists treediffs($ids)] ||
5183        [lsearch -exact $ids $nullid] >= 0 ||
5184        [lsearch -exact $ids $nullid2] >= 0} {
5185        if {![info exists treepending]} {
5186            gettreediffs $ids
5187        }
5188    } else {
5189        addtocflist $ids
5190    }
5191}
5192
5193proc path_filter {filter name} {
5194    foreach p $filter {
5195        set l [string length $p]
5196        if {[string index $p end] eq "/"} {
5197            if {[string compare -length $l $p $name] == 0} {
5198                return 1
5199            }
5200        } else {
5201            if {[string compare -length $l $p $name] == 0 &&
5202                ([string length $name] == $l ||
5203                 [string index $name $l] eq "/")} {
5204                return 1
5205            }
5206        }
5207    }
5208    return 0
5209}
5210
5211proc addtocflist {ids} {
5212    global treediffs
5213
5214    add_flist $treediffs($ids)
5215    getblobdiffs $ids
5216}
5217
5218proc diffcmd {ids flags} {
5219    global nullid nullid2
5220
5221    set i [lsearch -exact $ids $nullid]
5222    set j [lsearch -exact $ids $nullid2]
5223    if {$i >= 0} {
5224        if {[llength $ids] > 1 && $j < 0} {
5225            # comparing working directory with some specific revision
5226            set cmd [concat | git diff-index $flags]
5227            if {$i == 0} {
5228                lappend cmd -R [lindex $ids 1]
5229            } else {
5230                lappend cmd [lindex $ids 0]
5231            }
5232        } else {
5233            # comparing working directory with index
5234            set cmd [concat | git diff-files $flags]
5235            if {$j == 1} {
5236                lappend cmd -R
5237            }
5238        }
5239    } elseif {$j >= 0} {
5240        set cmd [concat | git diff-index --cached $flags]
5241        if {[llength $ids] > 1} {
5242            # comparing index with specific revision
5243            if {$i == 0} {
5244                lappend cmd -R [lindex $ids 1]
5245            } else {
5246                lappend cmd [lindex $ids 0]
5247            }
5248        } else {
5249            # comparing index with HEAD
5250            lappend cmd HEAD
5251        }
5252    } else {
5253        set cmd [concat | git diff-tree -r $flags $ids]
5254    }
5255    return $cmd
5256}
5257
5258proc gettreediffs {ids} {
5259    global treediff treepending
5260
5261    set treepending $ids
5262    set treediff {}
5263    if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
5264    fconfigure $gdtf -blocking 0
5265    filerun $gdtf [list gettreediffline $gdtf $ids]
5266}
5267
5268proc gettreediffline {gdtf ids} {
5269    global treediff treediffs treepending diffids diffmergeid
5270    global cmitmode viewfiles curview limitdiffs
5271
5272    set nr 0
5273    while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
5274        set i [string first "\t" $line]
5275        if {$i >= 0} {
5276            set file [string range $line [expr {$i+1}] end]
5277            if {[string index $file 0] eq "\""} {
5278                set file [lindex $file 0]
5279            }
5280            lappend treediff $file
5281        }
5282    }
5283    if {![eof $gdtf]} {
5284        return [expr {$nr >= 1000? 2: 1}]
5285    }
5286    close $gdtf
5287    if {$limitdiffs && $viewfiles($curview) ne {}} {
5288        set flist {}
5289        foreach f $treediff {
5290            if {[path_filter $viewfiles($curview) $f]} {
5291                lappend flist $f
5292            }
5293        }
5294        set treediffs($ids) $flist
5295    } else {
5296        set treediffs($ids) $treediff
5297    }
5298    unset treepending
5299    if {$cmitmode eq "tree"} {
5300        gettree $diffids
5301    } elseif {$ids != $diffids} {
5302        if {![info exists diffmergeid]} {
5303            gettreediffs $diffids
5304        }
5305    } else {
5306        addtocflist $ids
5307    }
5308    return 0
5309}
5310
5311# empty string or positive integer
5312proc diffcontextvalidate {v} {
5313    return [regexp {^(|[1-9][0-9]*)$} $v]
5314}
5315
5316proc diffcontextchange {n1 n2 op} {
5317    global diffcontextstring diffcontext
5318
5319    if {[string is integer -strict $diffcontextstring]} {
5320        if {$diffcontextstring > 0} {
5321            set diffcontext $diffcontextstring
5322            reselectline
5323        }
5324    }
5325}
5326
5327proc changeignorespace {} {
5328    reselectline
5329}
5330
5331proc getblobdiffs {ids} {
5332    global blobdifffd diffids env
5333    global diffinhdr treediffs
5334    global diffcontext
5335    global ignorespace
5336    global limitdiffs viewfiles curview
5337
5338    set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
5339    if {$ignorespace} {
5340        append cmd " -w"
5341    }
5342    if {$limitdiffs && $viewfiles($curview) ne {}} {
5343        set cmd [concat $cmd -- $viewfiles($curview)]
5344    }
5345    if {[catch {set bdf [open $cmd r]} err]} {
5346        puts "error getting diffs: $err"
5347        return
5348    }
5349    set diffinhdr 0
5350    fconfigure $bdf -blocking 0
5351    set blobdifffd($ids) $bdf
5352    filerun $bdf [list getblobdiffline $bdf $diffids]
5353}
5354
5355proc setinlist {var i val} {
5356    global $var
5357
5358    while {[llength [set $var]] < $i} {
5359        lappend $var {}
5360    }
5361    if {[llength [set $var]] == $i} {
5362        lappend $var $val
5363    } else {
5364        lset $var $i $val
5365    }
5366}
5367
5368proc makediffhdr {fname ids} {
5369    global ctext curdiffstart treediffs
5370
5371    set i [lsearch -exact $treediffs($ids) $fname]
5372    if {$i >= 0} {
5373        setinlist difffilestart $i $curdiffstart
5374    }
5375    set l [expr {(78 - [string length $fname]) / 2}]
5376    set pad [string range "----------------------------------------" 1 $l]
5377    $ctext insert $curdiffstart "$pad $fname $pad" filesep
5378}
5379
5380proc getblobdiffline {bdf ids} {
5381    global diffids blobdifffd ctext curdiffstart
5382    global diffnexthead diffnextnote difffilestart
5383    global diffinhdr treediffs
5384
5385    set nr 0
5386    $ctext conf -state normal
5387    while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
5388        if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
5389            close $bdf
5390            return 0
5391        }
5392        if {![string compare -length 11 "diff --git " $line]} {
5393            # trim off "diff --git "
5394            set line [string range $line 11 end]
5395            set diffinhdr 1
5396            # start of a new file
5397            $ctext insert end "\n"
5398            set curdiffstart [$ctext index "end - 1c"]
5399            $ctext insert end "\n" filesep
5400            # If the name hasn't changed the length will be odd,
5401            # the middle char will be a space, and the two bits either
5402            # side will be a/name and b/name, or "a/name" and "b/name".
5403            # If the name has changed we'll get "rename from" and
5404            # "rename to" or "copy from" and "copy to" lines following this,
5405            # and we'll use them to get the filenames.
5406            # This complexity is necessary because spaces in the filename(s)
5407            # don't get escaped.
5408            set l [string length $line]
5409            set i [expr {$l / 2}]
5410            if {!(($l & 1) && [string index $line $i] eq " " &&
5411                  [string range $line 2 [expr {$i - 1}]] eq \
5412                      [string range $line [expr {$i + 3}] end])} {
5413                continue
5414            }
5415            # unescape if quoted and chop off the a/ from the front
5416            if {[string index $line 0] eq "\""} {
5417                set fname [string range [lindex $line 0] 2 end]
5418            } else {
5419                set fname [string range $line 2 [expr {$i - 1}]]
5420            }
5421            makediffhdr $fname $ids
5422
5423        } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
5424                       $line match f1l f1c f2l f2c rest]} {
5425            $ctext insert end "$line\n" hunksep
5426            set diffinhdr 0
5427
5428        } elseif {$diffinhdr} {
5429            if {![string compare -length 12 "rename from " $line]} {
5430                set fname [string range $line [expr 6 + [string first " from " $line] ] end]
5431                if {[string index $fname 0] eq "\""} {
5432                    set fname [lindex $fname 0]
5433                }
5434                set i [lsearch -exact $treediffs($ids) $fname]
5435                if {$i >= 0} {
5436                    setinlist difffilestart $i $curdiffstart
5437                }
5438            } elseif {![string compare -length 10 $line "rename to "] ||
5439                      ![string compare -length 8 $line "copy to "]} {
5440                set fname [string range $line [expr 4 + [string first " to " $line] ] end]
5441                if {[string index $fname 0] eq "\""} {
5442                    set fname [lindex $fname 0]
5443                }
5444                makediffhdr $fname $ids
5445            } elseif {[string compare -length 3 $line "---"] == 0} {
5446                # do nothing
5447                continue
5448            } elseif {[string compare -length 3 $line "+++"] == 0} {
5449                set diffinhdr 0
5450                continue
5451            }
5452            $ctext insert end "$line\n" filesep
5453
5454        } else {
5455            set x [string range $line 0 0]
5456            if {$x == "-" || $x == "+"} {
5457                set tag [expr {$x == "+"}]
5458                $ctext insert end "$line\n" d$tag
5459            } elseif {$x == " "} {
5460                $ctext insert end "$line\n"
5461            } else {
5462                # "\ No newline at end of file",
5463                # or something else we don't recognize
5464                $ctext insert end "$line\n" hunksep
5465            }
5466        }
5467    }
5468    $ctext conf -state disabled
5469    if {[eof $bdf]} {
5470        close $bdf
5471        return 0
5472    }
5473    return [expr {$nr >= 1000? 2: 1}]
5474}
5475
5476proc changediffdisp {} {
5477    global ctext diffelide
5478
5479    $ctext tag conf d0 -elide [lindex $diffelide 0]
5480    $ctext tag conf d1 -elide [lindex $diffelide 1]
5481}
5482
5483proc prevfile {} {
5484    global difffilestart ctext
5485    set prev [lindex $difffilestart 0]
5486    set here [$ctext index @0,0]
5487    foreach loc $difffilestart {
5488        if {[$ctext compare $loc >= $here]} {
5489            $ctext yview $prev
5490            return
5491        }
5492        set prev $loc
5493    }
5494    $ctext yview $prev
5495}
5496
5497proc nextfile {} {
5498    global difffilestart ctext
5499    set here [$ctext index @0,0]
5500    foreach loc $difffilestart {
5501        if {[$ctext compare $loc > $here]} {
5502            $ctext yview $loc
5503            return
5504        }
5505    }
5506}
5507
5508proc clear_ctext {{first 1.0}} {
5509    global ctext smarktop smarkbot
5510    global pendinglinks
5511
5512    set l [lindex [split $first .] 0]
5513    if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
5514        set smarktop $l
5515    }
5516    if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
5517        set smarkbot $l
5518    }
5519    $ctext delete $first end
5520    if {$first eq "1.0"} {
5521        catch {unset pendinglinks}
5522    }
5523}
5524
5525proc settabs {{firstab {}}} {
5526    global firsttabstop tabstop ctext have_tk85
5527
5528    if {$firstab ne {} && $have_tk85} {
5529        set firsttabstop $firstab
5530    }
5531    set w [font measure textfont "0"]
5532    if {$firsttabstop != 0} {
5533        $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
5534                               [expr {($firsttabstop + 2 * $tabstop) * $w}]]
5535    } elseif {$have_tk85 || $tabstop != 8} {
5536        $ctext conf -tabs [expr {$tabstop * $w}]
5537    } else {
5538        $ctext conf -tabs {}
5539    }
5540}
5541
5542proc incrsearch {name ix op} {
5543    global ctext searchstring searchdirn
5544
5545    $ctext tag remove found 1.0 end
5546    if {[catch {$ctext index anchor}]} {
5547        # no anchor set, use start of selection, or of visible area
5548        set sel [$ctext tag ranges sel]
5549        if {$sel ne {}} {
5550            $ctext mark set anchor [lindex $sel 0]
5551        } elseif {$searchdirn eq "-forwards"} {
5552            $ctext mark set anchor @0,0
5553        } else {
5554            $ctext mark set anchor @0,[winfo height $ctext]
5555        }
5556    }
5557    if {$searchstring ne {}} {
5558        set here [$ctext search $searchdirn -- $searchstring anchor]
5559        if {$here ne {}} {
5560            $ctext see $here
5561        }
5562        searchmarkvisible 1
5563    }
5564}
5565
5566proc dosearch {} {
5567    global sstring ctext searchstring searchdirn
5568
5569    focus $sstring
5570    $sstring icursor end
5571    set searchdirn -forwards
5572    if {$searchstring ne {}} {
5573        set sel [$ctext tag ranges sel]
5574        if {$sel ne {}} {
5575            set start "[lindex $sel 0] + 1c"
5576        } elseif {[catch {set start [$ctext index anchor]}]} {
5577            set start "@0,0"
5578        }
5579        set match [$ctext search -count mlen -- $searchstring $start]
5580        $ctext tag remove sel 1.0 end
5581        if {$match eq {}} {
5582            bell
5583            return
5584        }
5585        $ctext see $match
5586        set mend "$match + $mlen c"
5587        $ctext tag add sel $match $mend
5588        $ctext mark unset anchor
5589    }
5590}
5591
5592proc dosearchback {} {
5593    global sstring ctext searchstring searchdirn
5594
5595    focus $sstring
5596    $sstring icursor end
5597    set searchdirn -backwards
5598    if {$searchstring ne {}} {
5599        set sel [$ctext tag ranges sel]
5600        if {$sel ne {}} {
5601            set start [lindex $sel 0]
5602        } elseif {[catch {set start [$ctext index anchor]}]} {
5603            set start @0,[winfo height $ctext]
5604        }
5605        set match [$ctext search -backwards -count ml -- $searchstring $start]
5606        $ctext tag remove sel 1.0 end
5607        if {$match eq {}} {
5608            bell
5609            return
5610        }
5611        $ctext see $match
5612        set mend "$match + $ml c"
5613        $ctext tag add sel $match $mend
5614        $ctext mark unset anchor
5615    }
5616}
5617
5618proc searchmark {first last} {
5619    global ctext searchstring
5620
5621    set mend $first.0
5622    while {1} {
5623        set match [$ctext search -count mlen -- $searchstring $mend $last.end]
5624        if {$match eq {}} break
5625        set mend "$match + $mlen c"
5626        $ctext tag add found $match $mend
5627    }
5628}
5629
5630proc searchmarkvisible {doall} {
5631    global ctext smarktop smarkbot
5632
5633    set topline [lindex [split [$ctext index @0,0] .] 0]
5634    set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
5635    if {$doall || $botline < $smarktop || $topline > $smarkbot} {
5636        # no overlap with previous
5637        searchmark $topline $botline
5638        set smarktop $topline
5639        set smarkbot $botline
5640    } else {
5641        if {$topline < $smarktop} {
5642            searchmark $topline [expr {$smarktop-1}]
5643            set smarktop $topline
5644        }
5645        if {$botline > $smarkbot} {
5646            searchmark [expr {$smarkbot+1}] $botline
5647            set smarkbot $botline
5648        }
5649    }
5650}
5651
5652proc scrolltext {f0 f1} {
5653    global searchstring
5654
5655    .bleft.bottom.sb set $f0 $f1
5656    if {$searchstring ne {}} {
5657        searchmarkvisible 0
5658    }
5659}
5660
5661proc setcoords {} {
5662    global linespc charspc canvx0 canvy0
5663    global xspc1 xspc2 lthickness
5664
5665    set linespc [font metrics mainfont -linespace]
5666    set charspc [font measure mainfont "m"]
5667    set canvy0 [expr {int(3 + 0.5 * $linespc)}]
5668    set canvx0 [expr {int(3 + 0.5 * $linespc)}]
5669    set lthickness [expr {int($linespc / 9) + 1}]
5670    set xspc1(0) $linespc
5671    set xspc2 $linespc
5672}
5673
5674proc redisplay {} {
5675    global canv
5676    global selectedline
5677
5678    set ymax [lindex [$canv cget -scrollregion] 3]
5679    if {$ymax eq {} || $ymax == 0} return
5680    set span [$canv yview]
5681    clear_display
5682    setcanvscroll
5683    allcanvs yview moveto [lindex $span 0]
5684    drawvisible
5685    if {[info exists selectedline]} {
5686        selectline $selectedline 0
5687        allcanvs yview moveto [lindex $span 0]
5688    }
5689}
5690
5691proc parsefont {f n} {
5692    global fontattr
5693
5694    set fontattr($f,family) [lindex $n 0]
5695    set s [lindex $n 1]
5696    if {$s eq {} || $s == 0} {
5697        set s 10
5698    } elseif {$s < 0} {
5699        set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
5700    }
5701    set fontattr($f,size) $s
5702    set fontattr($f,weight) normal
5703    set fontattr($f,slant) roman
5704    foreach style [lrange $n 2 end] {
5705        switch -- $style {
5706            "normal" -
5707            "bold"   {set fontattr($f,weight) $style}
5708            "roman" -
5709            "italic" {set fontattr($f,slant) $style}
5710        }
5711    }
5712}
5713
5714proc fontflags {f {isbold 0}} {
5715    global fontattr
5716
5717    return [list -family $fontattr($f,family) -size $fontattr($f,size) \
5718                -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
5719                -slant $fontattr($f,slant)]
5720}
5721
5722proc fontname {f} {
5723    global fontattr
5724
5725    set n [list $fontattr($f,family) $fontattr($f,size)]
5726    if {$fontattr($f,weight) eq "bold"} {
5727        lappend n "bold"
5728    }
5729    if {$fontattr($f,slant) eq "italic"} {
5730        lappend n "italic"
5731    }
5732    return $n
5733}
5734
5735proc incrfont {inc} {
5736    global mainfont textfont ctext canv phase cflist showrefstop
5737    global stopped entries fontattr
5738
5739    unmarkmatches
5740    set s $fontattr(mainfont,size)
5741    incr s $inc
5742    if {$s < 1} {
5743        set s 1
5744    }
5745    set fontattr(mainfont,size) $s
5746    font config mainfont -size $s
5747    font config mainfontbold -size $s
5748    set mainfont [fontname mainfont]
5749    set s $fontattr(textfont,size)
5750    incr s $inc
5751    if {$s < 1} {
5752        set s 1
5753    }
5754    set fontattr(textfont,size) $s
5755    font config textfont -size $s
5756    font config textfontbold -size $s
5757    set textfont [fontname textfont]
5758    setcoords
5759    settabs
5760    redisplay
5761}
5762
5763proc clearsha1 {} {
5764    global sha1entry sha1string
5765    if {[string length $sha1string] == 40} {
5766        $sha1entry delete 0 end
5767    }
5768}
5769
5770proc sha1change {n1 n2 op} {
5771    global sha1string currentid sha1but
5772    if {$sha1string == {}
5773        || ([info exists currentid] && $sha1string == $currentid)} {
5774        set state disabled
5775    } else {
5776        set state normal
5777    }
5778    if {[$sha1but cget -state] == $state} return
5779    if {$state == "normal"} {
5780        $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
5781    } else {
5782        $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
5783    }
5784}
5785
5786proc gotocommit {} {
5787    global sha1string currentid commitrow tagids headids
5788    global displayorder numcommits curview
5789
5790    if {$sha1string == {}
5791        || ([info exists currentid] && $sha1string == $currentid)} return
5792    if {[info exists tagids($sha1string)]} {
5793        set id $tagids($sha1string)
5794    } elseif {[info exists headids($sha1string)]} {
5795        set id $headids($sha1string)
5796    } else {
5797        set id [string tolower $sha1string]
5798        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
5799            set matches {}
5800            foreach i $displayorder {
5801                if {[string match $id* $i]} {
5802                    lappend matches $i
5803                }
5804            }
5805            if {$matches ne {}} {
5806                if {[llength $matches] > 1} {
5807                    error_popup [mc "Short SHA1 id %s is ambiguous" $id]
5808                    return
5809                }
5810                set id [lindex $matches 0]
5811            }
5812        }
5813    }
5814    if {[info exists commitrow($curview,$id)]} {
5815        selectline $commitrow($curview,$id) 1
5816        return
5817    }
5818    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
5819        set msg [mc "SHA1 id %s is not known" $sha1string]
5820    } else {
5821        set msg [mc "Tag/Head %s is not known" $sha1string]
5822    }
5823    error_popup $msg
5824}
5825
5826proc lineenter {x y id} {
5827    global hoverx hovery hoverid hovertimer
5828    global commitinfo canv
5829
5830    if {![info exists commitinfo($id)] && ![getcommit $id]} return
5831    set hoverx $x
5832    set hovery $y
5833    set hoverid $id
5834    if {[info exists hovertimer]} {
5835        after cancel $hovertimer
5836    }
5837    set hovertimer [after 500 linehover]
5838    $canv delete hover
5839}
5840
5841proc linemotion {x y id} {
5842    global hoverx hovery hoverid hovertimer
5843
5844    if {[info exists hoverid] && $id == $hoverid} {
5845        set hoverx $x
5846        set hovery $y
5847        if {[info exists hovertimer]} {
5848            after cancel $hovertimer
5849        }
5850        set hovertimer [after 500 linehover]
5851    }
5852}
5853
5854proc lineleave {id} {
5855    global hoverid hovertimer canv
5856
5857    if {[info exists hoverid] && $id == $hoverid} {
5858        $canv delete hover
5859        if {[info exists hovertimer]} {
5860            after cancel $hovertimer
5861            unset hovertimer
5862        }
5863        unset hoverid
5864    }
5865}
5866
5867proc linehover {} {
5868    global hoverx hovery hoverid hovertimer
5869    global canv linespc lthickness
5870    global commitinfo
5871
5872    set text [lindex $commitinfo($hoverid) 0]
5873    set ymax [lindex [$canv cget -scrollregion] 3]
5874    if {$ymax == {}} return
5875    set yfrac [lindex [$canv yview] 0]
5876    set x [expr {$hoverx + 2 * $linespc}]
5877    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
5878    set x0 [expr {$x - 2 * $lthickness}]
5879    set y0 [expr {$y - 2 * $lthickness}]
5880    set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
5881    set y1 [expr {$y + $linespc + 2 * $lthickness}]
5882    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
5883               -fill \#ffff80 -outline black -width 1 -tags hover]
5884    $canv raise $t
5885    set t [$canv create text $x $y -anchor nw -text $text -tags hover \
5886               -font mainfont]
5887    $canv raise $t
5888}
5889
5890proc clickisonarrow {id y} {
5891    global lthickness
5892
5893    set ranges [rowranges $id]
5894    set thresh [expr {2 * $lthickness + 6}]
5895    set n [expr {[llength $ranges] - 1}]
5896    for {set i 1} {$i < $n} {incr i} {
5897        set row [lindex $ranges $i]
5898        if {abs([yc $row] - $y) < $thresh} {
5899            return $i
5900        }
5901    }
5902    return {}
5903}
5904
5905proc arrowjump {id n y} {
5906    global canv
5907
5908    # 1 <-> 2, 3 <-> 4, etc...
5909    set n [expr {(($n - 1) ^ 1) + 1}]
5910    set row [lindex [rowranges $id] $n]
5911    set yt [yc $row]
5912    set ymax [lindex [$canv cget -scrollregion] 3]
5913    if {$ymax eq {} || $ymax <= 0} return
5914    set view [$canv yview]
5915    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
5916    set yfrac [expr {$yt / $ymax - $yspan / 2}]
5917    if {$yfrac < 0} {
5918        set yfrac 0
5919    }
5920    allcanvs yview moveto $yfrac
5921}
5922
5923proc lineclick {x y id isnew} {
5924    global ctext commitinfo children canv thickerline curview commitrow
5925
5926    if {![info exists commitinfo($id)] && ![getcommit $id]} return
5927    unmarkmatches
5928    unselectline
5929    normalline
5930    $canv delete hover
5931    # draw this line thicker than normal
5932    set thickerline $id
5933    drawlines $id
5934    if {$isnew} {
5935        set ymax [lindex [$canv cget -scrollregion] 3]
5936        if {$ymax eq {}} return
5937        set yfrac [lindex [$canv yview] 0]
5938        set y [expr {$y + $yfrac * $ymax}]
5939    }
5940    set dirn [clickisonarrow $id $y]
5941    if {$dirn ne {}} {
5942        arrowjump $id $dirn $y
5943        return
5944    }
5945
5946    if {$isnew} {
5947        addtohistory [list lineclick $x $y $id 0]
5948    }
5949    # fill the details pane with info about this line
5950    $ctext conf -state normal
5951    clear_ctext
5952    settabs 0
5953    $ctext insert end "[mc "Parent"]:\t"
5954    $ctext insert end $id link0
5955    setlink $id link0
5956    set info $commitinfo($id)
5957    $ctext insert end "\n\t[lindex $info 0]\n"
5958    $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
5959    set date [formatdate [lindex $info 2]]
5960    $ctext insert end "\t[mc "Date"]:\t$date\n"
5961    set kids $children($curview,$id)
5962    if {$kids ne {}} {
5963        $ctext insert end "\n[mc "Children"]:"
5964        set i 0
5965        foreach child $kids {
5966            incr i
5967            if {![info exists commitinfo($child)] && ![getcommit $child]} continue
5968            set info $commitinfo($child)
5969            $ctext insert end "\n\t"
5970            $ctext insert end $child link$i
5971            setlink $child link$i
5972            $ctext insert end "\n\t[lindex $info 0]"
5973            $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
5974            set date [formatdate [lindex $info 2]]
5975            $ctext insert end "\n\t[mc "Date"]:\t$date\n"
5976        }
5977    }
5978    $ctext conf -state disabled
5979    init_flist {}
5980}
5981
5982proc normalline {} {
5983    global thickerline
5984    if {[info exists thickerline]} {
5985        set id $thickerline
5986        unset thickerline
5987        drawlines $id
5988    }
5989}
5990
5991proc selbyid {id} {
5992    global commitrow curview
5993    if {[info exists commitrow($curview,$id)]} {
5994        selectline $commitrow($curview,$id) 1
5995    }
5996}
5997
5998proc mstime {} {
5999    global startmstime
6000    if {![info exists startmstime]} {
6001        set startmstime [clock clicks -milliseconds]
6002    }
6003    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
6004}
6005
6006proc rowmenu {x y id} {
6007    global rowctxmenu commitrow selectedline rowmenuid curview
6008    global nullid nullid2 fakerowmenu mainhead
6009
6010    stopfinding
6011    set rowmenuid $id
6012    if {![info exists selectedline]
6013        || $commitrow($curview,$id) eq $selectedline} {
6014        set state disabled
6015    } else {
6016        set state normal
6017    }
6018    if {$id ne $nullid && $id ne $nullid2} {
6019        set menu $rowctxmenu
6020        $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
6021    } else {
6022        set menu $fakerowmenu
6023    }
6024    $menu entryconfigure [mc "Diff this -> selected"] -state $state
6025    $menu entryconfigure [mc "Diff selected -> this"] -state $state
6026    $menu entryconfigure [mc "Make patch"] -state $state
6027    tk_popup $menu $x $y
6028}
6029
6030proc diffvssel {dirn} {
6031    global rowmenuid selectedline displayorder
6032
6033    if {![info exists selectedline]} return
6034    if {$dirn} {
6035        set oldid [lindex $displayorder $selectedline]
6036        set newid $rowmenuid
6037    } else {
6038        set oldid $rowmenuid
6039        set newid [lindex $displayorder $selectedline]
6040    }
6041    addtohistory [list doseldiff $oldid $newid]
6042    doseldiff $oldid $newid
6043}
6044
6045proc doseldiff {oldid newid} {
6046    global ctext
6047    global commitinfo
6048
6049    $ctext conf -state normal
6050    clear_ctext
6051    init_flist [mc "Top"]
6052    $ctext insert end "[mc "From"] "
6053    $ctext insert end $oldid link0
6054    setlink $oldid link0
6055    $ctext insert end "\n     "
6056    $ctext insert end [lindex $commitinfo($oldid) 0]
6057    $ctext insert end "\n\n[mc "To"]   "
6058    $ctext insert end $newid link1
6059    setlink $newid link1
6060    $ctext insert end "\n     "
6061    $ctext insert end [lindex $commitinfo($newid) 0]
6062    $ctext insert end "\n"
6063    $ctext conf -state disabled
6064    $ctext tag remove found 1.0 end
6065    startdiff [list $oldid $newid]
6066}
6067
6068proc mkpatch {} {
6069    global rowmenuid currentid commitinfo patchtop patchnum
6070
6071    if {![info exists currentid]} return
6072    set oldid $currentid
6073    set oldhead [lindex $commitinfo($oldid) 0]
6074    set newid $rowmenuid
6075    set newhead [lindex $commitinfo($newid) 0]
6076    set top .patch
6077    set patchtop $top
6078    catch {destroy $top}
6079    toplevel $top
6080    label $top.title -text [mc "Generate patch"]
6081    grid $top.title - -pady 10
6082    label $top.from -text [mc "From:"]
6083    entry $top.fromsha1 -width 40 -relief flat
6084    $top.fromsha1 insert 0 $oldid
6085    $top.fromsha1 conf -state readonly
6086    grid $top.from $top.fromsha1 -sticky w
6087    entry $top.fromhead -width 60 -relief flat
6088    $top.fromhead insert 0 $oldhead
6089    $top.fromhead conf -state readonly
6090    grid x $top.fromhead -sticky w
6091    label $top.to -text [mc "To:"]
6092    entry $top.tosha1 -width 40 -relief flat
6093    $top.tosha1 insert 0 $newid
6094    $top.tosha1 conf -state readonly
6095    grid $top.to $top.tosha1 -sticky w
6096    entry $top.tohead -width 60 -relief flat
6097    $top.tohead insert 0 $newhead
6098    $top.tohead conf -state readonly
6099    grid x $top.tohead -sticky w
6100    button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
6101    grid $top.rev x -pady 10
6102    label $top.flab -text [mc "Output file:"]
6103    entry $top.fname -width 60
6104    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
6105    incr patchnum
6106    grid $top.flab $top.fname -sticky w
6107    frame $top.buts
6108    button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
6109    button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
6110    grid $top.buts.gen $top.buts.can
6111    grid columnconfigure $top.buts 0 -weight 1 -uniform a
6112    grid columnconfigure $top.buts 1 -weight 1 -uniform a
6113    grid $top.buts - -pady 10 -sticky ew
6114    focus $top.fname
6115}
6116
6117proc mkpatchrev {} {
6118    global patchtop
6119
6120    set oldid [$patchtop.fromsha1 get]
6121    set oldhead [$patchtop.fromhead get]
6122    set newid [$patchtop.tosha1 get]
6123    set newhead [$patchtop.tohead get]
6124    foreach e [list fromsha1 fromhead tosha1 tohead] \
6125            v [list $newid $newhead $oldid $oldhead] {
6126        $patchtop.$e conf -state normal
6127        $patchtop.$e delete 0 end
6128        $patchtop.$e insert 0 $v
6129        $patchtop.$e conf -state readonly
6130    }
6131}
6132
6133proc mkpatchgo {} {
6134    global patchtop nullid nullid2
6135
6136    set oldid [$patchtop.fromsha1 get]
6137    set newid [$patchtop.tosha1 get]
6138    set fname [$patchtop.fname get]
6139    set cmd [diffcmd [list $oldid $newid] -p]
6140    # trim off the initial "|"
6141    set cmd [lrange $cmd 1 end]
6142    lappend cmd >$fname &
6143    if {[catch {eval exec $cmd} err]} {
6144        error_popup "[mc "Error creating patch:"] $err"
6145    }
6146    catch {destroy $patchtop}
6147    unset patchtop
6148}
6149
6150proc mkpatchcan {} {
6151    global patchtop
6152
6153    catch {destroy $patchtop}
6154    unset patchtop
6155}
6156
6157proc mktag {} {
6158    global rowmenuid mktagtop commitinfo
6159
6160    set top .maketag
6161    set mktagtop $top
6162    catch {destroy $top}
6163    toplevel $top
6164    label $top.title -text [mc "Create tag"]
6165    grid $top.title - -pady 10
6166    label $top.id -text [mc "ID:"]
6167    entry $top.sha1 -width 40 -relief flat
6168    $top.sha1 insert 0 $rowmenuid
6169    $top.sha1 conf -state readonly
6170    grid $top.id $top.sha1 -sticky w
6171    entry $top.head -width 60 -relief flat
6172    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6173    $top.head conf -state readonly
6174    grid x $top.head -sticky w
6175    label $top.tlab -text [mc "Tag name:"]
6176    entry $top.tag -width 60
6177    grid $top.tlab $top.tag -sticky w
6178    frame $top.buts
6179    button $top.buts.gen -text [mc "Create"] -command mktaggo
6180    button $top.buts.can -text [mc "Cancel"] -command mktagcan
6181    grid $top.buts.gen $top.buts.can
6182    grid columnconfigure $top.buts 0 -weight 1 -uniform a
6183    grid columnconfigure $top.buts 1 -weight 1 -uniform a
6184    grid $top.buts - -pady 10 -sticky ew
6185    focus $top.tag
6186}
6187
6188proc domktag {} {
6189    global mktagtop env tagids idtags
6190
6191    set id [$mktagtop.sha1 get]
6192    set tag [$mktagtop.tag get]
6193    if {$tag == {}} {
6194        error_popup [mc "No tag name specified"]
6195        return
6196    }
6197    if {[info exists tagids($tag)]} {
6198        error_popup [mc "Tag \"%s\" already exists" $tag]
6199        return
6200    }
6201    if {[catch {
6202        exec git tag $tag $id
6203    } err]} {
6204        error_popup "[mc "Error creating tag:"] $err"
6205        return
6206    }
6207
6208    set tagids($tag) $id
6209    lappend idtags($id) $tag
6210    redrawtags $id
6211    addedtag $id
6212    dispneartags 0
6213    run refill_reflist
6214}
6215
6216proc redrawtags {id} {
6217    global canv linehtag commitrow idpos selectedline curview
6218    global canvxmax iddrawn
6219
6220    if {![info exists commitrow($curview,$id)]} return
6221    if {![info exists iddrawn($id)]} return
6222    drawcommits $commitrow($curview,$id)
6223    $canv delete tag.$id
6224    set xt [eval drawtags $id $idpos($id)]
6225    $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
6226    set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
6227    set xr [expr {$xt + [font measure mainfont $text]}]
6228    if {$xr > $canvxmax} {
6229        set canvxmax $xr
6230        setcanvscroll
6231    }
6232    if {[info exists selectedline]
6233        && $selectedline == $commitrow($curview,$id)} {
6234        selectline $selectedline 0
6235    }
6236}
6237
6238proc mktagcan {} {
6239    global mktagtop
6240
6241    catch {destroy $mktagtop}
6242    unset mktagtop
6243}
6244
6245proc mktaggo {} {
6246    domktag
6247    mktagcan
6248}
6249
6250proc writecommit {} {
6251    global rowmenuid wrcomtop commitinfo wrcomcmd
6252
6253    set top .writecommit
6254    set wrcomtop $top
6255    catch {destroy $top}
6256    toplevel $top
6257    label $top.title -text [mc "Write commit to file"]
6258    grid $top.title - -pady 10
6259    label $top.id -text [mc "ID:"]
6260    entry $top.sha1 -width 40 -relief flat
6261    $top.sha1 insert 0 $rowmenuid
6262    $top.sha1 conf -state readonly
6263    grid $top.id $top.sha1 -sticky w
6264    entry $top.head -width 60 -relief flat
6265    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6266    $top.head conf -state readonly
6267    grid x $top.head -sticky w
6268    label $top.clab -text [mc "Command:"]
6269    entry $top.cmd -width 60 -textvariable wrcomcmd
6270    grid $top.clab $top.cmd -sticky w -pady 10
6271    label $top.flab -text [mc "Output file:"]
6272    entry $top.fname -width 60
6273    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
6274    grid $top.flab $top.fname -sticky w
6275    frame $top.buts
6276    button $top.buts.gen -text [mc "Write"] -command wrcomgo
6277    button $top.buts.can -text [mc "Cancel"] -command wrcomcan
6278    grid $top.buts.gen $top.buts.can
6279    grid columnconfigure $top.buts 0 -weight 1 -uniform a
6280    grid columnconfigure $top.buts 1 -weight 1 -uniform a
6281    grid $top.buts - -pady 10 -sticky ew
6282    focus $top.fname
6283}
6284
6285proc wrcomgo {} {
6286    global wrcomtop
6287
6288    set id [$wrcomtop.sha1 get]
6289    set cmd "echo $id | [$wrcomtop.cmd get]"
6290    set fname [$wrcomtop.fname get]
6291    if {[catch {exec sh -c $cmd >$fname &} err]} {
6292        error_popup "[mc "Error writing commit:"] $err"
6293    }
6294    catch {destroy $wrcomtop}
6295    unset wrcomtop
6296}
6297
6298proc wrcomcan {} {
6299    global wrcomtop
6300
6301    catch {destroy $wrcomtop}
6302    unset wrcomtop
6303}
6304
6305proc mkbranch {} {
6306    global rowmenuid mkbrtop
6307
6308    set top .makebranch
6309    catch {destroy $top}
6310    toplevel $top
6311    label $top.title -text [mc "Create new branch"]
6312    grid $top.title - -pady 10
6313    label $top.id -text [mc "ID:"]
6314    entry $top.sha1 -width 40 -relief flat
6315    $top.sha1 insert 0 $rowmenuid
6316    $top.sha1 conf -state readonly
6317    grid $top.id $top.sha1 -sticky w
6318    label $top.nlab -text [mc "Name:"]
6319    entry $top.name -width 40
6320    grid $top.nlab $top.name -sticky w
6321    frame $top.buts
6322    button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
6323    button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
6324    grid $top.buts.go $top.buts.can
6325    grid columnconfigure $top.buts 0 -weight 1 -uniform a
6326    grid columnconfigure $top.buts 1 -weight 1 -uniform a
6327    grid $top.buts - -pady 10 -sticky ew
6328    focus $top.name
6329}
6330
6331proc mkbrgo {top} {
6332    global headids idheads
6333
6334    set name [$top.name get]
6335    set id [$top.sha1 get]
6336    if {$name eq {}} {
6337        error_popup [mc "Please specify a name for the new branch"]
6338        return
6339    }
6340    catch {destroy $top}
6341    nowbusy newbranch
6342    update
6343    if {[catch {
6344        exec git branch $name $id
6345    } err]} {
6346        notbusy newbranch
6347        error_popup $err
6348    } else {
6349        set headids($name) $id
6350        lappend idheads($id) $name
6351        addedhead $id $name
6352        notbusy newbranch
6353        redrawtags $id
6354        dispneartags 0
6355        run refill_reflist
6356    }
6357}
6358
6359proc cherrypick {} {
6360    global rowmenuid curview commitrow
6361    global mainhead
6362
6363    set oldhead [exec git rev-parse HEAD]
6364    set dheads [descheads $rowmenuid]
6365    if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
6366        set ok [confirm_popup [mc "Commit %s is already\
6367                included in branch %s -- really re-apply it?" \
6368                                   [string range $rowmenuid 0 7] $mainhead]]
6369        if {!$ok} return
6370    }
6371    nowbusy cherrypick [mc "Cherry-picking"]
6372    update
6373    # Unfortunately git-cherry-pick writes stuff to stderr even when
6374    # no error occurs, and exec takes that as an indication of error...
6375    if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
6376        notbusy cherrypick
6377        error_popup $err
6378        return
6379    }
6380    set newhead [exec git rev-parse HEAD]
6381    if {$newhead eq $oldhead} {
6382        notbusy cherrypick
6383        error_popup [mc "No changes committed"]
6384        return
6385    }
6386    addnewchild $newhead $oldhead
6387    if {[info exists commitrow($curview,$oldhead)]} {
6388        insertrow $commitrow($curview,$oldhead) $newhead
6389        if {$mainhead ne {}} {
6390            movehead $newhead $mainhead
6391            movedhead $newhead $mainhead
6392        }
6393        redrawtags $oldhead
6394        redrawtags $newhead
6395    }
6396    notbusy cherrypick
6397}
6398
6399proc resethead {} {
6400    global mainheadid mainhead rowmenuid confirm_ok resettype
6401
6402    set confirm_ok 0
6403    set w ".confirmreset"
6404    toplevel $w
6405    wm transient $w .
6406    wm title $w [mc "Confirm reset"]
6407    message $w.m -text \
6408        [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
6409        -justify center -aspect 1000
6410    pack $w.m -side top -fill x -padx 20 -pady 20
6411    frame $w.f -relief sunken -border 2
6412    message $w.f.rt -text [mc "Reset type:"] -aspect 1000
6413    grid $w.f.rt -sticky w
6414    set resettype mixed
6415    radiobutton $w.f.soft -value soft -variable resettype -justify left \
6416        -text [mc "Soft: Leave working tree and index untouched"]
6417    grid $w.f.soft -sticky w
6418    radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
6419        -text [mc "Mixed: Leave working tree untouched, reset index"]
6420    grid $w.f.mixed -sticky w
6421    radiobutton $w.f.hard -value hard -variable resettype -justify left \
6422        -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
6423    grid $w.f.hard -sticky w
6424    pack $w.f -side top -fill x
6425    button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
6426    pack $w.ok -side left -fill x -padx 20 -pady 20
6427    button $w.cancel -text [mc Cancel] -command "destroy $w"
6428    pack $w.cancel -side right -fill x -padx 20 -pady 20
6429    bind $w <Visibility> "grab $w; focus $w"
6430    tkwait window $w
6431    if {!$confirm_ok} return
6432    if {[catch {set fd [open \
6433            [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
6434        error_popup $err
6435    } else {
6436        dohidelocalchanges
6437        filerun $fd [list readresetstat $fd]
6438        nowbusy reset [mc "Resetting"]
6439    }
6440}
6441
6442proc readresetstat {fd} {
6443    global mainhead mainheadid showlocalchanges rprogcoord
6444
6445    if {[gets $fd line] >= 0} {
6446        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
6447            set rprogcoord [expr {1.0 * $m / $n}]
6448            adjustprogress
6449        }
6450        return 1
6451    }
6452    set rprogcoord 0
6453    adjustprogress
6454    notbusy reset
6455    if {[catch {close $fd} err]} {
6456        error_popup $err
6457    }
6458    set oldhead $mainheadid
6459    set newhead [exec git rev-parse HEAD]
6460    if {$newhead ne $oldhead} {
6461        movehead $newhead $mainhead
6462        movedhead $newhead $mainhead
6463        set mainheadid $newhead
6464        redrawtags $oldhead
6465        redrawtags $newhead
6466    }
6467    if {$showlocalchanges} {
6468        doshowlocalchanges
6469    }
6470    return 0
6471}
6472
6473# context menu for a head
6474proc headmenu {x y id head} {
6475    global headmenuid headmenuhead headctxmenu mainhead
6476
6477    stopfinding
6478    set headmenuid $id
6479    set headmenuhead $head
6480    set state normal
6481    if {$head eq $mainhead} {
6482        set state disabled
6483    }
6484    $headctxmenu entryconfigure 0 -state $state
6485    $headctxmenu entryconfigure 1 -state $state
6486    tk_popup $headctxmenu $x $y
6487}
6488
6489proc cobranch {} {
6490    global headmenuid headmenuhead mainhead headids
6491    global showlocalchanges mainheadid
6492
6493    # check the tree is clean first??
6494    set oldmainhead $mainhead
6495    nowbusy checkout [mc "Checking out"]
6496    update
6497    dohidelocalchanges
6498    if {[catch {
6499        exec git checkout -q $headmenuhead
6500    } err]} {
6501        notbusy checkout
6502        error_popup $err
6503    } else {
6504        notbusy checkout
6505        set mainhead $headmenuhead
6506        set mainheadid $headmenuid
6507        if {[info exists headids($oldmainhead)]} {
6508            redrawtags $headids($oldmainhead)
6509        }
6510        redrawtags $headmenuid
6511    }
6512    if {$showlocalchanges} {
6513        dodiffindex
6514    }
6515}
6516
6517proc rmbranch {} {
6518    global headmenuid headmenuhead mainhead
6519    global idheads
6520
6521    set head $headmenuhead
6522    set id $headmenuid
6523    # this check shouldn't be needed any more...
6524    if {$head eq $mainhead} {
6525        error_popup [mc "Cannot delete the currently checked-out branch"]
6526        return
6527    }
6528    set dheads [descheads $id]
6529    if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
6530        # the stuff on this branch isn't on any other branch
6531        if {![confirm_popup [mc "The commits on branch %s aren't on any other\
6532                        branch.\nReally delete branch %s?" $head $head]]} return
6533    }
6534    nowbusy rmbranch
6535    update
6536    if {[catch {exec git branch -D $head} err]} {
6537        notbusy rmbranch
6538        error_popup $err
6539        return
6540    }
6541    removehead $id $head
6542    removedhead $id $head
6543    redrawtags $id
6544    notbusy rmbranch
6545    dispneartags 0
6546    run refill_reflist
6547}
6548
6549# Display a list of tags and heads
6550proc showrefs {} {
6551    global showrefstop bgcolor fgcolor selectbgcolor
6552    global bglist fglist reflistfilter reflist maincursor
6553
6554    set top .showrefs
6555    set showrefstop $top
6556    if {[winfo exists $top]} {
6557        raise $top
6558        refill_reflist
6559        return
6560    }
6561    toplevel $top
6562    wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
6563    text $top.list -background $bgcolor -foreground $fgcolor \
6564        -selectbackground $selectbgcolor -font mainfont \
6565        -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
6566        -width 30 -height 20 -cursor $maincursor \
6567        -spacing1 1 -spacing3 1 -state disabled
6568    $top.list tag configure highlight -background $selectbgcolor
6569    lappend bglist $top.list
6570    lappend fglist $top.list
6571    scrollbar $top.ysb -command "$top.list yview" -orient vertical
6572    scrollbar $top.xsb -command "$top.list xview" -orient horizontal
6573    grid $top.list $top.ysb -sticky nsew
6574    grid $top.xsb x -sticky ew
6575    frame $top.f
6576    label $top.f.l -text "[mc "Filter"]: "
6577    entry $top.f.e -width 20 -textvariable reflistfilter
6578    set reflistfilter "*"
6579    trace add variable reflistfilter write reflistfilter_change
6580    pack $top.f.e -side right -fill x -expand 1
6581    pack $top.f.l -side left
6582    grid $top.f - -sticky ew -pady 2
6583    button $top.close -command [list destroy $top] -text [mc "Close"]
6584    grid $top.close -
6585    grid columnconfigure $top 0 -weight 1
6586    grid rowconfigure $top 0 -weight 1
6587    bind $top.list <1> {break}
6588    bind $top.list <B1-Motion> {break}
6589    bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
6590    set reflist {}
6591    refill_reflist
6592}
6593
6594proc sel_reflist {w x y} {
6595    global showrefstop reflist headids tagids otherrefids
6596
6597    if {![winfo exists $showrefstop]} return
6598    set l [lindex [split [$w index "@$x,$y"] "."] 0]
6599    set ref [lindex $reflist [expr {$l-1}]]
6600    set n [lindex $ref 0]
6601    switch -- [lindex $ref 1] {
6602        "H" {selbyid $headids($n)}
6603        "T" {selbyid $tagids($n)}
6604        "o" {selbyid $otherrefids($n)}
6605    }
6606    $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
6607}
6608
6609proc unsel_reflist {} {
6610    global showrefstop
6611
6612    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6613    $showrefstop.list tag remove highlight 0.0 end
6614}
6615
6616proc reflistfilter_change {n1 n2 op} {
6617    global reflistfilter
6618
6619    after cancel refill_reflist
6620    after 200 refill_reflist
6621}
6622
6623proc refill_reflist {} {
6624    global reflist reflistfilter showrefstop headids tagids otherrefids
6625    global commitrow curview commitinterest
6626
6627    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
6628    set refs {}
6629    foreach n [array names headids] {
6630        if {[string match $reflistfilter $n]} {
6631            if {[info exists commitrow($curview,$headids($n))]} {
6632                lappend refs [list $n H]
6633            } else {
6634                set commitinterest($headids($n)) {run refill_reflist}
6635            }
6636        }
6637    }
6638    foreach n [array names tagids] {
6639        if {[string match $reflistfilter $n]} {
6640            if {[info exists commitrow($curview,$tagids($n))]} {
6641                lappend refs [list $n T]
6642            } else {
6643                set commitinterest($tagids($n)) {run refill_reflist}
6644            }
6645        }
6646    }
6647    foreach n [array names otherrefids] {
6648        if {[string match $reflistfilter $n]} {
6649            if {[info exists commitrow($curview,$otherrefids($n))]} {
6650                lappend refs [list $n o]
6651            } else {
6652                set commitinterest($otherrefids($n)) {run refill_reflist}
6653            }
6654        }
6655    }
6656    set refs [lsort -index 0 $refs]
6657    if {$refs eq $reflist} return
6658
6659    # Update the contents of $showrefstop.list according to the
6660    # differences between $reflist (old) and $refs (new)
6661    $showrefstop.list conf -state normal
6662    $showrefstop.list insert end "\n"
6663    set i 0
6664    set j 0
6665    while {$i < [llength $reflist] || $j < [llength $refs]} {
6666        if {$i < [llength $reflist]} {
6667            if {$j < [llength $refs]} {
6668                set cmp [string compare [lindex $reflist $i 0] \
6669                             [lindex $refs $j 0]]
6670                if {$cmp == 0} {
6671                    set cmp [string compare [lindex $reflist $i 1] \
6672                                 [lindex $refs $j 1]]
6673                }
6674            } else {
6675                set cmp -1
6676            }
6677        } else {
6678            set cmp 1
6679        }
6680        switch -- $cmp {
6681            -1 {
6682                $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
6683                incr i
6684            }
6685            0 {
6686                incr i
6687                incr j
6688            }
6689            1 {
6690                set l [expr {$j + 1}]
6691                $showrefstop.list image create $l.0 -align baseline \
6692                    -image reficon-[lindex $refs $j 1] -padx 2
6693                $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
6694                incr j
6695            }
6696        }
6697    }
6698    set reflist $refs
6699    # delete last newline
6700    $showrefstop.list delete end-2c end-1c
6701    $showrefstop.list conf -state disabled
6702}
6703
6704# Stuff for finding nearby tags
6705proc getallcommits {} {
6706    global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
6707    global idheads idtags idotherrefs allparents tagobjid
6708
6709    if {![info exists allcommits]} {
6710        set nextarc 0
6711        set allcommits 0
6712        set seeds {}
6713        set allcwait 0
6714        set cachedarcs 0
6715        set allccache [file join [gitdir] "gitk.cache"]
6716        if {![catch {
6717            set f [open $allccache r]
6718            set allcwait 1
6719            getcache $f
6720        }]} return
6721    }
6722
6723    if {$allcwait} {
6724        return
6725    }
6726    set cmd [list | git rev-list --parents]
6727    set allcupdate [expr {$seeds ne {}}]
6728    if {!$allcupdate} {
6729        set ids "--all"
6730    } else {
6731        set refs [concat [array names idheads] [array names idtags] \
6732                      [array names idotherrefs]]
6733        set ids {}
6734        set tagobjs {}
6735        foreach name [array names tagobjid] {
6736            lappend tagobjs $tagobjid($name)
6737        }
6738        foreach id [lsort -unique $refs] {
6739            if {![info exists allparents($id)] &&
6740                [lsearch -exact $tagobjs $id] < 0} {
6741                lappend ids $id
6742            }
6743        }
6744        if {$ids ne {}} {
6745            foreach id $seeds {
6746                lappend ids "^$id"
6747            }
6748        }
6749    }
6750    if {$ids ne {}} {
6751        set fd [open [concat $cmd $ids] r]
6752        fconfigure $fd -blocking 0
6753        incr allcommits
6754        nowbusy allcommits
6755        filerun $fd [list getallclines $fd]
6756    } else {
6757        dispneartags 0
6758    }
6759}
6760
6761# Since most commits have 1 parent and 1 child, we group strings of
6762# such commits into "arcs" joining branch/merge points (BMPs), which
6763# are commits that either don't have 1 parent or don't have 1 child.
6764#
6765# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
6766# arcout(id) - outgoing arcs for BMP
6767# arcids(a) - list of IDs on arc including end but not start
6768# arcstart(a) - BMP ID at start of arc
6769# arcend(a) - BMP ID at end of arc
6770# growing(a) - arc a is still growing
6771# arctags(a) - IDs out of arcids (excluding end) that have tags
6772# archeads(a) - IDs out of arcids (excluding end) that have heads
6773# The start of an arc is at the descendent end, so "incoming" means
6774# coming from descendents, and "outgoing" means going towards ancestors.
6775
6776proc getallclines {fd} {
6777    global allparents allchildren idtags idheads nextarc
6778    global arcnos arcids arctags arcout arcend arcstart archeads growing
6779    global seeds allcommits cachedarcs allcupdate
6780    
6781    set nid 0
6782    while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
6783        set id [lindex $line 0]
6784        if {[info exists allparents($id)]} {
6785            # seen it already
6786            continue
6787        }
6788        set cachedarcs 0
6789        set olds [lrange $line 1 end]
6790        set allparents($id) $olds
6791        if {![info exists allchildren($id)]} {
6792            set allchildren($id) {}
6793            set arcnos($id) {}
6794            lappend seeds $id
6795        } else {
6796            set a $arcnos($id)
6797            if {[llength $olds] == 1 && [llength $a] == 1} {
6798                lappend arcids($a) $id
6799                if {[info exists idtags($id)]} {
6800                    lappend arctags($a) $id
6801                }
6802                if {[info exists idheads($id)]} {
6803                    lappend archeads($a) $id
6804                }
6805                if {[info exists allparents($olds)]} {
6806                    # seen parent already
6807                    if {![info exists arcout($olds)]} {
6808                        splitarc $olds
6809                    }
6810                    lappend arcids($a) $olds
6811                    set arcend($a) $olds
6812                    unset growing($a)
6813                }
6814                lappend allchildren($olds) $id
6815                lappend arcnos($olds) $a
6816                continue
6817            }
6818        }
6819        foreach a $arcnos($id) {
6820            lappend arcids($a) $id
6821            set arcend($a) $id
6822            unset growing($a)
6823        }
6824
6825        set ao {}
6826        foreach p $olds {
6827            lappend allchildren($p) $id
6828            set a [incr nextarc]
6829            set arcstart($a) $id
6830            set archeads($a) {}
6831            set arctags($a) {}
6832            set archeads($a) {}
6833            set arcids($a) {}
6834            lappend ao $a
6835            set growing($a) 1
6836            if {[info exists allparents($p)]} {
6837                # seen it already, may need to make a new branch
6838                if {![info exists arcout($p)]} {
6839                    splitarc $p
6840                }
6841                lappend arcids($a) $p
6842                set arcend($a) $p
6843                unset growing($a)
6844            }
6845            lappend arcnos($p) $a
6846        }
6847        set arcout($id) $ao
6848    }
6849    if {$nid > 0} {
6850        global cached_dheads cached_dtags cached_atags
6851        catch {unset cached_dheads}
6852        catch {unset cached_dtags}
6853        catch {unset cached_atags}
6854    }
6855    if {![eof $fd]} {
6856        return [expr {$nid >= 1000? 2: 1}]
6857    }
6858    set cacheok 1
6859    if {[catch {
6860        fconfigure $fd -blocking 1
6861        close $fd
6862    } err]} {
6863        # got an error reading the list of commits
6864        # if we were updating, try rereading the whole thing again
6865        if {$allcupdate} {
6866            incr allcommits -1
6867            dropcache $err
6868            return
6869        }
6870        error_popup "[mc "Error reading commit topology information;\
6871                branch and preceding/following tag information\
6872                will be incomplete."]\n($err)"
6873        set cacheok 0
6874    }
6875    if {[incr allcommits -1] == 0} {
6876        notbusy allcommits
6877        if {$cacheok} {
6878            run savecache
6879        }
6880    }
6881    dispneartags 0
6882    return 0
6883}
6884
6885proc recalcarc {a} {
6886    global arctags archeads arcids idtags idheads
6887
6888    set at {}
6889    set ah {}
6890    foreach id [lrange $arcids($a) 0 end-1] {
6891        if {[info exists idtags($id)]} {
6892            lappend at $id
6893        }
6894        if {[info exists idheads($id)]} {
6895            lappend ah $id
6896        }
6897    }
6898    set arctags($a) $at
6899    set archeads($a) $ah
6900}
6901
6902proc splitarc {p} {
6903    global arcnos arcids nextarc arctags archeads idtags idheads
6904    global arcstart arcend arcout allparents growing
6905
6906    set a $arcnos($p)
6907    if {[llength $a] != 1} {
6908        puts "oops splitarc called but [llength $a] arcs already"
6909        return
6910    }
6911    set a [lindex $a 0]
6912    set i [lsearch -exact $arcids($a) $p]
6913    if {$i < 0} {
6914        puts "oops splitarc $p not in arc $a"
6915        return
6916    }
6917    set na [incr nextarc]
6918    if {[info exists arcend($a)]} {
6919        set arcend($na) $arcend($a)
6920    } else {
6921        set l [lindex $allparents([lindex $arcids($a) end]) 0]
6922        set j [lsearch -exact $arcnos($l) $a]
6923        set arcnos($l) [lreplace $arcnos($l) $j $j $na]
6924    }
6925    set tail [lrange $arcids($a) [expr {$i+1}] end]
6926    set arcids($a) [lrange $arcids($a) 0 $i]
6927    set arcend($a) $p
6928    set arcstart($na) $p
6929    set arcout($p) $na
6930    set arcids($na) $tail
6931    if {[info exists growing($a)]} {
6932        set growing($na) 1
6933        unset growing($a)
6934    }
6935
6936    foreach id $tail {
6937        if {[llength $arcnos($id)] == 1} {
6938            set arcnos($id) $na
6939        } else {
6940            set j [lsearch -exact $arcnos($id) $a]
6941            set arcnos($id) [lreplace $arcnos($id) $j $j $na]
6942        }
6943    }
6944
6945    # reconstruct tags and heads lists
6946    if {$arctags($a) ne {} || $archeads($a) ne {}} {
6947        recalcarc $a
6948        recalcarc $na
6949    } else {
6950        set arctags($na) {}
6951        set archeads($na) {}
6952    }
6953}
6954
6955# Update things for a new commit added that is a child of one
6956# existing commit.  Used when cherry-picking.
6957proc addnewchild {id p} {
6958    global allparents allchildren idtags nextarc
6959    global arcnos arcids arctags arcout arcend arcstart archeads growing
6960    global seeds allcommits
6961
6962    if {![info exists allcommits] || ![info exists arcnos($p)]} return
6963    set allparents($id) [list $p]
6964    set allchildren($id) {}
6965    set arcnos($id) {}
6966    lappend seeds $id
6967    lappend allchildren($p) $id
6968    set a [incr nextarc]
6969    set arcstart($a) $id
6970    set archeads($a) {}
6971    set arctags($a) {}
6972    set arcids($a) [list $p]
6973    set arcend($a) $p
6974    if {![info exists arcout($p)]} {
6975        splitarc $p
6976    }
6977    lappend arcnos($p) $a
6978    set arcout($id) [list $a]
6979}
6980
6981# This implements a cache for the topology information.
6982# The cache saves, for each arc, the start and end of the arc,
6983# the ids on the arc, and the outgoing arcs from the end.
6984proc readcache {f} {
6985    global arcnos arcids arcout arcstart arcend arctags archeads nextarc
6986    global idtags idheads allparents cachedarcs possible_seeds seeds growing
6987    global allcwait
6988
6989    set a $nextarc
6990    set lim $cachedarcs
6991    if {$lim - $a > 500} {
6992        set lim [expr {$a + 500}]
6993    }
6994    if {[catch {
6995        if {$a == $lim} {
6996            # finish reading the cache and setting up arctags, etc.
6997            set line [gets $f]
6998            if {$line ne "1"} {error "bad final version"}
6999            close $f
7000            foreach id [array names idtags] {
7001                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
7002                    [llength $allparents($id)] == 1} {
7003                    set a [lindex $arcnos($id) 0]
7004                    if {$arctags($a) eq {}} {
7005                        recalcarc $a
7006                    }
7007                }
7008            }
7009            foreach id [array names idheads] {
7010                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
7011                    [llength $allparents($id)] == 1} {
7012                    set a [lindex $arcnos($id) 0]
7013                    if {$archeads($a) eq {}} {
7014                        recalcarc $a
7015                    }
7016                }
7017            }
7018            foreach id [lsort -unique $possible_seeds] {
7019                if {$arcnos($id) eq {}} {
7020                    lappend seeds $id
7021                }
7022            }
7023            set allcwait 0
7024        } else {
7025            while {[incr a] <= $lim} {
7026                set line [gets $f]
7027                if {[llength $line] != 3} {error "bad line"}
7028                set s [lindex $line 0]
7029                set arcstart($a) $s
7030                lappend arcout($s) $a
7031                if {![info exists arcnos($s)]} {
7032                    lappend possible_seeds $s
7033                    set arcnos($s) {}
7034                }
7035                set e [lindex $line 1]
7036                if {$e eq {}} {
7037                    set growing($a) 1
7038                } else {
7039                    set arcend($a) $e
7040                    if {![info exists arcout($e)]} {
7041                        set arcout($e) {}
7042                    }
7043                }
7044                set arcids($a) [lindex $line 2]
7045                foreach id $arcids($a) {
7046                    lappend allparents($s) $id
7047                    set s $id
7048                    lappend arcnos($id) $a
7049                }
7050                if {![info exists allparents($s)]} {
7051                    set allparents($s) {}
7052                }
7053                set arctags($a) {}
7054                set archeads($a) {}
7055            }
7056            set nextarc [expr {$a - 1}]
7057        }
7058    } err]} {
7059        dropcache $err
7060        return 0
7061    }
7062    if {!$allcwait} {
7063        getallcommits
7064    }
7065    return $allcwait
7066}
7067
7068proc getcache {f} {
7069    global nextarc cachedarcs possible_seeds
7070
7071    if {[catch {
7072        set line [gets $f]
7073        if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
7074        # make sure it's an integer
7075        set cachedarcs [expr {int([lindex $line 1])}]
7076        if {$cachedarcs < 0} {error "bad number of arcs"}
7077        set nextarc 0
7078        set possible_seeds {}
7079        run readcache $f
7080    } err]} {
7081        dropcache $err
7082    }
7083    return 0
7084}
7085
7086proc dropcache {err} {
7087    global allcwait nextarc cachedarcs seeds
7088
7089    #puts "dropping cache ($err)"
7090    foreach v {arcnos arcout arcids arcstart arcend growing \
7091                   arctags archeads allparents allchildren} {
7092        global $v
7093        catch {unset $v}
7094    }
7095    set allcwait 0
7096    set nextarc 0
7097    set cachedarcs 0
7098    set seeds {}
7099    getallcommits
7100}
7101
7102proc writecache {f} {
7103    global cachearc cachedarcs allccache
7104    global arcstart arcend arcnos arcids arcout
7105
7106    set a $cachearc
7107    set lim $cachedarcs
7108    if {$lim - $a > 1000} {
7109        set lim [expr {$a + 1000}]
7110    }
7111    if {[catch {
7112        while {[incr a] <= $lim} {
7113            if {[info exists arcend($a)]} {
7114                puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
7115            } else {
7116                puts $f [list $arcstart($a) {} $arcids($a)]
7117            }
7118        }
7119    } err]} {
7120        catch {close $f}
7121        catch {file delete $allccache}
7122        #puts "writing cache failed ($err)"
7123        return 0
7124    }
7125    set cachearc [expr {$a - 1}]
7126    if {$a > $cachedarcs} {
7127        puts $f "1"
7128        close $f
7129        return 0
7130    }
7131    return 1
7132}
7133
7134proc savecache {} {
7135    global nextarc cachedarcs cachearc allccache
7136
7137    if {$nextarc == $cachedarcs} return
7138    set cachearc 0
7139    set cachedarcs $nextarc
7140    catch {
7141        set f [open $allccache w]
7142        puts $f [list 1 $cachedarcs]
7143        run writecache $f
7144    }
7145}
7146
7147# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
7148# or 0 if neither is true.
7149proc anc_or_desc {a b} {
7150    global arcout arcstart arcend arcnos cached_isanc
7151
7152    if {$arcnos($a) eq $arcnos($b)} {
7153        # Both are on the same arc(s); either both are the same BMP,
7154        # or if one is not a BMP, the other is also not a BMP or is
7155        # the BMP at end of the arc (and it only has 1 incoming arc).
7156        # Or both can be BMPs with no incoming arcs.
7157        if {$a eq $b || $arcnos($a) eq {}} {
7158            return 0
7159        }
7160        # assert {[llength $arcnos($a)] == 1}
7161        set arc [lindex $arcnos($a) 0]
7162        set i [lsearch -exact $arcids($arc) $a]
7163        set j [lsearch -exact $arcids($arc) $b]
7164        if {$i < 0 || $i > $j} {
7165            return 1
7166        } else {
7167            return -1
7168        }
7169    }
7170
7171    if {![info exists arcout($a)]} {
7172        set arc [lindex $arcnos($a) 0]
7173        if {[info exists arcend($arc)]} {
7174            set aend $arcend($arc)
7175        } else {
7176            set aend {}
7177        }
7178        set a $arcstart($arc)
7179    } else {
7180        set aend $a
7181    }
7182    if {![info exists arcout($b)]} {
7183        set arc [lindex $arcnos($b) 0]
7184        if {[info exists arcend($arc)]} {
7185            set bend $arcend($arc)
7186        } else {
7187            set bend {}
7188        }
7189        set b $arcstart($arc)
7190    } else {
7191        set bend $b
7192    }
7193    if {$a eq $bend} {
7194        return 1
7195    }
7196    if {$b eq $aend} {
7197        return -1
7198    }
7199    if {[info exists cached_isanc($a,$bend)]} {
7200        if {$cached_isanc($a,$bend)} {
7201            return 1
7202        }
7203    }
7204    if {[info exists cached_isanc($b,$aend)]} {
7205        if {$cached_isanc($b,$aend)} {
7206            return -1
7207        }
7208        if {[info exists cached_isanc($a,$bend)]} {
7209            return 0
7210        }
7211    }
7212
7213    set todo [list $a $b]
7214    set anc($a) a
7215    set anc($b) b
7216    for {set i 0} {$i < [llength $todo]} {incr i} {
7217        set x [lindex $todo $i]
7218        if {$anc($x) eq {}} {
7219            continue
7220        }
7221        foreach arc $arcnos($x) {
7222            set xd $arcstart($arc)
7223            if {$xd eq $bend} {
7224                set cached_isanc($a,$bend) 1
7225                set cached_isanc($b,$aend) 0
7226                return 1
7227            } elseif {$xd eq $aend} {
7228                set cached_isanc($b,$aend) 1
7229                set cached_isanc($a,$bend) 0
7230                return -1
7231            }
7232            if {![info exists anc($xd)]} {
7233                set anc($xd) $anc($x)
7234                lappend todo $xd
7235            } elseif {$anc($xd) ne $anc($x)} {
7236                set anc($xd) {}
7237            }
7238        }
7239    }
7240    set cached_isanc($a,$bend) 0
7241    set cached_isanc($b,$aend) 0
7242    return 0
7243}
7244
7245# This identifies whether $desc has an ancestor that is
7246# a growing tip of the graph and which is not an ancestor of $anc
7247# and returns 0 if so and 1 if not.
7248# If we subsequently discover a tag on such a growing tip, and that
7249# turns out to be a descendent of $anc (which it could, since we
7250# don't necessarily see children before parents), then $desc
7251# isn't a good choice to display as a descendent tag of
7252# $anc (since it is the descendent of another tag which is
7253# a descendent of $anc).  Similarly, $anc isn't a good choice to
7254# display as a ancestor tag of $desc.
7255#
7256proc is_certain {desc anc} {
7257    global arcnos arcout arcstart arcend growing problems
7258
7259    set certain {}
7260    if {[llength $arcnos($anc)] == 1} {
7261        # tags on the same arc are certain
7262        if {$arcnos($desc) eq $arcnos($anc)} {
7263            return 1
7264        }
7265        if {![info exists arcout($anc)]} {
7266            # if $anc is partway along an arc, use the start of the arc instead
7267            set a [lindex $arcnos($anc) 0]
7268            set anc $arcstart($a)
7269        }
7270    }
7271    if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
7272        set x $desc
7273    } else {
7274        set a [lindex $arcnos($desc) 0]
7275        set x $arcend($a)
7276    }
7277    if {$x == $anc} {
7278        return 1
7279    }
7280    set anclist [list $x]
7281    set dl($x) 1
7282    set nnh 1
7283    set ngrowanc 0
7284    for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
7285        set x [lindex $anclist $i]
7286        if {$dl($x)} {
7287            incr nnh -1
7288        }
7289        set done($x) 1
7290        foreach a $arcout($x) {
7291            if {[info exists growing($a)]} {
7292                if {![info exists growanc($x)] && $dl($x)} {
7293                    set growanc($x) 1
7294                    incr ngrowanc
7295                }
7296            } else {
7297                set y $arcend($a)
7298                if {[info exists dl($y)]} {
7299                    if {$dl($y)} {
7300                        if {!$dl($x)} {
7301                            set dl($y) 0
7302                            if {![info exists done($y)]} {
7303                                incr nnh -1
7304                            }
7305                            if {[info exists growanc($x)]} {
7306                                incr ngrowanc -1
7307                            }
7308                            set xl [list $y]
7309                            for {set k 0} {$k < [llength $xl]} {incr k} {
7310                                set z [lindex $xl $k]
7311                                foreach c $arcout($z) {
7312                                    if {[info exists arcend($c)]} {
7313                                        set v $arcend($c)
7314                                        if {[info exists dl($v)] && $dl($v)} {
7315                                            set dl($v) 0
7316                                            if {![info exists done($v)]} {
7317                                                incr nnh -1
7318                                            }
7319                                            if {[info exists growanc($v)]} {
7320                                                incr ngrowanc -1
7321                                            }
7322                                            lappend xl $v
7323                                        }
7324                                    }
7325                                }
7326                            }
7327                        }
7328                    }
7329                } elseif {$y eq $anc || !$dl($x)} {
7330                    set dl($y) 0
7331                    lappend anclist $y
7332                } else {
7333                    set dl($y) 1
7334                    lappend anclist $y
7335                    incr nnh
7336                }
7337            }
7338        }
7339    }
7340    foreach x [array names growanc] {
7341        if {$dl($x)} {
7342            return 0
7343        }
7344        return 0
7345    }
7346    return 1
7347}
7348
7349proc validate_arctags {a} {
7350    global arctags idtags
7351
7352    set i -1
7353    set na $arctags($a)
7354    foreach id $arctags($a) {
7355        incr i
7356        if {![info exists idtags($id)]} {
7357            set na [lreplace $na $i $i]
7358            incr i -1
7359        }
7360    }
7361    set arctags($a) $na
7362}
7363
7364proc validate_archeads {a} {
7365    global archeads idheads
7366
7367    set i -1
7368    set na $archeads($a)
7369    foreach id $archeads($a) {
7370        incr i
7371        if {![info exists idheads($id)]} {
7372            set na [lreplace $na $i $i]
7373            incr i -1
7374        }
7375    }
7376    set archeads($a) $na
7377}
7378
7379# Return the list of IDs that have tags that are descendents of id,
7380# ignoring IDs that are descendents of IDs already reported.
7381proc desctags {id} {
7382    global arcnos arcstart arcids arctags idtags allparents
7383    global growing cached_dtags
7384
7385    if {![info exists allparents($id)]} {
7386        return {}
7387    }
7388    set t1 [clock clicks -milliseconds]
7389    set argid $id
7390    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7391        # part-way along an arc; check that arc first
7392        set a [lindex $arcnos($id) 0]
7393        if {$arctags($a) ne {}} {
7394            validate_arctags $a
7395            set i [lsearch -exact $arcids($a) $id]
7396            set tid {}
7397            foreach t $arctags($a) {
7398                set j [lsearch -exact $arcids($a) $t]
7399                if {$j >= $i} break
7400                set tid $t
7401            }
7402            if {$tid ne {}} {
7403                return $tid
7404            }
7405        }
7406        set id $arcstart($a)
7407        if {[info exists idtags($id)]} {
7408            return $id
7409        }
7410    }
7411    if {[info exists cached_dtags($id)]} {
7412        return $cached_dtags($id)
7413    }
7414
7415    set origid $id
7416    set todo [list $id]
7417    set queued($id) 1
7418    set nc 1
7419    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7420        set id [lindex $todo $i]
7421        set done($id) 1
7422        set ta [info exists hastaggedancestor($id)]
7423        if {!$ta} {
7424            incr nc -1
7425        }
7426        # ignore tags on starting node
7427        if {!$ta && $i > 0} {
7428            if {[info exists idtags($id)]} {
7429                set tagloc($id) $id
7430                set ta 1
7431            } elseif {[info exists cached_dtags($id)]} {
7432                set tagloc($id) $cached_dtags($id)
7433                set ta 1
7434            }
7435        }
7436        foreach a $arcnos($id) {
7437            set d $arcstart($a)
7438            if {!$ta && $arctags($a) ne {}} {
7439                validate_arctags $a
7440                if {$arctags($a) ne {}} {
7441                    lappend tagloc($id) [lindex $arctags($a) end]
7442                }
7443            }
7444            if {$ta || $arctags($a) ne {}} {
7445                set tomark [list $d]
7446                for {set j 0} {$j < [llength $tomark]} {incr j} {
7447                    set dd [lindex $tomark $j]
7448                    if {![info exists hastaggedancestor($dd)]} {
7449                        if {[info exists done($dd)]} {
7450                            foreach b $arcnos($dd) {
7451                                lappend tomark $arcstart($b)
7452                            }
7453                            if {[info exists tagloc($dd)]} {
7454                                unset tagloc($dd)
7455                            }
7456                        } elseif {[info exists queued($dd)]} {
7457                            incr nc -1
7458                        }
7459                        set hastaggedancestor($dd) 1
7460                    }
7461                }
7462            }
7463            if {![info exists queued($d)]} {
7464                lappend todo $d
7465                set queued($d) 1
7466                if {![info exists hastaggedancestor($d)]} {
7467                    incr nc
7468                }
7469            }
7470        }
7471    }
7472    set tags {}
7473    foreach id [array names tagloc] {
7474        if {![info exists hastaggedancestor($id)]} {
7475            foreach t $tagloc($id) {
7476                if {[lsearch -exact $tags $t] < 0} {
7477                    lappend tags $t
7478                }
7479            }
7480        }
7481    }
7482    set t2 [clock clicks -milliseconds]
7483    set loopix $i
7484
7485    # remove tags that are descendents of other tags
7486    for {set i 0} {$i < [llength $tags]} {incr i} {
7487        set a [lindex $tags $i]
7488        for {set j 0} {$j < $i} {incr j} {
7489            set b [lindex $tags $j]
7490            set r [anc_or_desc $a $b]
7491            if {$r == 1} {
7492                set tags [lreplace $tags $j $j]
7493                incr j -1
7494                incr i -1
7495            } elseif {$r == -1} {
7496                set tags [lreplace $tags $i $i]
7497                incr i -1
7498                break
7499            }
7500        }
7501    }
7502
7503    if {[array names growing] ne {}} {
7504        # graph isn't finished, need to check if any tag could get
7505        # eclipsed by another tag coming later.  Simply ignore any
7506        # tags that could later get eclipsed.
7507        set ctags {}
7508        foreach t $tags {
7509            if {[is_certain $t $origid]} {
7510                lappend ctags $t
7511            }
7512        }
7513        if {$tags eq $ctags} {
7514            set cached_dtags($origid) $tags
7515        } else {
7516            set tags $ctags
7517        }
7518    } else {
7519        set cached_dtags($origid) $tags
7520    }
7521    set t3 [clock clicks -milliseconds]
7522    if {0 && $t3 - $t1 >= 100} {
7523        puts "iterating descendents ($loopix/[llength $todo] nodes) took\
7524            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7525    }
7526    return $tags
7527}
7528
7529proc anctags {id} {
7530    global arcnos arcids arcout arcend arctags idtags allparents
7531    global growing cached_atags
7532
7533    if {![info exists allparents($id)]} {
7534        return {}
7535    }
7536    set t1 [clock clicks -milliseconds]
7537    set argid $id
7538    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7539        # part-way along an arc; check that arc first
7540        set a [lindex $arcnos($id) 0]
7541        if {$arctags($a) ne {}} {
7542            validate_arctags $a
7543            set i [lsearch -exact $arcids($a) $id]
7544            foreach t $arctags($a) {
7545                set j [lsearch -exact $arcids($a) $t]
7546                if {$j > $i} {
7547                    return $t
7548                }
7549            }
7550        }
7551        if {![info exists arcend($a)]} {
7552            return {}
7553        }
7554        set id $arcend($a)
7555        if {[info exists idtags($id)]} {
7556            return $id
7557        }
7558    }
7559    if {[info exists cached_atags($id)]} {
7560        return $cached_atags($id)
7561    }
7562
7563    set origid $id
7564    set todo [list $id]
7565    set queued($id) 1
7566    set taglist {}
7567    set nc 1
7568    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
7569        set id [lindex $todo $i]
7570        set done($id) 1
7571        set td [info exists hastaggeddescendent($id)]
7572        if {!$td} {
7573            incr nc -1
7574        }
7575        # ignore tags on starting node
7576        if {!$td && $i > 0} {
7577            if {[info exists idtags($id)]} {
7578                set tagloc($id) $id
7579                set td 1
7580            } elseif {[info exists cached_atags($id)]} {
7581                set tagloc($id) $cached_atags($id)
7582                set td 1
7583            }
7584        }
7585        foreach a $arcout($id) {
7586            if {!$td && $arctags($a) ne {}} {
7587                validate_arctags $a
7588                if {$arctags($a) ne {}} {
7589                    lappend tagloc($id) [lindex $arctags($a) 0]
7590                }
7591            }
7592            if {![info exists arcend($a)]} continue
7593            set d $arcend($a)
7594            if {$td || $arctags($a) ne {}} {
7595                set tomark [list $d]
7596                for {set j 0} {$j < [llength $tomark]} {incr j} {
7597                    set dd [lindex $tomark $j]
7598                    if {![info exists hastaggeddescendent($dd)]} {
7599                        if {[info exists done($dd)]} {
7600                            foreach b $arcout($dd) {
7601                                if {[info exists arcend($b)]} {
7602                                    lappend tomark $arcend($b)
7603                                }
7604                            }
7605                            if {[info exists tagloc($dd)]} {
7606                                unset tagloc($dd)
7607                            }
7608                        } elseif {[info exists queued($dd)]} {
7609                            incr nc -1
7610                        }
7611                        set hastaggeddescendent($dd) 1
7612                    }
7613                }
7614            }
7615            if {![info exists queued($d)]} {
7616                lappend todo $d
7617                set queued($d) 1
7618                if {![info exists hastaggeddescendent($d)]} {
7619                    incr nc
7620                }
7621            }
7622        }
7623    }
7624    set t2 [clock clicks -milliseconds]
7625    set loopix $i
7626    set tags {}
7627    foreach id [array names tagloc] {
7628        if {![info exists hastaggeddescendent($id)]} {
7629            foreach t $tagloc($id) {
7630                if {[lsearch -exact $tags $t] < 0} {
7631                    lappend tags $t
7632                }
7633            }
7634        }
7635    }
7636
7637    # remove tags that are ancestors of other tags
7638    for {set i 0} {$i < [llength $tags]} {incr i} {
7639        set a [lindex $tags $i]
7640        for {set j 0} {$j < $i} {incr j} {
7641            set b [lindex $tags $j]
7642            set r [anc_or_desc $a $b]
7643            if {$r == -1} {
7644                set tags [lreplace $tags $j $j]
7645                incr j -1
7646                incr i -1
7647            } elseif {$r == 1} {
7648                set tags [lreplace $tags $i $i]
7649                incr i -1
7650                break
7651            }
7652        }
7653    }
7654
7655    if {[array names growing] ne {}} {
7656        # graph isn't finished, need to check if any tag could get
7657        # eclipsed by another tag coming later.  Simply ignore any
7658        # tags that could later get eclipsed.
7659        set ctags {}
7660        foreach t $tags {
7661            if {[is_certain $origid $t]} {
7662                lappend ctags $t
7663            }
7664        }
7665        if {$tags eq $ctags} {
7666            set cached_atags($origid) $tags
7667        } else {
7668            set tags $ctags
7669        }
7670    } else {
7671        set cached_atags($origid) $tags
7672    }
7673    set t3 [clock clicks -milliseconds]
7674    if {0 && $t3 - $t1 >= 100} {
7675        puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
7676            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
7677    }
7678    return $tags
7679}
7680
7681# Return the list of IDs that have heads that are descendents of id,
7682# including id itself if it has a head.
7683proc descheads {id} {
7684    global arcnos arcstart arcids archeads idheads cached_dheads
7685    global allparents
7686
7687    if {![info exists allparents($id)]} {
7688        return {}
7689    }
7690    set aret {}
7691    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
7692        # part-way along an arc; check it first
7693        set a [lindex $arcnos($id) 0]
7694        if {$archeads($a) ne {}} {
7695            validate_archeads $a
7696            set i [lsearch -exact $arcids($a) $id]
7697            foreach t $archeads($a) {
7698                set j [lsearch -exact $arcids($a) $t]
7699                if {$j > $i} break
7700                lappend aret $t
7701            }
7702        }
7703        set id $arcstart($a)
7704    }
7705    set origid $id
7706    set todo [list $id]
7707    set seen($id) 1
7708    set ret {}
7709    for {set i 0} {$i < [llength $todo]} {incr i} {
7710        set id [lindex $todo $i]
7711        if {[info exists cached_dheads($id)]} {
7712            set ret [concat $ret $cached_dheads($id)]
7713        } else {
7714            if {[info exists idheads($id)]} {
7715                lappend ret $id
7716            }
7717            foreach a $arcnos($id) {
7718                if {$archeads($a) ne {}} {
7719                    validate_archeads $a
7720                    if {$archeads($a) ne {}} {
7721                        set ret [concat $ret $archeads($a)]
7722                    }
7723                }
7724                set d $arcstart($a)
7725                if {![info exists seen($d)]} {
7726                    lappend todo $d
7727                    set seen($d) 1
7728                }
7729            }
7730        }
7731    }
7732    set ret [lsort -unique $ret]
7733    set cached_dheads($origid) $ret
7734    return [concat $ret $aret]
7735}
7736
7737proc addedtag {id} {
7738    global arcnos arcout cached_dtags cached_atags
7739
7740    if {![info exists arcnos($id)]} return
7741    if {![info exists arcout($id)]} {
7742        recalcarc [lindex $arcnos($id) 0]
7743    }
7744    catch {unset cached_dtags}
7745    catch {unset cached_atags}
7746}
7747
7748proc addedhead {hid head} {
7749    global arcnos arcout cached_dheads
7750
7751    if {![info exists arcnos($hid)]} return
7752    if {![info exists arcout($hid)]} {
7753        recalcarc [lindex $arcnos($hid) 0]
7754    }
7755    catch {unset cached_dheads}
7756}
7757
7758proc removedhead {hid head} {
7759    global cached_dheads
7760
7761    catch {unset cached_dheads}
7762}
7763
7764proc movedhead {hid head} {
7765    global arcnos arcout cached_dheads
7766
7767    if {![info exists arcnos($hid)]} return
7768    if {![info exists arcout($hid)]} {
7769        recalcarc [lindex $arcnos($hid) 0]
7770    }
7771    catch {unset cached_dheads}
7772}
7773
7774proc changedrefs {} {
7775    global cached_dheads cached_dtags cached_atags
7776    global arctags archeads arcnos arcout idheads idtags
7777
7778    foreach id [concat [array names idheads] [array names idtags]] {
7779        if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
7780            set a [lindex $arcnos($id) 0]
7781            if {![info exists donearc($a)]} {
7782                recalcarc $a
7783                set donearc($a) 1
7784            }
7785        }
7786    }
7787    catch {unset cached_dtags}
7788    catch {unset cached_atags}
7789    catch {unset cached_dheads}
7790}
7791
7792proc rereadrefs {} {
7793    global idtags idheads idotherrefs mainhead
7794
7795    set refids [concat [array names idtags] \
7796                    [array names idheads] [array names idotherrefs]]
7797    foreach id $refids {
7798        if {![info exists ref($id)]} {
7799            set ref($id) [listrefs $id]
7800        }
7801    }
7802    set oldmainhead $mainhead
7803    readrefs
7804    changedrefs
7805    set refids [lsort -unique [concat $refids [array names idtags] \
7806                        [array names idheads] [array names idotherrefs]]]
7807    foreach id $refids {
7808        set v [listrefs $id]
7809        if {![info exists ref($id)] || $ref($id) != $v ||
7810            ($id eq $oldmainhead && $id ne $mainhead) ||
7811            ($id eq $mainhead && $id ne $oldmainhead)} {
7812            redrawtags $id
7813        }
7814    }
7815    run refill_reflist
7816}
7817
7818proc listrefs {id} {
7819    global idtags idheads idotherrefs
7820
7821    set x {}
7822    if {[info exists idtags($id)]} {
7823        set x $idtags($id)
7824    }
7825    set y {}
7826    if {[info exists idheads($id)]} {
7827        set y $idheads($id)
7828    }
7829    set z {}
7830    if {[info exists idotherrefs($id)]} {
7831        set z $idotherrefs($id)
7832    }
7833    return [list $x $y $z]
7834}
7835
7836proc showtag {tag isnew} {
7837    global ctext tagcontents tagids linknum tagobjid
7838
7839    if {$isnew} {
7840        addtohistory [list showtag $tag 0]
7841    }
7842    $ctext conf -state normal
7843    clear_ctext
7844    settabs 0
7845    set linknum 0
7846    if {![info exists tagcontents($tag)]} {
7847        catch {
7848            set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
7849        }
7850    }
7851    if {[info exists tagcontents($tag)]} {
7852        set text $tagcontents($tag)
7853    } else {
7854        set text "[mc "Tag"]: $tag\n[mc "Id"]:  $tagids($tag)"
7855    }
7856    appendwithlinks $text {}
7857    $ctext conf -state disabled
7858    init_flist {}
7859}
7860
7861proc doquit {} {
7862    global stopped
7863    set stopped 100
7864    savestuff .
7865    destroy .
7866}
7867
7868proc mkfontdisp {font top which} {
7869    global fontattr fontpref $font
7870
7871    set fontpref($font) [set $font]
7872    button $top.${font}but -text $which -font optionfont \
7873        -command [list choosefont $font $which]
7874    label $top.$font -relief flat -font $font \
7875        -text $fontattr($font,family) -justify left
7876    grid x $top.${font}but $top.$font -sticky w
7877}
7878
7879proc choosefont {font which} {
7880    global fontparam fontlist fonttop fontattr
7881
7882    set fontparam(which) $which
7883    set fontparam(font) $font
7884    set fontparam(family) [font actual $font -family]
7885    set fontparam(size) $fontattr($font,size)
7886    set fontparam(weight) $fontattr($font,weight)
7887    set fontparam(slant) $fontattr($font,slant)
7888    set top .gitkfont
7889    set fonttop $top
7890    if {![winfo exists $top]} {
7891        font create sample
7892        eval font config sample [font actual $font]
7893        toplevel $top
7894        wm title $top [mc "Gitk font chooser"]
7895        label $top.l -textvariable fontparam(which)
7896        pack $top.l -side top
7897        set fontlist [lsort [font families]]
7898        frame $top.f
7899        listbox $top.f.fam -listvariable fontlist \
7900            -yscrollcommand [list $top.f.sb set]
7901        bind $top.f.fam <<ListboxSelect>> selfontfam
7902        scrollbar $top.f.sb -command [list $top.f.fam yview]
7903        pack $top.f.sb -side right -fill y
7904        pack $top.f.fam -side left -fill both -expand 1
7905        pack $top.f -side top -fill both -expand 1
7906        frame $top.g
7907        spinbox $top.g.size -from 4 -to 40 -width 4 \
7908            -textvariable fontparam(size) \
7909            -validatecommand {string is integer -strict %s}
7910        checkbutton $top.g.bold -padx 5 \
7911            -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
7912            -variable fontparam(weight) -onvalue bold -offvalue normal
7913        checkbutton $top.g.ital -padx 5 \
7914            -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
7915            -variable fontparam(slant) -onvalue italic -offvalue roman
7916        pack $top.g.size $top.g.bold $top.g.ital -side left
7917        pack $top.g -side top
7918        canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
7919            -background white
7920        $top.c create text 100 25 -anchor center -text $which -font sample \
7921            -fill black -tags text
7922        bind $top.c <Configure> [list centertext $top.c]
7923        pack $top.c -side top -fill x
7924        frame $top.buts
7925        button $top.buts.ok -text [mc "OK"] -command fontok -default active
7926        button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
7927        grid $top.buts.ok $top.buts.can
7928        grid columnconfigure $top.buts 0 -weight 1 -uniform a
7929        grid columnconfigure $top.buts 1 -weight 1 -uniform a
7930        pack $top.buts -side bottom -fill x
7931        trace add variable fontparam write chg_fontparam
7932    } else {
7933        raise $top
7934        $top.c itemconf text -text $which
7935    }
7936    set i [lsearch -exact $fontlist $fontparam(family)]
7937    if {$i >= 0} {
7938        $top.f.fam selection set $i
7939        $top.f.fam see $i
7940    }
7941}
7942
7943proc centertext {w} {
7944    $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
7945}
7946
7947proc fontok {} {
7948    global fontparam fontpref prefstop
7949
7950    set f $fontparam(font)
7951    set fontpref($f) [list $fontparam(family) $fontparam(size)]
7952    if {$fontparam(weight) eq "bold"} {
7953        lappend fontpref($f) "bold"
7954    }
7955    if {$fontparam(slant) eq "italic"} {
7956        lappend fontpref($f) "italic"
7957    }
7958    set w $prefstop.$f
7959    $w conf -text $fontparam(family) -font $fontpref($f)
7960        
7961    fontcan
7962}
7963
7964proc fontcan {} {
7965    global fonttop fontparam
7966
7967    if {[info exists fonttop]} {
7968        catch {destroy $fonttop}
7969        catch {font delete sample}
7970        unset fonttop
7971        unset fontparam
7972    }
7973}
7974
7975proc selfontfam {} {
7976    global fonttop fontparam
7977
7978    set i [$fonttop.f.fam curselection]
7979    if {$i ne {}} {
7980        set fontparam(family) [$fonttop.f.fam get $i]
7981    }
7982}
7983
7984proc chg_fontparam {v sub op} {
7985    global fontparam
7986
7987    font config sample -$sub $fontparam($sub)
7988}
7989
7990proc doprefs {} {
7991    global maxwidth maxgraphpct
7992    global oldprefs prefstop showneartags showlocalchanges
7993    global bgcolor fgcolor ctext diffcolors selectbgcolor
7994    global tabstop limitdiffs autoselect
7995
7996    set top .gitkprefs
7997    set prefstop $top
7998    if {[winfo exists $top]} {
7999        raise $top
8000        return
8001    }
8002    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8003                   limitdiffs tabstop} {
8004        set oldprefs($v) [set $v]
8005    }
8006    toplevel $top
8007    wm title $top [mc "Gitk preferences"]
8008    label $top.ldisp -text [mc "Commit list display options"]
8009    grid $top.ldisp - -sticky w -pady 10
8010    label $top.spacer -text " "
8011    label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
8012        -font optionfont
8013    spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
8014    grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
8015    label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
8016        -font optionfont
8017    spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
8018    grid x $top.maxpctl $top.maxpct -sticky w
8019    frame $top.showlocal
8020    label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
8021    checkbutton $top.showlocal.b -variable showlocalchanges
8022    pack $top.showlocal.b $top.showlocal.l -side left
8023    grid x $top.showlocal -sticky w
8024    frame $top.autoselect
8025    label $top.autoselect.l -text [mc "Auto-select SHA1"] -font optionfont
8026    checkbutton $top.autoselect.b -variable autoselect
8027    pack $top.autoselect.b $top.autoselect.l -side left
8028    grid x $top.autoselect -sticky w
8029
8030    label $top.ddisp -text [mc "Diff display options"]
8031    grid $top.ddisp - -sticky w -pady 10
8032    label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
8033    spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
8034    grid x $top.tabstopl $top.tabstop -sticky w
8035    frame $top.ntag
8036    label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
8037    checkbutton $top.ntag.b -variable showneartags
8038    pack $top.ntag.b $top.ntag.l -side left
8039    grid x $top.ntag -sticky w
8040    frame $top.ldiff
8041    label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
8042    checkbutton $top.ldiff.b -variable limitdiffs
8043    pack $top.ldiff.b $top.ldiff.l -side left
8044    grid x $top.ldiff -sticky w
8045
8046    label $top.cdisp -text [mc "Colors: press to choose"]
8047    grid $top.cdisp - -sticky w -pady 10
8048    label $top.bg -padx 40 -relief sunk -background $bgcolor
8049    button $top.bgbut -text [mc "Background"] -font optionfont \
8050        -command [list choosecolor bgcolor 0 $top.bg background setbg]
8051    grid x $top.bgbut $top.bg -sticky w
8052    label $top.fg -padx 40 -relief sunk -background $fgcolor
8053    button $top.fgbut -text [mc "Foreground"] -font optionfont \
8054        -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
8055    grid x $top.fgbut $top.fg -sticky w
8056    label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
8057    button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
8058        -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
8059                      [list $ctext tag conf d0 -foreground]]
8060    grid x $top.diffoldbut $top.diffold -sticky w
8061    label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
8062    button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
8063        -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
8064                      [list $ctext tag conf d1 -foreground]]
8065    grid x $top.diffnewbut $top.diffnew -sticky w
8066    label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
8067    button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
8068        -command [list choosecolor diffcolors 2 $top.hunksep \
8069                      "diff hunk header" \
8070                      [list $ctext tag conf hunksep -foreground]]
8071    grid x $top.hunksepbut $top.hunksep -sticky w
8072    label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
8073    button $top.selbgbut -text [mc "Select bg"] -font optionfont \
8074        -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
8075    grid x $top.selbgbut $top.selbgsep -sticky w
8076
8077    label $top.cfont -text [mc "Fonts: press to choose"]
8078    grid $top.cfont - -sticky w -pady 10
8079    mkfontdisp mainfont $top [mc "Main font"]
8080    mkfontdisp textfont $top [mc "Diff display font"]
8081    mkfontdisp uifont $top [mc "User interface font"]
8082
8083    frame $top.buts
8084    button $top.buts.ok -text [mc "OK"] -command prefsok -default active
8085    button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
8086    grid $top.buts.ok $top.buts.can
8087    grid columnconfigure $top.buts 0 -weight 1 -uniform a
8088    grid columnconfigure $top.buts 1 -weight 1 -uniform a
8089    grid $top.buts - - -pady 10 -sticky ew
8090    bind $top <Visibility> "focus $top.buts.ok"
8091}
8092
8093proc choosecolor {v vi w x cmd} {
8094    global $v
8095
8096    set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
8097               -title [mc "Gitk: choose color for %s" $x]]
8098    if {$c eq {}} return
8099    $w conf -background $c
8100    lset $v $vi $c
8101    eval $cmd $c
8102}
8103
8104proc setselbg {c} {
8105    global bglist cflist
8106    foreach w $bglist {
8107        $w configure -selectbackground $c
8108    }
8109    $cflist tag configure highlight \
8110        -background [$cflist cget -selectbackground]
8111    allcanvs itemconf secsel -fill $c
8112}
8113
8114proc setbg {c} {
8115    global bglist
8116
8117    foreach w $bglist {
8118        $w conf -background $c
8119    }
8120}
8121
8122proc setfg {c} {
8123    global fglist canv
8124
8125    foreach w $fglist {
8126        $w conf -foreground $c
8127    }
8128    allcanvs itemconf text -fill $c
8129    $canv itemconf circle -outline $c
8130}
8131
8132proc prefscan {} {
8133    global oldprefs prefstop
8134
8135    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8136                   limitdiffs tabstop} {
8137        global $v
8138        set $v $oldprefs($v)
8139    }
8140    catch {destroy $prefstop}
8141    unset prefstop
8142    fontcan
8143}
8144
8145proc prefsok {} {
8146    global maxwidth maxgraphpct
8147    global oldprefs prefstop showneartags showlocalchanges
8148    global fontpref mainfont textfont uifont
8149    global limitdiffs treediffs
8150
8151    catch {destroy $prefstop}
8152    unset prefstop
8153    fontcan
8154    set fontchanged 0
8155    if {$mainfont ne $fontpref(mainfont)} {
8156        set mainfont $fontpref(mainfont)
8157        parsefont mainfont $mainfont
8158        eval font configure mainfont [fontflags mainfont]
8159        eval font configure mainfontbold [fontflags mainfont 1]
8160        setcoords
8161        set fontchanged 1
8162    }
8163    if {$textfont ne $fontpref(textfont)} {
8164        set textfont $fontpref(textfont)
8165        parsefont textfont $textfont
8166        eval font configure textfont [fontflags textfont]
8167        eval font configure textfontbold [fontflags textfont 1]
8168    }
8169    if {$uifont ne $fontpref(uifont)} {
8170        set uifont $fontpref(uifont)
8171        parsefont uifont $uifont
8172        eval font configure uifont [fontflags uifont]
8173    }
8174    settabs
8175    if {$showlocalchanges != $oldprefs(showlocalchanges)} {
8176        if {$showlocalchanges} {
8177            doshowlocalchanges
8178        } else {
8179            dohidelocalchanges
8180        }
8181    }
8182    if {$limitdiffs != $oldprefs(limitdiffs)} {
8183        # treediffs elements are limited by path
8184        catch {unset treediffs}
8185    }
8186    if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
8187        || $maxgraphpct != $oldprefs(maxgraphpct)} {
8188        redisplay
8189    } elseif {$showneartags != $oldprefs(showneartags) ||
8190          $limitdiffs != $oldprefs(limitdiffs)} {
8191        reselectline
8192    }
8193}
8194
8195proc formatdate {d} {
8196    global datetimeformat
8197    if {$d ne {}} {
8198        set d [clock format $d -format $datetimeformat]
8199    }
8200    return $d
8201}
8202
8203# This list of encoding names and aliases is distilled from
8204# http://www.iana.org/assignments/character-sets.
8205# Not all of them are supported by Tcl.
8206set encoding_aliases {
8207    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
8208      ISO646-US US-ASCII us IBM367 cp367 csASCII }
8209    { ISO-10646-UTF-1 csISO10646UTF1 }
8210    { ISO_646.basic:1983 ref csISO646basic1983 }
8211    { INVARIANT csINVARIANT }
8212    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
8213    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
8214    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
8215    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
8216    { NATS-DANO iso-ir-9-1 csNATSDANO }
8217    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
8218    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
8219    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
8220    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
8221    { ISO-2022-KR csISO2022KR }
8222    { EUC-KR csEUCKR }
8223    { ISO-2022-JP csISO2022JP }
8224    { ISO-2022-JP-2 csISO2022JP2 }
8225    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
8226      csISO13JISC6220jp }
8227    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
8228    { IT iso-ir-15 ISO646-IT csISO15Italian }
8229    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
8230    { ES iso-ir-17 ISO646-ES csISO17Spanish }
8231    { greek7-old iso-ir-18 csISO18Greek7Old }
8232    { latin-greek iso-ir-19 csISO19LatinGreek }
8233    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
8234    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
8235    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
8236    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
8237    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
8238    { BS_viewdata iso-ir-47 csISO47BSViewdata }
8239    { INIS iso-ir-49 csISO49INIS }
8240    { INIS-8 iso-ir-50 csISO50INIS8 }
8241    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
8242    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
8243    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
8244    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
8245    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
8246    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
8247      csISO60Norwegian1 }
8248    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
8249    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
8250    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
8251    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
8252    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
8253    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
8254    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
8255    { greek7 iso-ir-88 csISO88Greek7 }
8256    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
8257    { iso-ir-90 csISO90 }
8258    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
8259    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
8260      csISO92JISC62991984b }
8261    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
8262    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
8263    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
8264      csISO95JIS62291984handadd }
8265    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
8266    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
8267    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
8268    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
8269      CP819 csISOLatin1 }
8270    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
8271    { T.61-7bit iso-ir-102 csISO102T617bit }
8272    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
8273    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
8274    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
8275    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
8276    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
8277    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
8278    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
8279    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
8280      arabic csISOLatinArabic }
8281    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
8282    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
8283    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
8284      greek greek8 csISOLatinGreek }
8285    { T.101-G2 iso-ir-128 csISO128T101G2 }
8286    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
8287      csISOLatinHebrew }
8288    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
8289    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
8290    { CSN_369103 iso-ir-139 csISO139CSN369103 }
8291    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
8292    { ISO_6937-2-add iso-ir-142 csISOTextComm }
8293    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
8294    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
8295      csISOLatinCyrillic }
8296    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
8297    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
8298    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
8299    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
8300    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
8301    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
8302    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
8303    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
8304    { ISO_10367-box iso-ir-155 csISO10367Box }
8305    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
8306    { latin-lap lap iso-ir-158 csISO158Lap }
8307    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
8308    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
8309    { us-dk csUSDK }
8310    { dk-us csDKUS }
8311    { JIS_X0201 X0201 csHalfWidthKatakana }
8312    { KSC5636 ISO646-KR csKSC5636 }
8313    { ISO-10646-UCS-2 csUnicode }
8314    { ISO-10646-UCS-4 csUCS4 }
8315    { DEC-MCS dec csDECMCS }
8316    { hp-roman8 roman8 r8 csHPRoman8 }
8317    { macintosh mac csMacintosh }
8318    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
8319      csIBM037 }
8320    { IBM038 EBCDIC-INT cp038 csIBM038 }
8321    { IBM273 CP273 csIBM273 }
8322    { IBM274 EBCDIC-BE CP274 csIBM274 }
8323    { IBM275 EBCDIC-BR cp275 csIBM275 }
8324    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
8325    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
8326    { IBM280 CP280 ebcdic-cp-it csIBM280 }
8327    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
8328    { IBM284 CP284 ebcdic-cp-es csIBM284 }
8329    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
8330    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
8331    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
8332    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
8333    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
8334    { IBM424 cp424 ebcdic-cp-he csIBM424 }
8335    { IBM437 cp437 437 csPC8CodePage437 }
8336    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
8337    { IBM775 cp775 csPC775Baltic }
8338    { IBM850 cp850 850 csPC850Multilingual }
8339    { IBM851 cp851 851 csIBM851 }
8340    { IBM852 cp852 852 csPCp852 }
8341    { IBM855 cp855 855 csIBM855 }
8342    { IBM857 cp857 857 csIBM857 }
8343    { IBM860 cp860 860 csIBM860 }
8344    { IBM861 cp861 861 cp-is csIBM861 }
8345    { IBM862 cp862 862 csPC862LatinHebrew }
8346    { IBM863 cp863 863 csIBM863 }
8347    { IBM864 cp864 csIBM864 }
8348    { IBM865 cp865 865 csIBM865 }
8349    { IBM866 cp866 866 csIBM866 }
8350    { IBM868 CP868 cp-ar csIBM868 }
8351    { IBM869 cp869 869 cp-gr csIBM869 }
8352    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
8353    { IBM871 CP871 ebcdic-cp-is csIBM871 }
8354    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
8355    { IBM891 cp891 csIBM891 }
8356    { IBM903 cp903 csIBM903 }
8357    { IBM904 cp904 904 csIBBM904 }
8358    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
8359    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
8360    { IBM1026 CP1026 csIBM1026 }
8361    { EBCDIC-AT-DE csIBMEBCDICATDE }
8362    { EBCDIC-AT-DE-A csEBCDICATDEA }
8363    { EBCDIC-CA-FR csEBCDICCAFR }
8364    { EBCDIC-DK-NO csEBCDICDKNO }
8365    { EBCDIC-DK-NO-A csEBCDICDKNOA }
8366    { EBCDIC-FI-SE csEBCDICFISE }
8367    { EBCDIC-FI-SE-A csEBCDICFISEA }
8368    { EBCDIC-FR csEBCDICFR }
8369    { EBCDIC-IT csEBCDICIT }
8370    { EBCDIC-PT csEBCDICPT }
8371    { EBCDIC-ES csEBCDICES }
8372    { EBCDIC-ES-A csEBCDICESA }
8373    { EBCDIC-ES-S csEBCDICESS }
8374    { EBCDIC-UK csEBCDICUK }
8375    { EBCDIC-US csEBCDICUS }
8376    { UNKNOWN-8BIT csUnknown8BiT }
8377    { MNEMONIC csMnemonic }
8378    { MNEM csMnem }
8379    { VISCII csVISCII }
8380    { VIQR csVIQR }
8381    { KOI8-R csKOI8R }
8382    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
8383    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
8384    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
8385    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
8386    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
8387    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
8388    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
8389    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
8390    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
8391    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
8392    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
8393    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
8394    { IBM1047 IBM-1047 }
8395    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
8396    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
8397    { UNICODE-1-1 csUnicode11 }
8398    { CESU-8 csCESU-8 }
8399    { BOCU-1 csBOCU-1 }
8400    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
8401    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
8402      l8 }
8403    { ISO-8859-15 ISO_8859-15 Latin-9 }
8404    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
8405    { GBK CP936 MS936 windows-936 }
8406    { JIS_Encoding csJISEncoding }
8407    { Shift_JIS MS_Kanji csShiftJIS }
8408    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
8409      EUC-JP }
8410    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
8411    { ISO-10646-UCS-Basic csUnicodeASCII }
8412    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
8413    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
8414    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
8415    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
8416    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
8417    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
8418    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
8419    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
8420    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
8421    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
8422    { Adobe-Standard-Encoding csAdobeStandardEncoding }
8423    { Ventura-US csVenturaUS }
8424    { Ventura-International csVenturaInternational }
8425    { PC8-Danish-Norwegian csPC8DanishNorwegian }
8426    { PC8-Turkish csPC8Turkish }
8427    { IBM-Symbols csIBMSymbols }
8428    { IBM-Thai csIBMThai }
8429    { HP-Legal csHPLegal }
8430    { HP-Pi-font csHPPiFont }
8431    { HP-Math8 csHPMath8 }
8432    { Adobe-Symbol-Encoding csHPPSMath }
8433    { HP-DeskTop csHPDesktop }
8434    { Ventura-Math csVenturaMath }
8435    { Microsoft-Publishing csMicrosoftPublishing }
8436    { Windows-31J csWindows31J }
8437    { GB2312 csGB2312 }
8438    { Big5 csBig5 }
8439}
8440
8441proc tcl_encoding {enc} {
8442    global encoding_aliases
8443    set names [encoding names]
8444    set lcnames [string tolower $names]
8445    set enc [string tolower $enc]
8446    set i [lsearch -exact $lcnames $enc]
8447    if {$i < 0} {
8448        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
8449        if {[regsub {^iso[-_]} $enc iso encx]} {
8450            set i [lsearch -exact $lcnames $encx]
8451        }
8452    }
8453    if {$i < 0} {
8454        foreach l $encoding_aliases {
8455            set ll [string tolower $l]
8456            if {[lsearch -exact $ll $enc] < 0} continue
8457            # look through the aliases for one that tcl knows about
8458            foreach e $ll {
8459                set i [lsearch -exact $lcnames $e]
8460                if {$i < 0} {
8461                    if {[regsub {^iso[-_]} $e iso ex]} {
8462                        set i [lsearch -exact $lcnames $ex]
8463                    }
8464                }
8465                if {$i >= 0} break
8466            }
8467            break
8468        }
8469    }
8470    if {$i >= 0} {
8471        return [lindex $names $i]
8472    }
8473    return {}
8474}
8475
8476# First check that Tcl/Tk is recent enough
8477if {[catch {package require Tk 8.4} err]} {
8478    show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
8479                     Gitk requires at least Tcl/Tk 8.4."]
8480    exit 1
8481}
8482
8483# defaults...
8484set datemode 0
8485set wrcomcmd "git diff-tree --stdin -p --pretty"
8486
8487set gitencoding {}
8488catch {
8489    set gitencoding [exec git config --get i18n.commitencoding]
8490}
8491if {$gitencoding == ""} {
8492    set gitencoding "utf-8"
8493}
8494set tclencoding [tcl_encoding $gitencoding]
8495if {$tclencoding == {}} {
8496    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
8497}
8498
8499set mainfont {Helvetica 9}
8500set textfont {Courier 9}
8501set uifont {Helvetica 9 bold}
8502set tabstop 8
8503set findmergefiles 0
8504set maxgraphpct 50
8505set maxwidth 16
8506set revlistorder 0
8507set fastdate 0
8508set uparrowlen 5
8509set downarrowlen 5
8510set mingaplen 100
8511set cmitmode "patch"
8512set wrapcomment "none"
8513set showneartags 1
8514set maxrefs 20
8515set maxlinelen 200
8516set showlocalchanges 1
8517set limitdiffs 1
8518set datetimeformat "%Y-%m-%d %H:%M:%S"
8519set autoselect 1
8520
8521set colors {green red blue magenta darkgrey brown orange}
8522set bgcolor white
8523set fgcolor black
8524set diffcolors {red "#00a000" blue}
8525set diffcontext 3
8526set ignorespace 0
8527set selectbgcolor gray85
8528
8529## For msgcat loading, first locate the installation location.
8530if { [info exists ::env(GITK_MSGSDIR)] } {
8531    ## Msgsdir was manually set in the environment.
8532    set gitk_msgsdir $::env(GITK_MSGSDIR)
8533} else {
8534    ## Let's guess the prefix from argv0.
8535    set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
8536    set gitk_libdir [file join $gitk_prefix share gitk lib]
8537    set gitk_msgsdir [file join $gitk_libdir msgs]
8538    unset gitk_prefix
8539}
8540
8541## Internationalization (i18n) through msgcat and gettext. See
8542## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
8543package require msgcat
8544namespace import ::msgcat::mc
8545## And eventually load the actual message catalog
8546::msgcat::mcload $gitk_msgsdir
8547
8548catch {source ~/.gitk}
8549
8550font create optionfont -family sans-serif -size -12
8551
8552parsefont mainfont $mainfont
8553eval font create mainfont [fontflags mainfont]
8554eval font create mainfontbold [fontflags mainfont 1]
8555
8556parsefont textfont $textfont
8557eval font create textfont [fontflags textfont]
8558eval font create textfontbold [fontflags textfont 1]
8559
8560parsefont uifont $uifont
8561eval font create uifont [fontflags uifont]
8562
8563setoptions
8564
8565# check that we can find a .git directory somewhere...
8566if {[catch {set gitdir [gitdir]}]} {
8567    show_error {} . [mc "Cannot find a git repository here."]
8568    exit 1
8569}
8570if {![file isdirectory $gitdir]} {
8571    show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
8572    exit 1
8573}
8574
8575set mergeonly 0
8576set revtreeargs {}
8577set cmdline_files {}
8578set i 0
8579set revtreeargscmd {}
8580foreach arg $argv {
8581    switch -glob -- $arg {
8582        "" { }
8583        "-d" { set datemode 1 }
8584        "--merge" {
8585            set mergeonly 1
8586            lappend revtreeargs $arg
8587        }
8588        "--" {
8589            set cmdline_files [lrange $argv [expr {$i + 1}] end]
8590            break
8591        }
8592        "--argscmd=*" {
8593            set revtreeargscmd [string range $arg 10 end]
8594        }
8595        default {
8596            lappend revtreeargs $arg
8597        }
8598    }
8599    incr i
8600}
8601
8602if {$i >= [llength $argv] && $revtreeargs ne {}} {
8603    # no -- on command line, but some arguments (other than -d)
8604    if {[catch {
8605        set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
8606        set cmdline_files [split $f "\n"]
8607        set n [llength $cmdline_files]
8608        set revtreeargs [lrange $revtreeargs 0 end-$n]
8609        # Unfortunately git rev-parse doesn't produce an error when
8610        # something is both a revision and a filename.  To be consistent
8611        # with git log and git rev-list, check revtreeargs for filenames.
8612        foreach arg $revtreeargs {
8613            if {[file exists $arg]} {
8614                show_error {} . [mc "Ambiguous argument '%s': both revision\
8615                                 and filename" $arg]
8616                exit 1
8617            }
8618        }
8619    } err]} {
8620        # unfortunately we get both stdout and stderr in $err,
8621        # so look for "fatal:".
8622        set i [string first "fatal:" $err]
8623        if {$i > 0} {
8624            set err [string range $err [expr {$i + 6}] end]
8625        }
8626        show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
8627        exit 1
8628    }
8629}
8630
8631if {$mergeonly} {
8632    # find the list of unmerged files
8633    set mlist {}
8634    set nr_unmerged 0
8635    if {[catch {
8636        set fd [open "| git ls-files -u" r]
8637    } err]} {
8638        show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
8639        exit 1
8640    }
8641    while {[gets $fd line] >= 0} {
8642        set i [string first "\t" $line]
8643        if {$i < 0} continue
8644        set fname [string range $line [expr {$i+1}] end]
8645        if {[lsearch -exact $mlist $fname] >= 0} continue
8646        incr nr_unmerged
8647        if {$cmdline_files eq {} || [path_filter $cmdline_files $fname]} {
8648            lappend mlist $fname
8649        }
8650    }
8651    catch {close $fd}
8652    if {$mlist eq {}} {
8653        if {$nr_unmerged == 0} {
8654            show_error {} . [mc "No files selected: --merge specified but\
8655                             no files are unmerged."]
8656        } else {
8657            show_error {} . [mc "No files selected: --merge specified but\
8658                             no unmerged files are within file limit."]
8659        }
8660        exit 1
8661    }
8662    set cmdline_files $mlist
8663}
8664
8665set nullid "0000000000000000000000000000000000000000"
8666set nullid2 "0000000000000000000000000000000000000001"
8667
8668set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
8669
8670set runq {}
8671set history {}
8672set historyindex 0
8673set fh_serial 0
8674set nhl_names {}
8675set highlight_paths {}
8676set findpattern {}
8677set searchdirn -forwards
8678set boldrows {}
8679set boldnamerows {}
8680set diffelide {0 0}
8681set markingmatches 0
8682set linkentercount 0
8683set need_redisplay 0
8684set nrows_drawn 0
8685set firsttabstop 0
8686
8687set nextviewnum 1
8688set curview 0
8689set selectedview 0
8690set selectedhlview [mc "None"]
8691set highlight_related [mc "None"]
8692set highlight_files {}
8693set viewfiles(0) {}
8694set viewperm(0) 0
8695set viewargs(0) {}
8696set viewargscmd(0) {}
8697
8698set cmdlineok 0
8699set stopped 0
8700set stuffsaved 0
8701set patchnum 0
8702set localirow -1
8703set localfrow -1
8704set lserial 0
8705set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
8706setcoords
8707makewindow
8708# wait for the window to become visible
8709tkwait visibility .
8710wm title . "[file tail $argv0]: [file tail [pwd]]"
8711readrefs
8712
8713if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
8714    # create a view for the files/dirs specified on the command line
8715    set curview 1
8716    set selectedview 1
8717    set nextviewnum 2
8718    set viewname(1) [mc "Command line"]
8719    set viewfiles(1) $cmdline_files
8720    set viewargs(1) $revtreeargs
8721    set viewargscmd(1) $revtreeargscmd
8722    set viewperm(1) 0
8723    addviewmenu 1
8724    .bar.view entryconf [mc "Edit view..."] -state normal
8725    .bar.view entryconf [mc "Delete view"] -state normal
8726}
8727
8728if {[info exists permviews]} {
8729    foreach v $permviews {
8730        set n $nextviewnum
8731        incr nextviewnum
8732        set viewname($n) [lindex $v 0]
8733        set viewfiles($n) [lindex $v 1]
8734        set viewargs($n) [lindex $v 2]
8735        set viewargscmd($n) [lindex $v 3]
8736        set viewperm($n) 1
8737        addviewmenu $n
8738    }
8739}
8740getcommits