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