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