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