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