c707c3c1048bfe286a49846b5dcb6835dfacbc55
   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) $varcid($curview,$p)]
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        selbyid $newhead
7032    }
7033    notbusy cherrypick
7034}
7035
7036proc resethead {} {
7037    global mainheadid mainhead rowmenuid confirm_ok resettype
7038
7039    set confirm_ok 0
7040    set w ".confirmreset"
7041    toplevel $w
7042    wm transient $w .
7043    wm title $w [mc "Confirm reset"]
7044    message $w.m -text \
7045        [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
7046        -justify center -aspect 1000
7047    pack $w.m -side top -fill x -padx 20 -pady 20
7048    frame $w.f -relief sunken -border 2
7049    message $w.f.rt -text [mc "Reset type:"] -aspect 1000
7050    grid $w.f.rt -sticky w
7051    set resettype mixed
7052    radiobutton $w.f.soft -value soft -variable resettype -justify left \
7053        -text [mc "Soft: Leave working tree and index untouched"]
7054    grid $w.f.soft -sticky w
7055    radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
7056        -text [mc "Mixed: Leave working tree untouched, reset index"]
7057    grid $w.f.mixed -sticky w
7058    radiobutton $w.f.hard -value hard -variable resettype -justify left \
7059        -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
7060    grid $w.f.hard -sticky w
7061    pack $w.f -side top -fill x
7062    button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
7063    pack $w.ok -side left -fill x -padx 20 -pady 20
7064    button $w.cancel -text [mc Cancel] -command "destroy $w"
7065    pack $w.cancel -side right -fill x -padx 20 -pady 20
7066    bind $w <Visibility> "grab $w; focus $w"
7067    tkwait window $w
7068    if {!$confirm_ok} return
7069    if {[catch {set fd [open \
7070            [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
7071        error_popup $err
7072    } else {
7073        dohidelocalchanges
7074        filerun $fd [list readresetstat $fd]
7075        nowbusy reset [mc "Resetting"]
7076        selbyid $rowmenuid
7077    }
7078}
7079
7080proc readresetstat {fd} {
7081    global mainhead mainheadid showlocalchanges rprogcoord
7082
7083    if {[gets $fd line] >= 0} {
7084        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
7085            set rprogcoord [expr {1.0 * $m / $n}]
7086            adjustprogress
7087        }
7088        return 1
7089    }
7090    set rprogcoord 0
7091    adjustprogress
7092    notbusy reset
7093    if {[catch {close $fd} err]} {
7094        error_popup $err
7095    }
7096    set oldhead $mainheadid
7097    set newhead [exec git rev-parse HEAD]
7098    if {$newhead ne $oldhead} {
7099        movehead $newhead $mainhead
7100        movedhead $newhead $mainhead
7101        set mainheadid $newhead
7102        redrawtags $oldhead
7103        redrawtags $newhead
7104    }
7105    if {$showlocalchanges} {
7106        doshowlocalchanges
7107    }
7108    return 0
7109}
7110
7111# context menu for a head
7112proc headmenu {x y id head} {
7113    global headmenuid headmenuhead headctxmenu mainhead
7114
7115    stopfinding
7116    set headmenuid $id
7117    set headmenuhead $head
7118    set state normal
7119    if {$head eq $mainhead} {
7120        set state disabled
7121    }
7122    $headctxmenu entryconfigure 0 -state $state
7123    $headctxmenu entryconfigure 1 -state $state
7124    tk_popup $headctxmenu $x $y
7125}
7126
7127proc cobranch {} {
7128    global headmenuid headmenuhead mainhead headids
7129    global showlocalchanges mainheadid
7130
7131    # check the tree is clean first??
7132    set oldmainhead $mainhead
7133    nowbusy checkout [mc "Checking out"]
7134    update
7135    dohidelocalchanges
7136    if {[catch {
7137        exec git checkout -q $headmenuhead
7138    } err]} {
7139        notbusy checkout
7140        error_popup $err
7141    } else {
7142        notbusy checkout
7143        set mainhead $headmenuhead
7144        set mainheadid $headmenuid
7145        if {[info exists headids($oldmainhead)]} {
7146            redrawtags $headids($oldmainhead)
7147        }
7148        redrawtags $headmenuid
7149        selbyid $headmenuid
7150    }
7151    if {$showlocalchanges} {
7152        dodiffindex
7153    }
7154}
7155
7156proc rmbranch {} {
7157    global headmenuid headmenuhead mainhead
7158    global idheads
7159
7160    set head $headmenuhead
7161    set id $headmenuid
7162    # this check shouldn't be needed any more...
7163    if {$head eq $mainhead} {
7164        error_popup [mc "Cannot delete the currently checked-out branch"]
7165        return
7166    }
7167    set dheads [descheads $id]
7168    if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
7169        # the stuff on this branch isn't on any other branch
7170        if {![confirm_popup [mc "The commits on branch %s aren't on any other\
7171                        branch.\nReally delete branch %s?" $head $head]]} return
7172    }
7173    nowbusy rmbranch
7174    update
7175    if {[catch {exec git branch -D $head} err]} {
7176        notbusy rmbranch
7177        error_popup $err
7178        return
7179    }
7180    removehead $id $head
7181    removedhead $id $head
7182    redrawtags $id
7183    notbusy rmbranch
7184    dispneartags 0
7185    run refill_reflist
7186}
7187
7188# Display a list of tags and heads
7189proc showrefs {} {
7190    global showrefstop bgcolor fgcolor selectbgcolor
7191    global bglist fglist reflistfilter reflist maincursor
7192
7193    set top .showrefs
7194    set showrefstop $top
7195    if {[winfo exists $top]} {
7196        raise $top
7197        refill_reflist
7198        return
7199    }
7200    toplevel $top
7201    wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
7202    text $top.list -background $bgcolor -foreground $fgcolor \
7203        -selectbackground $selectbgcolor -font mainfont \
7204        -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
7205        -width 30 -height 20 -cursor $maincursor \
7206        -spacing1 1 -spacing3 1 -state disabled
7207    $top.list tag configure highlight -background $selectbgcolor
7208    lappend bglist $top.list
7209    lappend fglist $top.list
7210    scrollbar $top.ysb -command "$top.list yview" -orient vertical
7211    scrollbar $top.xsb -command "$top.list xview" -orient horizontal
7212    grid $top.list $top.ysb -sticky nsew
7213    grid $top.xsb x -sticky ew
7214    frame $top.f
7215    label $top.f.l -text "[mc "Filter"]: "
7216    entry $top.f.e -width 20 -textvariable reflistfilter
7217    set reflistfilter "*"
7218    trace add variable reflistfilter write reflistfilter_change
7219    pack $top.f.e -side right -fill x -expand 1
7220    pack $top.f.l -side left
7221    grid $top.f - -sticky ew -pady 2
7222    button $top.close -command [list destroy $top] -text [mc "Close"]
7223    grid $top.close -
7224    grid columnconfigure $top 0 -weight 1
7225    grid rowconfigure $top 0 -weight 1
7226    bind $top.list <1> {break}
7227    bind $top.list <B1-Motion> {break}
7228    bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
7229    set reflist {}
7230    refill_reflist
7231}
7232
7233proc sel_reflist {w x y} {
7234    global showrefstop reflist headids tagids otherrefids
7235
7236    if {![winfo exists $showrefstop]} return
7237    set l [lindex [split [$w index "@$x,$y"] "."] 0]
7238    set ref [lindex $reflist [expr {$l-1}]]
7239    set n [lindex $ref 0]
7240    switch -- [lindex $ref 1] {
7241        "H" {selbyid $headids($n)}
7242        "T" {selbyid $tagids($n)}
7243        "o" {selbyid $otherrefids($n)}
7244    }
7245    $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
7246}
7247
7248proc unsel_reflist {} {
7249    global showrefstop
7250
7251    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7252    $showrefstop.list tag remove highlight 0.0 end
7253}
7254
7255proc reflistfilter_change {n1 n2 op} {
7256    global reflistfilter
7257
7258    after cancel refill_reflist
7259    after 200 refill_reflist
7260}
7261
7262proc refill_reflist {} {
7263    global reflist reflistfilter showrefstop headids tagids otherrefids
7264    global curview commitinterest
7265
7266    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7267    set refs {}
7268    foreach n [array names headids] {
7269        if {[string match $reflistfilter $n]} {
7270            if {[commitinview $headids($n) $curview]} {
7271                lappend refs [list $n H]
7272            } else {
7273                set commitinterest($headids($n)) {run refill_reflist}
7274            }
7275        }
7276    }
7277    foreach n [array names tagids] {
7278        if {[string match $reflistfilter $n]} {
7279            if {[commitinview $tagids($n) $curview]} {
7280                lappend refs [list $n T]
7281            } else {
7282                set commitinterest($tagids($n)) {run refill_reflist}
7283            }
7284        }
7285    }
7286    foreach n [array names otherrefids] {
7287        if {[string match $reflistfilter $n]} {
7288            if {[commitinview $otherrefids($n) $curview]} {
7289                lappend refs [list $n o]
7290            } else {
7291                set commitinterest($otherrefids($n)) {run refill_reflist}
7292            }
7293        }
7294    }
7295    set refs [lsort -index 0 $refs]
7296    if {$refs eq $reflist} return
7297
7298    # Update the contents of $showrefstop.list according to the
7299    # differences between $reflist (old) and $refs (new)
7300    $showrefstop.list conf -state normal
7301    $showrefstop.list insert end "\n"
7302    set i 0
7303    set j 0
7304    while {$i < [llength $reflist] || $j < [llength $refs]} {
7305        if {$i < [llength $reflist]} {
7306            if {$j < [llength $refs]} {
7307                set cmp [string compare [lindex $reflist $i 0] \
7308                             [lindex $refs $j 0]]
7309                if {$cmp == 0} {
7310                    set cmp [string compare [lindex $reflist $i 1] \
7311                                 [lindex $refs $j 1]]
7312                }
7313            } else {
7314                set cmp -1
7315            }
7316        } else {
7317            set cmp 1
7318        }
7319        switch -- $cmp {
7320            -1 {
7321                $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
7322                incr i
7323            }
7324            0 {
7325                incr i
7326                incr j
7327            }
7328            1 {
7329                set l [expr {$j + 1}]
7330                $showrefstop.list image create $l.0 -align baseline \
7331                    -image reficon-[lindex $refs $j 1] -padx 2
7332                $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
7333                incr j
7334            }
7335        }
7336    }
7337    set reflist $refs
7338    # delete last newline
7339    $showrefstop.list delete end-2c end-1c
7340    $showrefstop.list conf -state disabled
7341}
7342
7343# Stuff for finding nearby tags
7344proc getallcommits {} {
7345    global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
7346    global idheads idtags idotherrefs allparents tagobjid
7347
7348    if {![info exists allcommits]} {
7349        set nextarc 0
7350        set allcommits 0
7351        set seeds {}
7352        set allcwait 0
7353        set cachedarcs 0
7354        set allccache [file join [gitdir] "gitk.cache"]
7355        if {![catch {
7356            set f [open $allccache r]
7357            set allcwait 1
7358            getcache $f
7359        }]} return
7360    }
7361
7362    if {$allcwait} {
7363        return
7364    }
7365    set cmd [list | git rev-list --parents]
7366    set allcupdate [expr {$seeds ne {}}]
7367    if {!$allcupdate} {
7368        set ids "--all"
7369    } else {
7370        set refs [concat [array names idheads] [array names idtags] \
7371                      [array names idotherrefs]]
7372        set ids {}
7373        set tagobjs {}
7374        foreach name [array names tagobjid] {
7375            lappend tagobjs $tagobjid($name)
7376        }
7377        foreach id [lsort -unique $refs] {
7378            if {![info exists allparents($id)] &&
7379                [lsearch -exact $tagobjs $id] < 0} {
7380                lappend ids $id
7381            }
7382        }
7383        if {$ids ne {}} {
7384            foreach id $seeds {
7385                lappend ids "^$id"
7386            }
7387        }
7388    }
7389    if {$ids ne {}} {
7390        set fd [open [concat $cmd $ids] r]
7391        fconfigure $fd -blocking 0
7392        incr allcommits
7393        nowbusy allcommits
7394        filerun $fd [list getallclines $fd]
7395    } else {
7396        dispneartags 0
7397    }
7398}
7399
7400# Since most commits have 1 parent and 1 child, we group strings of
7401# such commits into "arcs" joining branch/merge points (BMPs), which
7402# are commits that either don't have 1 parent or don't have 1 child.
7403#
7404# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
7405# arcout(id) - outgoing arcs for BMP
7406# arcids(a) - list of IDs on arc including end but not start
7407# arcstart(a) - BMP ID at start of arc
7408# arcend(a) - BMP ID at end of arc
7409# growing(a) - arc a is still growing
7410# arctags(a) - IDs out of arcids (excluding end) that have tags
7411# archeads(a) - IDs out of arcids (excluding end) that have heads
7412# The start of an arc is at the descendent end, so "incoming" means
7413# coming from descendents, and "outgoing" means going towards ancestors.
7414
7415proc getallclines {fd} {
7416    global allparents allchildren idtags idheads nextarc
7417    global arcnos arcids arctags arcout arcend arcstart archeads growing
7418    global seeds allcommits cachedarcs allcupdate
7419    
7420    set nid 0
7421    while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
7422        set id [lindex $line 0]
7423        if {[info exists allparents($id)]} {
7424            # seen it already
7425            continue
7426        }
7427        set cachedarcs 0
7428        set olds [lrange $line 1 end]
7429        set allparents($id) $olds
7430        if {![info exists allchildren($id)]} {
7431            set allchildren($id) {}
7432            set arcnos($id) {}
7433            lappend seeds $id
7434        } else {
7435            set a $arcnos($id)
7436            if {[llength $olds] == 1 && [llength $a] == 1} {
7437                lappend arcids($a) $id
7438                if {[info exists idtags($id)]} {
7439                    lappend arctags($a) $id
7440                }
7441                if {[info exists idheads($id)]} {
7442                    lappend archeads($a) $id
7443                }
7444                if {[info exists allparents($olds)]} {
7445                    # seen parent already
7446                    if {![info exists arcout($olds)]} {
7447                        splitarc $olds
7448                    }
7449                    lappend arcids($a) $olds
7450                    set arcend($a) $olds
7451                    unset growing($a)
7452                }
7453                lappend allchildren($olds) $id
7454                lappend arcnos($olds) $a
7455                continue
7456            }
7457        }
7458        foreach a $arcnos($id) {
7459            lappend arcids($a) $id
7460            set arcend($a) $id
7461            unset growing($a)
7462        }
7463
7464        set ao {}
7465        foreach p $olds {
7466            lappend allchildren($p) $id
7467            set a [incr nextarc]
7468            set arcstart($a) $id
7469            set archeads($a) {}
7470            set arctags($a) {}
7471            set archeads($a) {}
7472            set arcids($a) {}
7473            lappend ao $a
7474            set growing($a) 1
7475            if {[info exists allparents($p)]} {
7476                # seen it already, may need to make a new branch
7477                if {![info exists arcout($p)]} {
7478                    splitarc $p
7479                }
7480                lappend arcids($a) $p
7481                set arcend($a) $p
7482                unset growing($a)
7483            }
7484            lappend arcnos($p) $a
7485        }
7486        set arcout($id) $ao
7487    }
7488    if {$nid > 0} {
7489        global cached_dheads cached_dtags cached_atags
7490        catch {unset cached_dheads}
7491        catch {unset cached_dtags}
7492        catch {unset cached_atags}
7493    }
7494    if {![eof $fd]} {
7495        return [expr {$nid >= 1000? 2: 1}]
7496    }
7497    set cacheok 1
7498    if {[catch {
7499        fconfigure $fd -blocking 1
7500        close $fd
7501    } err]} {
7502        # got an error reading the list of commits
7503        # if we were updating, try rereading the whole thing again
7504        if {$allcupdate} {
7505            incr allcommits -1
7506            dropcache $err
7507            return
7508        }
7509        error_popup "[mc "Error reading commit topology information;\
7510                branch and preceding/following tag information\
7511                will be incomplete."]\n($err)"
7512        set cacheok 0
7513    }
7514    if {[incr allcommits -1] == 0} {
7515        notbusy allcommits
7516        if {$cacheok} {
7517            run savecache
7518        }
7519    }
7520    dispneartags 0
7521    return 0
7522}
7523
7524proc recalcarc {a} {
7525    global arctags archeads arcids idtags idheads
7526
7527    set at {}
7528    set ah {}
7529    foreach id [lrange $arcids($a) 0 end-1] {
7530        if {[info exists idtags($id)]} {
7531            lappend at $id
7532        }
7533        if {[info exists idheads($id)]} {
7534            lappend ah $id
7535        }
7536    }
7537    set arctags($a) $at
7538    set archeads($a) $ah
7539}
7540
7541proc splitarc {p} {
7542    global arcnos arcids nextarc arctags archeads idtags idheads
7543    global arcstart arcend arcout allparents growing
7544
7545    set a $arcnos($p)
7546    if {[llength $a] != 1} {
7547        puts "oops splitarc called but [llength $a] arcs already"
7548        return
7549    }
7550    set a [lindex $a 0]
7551    set i [lsearch -exact $arcids($a) $p]
7552    if {$i < 0} {
7553        puts "oops splitarc $p not in arc $a"
7554        return
7555    }
7556    set na [incr nextarc]
7557    if {[info exists arcend($a)]} {
7558        set arcend($na) $arcend($a)
7559    } else {
7560        set l [lindex $allparents([lindex $arcids($a) end]) 0]
7561        set j [lsearch -exact $arcnos($l) $a]
7562        set arcnos($l) [lreplace $arcnos($l) $j $j $na]
7563    }
7564    set tail [lrange $arcids($a) [expr {$i+1}] end]
7565    set arcids($a) [lrange $arcids($a) 0 $i]
7566    set arcend($a) $p
7567    set arcstart($na) $p
7568    set arcout($p) $na
7569    set arcids($na) $tail
7570    if {[info exists growing($a)]} {
7571        set growing($na) 1
7572        unset growing($a)
7573    }
7574
7575    foreach id $tail {
7576        if {[llength $arcnos($id)] == 1} {
7577            set arcnos($id) $na
7578        } else {
7579            set j [lsearch -exact $arcnos($id) $a]
7580            set arcnos($id) [lreplace $arcnos($id) $j $j $na]
7581        }
7582    }
7583
7584    # reconstruct tags and heads lists
7585    if {$arctags($a) ne {} || $archeads($a) ne {}} {
7586        recalcarc $a
7587        recalcarc $na
7588    } else {
7589        set arctags($na) {}
7590        set archeads($na) {}
7591    }
7592}
7593
7594# Update things for a new commit added that is a child of one
7595# existing commit.  Used when cherry-picking.
7596proc addnewchild {id p} {
7597    global allparents allchildren idtags nextarc
7598    global arcnos arcids arctags arcout arcend arcstart archeads growing
7599    global seeds allcommits
7600
7601    if {![info exists allcommits] || ![info exists arcnos($p)]} return
7602    set allparents($id) [list $p]
7603    set allchildren($id) {}
7604    set arcnos($id) {}
7605    lappend seeds $id
7606    lappend allchildren($p) $id
7607    set a [incr nextarc]
7608    set arcstart($a) $id
7609    set archeads($a) {}
7610    set arctags($a) {}
7611    set arcids($a) [list $p]
7612    set arcend($a) $p
7613    if {![info exists arcout($p)]} {
7614        splitarc $p
7615    }
7616    lappend arcnos($p) $a
7617    set arcout($id) [list $a]
7618}
7619
7620# This implements a cache for the topology information.
7621# The cache saves, for each arc, the start and end of the arc,
7622# the ids on the arc, and the outgoing arcs from the end.
7623proc readcache {f} {
7624    global arcnos arcids arcout arcstart arcend arctags archeads nextarc
7625    global idtags idheads allparents cachedarcs possible_seeds seeds growing
7626    global allcwait
7627
7628    set a $nextarc
7629    set lim $cachedarcs
7630    if {$lim - $a > 500} {
7631        set lim [expr {$a + 500}]
7632    }
7633    if {[catch {
7634        if {$a == $lim} {
7635            # finish reading the cache and setting up arctags, etc.
7636            set line [gets $f]
7637            if {$line ne "1"} {error "bad final version"}
7638            close $f
7639            foreach id [array names idtags] {
7640                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
7641                    [llength $allparents($id)] == 1} {
7642                    set a [lindex $arcnos($id) 0]
7643                    if {$arctags($a) eq {}} {
7644                        recalcarc $a
7645                    }
7646                }
7647            }
7648            foreach id [array names idheads] {
7649                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
7650                    [llength $allparents($id)] == 1} {
7651                    set a [lindex $arcnos($id) 0]
7652                    if {$archeads($a) eq {}} {
7653                        recalcarc $a
7654                    }
7655                }
7656            }
7657            foreach id [lsort -unique $possible_seeds] {
7658                if {$arcnos($id) eq {}} {
7659                    lappend seeds $id
7660                }
7661            }
7662            set allcwait 0
7663        } else {
7664            while {[incr a] <= $lim} {
7665                set line [gets $f]
7666                if {[llength $line] != 3} {error "bad line"}
7667                set s [lindex $line 0]
7668                set arcstart($a) $s
7669                lappend arcout($s) $a
7670                if {![info exists arcnos($s)]} {
7671                    lappend possible_seeds $s
7672                    set arcnos($s) {}
7673                }
7674                set e [lindex $line 1]
7675                if {$e eq {}} {
7676                    set growing($a) 1
7677                } else {
7678                    set arcend($a) $e
7679                    if {![info exists arcout($e)]} {
7680                        set arcout($e) {}
7681                    }
7682                }
7683                set arcids($a) [lindex $line 2]
7684                foreach id $arcids($a) {
7685                    lappend allparents($s) $id
7686                    set s $id
7687                    lappend arcnos($id) $a
7688                }
7689                if {![info exists allparents($s)]} {
7690                    set allparents($s) {}
7691                }
7692                set arctags($a) {}
7693                set archeads($a) {}
7694            }
7695            set nextarc [expr {$a - 1}]
7696        }
7697    } err]} {
7698        dropcache $err
7699        return 0
7700    }
7701    if {!$allcwait} {
7702        getallcommits
7703    }
7704    return $allcwait
7705}
7706
7707proc getcache {f} {
7708    global nextarc cachedarcs possible_seeds
7709
7710    if {[catch {
7711        set line [gets $f]
7712        if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
7713        # make sure it's an integer
7714        set cachedarcs [expr {int([lindex $line 1])}]
7715        if {$cachedarcs < 0} {error "bad number of arcs"}
7716        set nextarc 0
7717        set possible_seeds {}
7718        run readcache $f
7719    } err]} {
7720        dropcache $err
7721    }
7722    return 0
7723}
7724
7725proc dropcache {err} {
7726    global allcwait nextarc cachedarcs seeds
7727
7728    #puts "dropping cache ($err)"
7729    foreach v {arcnos arcout arcids arcstart arcend growing \
7730                   arctags archeads allparents allchildren} {
7731        global $v
7732        catch {unset $v}
7733    }
7734    set allcwait 0
7735    set nextarc 0
7736    set cachedarcs 0
7737    set seeds {}
7738    getallcommits
7739}
7740
7741proc writecache {f} {
7742    global cachearc cachedarcs allccache
7743    global arcstart arcend arcnos arcids arcout
7744
7745    set a $cachearc
7746    set lim $cachedarcs
7747    if {$lim - $a > 1000} {
7748        set lim [expr {$a + 1000}]
7749    }
7750    if {[catch {
7751        while {[incr a] <= $lim} {
7752            if {[info exists arcend($a)]} {
7753                puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
7754            } else {
7755                puts $f [list $arcstart($a) {} $arcids($a)]
7756            }
7757        }
7758    } err]} {
7759        catch {close $f}
7760        catch {file delete $allccache}
7761        #puts "writing cache failed ($err)"
7762        return 0
7763    }
7764    set cachearc [expr {$a - 1}]
7765    if {$a > $cachedarcs} {
7766        puts $f "1"
7767        close $f
7768        return 0
7769    }
7770    return 1
7771}
7772
7773proc savecache {} {
7774    global nextarc cachedarcs cachearc allccache
7775
7776    if {$nextarc == $cachedarcs} return
7777    set cachearc 0
7778    set cachedarcs $nextarc
7779    catch {
7780        set f [open $allccache w]
7781        puts $f [list 1 $cachedarcs]
7782        run writecache $f
7783    }
7784}
7785
7786# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
7787# or 0 if neither is true.
7788proc anc_or_desc {a b} {
7789    global arcout arcstart arcend arcnos cached_isanc
7790
7791    if {$arcnos($a) eq $arcnos($b)} {
7792        # Both are on the same arc(s); either both are the same BMP,
7793        # or if one is not a BMP, the other is also not a BMP or is
7794        # the BMP at end of the arc (and it only has 1 incoming arc).
7795        # Or both can be BMPs with no incoming arcs.
7796        if {$a eq $b || $arcnos($a) eq {}} {
7797            return 0
7798        }
7799        # assert {[llength $arcnos($a)] == 1}
7800        set arc [lindex $arcnos($a) 0]
7801        set i [lsearch -exact $arcids($arc) $a]
7802        set j [lsearch -exact $arcids($arc) $b]
7803        if {$i < 0 || $i > $j} {
7804            return 1
7805        } else {
7806            return -1
7807        }
7808    }
7809
7810    if {![info exists arcout($a)]} {
7811        set arc [lindex $arcnos($a) 0]
7812        if {[info exists arcend($arc)]} {
7813            set aend $arcend($arc)
7814        } else {
7815            set aend {}
7816        }
7817        set a $arcstart($arc)
7818    } else {
7819        set aend $a
7820    }
7821    if {![info exists arcout($b)]} {
7822        set arc [lindex $arcnos($b) 0]
7823        if {[info exists arcend($arc)]} {
7824            set bend $arcend($arc)
7825        } else {
7826            set bend {}
7827        }
7828        set b $arcstart($arc)
7829    } else {
7830        set bend $b
7831    }
7832    if {$a eq $bend} {
7833        return 1
7834    }
7835    if {$b eq $aend} {
7836        return -1
7837    }
7838    if {[info exists cached_isanc($a,$bend)]} {
7839        if {$cached_isanc($a,$bend)} {
7840            return 1
7841        }
7842    }
7843    if {[info exists cached_isanc($b,$aend)]} {
7844        if {$cached_isanc($b,$aend)} {
7845            return -1
7846        }
7847        if {[info exists cached_isanc($a,$bend)]} {
7848            return 0
7849        }
7850    }
7851
7852    set todo [list $a $b]
7853    set anc($a) a
7854    set anc($b) b
7855    for {set i 0} {$i < [llength $todo]} {incr i} {
7856        set x [lindex $todo $i]
7857        if {$anc($x) eq {}} {
7858            continue
7859        }
7860        foreach arc $arcnos($x) {
7861            set xd $arcstart($arc)
7862            if {$xd eq $bend} {
7863                set cached_isanc($a,$bend) 1
7864                set cached_isanc($b,$aend) 0
7865                return 1
7866            } elseif {$xd eq $aend} {
7867                set cached_isanc($b,$aend) 1
7868                set cached_isanc($a,$bend) 0
7869                return -1
7870            }
7871            if {![info exists anc($xd)]} {
7872                set anc($xd) $anc($x)
7873                lappend todo $xd
7874            } elseif {$anc($xd) ne $anc($x)} {
7875                set anc($xd) {}
7876            }
7877        }
7878    }
7879    set cached_isanc($a,$bend) 0
7880    set cached_isanc($b,$aend) 0
7881    return 0
7882}
7883
7884# This identifies whether $desc has an ancestor that is
7885# a growing tip of the graph and which is not an ancestor of $anc
7886# and returns 0 if so and 1 if not.
7887# If we subsequently discover a tag on such a growing tip, and that
7888# turns out to be a descendent of $anc (which it could, since we
7889# don't necessarily see children before parents), then $desc
7890# isn't a good choice to display as a descendent tag of
7891# $anc (since it is the descendent of another tag which is
7892# a descendent of $anc).  Similarly, $anc isn't a good choice to
7893# display as a ancestor tag of $desc.
7894#
7895proc is_certain {desc anc} {
7896    global arcnos arcout arcstart arcend growing problems
7897
7898    set certain {}
7899    if {[llength $arcnos($anc)] == 1} {
7900        # tags on the same arc are certain
7901        if {$arcnos($desc) eq $arcnos($anc)} {
7902            return 1
7903        }
7904        if {![info exists arcout($anc)]} {
7905            # if $anc is partway along an arc, use the start of the arc instead
7906            set a [lindex $arcnos($anc) 0]
7907            set anc $arcstart($a)
7908        }
7909    }
7910    if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
7911        set x $desc
7912    } else {
7913        set a [lindex $arcnos($desc) 0]
7914        set x $arcend($a)
7915    }
7916    if {$x == $anc} {
7917        return 1
7918    }
7919    set anclist [list $x]
7920    set dl($x) 1
7921    set nnh 1
7922    set ngrowanc 0
7923    for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
7924        set x [lindex $anclist $i]
7925        if {$dl($x)} {
7926            incr nnh -1
7927        }
7928        set done($x) 1
7929        foreach a $arcout($x) {
7930            if {[info exists growing($a)]} {
7931                if {![info exists growanc($x)] && $dl($x)} {
7932                    set growanc($x) 1
7933                    incr ngrowanc
7934                }
7935            } else {
7936                set y $arcend($a)
7937                if {[info exists dl($y)]} {
7938                    if {$dl($y)} {
7939                        if {!$dl($x)} {
7940                            set dl($y) 0
7941                            if {![info exists done($y)]} {
7942                                incr nnh -1
7943                            }
7944                            if {[info exists growanc($x)]} {
7945                                incr ngrowanc -1
7946                            }
7947                            set xl [list $y]
7948                            for {set k 0} {$k < [llength $xl]} {incr k} {
7949                                set z [lindex $xl $k]
7950                                foreach c $arcout($z) {
7951                                    if {[info exists arcend($c)]} {
7952                                        set v $arcend($c)
7953                                        if {[info exists dl($v)] && $dl($v)} {
7954                                            set dl($v) 0
7955                                            if {![info exists done($v)]} {
7956                                                incr nnh -1
7957                                            }
7958                                            if {[info exists growanc($v)]} {
7959                                                incr ngrowanc -1
7960                                            }
7961                                            lappend xl $v
7962                                        }
7963                                    }
7964                                }
7965                            }
7966                        }
7967                    }
7968                } elseif {$y eq $anc || !$dl($x)} {
7969                    set dl($y) 0
7970                    lappend anclist $y
7971                } else {
7972                    set dl($y) 1
7973                    lappend anclist $y
7974                    incr nnh
7975                }
7976            }
7977        }
7978    }
7979    foreach x [array names growanc] {
7980        if {$dl($x)} {
7981            return 0
7982        }
7983        return 0
7984    }
7985    return 1
7986}
7987
7988proc validate_arctags {a} {
7989    global arctags idtags
7990
7991    set i -1
7992    set na $arctags($a)
7993    foreach id $arctags($a) {
7994        incr i
7995        if {![info exists idtags($id)]} {
7996            set na [lreplace $na $i $i]
7997            incr i -1
7998        }
7999    }
8000    set arctags($a) $na
8001}
8002
8003proc validate_archeads {a} {
8004    global archeads idheads
8005
8006    set i -1
8007    set na $archeads($a)
8008    foreach id $archeads($a) {
8009        incr i
8010        if {![info exists idheads($id)]} {
8011            set na [lreplace $na $i $i]
8012            incr i -1
8013        }
8014    }
8015    set archeads($a) $na
8016}
8017
8018# Return the list of IDs that have tags that are descendents of id,
8019# ignoring IDs that are descendents of IDs already reported.
8020proc desctags {id} {
8021    global arcnos arcstart arcids arctags idtags allparents
8022    global growing cached_dtags
8023
8024    if {![info exists allparents($id)]} {
8025        return {}
8026    }
8027    set t1 [clock clicks -milliseconds]
8028    set argid $id
8029    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8030        # part-way along an arc; check that arc first
8031        set a [lindex $arcnos($id) 0]
8032        if {$arctags($a) ne {}} {
8033            validate_arctags $a
8034            set i [lsearch -exact $arcids($a) $id]
8035            set tid {}
8036            foreach t $arctags($a) {
8037                set j [lsearch -exact $arcids($a) $t]
8038                if {$j >= $i} break
8039                set tid $t
8040            }
8041            if {$tid ne {}} {
8042                return $tid
8043            }
8044        }
8045        set id $arcstart($a)
8046        if {[info exists idtags($id)]} {
8047            return $id
8048        }
8049    }
8050    if {[info exists cached_dtags($id)]} {
8051        return $cached_dtags($id)
8052    }
8053
8054    set origid $id
8055    set todo [list $id]
8056    set queued($id) 1
8057    set nc 1
8058    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8059        set id [lindex $todo $i]
8060        set done($id) 1
8061        set ta [info exists hastaggedancestor($id)]
8062        if {!$ta} {
8063            incr nc -1
8064        }
8065        # ignore tags on starting node
8066        if {!$ta && $i > 0} {
8067            if {[info exists idtags($id)]} {
8068                set tagloc($id) $id
8069                set ta 1
8070            } elseif {[info exists cached_dtags($id)]} {
8071                set tagloc($id) $cached_dtags($id)
8072                set ta 1
8073            }
8074        }
8075        foreach a $arcnos($id) {
8076            set d $arcstart($a)
8077            if {!$ta && $arctags($a) ne {}} {
8078                validate_arctags $a
8079                if {$arctags($a) ne {}} {
8080                    lappend tagloc($id) [lindex $arctags($a) end]
8081                }
8082            }
8083            if {$ta || $arctags($a) ne {}} {
8084                set tomark [list $d]
8085                for {set j 0} {$j < [llength $tomark]} {incr j} {
8086                    set dd [lindex $tomark $j]
8087                    if {![info exists hastaggedancestor($dd)]} {
8088                        if {[info exists done($dd)]} {
8089                            foreach b $arcnos($dd) {
8090                                lappend tomark $arcstart($b)
8091                            }
8092                            if {[info exists tagloc($dd)]} {
8093                                unset tagloc($dd)
8094                            }
8095                        } elseif {[info exists queued($dd)]} {
8096                            incr nc -1
8097                        }
8098                        set hastaggedancestor($dd) 1
8099                    }
8100                }
8101            }
8102            if {![info exists queued($d)]} {
8103                lappend todo $d
8104                set queued($d) 1
8105                if {![info exists hastaggedancestor($d)]} {
8106                    incr nc
8107                }
8108            }
8109        }
8110    }
8111    set tags {}
8112    foreach id [array names tagloc] {
8113        if {![info exists hastaggedancestor($id)]} {
8114            foreach t $tagloc($id) {
8115                if {[lsearch -exact $tags $t] < 0} {
8116                    lappend tags $t
8117                }
8118            }
8119        }
8120    }
8121    set t2 [clock clicks -milliseconds]
8122    set loopix $i
8123
8124    # remove tags that are descendents of other tags
8125    for {set i 0} {$i < [llength $tags]} {incr i} {
8126        set a [lindex $tags $i]
8127        for {set j 0} {$j < $i} {incr j} {
8128            set b [lindex $tags $j]
8129            set r [anc_or_desc $a $b]
8130            if {$r == 1} {
8131                set tags [lreplace $tags $j $j]
8132                incr j -1
8133                incr i -1
8134            } elseif {$r == -1} {
8135                set tags [lreplace $tags $i $i]
8136                incr i -1
8137                break
8138            }
8139        }
8140    }
8141
8142    if {[array names growing] ne {}} {
8143        # graph isn't finished, need to check if any tag could get
8144        # eclipsed by another tag coming later.  Simply ignore any
8145        # tags that could later get eclipsed.
8146        set ctags {}
8147        foreach t $tags {
8148            if {[is_certain $t $origid]} {
8149                lappend ctags $t
8150            }
8151        }
8152        if {$tags eq $ctags} {
8153            set cached_dtags($origid) $tags
8154        } else {
8155            set tags $ctags
8156        }
8157    } else {
8158        set cached_dtags($origid) $tags
8159    }
8160    set t3 [clock clicks -milliseconds]
8161    if {0 && $t3 - $t1 >= 100} {
8162        puts "iterating descendents ($loopix/[llength $todo] nodes) took\
8163            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8164    }
8165    return $tags
8166}
8167
8168proc anctags {id} {
8169    global arcnos arcids arcout arcend arctags idtags allparents
8170    global growing cached_atags
8171
8172    if {![info exists allparents($id)]} {
8173        return {}
8174    }
8175    set t1 [clock clicks -milliseconds]
8176    set argid $id
8177    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8178        # part-way along an arc; check that arc first
8179        set a [lindex $arcnos($id) 0]
8180        if {$arctags($a) ne {}} {
8181            validate_arctags $a
8182            set i [lsearch -exact $arcids($a) $id]
8183            foreach t $arctags($a) {
8184                set j [lsearch -exact $arcids($a) $t]
8185                if {$j > $i} {
8186                    return $t
8187                }
8188            }
8189        }
8190        if {![info exists arcend($a)]} {
8191            return {}
8192        }
8193        set id $arcend($a)
8194        if {[info exists idtags($id)]} {
8195            return $id
8196        }
8197    }
8198    if {[info exists cached_atags($id)]} {
8199        return $cached_atags($id)
8200    }
8201
8202    set origid $id
8203    set todo [list $id]
8204    set queued($id) 1
8205    set taglist {}
8206    set nc 1
8207    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8208        set id [lindex $todo $i]
8209        set done($id) 1
8210        set td [info exists hastaggeddescendent($id)]
8211        if {!$td} {
8212            incr nc -1
8213        }
8214        # ignore tags on starting node
8215        if {!$td && $i > 0} {
8216            if {[info exists idtags($id)]} {
8217                set tagloc($id) $id
8218                set td 1
8219            } elseif {[info exists cached_atags($id)]} {
8220                set tagloc($id) $cached_atags($id)
8221                set td 1
8222            }
8223        }
8224        foreach a $arcout($id) {
8225            if {!$td && $arctags($a) ne {}} {
8226                validate_arctags $a
8227                if {$arctags($a) ne {}} {
8228                    lappend tagloc($id) [lindex $arctags($a) 0]
8229                }
8230            }
8231            if {![info exists arcend($a)]} continue
8232            set d $arcend($a)
8233            if {$td || $arctags($a) ne {}} {
8234                set tomark [list $d]
8235                for {set j 0} {$j < [llength $tomark]} {incr j} {
8236                    set dd [lindex $tomark $j]
8237                    if {![info exists hastaggeddescendent($dd)]} {
8238                        if {[info exists done($dd)]} {
8239                            foreach b $arcout($dd) {
8240                                if {[info exists arcend($b)]} {
8241                                    lappend tomark $arcend($b)
8242                                }
8243                            }
8244                            if {[info exists tagloc($dd)]} {
8245                                unset tagloc($dd)
8246                            }
8247                        } elseif {[info exists queued($dd)]} {
8248                            incr nc -1
8249                        }
8250                        set hastaggeddescendent($dd) 1
8251                    }
8252                }
8253            }
8254            if {![info exists queued($d)]} {
8255                lappend todo $d
8256                set queued($d) 1
8257                if {![info exists hastaggeddescendent($d)]} {
8258                    incr nc
8259                }
8260            }
8261        }
8262    }
8263    set t2 [clock clicks -milliseconds]
8264    set loopix $i
8265    set tags {}
8266    foreach id [array names tagloc] {
8267        if {![info exists hastaggeddescendent($id)]} {
8268            foreach t $tagloc($id) {
8269                if {[lsearch -exact $tags $t] < 0} {
8270                    lappend tags $t
8271                }
8272            }
8273        }
8274    }
8275
8276    # remove tags that are ancestors of other tags
8277    for {set i 0} {$i < [llength $tags]} {incr i} {
8278        set a [lindex $tags $i]
8279        for {set j 0} {$j < $i} {incr j} {
8280            set b [lindex $tags $j]
8281            set r [anc_or_desc $a $b]
8282            if {$r == -1} {
8283                set tags [lreplace $tags $j $j]
8284                incr j -1
8285                incr i -1
8286            } elseif {$r == 1} {
8287                set tags [lreplace $tags $i $i]
8288                incr i -1
8289                break
8290            }
8291        }
8292    }
8293
8294    if {[array names growing] ne {}} {
8295        # graph isn't finished, need to check if any tag could get
8296        # eclipsed by another tag coming later.  Simply ignore any
8297        # tags that could later get eclipsed.
8298        set ctags {}
8299        foreach t $tags {
8300            if {[is_certain $origid $t]} {
8301                lappend ctags $t
8302            }
8303        }
8304        if {$tags eq $ctags} {
8305            set cached_atags($origid) $tags
8306        } else {
8307            set tags $ctags
8308        }
8309    } else {
8310        set cached_atags($origid) $tags
8311    }
8312    set t3 [clock clicks -milliseconds]
8313    if {0 && $t3 - $t1 >= 100} {
8314        puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
8315            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8316    }
8317    return $tags
8318}
8319
8320# Return the list of IDs that have heads that are descendents of id,
8321# including id itself if it has a head.
8322proc descheads {id} {
8323    global arcnos arcstart arcids archeads idheads cached_dheads
8324    global allparents
8325
8326    if {![info exists allparents($id)]} {
8327        return {}
8328    }
8329    set aret {}
8330    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8331        # part-way along an arc; check it first
8332        set a [lindex $arcnos($id) 0]
8333        if {$archeads($a) ne {}} {
8334            validate_archeads $a
8335            set i [lsearch -exact $arcids($a) $id]
8336            foreach t $archeads($a) {
8337                set j [lsearch -exact $arcids($a) $t]
8338                if {$j > $i} break
8339                lappend aret $t
8340            }
8341        }
8342        set id $arcstart($a)
8343    }
8344    set origid $id
8345    set todo [list $id]
8346    set seen($id) 1
8347    set ret {}
8348    for {set i 0} {$i < [llength $todo]} {incr i} {
8349        set id [lindex $todo $i]
8350        if {[info exists cached_dheads($id)]} {
8351            set ret [concat $ret $cached_dheads($id)]
8352        } else {
8353            if {[info exists idheads($id)]} {
8354                lappend ret $id
8355            }
8356            foreach a $arcnos($id) {
8357                if {$archeads($a) ne {}} {
8358                    validate_archeads $a
8359                    if {$archeads($a) ne {}} {
8360                        set ret [concat $ret $archeads($a)]
8361                    }
8362                }
8363                set d $arcstart($a)
8364                if {![info exists seen($d)]} {
8365                    lappend todo $d
8366                    set seen($d) 1
8367                }
8368            }
8369        }
8370    }
8371    set ret [lsort -unique $ret]
8372    set cached_dheads($origid) $ret
8373    return [concat $ret $aret]
8374}
8375
8376proc addedtag {id} {
8377    global arcnos arcout cached_dtags cached_atags
8378
8379    if {![info exists arcnos($id)]} return
8380    if {![info exists arcout($id)]} {
8381        recalcarc [lindex $arcnos($id) 0]
8382    }
8383    catch {unset cached_dtags}
8384    catch {unset cached_atags}
8385}
8386
8387proc addedhead {hid head} {
8388    global arcnos arcout cached_dheads
8389
8390    if {![info exists arcnos($hid)]} return
8391    if {![info exists arcout($hid)]} {
8392        recalcarc [lindex $arcnos($hid) 0]
8393    }
8394    catch {unset cached_dheads}
8395}
8396
8397proc removedhead {hid head} {
8398    global cached_dheads
8399
8400    catch {unset cached_dheads}
8401}
8402
8403proc movedhead {hid head} {
8404    global arcnos arcout cached_dheads
8405
8406    if {![info exists arcnos($hid)]} return
8407    if {![info exists arcout($hid)]} {
8408        recalcarc [lindex $arcnos($hid) 0]
8409    }
8410    catch {unset cached_dheads}
8411}
8412
8413proc changedrefs {} {
8414    global cached_dheads cached_dtags cached_atags
8415    global arctags archeads arcnos arcout idheads idtags
8416
8417    foreach id [concat [array names idheads] [array names idtags]] {
8418        if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
8419            set a [lindex $arcnos($id) 0]
8420            if {![info exists donearc($a)]} {
8421                recalcarc $a
8422                set donearc($a) 1
8423            }
8424        }
8425    }
8426    catch {unset cached_dtags}
8427    catch {unset cached_atags}
8428    catch {unset cached_dheads}
8429}
8430
8431proc rereadrefs {} {
8432    global idtags idheads idotherrefs mainheadid
8433
8434    set refids [concat [array names idtags] \
8435                    [array names idheads] [array names idotherrefs]]
8436    foreach id $refids {
8437        if {![info exists ref($id)]} {
8438            set ref($id) [listrefs $id]
8439        }
8440    }
8441    set oldmainhead $mainheadid
8442    readrefs
8443    changedrefs
8444    set refids [lsort -unique [concat $refids [array names idtags] \
8445                        [array names idheads] [array names idotherrefs]]]
8446    foreach id $refids {
8447        set v [listrefs $id]
8448        if {![info exists ref($id)] || $ref($id) != $v ||
8449            ($id eq $oldmainhead && $id ne $mainheadid) ||
8450            ($id eq $mainheadid && $id ne $oldmainhead)} {
8451            redrawtags $id
8452        }
8453    }
8454    run refill_reflist
8455}
8456
8457proc listrefs {id} {
8458    global idtags idheads idotherrefs
8459
8460    set x {}
8461    if {[info exists idtags($id)]} {
8462        set x $idtags($id)
8463    }
8464    set y {}
8465    if {[info exists idheads($id)]} {
8466        set y $idheads($id)
8467    }
8468    set z {}
8469    if {[info exists idotherrefs($id)]} {
8470        set z $idotherrefs($id)
8471    }
8472    return [list $x $y $z]
8473}
8474
8475proc showtag {tag isnew} {
8476    global ctext tagcontents tagids linknum tagobjid
8477
8478    if {$isnew} {
8479        addtohistory [list showtag $tag 0]
8480    }
8481    $ctext conf -state normal
8482    clear_ctext
8483    settabs 0
8484    set linknum 0
8485    if {![info exists tagcontents($tag)]} {
8486        catch {
8487            set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
8488        }
8489    }
8490    if {[info exists tagcontents($tag)]} {
8491        set text $tagcontents($tag)
8492    } else {
8493        set text "[mc "Tag"]: $tag\n[mc "Id"]:  $tagids($tag)"
8494    }
8495    appendwithlinks $text {}
8496    $ctext conf -state disabled
8497    init_flist {}
8498}
8499
8500proc doquit {} {
8501    global stopped
8502    set stopped 100
8503    savestuff .
8504    destroy .
8505}
8506
8507proc mkfontdisp {font top which} {
8508    global fontattr fontpref $font
8509
8510    set fontpref($font) [set $font]
8511    button $top.${font}but -text $which -font optionfont \
8512        -command [list choosefont $font $which]
8513    label $top.$font -relief flat -font $font \
8514        -text $fontattr($font,family) -justify left
8515    grid x $top.${font}but $top.$font -sticky w
8516}
8517
8518proc choosefont {font which} {
8519    global fontparam fontlist fonttop fontattr
8520
8521    set fontparam(which) $which
8522    set fontparam(font) $font
8523    set fontparam(family) [font actual $font -family]
8524    set fontparam(size) $fontattr($font,size)
8525    set fontparam(weight) $fontattr($font,weight)
8526    set fontparam(slant) $fontattr($font,slant)
8527    set top .gitkfont
8528    set fonttop $top
8529    if {![winfo exists $top]} {
8530        font create sample
8531        eval font config sample [font actual $font]
8532        toplevel $top
8533        wm title $top [mc "Gitk font chooser"]
8534        label $top.l -textvariable fontparam(which)
8535        pack $top.l -side top
8536        set fontlist [lsort [font families]]
8537        frame $top.f
8538        listbox $top.f.fam -listvariable fontlist \
8539            -yscrollcommand [list $top.f.sb set]
8540        bind $top.f.fam <<ListboxSelect>> selfontfam
8541        scrollbar $top.f.sb -command [list $top.f.fam yview]
8542        pack $top.f.sb -side right -fill y
8543        pack $top.f.fam -side left -fill both -expand 1
8544        pack $top.f -side top -fill both -expand 1
8545        frame $top.g
8546        spinbox $top.g.size -from 4 -to 40 -width 4 \
8547            -textvariable fontparam(size) \
8548            -validatecommand {string is integer -strict %s}
8549        checkbutton $top.g.bold -padx 5 \
8550            -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
8551            -variable fontparam(weight) -onvalue bold -offvalue normal
8552        checkbutton $top.g.ital -padx 5 \
8553            -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
8554            -variable fontparam(slant) -onvalue italic -offvalue roman
8555        pack $top.g.size $top.g.bold $top.g.ital -side left
8556        pack $top.g -side top
8557        canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
8558            -background white
8559        $top.c create text 100 25 -anchor center -text $which -font sample \
8560            -fill black -tags text
8561        bind $top.c <Configure> [list centertext $top.c]
8562        pack $top.c -side top -fill x
8563        frame $top.buts
8564        button $top.buts.ok -text [mc "OK"] -command fontok -default active
8565        button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
8566        grid $top.buts.ok $top.buts.can
8567        grid columnconfigure $top.buts 0 -weight 1 -uniform a
8568        grid columnconfigure $top.buts 1 -weight 1 -uniform a
8569        pack $top.buts -side bottom -fill x
8570        trace add variable fontparam write chg_fontparam
8571    } else {
8572        raise $top
8573        $top.c itemconf text -text $which
8574    }
8575    set i [lsearch -exact $fontlist $fontparam(family)]
8576    if {$i >= 0} {
8577        $top.f.fam selection set $i
8578        $top.f.fam see $i
8579    }
8580}
8581
8582proc centertext {w} {
8583    $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
8584}
8585
8586proc fontok {} {
8587    global fontparam fontpref prefstop
8588
8589    set f $fontparam(font)
8590    set fontpref($f) [list $fontparam(family) $fontparam(size)]
8591    if {$fontparam(weight) eq "bold"} {
8592        lappend fontpref($f) "bold"
8593    }
8594    if {$fontparam(slant) eq "italic"} {
8595        lappend fontpref($f) "italic"
8596    }
8597    set w $prefstop.$f
8598    $w conf -text $fontparam(family) -font $fontpref($f)
8599        
8600    fontcan
8601}
8602
8603proc fontcan {} {
8604    global fonttop fontparam
8605
8606    if {[info exists fonttop]} {
8607        catch {destroy $fonttop}
8608        catch {font delete sample}
8609        unset fonttop
8610        unset fontparam
8611    }
8612}
8613
8614proc selfontfam {} {
8615    global fonttop fontparam
8616
8617    set i [$fonttop.f.fam curselection]
8618    if {$i ne {}} {
8619        set fontparam(family) [$fonttop.f.fam get $i]
8620    }
8621}
8622
8623proc chg_fontparam {v sub op} {
8624    global fontparam
8625
8626    font config sample -$sub $fontparam($sub)
8627}
8628
8629proc doprefs {} {
8630    global maxwidth maxgraphpct
8631    global oldprefs prefstop showneartags showlocalchanges
8632    global bgcolor fgcolor ctext diffcolors selectbgcolor
8633    global tabstop limitdiffs
8634
8635    set top .gitkprefs
8636    set prefstop $top
8637    if {[winfo exists $top]} {
8638        raise $top
8639        return
8640    }
8641    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8642                   limitdiffs tabstop} {
8643        set oldprefs($v) [set $v]
8644    }
8645    toplevel $top
8646    wm title $top [mc "Gitk preferences"]
8647    label $top.ldisp -text [mc "Commit list display options"]
8648    grid $top.ldisp - -sticky w -pady 10
8649    label $top.spacer -text " "
8650    label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
8651        -font optionfont
8652    spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
8653    grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
8654    label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
8655        -font optionfont
8656    spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
8657    grid x $top.maxpctl $top.maxpct -sticky w
8658    frame $top.showlocal
8659    label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
8660    checkbutton $top.showlocal.b -variable showlocalchanges
8661    pack $top.showlocal.b $top.showlocal.l -side left
8662    grid x $top.showlocal -sticky w
8663
8664    label $top.ddisp -text [mc "Diff display options"]
8665    grid $top.ddisp - -sticky w -pady 10
8666    label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
8667    spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
8668    grid x $top.tabstopl $top.tabstop -sticky w
8669    frame $top.ntag
8670    label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
8671    checkbutton $top.ntag.b -variable showneartags
8672    pack $top.ntag.b $top.ntag.l -side left
8673    grid x $top.ntag -sticky w
8674    frame $top.ldiff
8675    label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
8676    checkbutton $top.ldiff.b -variable limitdiffs
8677    pack $top.ldiff.b $top.ldiff.l -side left
8678    grid x $top.ldiff -sticky w
8679
8680    label $top.cdisp -text [mc "Colors: press to choose"]
8681    grid $top.cdisp - -sticky w -pady 10
8682    label $top.bg -padx 40 -relief sunk -background $bgcolor
8683    button $top.bgbut -text [mc "Background"] -font optionfont \
8684        -command [list choosecolor bgcolor 0 $top.bg background setbg]
8685    grid x $top.bgbut $top.bg -sticky w
8686    label $top.fg -padx 40 -relief sunk -background $fgcolor
8687    button $top.fgbut -text [mc "Foreground"] -font optionfont \
8688        -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
8689    grid x $top.fgbut $top.fg -sticky w
8690    label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
8691    button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
8692        -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
8693                      [list $ctext tag conf d0 -foreground]]
8694    grid x $top.diffoldbut $top.diffold -sticky w
8695    label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
8696    button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
8697        -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
8698                      [list $ctext tag conf d1 -foreground]]
8699    grid x $top.diffnewbut $top.diffnew -sticky w
8700    label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
8701    button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
8702        -command [list choosecolor diffcolors 2 $top.hunksep \
8703                      "diff hunk header" \
8704                      [list $ctext tag conf hunksep -foreground]]
8705    grid x $top.hunksepbut $top.hunksep -sticky w
8706    label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
8707    button $top.selbgbut -text [mc "Select bg"] -font optionfont \
8708        -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
8709    grid x $top.selbgbut $top.selbgsep -sticky w
8710
8711    label $top.cfont -text [mc "Fonts: press to choose"]
8712    grid $top.cfont - -sticky w -pady 10
8713    mkfontdisp mainfont $top [mc "Main font"]
8714    mkfontdisp textfont $top [mc "Diff display font"]
8715    mkfontdisp uifont $top [mc "User interface font"]
8716
8717    frame $top.buts
8718    button $top.buts.ok -text [mc "OK"] -command prefsok -default active
8719    button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
8720    grid $top.buts.ok $top.buts.can
8721    grid columnconfigure $top.buts 0 -weight 1 -uniform a
8722    grid columnconfigure $top.buts 1 -weight 1 -uniform a
8723    grid $top.buts - - -pady 10 -sticky ew
8724    bind $top <Visibility> "focus $top.buts.ok"
8725}
8726
8727proc choosecolor {v vi w x cmd} {
8728    global $v
8729
8730    set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
8731               -title [mc "Gitk: choose color for %s" $x]]
8732    if {$c eq {}} return
8733    $w conf -background $c
8734    lset $v $vi $c
8735    eval $cmd $c
8736}
8737
8738proc setselbg {c} {
8739    global bglist cflist
8740    foreach w $bglist {
8741        $w configure -selectbackground $c
8742    }
8743    $cflist tag configure highlight \
8744        -background [$cflist cget -selectbackground]
8745    allcanvs itemconf secsel -fill $c
8746}
8747
8748proc setbg {c} {
8749    global bglist
8750
8751    foreach w $bglist {
8752        $w conf -background $c
8753    }
8754}
8755
8756proc setfg {c} {
8757    global fglist canv
8758
8759    foreach w $fglist {
8760        $w conf -foreground $c
8761    }
8762    allcanvs itemconf text -fill $c
8763    $canv itemconf circle -outline $c
8764}
8765
8766proc prefscan {} {
8767    global oldprefs prefstop
8768
8769    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8770                   limitdiffs tabstop} {
8771        global $v
8772        set $v $oldprefs($v)
8773    }
8774    catch {destroy $prefstop}
8775    unset prefstop
8776    fontcan
8777}
8778
8779proc prefsok {} {
8780    global maxwidth maxgraphpct
8781    global oldprefs prefstop showneartags showlocalchanges
8782    global fontpref mainfont textfont uifont
8783    global limitdiffs treediffs
8784
8785    catch {destroy $prefstop}
8786    unset prefstop
8787    fontcan
8788    set fontchanged 0
8789    if {$mainfont ne $fontpref(mainfont)} {
8790        set mainfont $fontpref(mainfont)
8791        parsefont mainfont $mainfont
8792        eval font configure mainfont [fontflags mainfont]
8793        eval font configure mainfontbold [fontflags mainfont 1]
8794        setcoords
8795        set fontchanged 1
8796    }
8797    if {$textfont ne $fontpref(textfont)} {
8798        set textfont $fontpref(textfont)
8799        parsefont textfont $textfont
8800        eval font configure textfont [fontflags textfont]
8801        eval font configure textfontbold [fontflags textfont 1]
8802    }
8803    if {$uifont ne $fontpref(uifont)} {
8804        set uifont $fontpref(uifont)
8805        parsefont uifont $uifont
8806        eval font configure uifont [fontflags uifont]
8807    }
8808    settabs
8809    if {$showlocalchanges != $oldprefs(showlocalchanges)} {
8810        if {$showlocalchanges} {
8811            doshowlocalchanges
8812        } else {
8813            dohidelocalchanges
8814        }
8815    }
8816    if {$limitdiffs != $oldprefs(limitdiffs)} {
8817        # treediffs elements are limited by path
8818        catch {unset treediffs}
8819    }
8820    if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
8821        || $maxgraphpct != $oldprefs(maxgraphpct)} {
8822        redisplay
8823    } elseif {$showneartags != $oldprefs(showneartags) ||
8824          $limitdiffs != $oldprefs(limitdiffs)} {
8825        reselectline
8826    }
8827}
8828
8829proc formatdate {d} {
8830    global datetimeformat
8831    if {$d ne {}} {
8832        set d [clock format $d -format $datetimeformat]
8833    }
8834    return $d
8835}
8836
8837# This list of encoding names and aliases is distilled from
8838# http://www.iana.org/assignments/character-sets.
8839# Not all of them are supported by Tcl.
8840set encoding_aliases {
8841    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
8842      ISO646-US US-ASCII us IBM367 cp367 csASCII }
8843    { ISO-10646-UTF-1 csISO10646UTF1 }
8844    { ISO_646.basic:1983 ref csISO646basic1983 }
8845    { INVARIANT csINVARIANT }
8846    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
8847    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
8848    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
8849    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
8850    { NATS-DANO iso-ir-9-1 csNATSDANO }
8851    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
8852    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
8853    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
8854    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
8855    { ISO-2022-KR csISO2022KR }
8856    { EUC-KR csEUCKR }
8857    { ISO-2022-JP csISO2022JP }
8858    { ISO-2022-JP-2 csISO2022JP2 }
8859    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
8860      csISO13JISC6220jp }
8861    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
8862    { IT iso-ir-15 ISO646-IT csISO15Italian }
8863    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
8864    { ES iso-ir-17 ISO646-ES csISO17Spanish }
8865    { greek7-old iso-ir-18 csISO18Greek7Old }
8866    { latin-greek iso-ir-19 csISO19LatinGreek }
8867    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
8868    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
8869    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
8870    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
8871    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
8872    { BS_viewdata iso-ir-47 csISO47BSViewdata }
8873    { INIS iso-ir-49 csISO49INIS }
8874    { INIS-8 iso-ir-50 csISO50INIS8 }
8875    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
8876    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
8877    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
8878    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
8879    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
8880    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
8881      csISO60Norwegian1 }
8882    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
8883    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
8884    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
8885    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
8886    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
8887    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
8888    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
8889    { greek7 iso-ir-88 csISO88Greek7 }
8890    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
8891    { iso-ir-90 csISO90 }
8892    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
8893    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
8894      csISO92JISC62991984b }
8895    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
8896    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
8897    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
8898      csISO95JIS62291984handadd }
8899    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
8900    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
8901    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
8902    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
8903      CP819 csISOLatin1 }
8904    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
8905    { T.61-7bit iso-ir-102 csISO102T617bit }
8906    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
8907    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
8908    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
8909    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
8910    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
8911    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
8912    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
8913    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
8914      arabic csISOLatinArabic }
8915    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
8916    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
8917    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
8918      greek greek8 csISOLatinGreek }
8919    { T.101-G2 iso-ir-128 csISO128T101G2 }
8920    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
8921      csISOLatinHebrew }
8922    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
8923    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
8924    { CSN_369103 iso-ir-139 csISO139CSN369103 }
8925    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
8926    { ISO_6937-2-add iso-ir-142 csISOTextComm }
8927    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
8928    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
8929      csISOLatinCyrillic }
8930    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
8931    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
8932    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
8933    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
8934    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
8935    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
8936    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
8937    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
8938    { ISO_10367-box iso-ir-155 csISO10367Box }
8939    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
8940    { latin-lap lap iso-ir-158 csISO158Lap }
8941    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
8942    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
8943    { us-dk csUSDK }
8944    { dk-us csDKUS }
8945    { JIS_X0201 X0201 csHalfWidthKatakana }
8946    { KSC5636 ISO646-KR csKSC5636 }
8947    { ISO-10646-UCS-2 csUnicode }
8948    { ISO-10646-UCS-4 csUCS4 }
8949    { DEC-MCS dec csDECMCS }
8950    { hp-roman8 roman8 r8 csHPRoman8 }
8951    { macintosh mac csMacintosh }
8952    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
8953      csIBM037 }
8954    { IBM038 EBCDIC-INT cp038 csIBM038 }
8955    { IBM273 CP273 csIBM273 }
8956    { IBM274 EBCDIC-BE CP274 csIBM274 }
8957    { IBM275 EBCDIC-BR cp275 csIBM275 }
8958    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
8959    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
8960    { IBM280 CP280 ebcdic-cp-it csIBM280 }
8961    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
8962    { IBM284 CP284 ebcdic-cp-es csIBM284 }
8963    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
8964    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
8965    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
8966    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
8967    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
8968    { IBM424 cp424 ebcdic-cp-he csIBM424 }
8969    { IBM437 cp437 437 csPC8CodePage437 }
8970    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
8971    { IBM775 cp775 csPC775Baltic }
8972    { IBM850 cp850 850 csPC850Multilingual }
8973    { IBM851 cp851 851 csIBM851 }
8974    { IBM852 cp852 852 csPCp852 }
8975    { IBM855 cp855 855 csIBM855 }
8976    { IBM857 cp857 857 csIBM857 }
8977    { IBM860 cp860 860 csIBM860 }
8978    { IBM861 cp861 861 cp-is csIBM861 }
8979    { IBM862 cp862 862 csPC862LatinHebrew }
8980    { IBM863 cp863 863 csIBM863 }
8981    { IBM864 cp864 csIBM864 }
8982    { IBM865 cp865 865 csIBM865 }
8983    { IBM866 cp866 866 csIBM866 }
8984    { IBM868 CP868 cp-ar csIBM868 }
8985    { IBM869 cp869 869 cp-gr csIBM869 }
8986    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
8987    { IBM871 CP871 ebcdic-cp-is csIBM871 }
8988    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
8989    { IBM891 cp891 csIBM891 }
8990    { IBM903 cp903 csIBM903 }
8991    { IBM904 cp904 904 csIBBM904 }
8992    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
8993    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
8994    { IBM1026 CP1026 csIBM1026 }
8995    { EBCDIC-AT-DE csIBMEBCDICATDE }
8996    { EBCDIC-AT-DE-A csEBCDICATDEA }
8997    { EBCDIC-CA-FR csEBCDICCAFR }
8998    { EBCDIC-DK-NO csEBCDICDKNO }
8999    { EBCDIC-DK-NO-A csEBCDICDKNOA }
9000    { EBCDIC-FI-SE csEBCDICFISE }
9001    { EBCDIC-FI-SE-A csEBCDICFISEA }
9002    { EBCDIC-FR csEBCDICFR }
9003    { EBCDIC-IT csEBCDICIT }
9004    { EBCDIC-PT csEBCDICPT }
9005    { EBCDIC-ES csEBCDICES }
9006    { EBCDIC-ES-A csEBCDICESA }
9007    { EBCDIC-ES-S csEBCDICESS }
9008    { EBCDIC-UK csEBCDICUK }
9009    { EBCDIC-US csEBCDICUS }
9010    { UNKNOWN-8BIT csUnknown8BiT }
9011    { MNEMONIC csMnemonic }
9012    { MNEM csMnem }
9013    { VISCII csVISCII }
9014    { VIQR csVIQR }
9015    { KOI8-R csKOI8R }
9016    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
9017    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
9018    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
9019    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
9020    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
9021    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
9022    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
9023    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
9024    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
9025    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
9026    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
9027    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
9028    { IBM1047 IBM-1047 }
9029    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
9030    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
9031    { UNICODE-1-1 csUnicode11 }
9032    { CESU-8 csCESU-8 }
9033    { BOCU-1 csBOCU-1 }
9034    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
9035    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
9036      l8 }
9037    { ISO-8859-15 ISO_8859-15 Latin-9 }
9038    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
9039    { GBK CP936 MS936 windows-936 }
9040    { JIS_Encoding csJISEncoding }
9041    { Shift_JIS MS_Kanji csShiftJIS }
9042    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
9043      EUC-JP }
9044    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
9045    { ISO-10646-UCS-Basic csUnicodeASCII }
9046    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
9047    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
9048    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
9049    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
9050    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
9051    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
9052    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
9053    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
9054    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
9055    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
9056    { Adobe-Standard-Encoding csAdobeStandardEncoding }
9057    { Ventura-US csVenturaUS }
9058    { Ventura-International csVenturaInternational }
9059    { PC8-Danish-Norwegian csPC8DanishNorwegian }
9060    { PC8-Turkish csPC8Turkish }
9061    { IBM-Symbols csIBMSymbols }
9062    { IBM-Thai csIBMThai }
9063    { HP-Legal csHPLegal }
9064    { HP-Pi-font csHPPiFont }
9065    { HP-Math8 csHPMath8 }
9066    { Adobe-Symbol-Encoding csHPPSMath }
9067    { HP-DeskTop csHPDesktop }
9068    { Ventura-Math csVenturaMath }
9069    { Microsoft-Publishing csMicrosoftPublishing }
9070    { Windows-31J csWindows31J }
9071    { GB2312 csGB2312 }
9072    { Big5 csBig5 }
9073}
9074
9075proc tcl_encoding {enc} {
9076    global encoding_aliases
9077    set names [encoding names]
9078    set lcnames [string tolower $names]
9079    set enc [string tolower $enc]
9080    set i [lsearch -exact $lcnames $enc]
9081    if {$i < 0} {
9082        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
9083        if {[regsub {^iso[-_]} $enc iso encx]} {
9084            set i [lsearch -exact $lcnames $encx]
9085        }
9086    }
9087    if {$i < 0} {
9088        foreach l $encoding_aliases {
9089            set ll [string tolower $l]
9090            if {[lsearch -exact $ll $enc] < 0} continue
9091            # look through the aliases for one that tcl knows about
9092            foreach e $ll {
9093                set i [lsearch -exact $lcnames $e]
9094                if {$i < 0} {
9095                    if {[regsub {^iso[-_]} $e iso ex]} {
9096                        set i [lsearch -exact $lcnames $ex]
9097                    }
9098                }
9099                if {$i >= 0} break
9100            }
9101            break
9102        }
9103    }
9104    if {$i >= 0} {
9105        return [lindex $names $i]
9106    }
9107    return {}
9108}
9109
9110# First check that Tcl/Tk is recent enough
9111if {[catch {package require Tk 8.4} err]} {
9112    show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
9113                     Gitk requires at least Tcl/Tk 8.4."]
9114    exit 1
9115}
9116
9117# defaults...
9118set datemode 0
9119set wrcomcmd "git diff-tree --stdin -p --pretty"
9120
9121set gitencoding {}
9122catch {
9123    set gitencoding [exec git config --get i18n.commitencoding]
9124}
9125if {$gitencoding == ""} {
9126    set gitencoding "utf-8"
9127}
9128set tclencoding [tcl_encoding $gitencoding]
9129if {$tclencoding == {}} {
9130    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
9131}
9132
9133set mainfont {Helvetica 9}
9134set textfont {Courier 9}
9135set uifont {Helvetica 9 bold}
9136set tabstop 8
9137set findmergefiles 0
9138set maxgraphpct 50
9139set maxwidth 16
9140set revlistorder 0
9141set fastdate 0
9142set uparrowlen 5
9143set downarrowlen 5
9144set mingaplen 100
9145set cmitmode "patch"
9146set wrapcomment "none"
9147set showneartags 1
9148set maxrefs 20
9149set maxlinelen 200
9150set showlocalchanges 1
9151set limitdiffs 1
9152set datetimeformat "%Y-%m-%d %H:%M:%S"
9153
9154set colors {green red blue magenta darkgrey brown orange}
9155set bgcolor white
9156set fgcolor black
9157set diffcolors {red "#00a000" blue}
9158set diffcontext 3
9159set selectbgcolor gray85
9160
9161## For msgcat loading, first locate the installation location.
9162if { [info exists ::env(GITK_MSGSDIR)] } {
9163    ## Msgsdir was manually set in the environment.
9164    set gitk_msgsdir $::env(GITK_MSGSDIR)
9165} else {
9166    ## Let's guess the prefix from argv0.
9167    set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
9168    set gitk_libdir [file join $gitk_prefix share gitk lib]
9169    set gitk_msgsdir [file join $gitk_libdir msgs]
9170    unset gitk_prefix
9171}
9172
9173## Internationalization (i18n) through msgcat and gettext. See
9174## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
9175package require msgcat
9176namespace import ::msgcat::mc
9177## And eventually load the actual message catalog
9178::msgcat::mcload $gitk_msgsdir
9179
9180catch {source ~/.gitk}
9181
9182font create optionfont -family sans-serif -size -12
9183
9184parsefont mainfont $mainfont
9185eval font create mainfont [fontflags mainfont]
9186eval font create mainfontbold [fontflags mainfont 1]
9187
9188parsefont textfont $textfont
9189eval font create textfont [fontflags textfont]
9190eval font create textfontbold [fontflags textfont 1]
9191
9192parsefont uifont $uifont
9193eval font create uifont [fontflags uifont]
9194
9195setoptions
9196
9197# check that we can find a .git directory somewhere...
9198if {[catch {set gitdir [gitdir]}]} {
9199    show_error {} . [mc "Cannot find a git repository here."]
9200    exit 1
9201}
9202if {![file isdirectory $gitdir]} {
9203    show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
9204    exit 1
9205}
9206
9207set mergeonly 0
9208set revtreeargs {}
9209set cmdline_files {}
9210set i 0
9211foreach arg $argv {
9212    switch -- $arg {
9213        "" { }
9214        "-d" { set datemode 1 }
9215        "--merge" {
9216            set mergeonly 1
9217            lappend revtreeargs $arg
9218        }
9219        "--" {
9220            set cmdline_files [lrange $argv [expr {$i + 1}] end]
9221            break
9222        }
9223        default {
9224            lappend revtreeargs $arg
9225        }
9226    }
9227    incr i
9228}
9229
9230if {$i >= [llength $argv] && $revtreeargs ne {}} {
9231    # no -- on command line, but some arguments (other than -d)
9232    if {[catch {
9233        set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
9234        set cmdline_files [split $f "\n"]
9235        set n [llength $cmdline_files]
9236        set revtreeargs [lrange $revtreeargs 0 end-$n]
9237        # Unfortunately git rev-parse doesn't produce an error when
9238        # something is both a revision and a filename.  To be consistent
9239        # with git log and git rev-list, check revtreeargs for filenames.
9240        foreach arg $revtreeargs {
9241            if {[file exists $arg]} {
9242                show_error {} . [mc "Ambiguous argument '%s': both revision\
9243                                 and filename" $arg]
9244                exit 1
9245            }
9246        }
9247    } err]} {
9248        # unfortunately we get both stdout and stderr in $err,
9249        # so look for "fatal:".
9250        set i [string first "fatal:" $err]
9251        if {$i > 0} {
9252            set err [string range $err [expr {$i + 6}] end]
9253        }
9254        show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
9255        exit 1
9256    }
9257}
9258
9259if {$mergeonly} {
9260    # find the list of unmerged files
9261    set mlist {}
9262    set nr_unmerged 0
9263    if {[catch {
9264        set fd [open "| git ls-files -u" r]
9265    } err]} {
9266        show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
9267        exit 1
9268    }
9269    while {[gets $fd line] >= 0} {
9270        set i [string first "\t" $line]
9271        if {$i < 0} continue
9272        set fname [string range $line [expr {$i+1}] end]
9273        if {[lsearch -exact $mlist $fname] >= 0} continue
9274        incr nr_unmerged
9275        if {$cmdline_files eq {} || [path_filter $cmdline_files $fname]} {
9276            lappend mlist $fname
9277        }
9278    }
9279    catch {close $fd}
9280    if {$mlist eq {}} {
9281        if {$nr_unmerged == 0} {
9282            show_error {} . [mc "No files selected: --merge specified but\
9283                             no files are unmerged."]
9284        } else {
9285            show_error {} . [mc "No files selected: --merge specified but\
9286                             no unmerged files are within file limit."]
9287        }
9288        exit 1
9289    }
9290    set cmdline_files $mlist
9291}
9292
9293set nullid "0000000000000000000000000000000000000000"
9294set nullid2 "0000000000000000000000000000000000000001"
9295
9296set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
9297
9298set runq {}
9299set history {}
9300set historyindex 0
9301set fh_serial 0
9302set nhl_names {}
9303set highlight_paths {}
9304set findpattern {}
9305set searchdirn -forwards
9306set boldrows {}
9307set boldnamerows {}
9308set diffelide {0 0}
9309set markingmatches 0
9310set linkentercount 0
9311set need_redisplay 0
9312set nrows_drawn 0
9313set firsttabstop 0
9314
9315set nextviewnum 1
9316set curview 0
9317set selectedview 0
9318set selectedhlview [mc "None"]
9319set highlight_related [mc "None"]
9320set highlight_files {}
9321set viewfiles(0) {}
9322set viewperm(0) 0
9323set viewargs(0) {}
9324
9325set loginstance 0
9326set cmdlineok 0
9327set stopped 0
9328set stuffsaved 0
9329set patchnum 0
9330set lserial 0
9331setcoords
9332makewindow
9333# wait for the window to become visible
9334tkwait visibility .
9335wm title . "[file tail $argv0]: [file tail [pwd]]"
9336readrefs
9337
9338if {$cmdline_files ne {} || $revtreeargs ne {}} {
9339    # create a view for the files/dirs specified on the command line
9340    set curview 1
9341    set selectedview 1
9342    set nextviewnum 2
9343    set viewname(1) [mc "Command line"]
9344    set viewfiles(1) $cmdline_files
9345    set viewargs(1) $revtreeargs
9346    set viewperm(1) 0
9347    addviewmenu 1
9348    .bar.view entryconf [mc "Edit view..."] -state normal
9349    .bar.view entryconf [mc "Delete view"] -state normal
9350}
9351
9352if {[info exists permviews]} {
9353    foreach v $permviews {
9354        set n $nextviewnum
9355        incr nextviewnum
9356        set viewname($n) [lindex $v 0]
9357        set viewfiles($n) [lindex $v 1]
9358        set viewargs($n) [lindex $v 2]
9359        set viewperm($n) 1
9360        addviewmenu $n
9361    }
9362}
9363getcommits