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