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