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