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