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