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