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