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