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