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