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