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