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