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