19325086bf68951df6a85d17beb1a513cbd8d64a
   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
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
5444    set y [expr {$canvy0 + $l * $linespc}]
5445    set ymax [lindex [$canv cget -scrollregion] 3]
5446    set ytop [expr {$y - $linespc - 1}]
5447    set ybot [expr {$y + $linespc + 1}]
5448    set wnow [$canv yview]
5449    set wtop [expr {[lindex $wnow 0] * $ymax}]
5450    set wbot [expr {[lindex $wnow 1] * $ymax}]
5451    set wh [expr {$wbot - $wtop}]
5452    set newtop $wtop
5453    if {$ytop < $wtop} {
5454        if {$ybot < $wtop} {
5455            set newtop [expr {$y - $wh / 2.0}]
5456        } else {
5457            set newtop $ytop
5458            if {$newtop > $wtop - $linespc} {
5459                set newtop [expr {$wtop - $linespc}]
5460            }
5461        }
5462    } elseif {$ybot > $wbot} {
5463        if {$ytop > $wbot} {
5464            set newtop [expr {$y - $wh / 2.0}]
5465        } else {
5466            set newtop [expr {$ybot - $wh}]
5467            if {$newtop < $wtop + $linespc} {
5468                set newtop [expr {$wtop + $linespc}]
5469            }
5470        }
5471    }
5472    if {$newtop != $wtop} {
5473        if {$newtop < 0} {
5474            set newtop 0
5475        }
5476        allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
5477        drawvisible
5478    }
5479
5480    make_secsel $l
5481
5482    if {$isnew} {
5483        addtohistory [list selbyid $id]
5484    }
5485
5486    set selectedline $l
5487    set currentid $id
5488    $sha1entry delete 0 end
5489    $sha1entry insert 0 $id
5490    $sha1entry selection from 0
5491    $sha1entry selection to end
5492    rhighlight_sel $id
5493
5494    $ctext conf -state normal
5495    clear_ctext
5496    set linknum 0
5497    if {![info exists commitinfo($id)]} {
5498        getcommit $id
5499    }
5500    set info $commitinfo($id)
5501    set date [formatdate [lindex $info 2]]
5502    $ctext insert end "[mc "Author"]: [lindex $info 1]  $date\n"
5503    set date [formatdate [lindex $info 4]]
5504    $ctext insert end "[mc "Committer"]: [lindex $info 3]  $date\n"
5505    if {[info exists idtags($id)]} {
5506        $ctext insert end [mc "Tags:"]
5507        foreach tag $idtags($id) {
5508            $ctext insert end " $tag"
5509        }
5510        $ctext insert end "\n"
5511    }
5512
5513    set headers {}
5514    set olds $parents($curview,$id)
5515    if {[llength $olds] > 1} {
5516        set np 0
5517        foreach p $olds {
5518            if {$np >= $mergemax} {
5519                set tag mmax
5520            } else {
5521                set tag m$np
5522            }
5523            $ctext insert end "[mc "Parent"]: " $tag
5524            appendwithlinks [commit_descriptor $p] {}
5525            incr np
5526        }
5527    } else {
5528        foreach p $olds {
5529            append headers "[mc "Parent"]: [commit_descriptor $p]"
5530        }
5531    }
5532
5533    foreach c $children($curview,$id) {
5534        append headers "[mc "Child"]:  [commit_descriptor $c]"
5535    }
5536
5537    # make anything that looks like a SHA1 ID be a clickable link
5538    appendwithlinks $headers {}
5539    if {$showneartags} {
5540        if {![info exists allcommits]} {
5541            getallcommits
5542        }
5543        $ctext insert end "[mc "Branch"]: "
5544        $ctext mark set branch "end -1c"
5545        $ctext mark gravity branch left
5546        $ctext insert end "\n[mc "Follows"]: "
5547        $ctext mark set follows "end -1c"
5548        $ctext mark gravity follows left
5549        $ctext insert end "\n[mc "Precedes"]: "
5550        $ctext mark set precedes "end -1c"
5551        $ctext mark gravity precedes left
5552        $ctext insert end "\n"
5553        dispneartags 1
5554    }
5555    $ctext insert end "\n"
5556    set comment [lindex $info 5]
5557    if {[string first "\r" $comment] >= 0} {
5558        set comment [string map {"\r" "\n    "} $comment]
5559    }
5560    appendwithlinks $comment {comment}
5561
5562    $ctext tag remove found 1.0 end
5563    $ctext conf -state disabled
5564    set commentend [$ctext index "end - 1c"]
5565
5566    init_flist [mc "Comments"]
5567    if {$cmitmode eq "tree"} {
5568        gettree $id
5569    } elseif {[llength $olds] <= 1} {
5570        startdiff $id
5571    } else {
5572        mergediff $id
5573    }
5574}
5575
5576proc selfirstline {} {
5577    unmarkmatches
5578    selectline 0 1
5579}
5580
5581proc sellastline {} {
5582    global numcommits
5583    unmarkmatches
5584    set l [expr {$numcommits - 1}]
5585    selectline $l 1
5586}
5587
5588proc selnextline {dir} {
5589    global selectedline
5590    focus .
5591    if {![info exists selectedline]} return
5592    set l [expr {$selectedline + $dir}]
5593    unmarkmatches
5594    selectline $l 1
5595}
5596
5597proc selnextpage {dir} {
5598    global canv linespc selectedline numcommits
5599
5600    set lpp [expr {([winfo height $canv] - 2) / $linespc}]
5601    if {$lpp < 1} {
5602        set lpp 1
5603    }
5604    allcanvs yview scroll [expr {$dir * $lpp}] units
5605    drawvisible
5606    if {![info exists selectedline]} return
5607    set l [expr {$selectedline + $dir * $lpp}]
5608    if {$l < 0} {
5609        set l 0
5610    } elseif {$l >= $numcommits} {
5611        set l [expr $numcommits - 1]
5612    }
5613    unmarkmatches
5614    selectline $l 1
5615}
5616
5617proc unselectline {} {
5618    global selectedline currentid
5619
5620    catch {unset selectedline}
5621    catch {unset currentid}
5622    allcanvs delete secsel
5623    rhighlight_none
5624}
5625
5626proc reselectline {} {
5627    global selectedline
5628
5629    if {[info exists selectedline]} {
5630        selectline $selectedline 0
5631    }
5632}
5633
5634proc addtohistory {cmd} {
5635    global history historyindex curview
5636
5637    set elt [list $curview $cmd]
5638    if {$historyindex > 0
5639        && [lindex $history [expr {$historyindex - 1}]] == $elt} {
5640        return
5641    }
5642
5643    if {$historyindex < [llength $history]} {
5644        set history [lreplace $history $historyindex end $elt]
5645    } else {
5646        lappend history $elt
5647    }
5648    incr historyindex
5649    if {$historyindex > 1} {
5650        .tf.bar.leftbut conf -state normal
5651    } else {
5652        .tf.bar.leftbut conf -state disabled
5653    }
5654    .tf.bar.rightbut conf -state disabled
5655}
5656
5657proc godo {elt} {
5658    global curview
5659
5660    set view [lindex $elt 0]
5661    set cmd [lindex $elt 1]
5662    if {$curview != $view} {
5663        showview $view
5664    }
5665    eval $cmd
5666}
5667
5668proc goback {} {
5669    global history historyindex
5670    focus .
5671
5672    if {$historyindex > 1} {
5673        incr historyindex -1
5674        godo [lindex $history [expr {$historyindex - 1}]]
5675        .tf.bar.rightbut conf -state normal
5676    }
5677    if {$historyindex <= 1} {
5678        .tf.bar.leftbut conf -state disabled
5679    }
5680}
5681
5682proc goforw {} {
5683    global history historyindex
5684    focus .
5685
5686    if {$historyindex < [llength $history]} {
5687        set cmd [lindex $history $historyindex]
5688        incr historyindex
5689        godo $cmd
5690        .tf.bar.leftbut conf -state normal
5691    }
5692    if {$historyindex >= [llength $history]} {
5693        .tf.bar.rightbut conf -state disabled
5694    }
5695}
5696
5697proc gettree {id} {
5698    global treefilelist treeidlist diffids diffmergeid treepending
5699    global nullid nullid2
5700
5701    set diffids $id
5702    catch {unset diffmergeid}
5703    if {![info exists treefilelist($id)]} {
5704        if {![info exists treepending]} {
5705            if {$id eq $nullid} {
5706                set cmd [list | git ls-files]
5707            } elseif {$id eq $nullid2} {
5708                set cmd [list | git ls-files --stage -t]
5709            } else {
5710                set cmd [list | git ls-tree -r $id]
5711            }
5712            if {[catch {set gtf [open $cmd r]}]} {
5713                return
5714            }
5715            set treepending $id
5716            set treefilelist($id) {}
5717            set treeidlist($id) {}
5718            fconfigure $gtf -blocking 0
5719            filerun $gtf [list gettreeline $gtf $id]
5720        }
5721    } else {
5722        setfilelist $id
5723    }
5724}
5725
5726proc gettreeline {gtf id} {
5727    global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
5728
5729    set nl 0
5730    while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
5731        if {$diffids eq $nullid} {
5732            set fname $line
5733        } else {
5734            if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
5735            set i [string first "\t" $line]
5736            if {$i < 0} continue
5737            set sha1 [lindex $line 2]
5738            set fname [string range $line [expr {$i+1}] end]
5739            if {[string index $fname 0] eq "\""} {
5740                set fname [lindex $fname 0]
5741            }
5742            lappend treeidlist($id) $sha1
5743        }
5744        lappend treefilelist($id) $fname
5745    }
5746    if {![eof $gtf]} {
5747        return [expr {$nl >= 1000? 2: 1}]
5748    }
5749    close $gtf
5750    unset treepending
5751    if {$cmitmode ne "tree"} {
5752        if {![info exists diffmergeid]} {
5753            gettreediffs $diffids
5754        }
5755    } elseif {$id ne $diffids} {
5756        gettree $diffids
5757    } else {
5758        setfilelist $id
5759    }
5760    return 0
5761}
5762
5763proc showfile {f} {
5764    global treefilelist treeidlist diffids nullid nullid2
5765    global ctext commentend
5766
5767    set i [lsearch -exact $treefilelist($diffids) $f]
5768    if {$i < 0} {
5769        puts "oops, $f not in list for id $diffids"
5770        return
5771    }
5772    if {$diffids eq $nullid} {
5773        if {[catch {set bf [open $f r]} err]} {
5774            puts "oops, can't read $f: $err"
5775            return
5776        }
5777    } else {
5778        set blob [lindex $treeidlist($diffids) $i]
5779        if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
5780            puts "oops, error reading blob $blob: $err"
5781            return
5782        }
5783    }
5784    fconfigure $bf -blocking 0
5785    filerun $bf [list getblobline $bf $diffids]
5786    $ctext config -state normal
5787    clear_ctext $commentend
5788    $ctext insert end "\n"
5789    $ctext insert end "$f\n" filesep
5790    $ctext config -state disabled
5791    $ctext yview $commentend
5792    settabs 0
5793}
5794
5795proc getblobline {bf id} {
5796    global diffids cmitmode ctext
5797
5798    if {$id ne $diffids || $cmitmode ne "tree"} {
5799        catch {close $bf}
5800        return 0
5801    }
5802    $ctext config -state normal
5803    set nl 0
5804    while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
5805        $ctext insert end "$line\n"
5806    }
5807    if {[eof $bf]} {
5808        # delete last newline
5809        $ctext delete "end - 2c" "end - 1c"
5810        close $bf
5811        return 0
5812    }
5813    $ctext config -state disabled
5814    return [expr {$nl >= 1000? 2: 1}]
5815}
5816
5817proc mergediff {id} {
5818    global diffmergeid mdifffd
5819    global diffids
5820    global parents
5821    global diffcontext
5822    global limitdiffs viewfiles curview
5823
5824    set diffmergeid $id
5825    set diffids $id
5826    # this doesn't seem to actually affect anything...
5827    set cmd [concat | git diff-tree --no-commit-id --cc -U$diffcontext $id]
5828    if {$limitdiffs && $viewfiles($curview) ne {}} {
5829        set cmd [concat $cmd -- $viewfiles($curview)]
5830    }
5831    if {[catch {set mdf [open $cmd r]} err]} {
5832        error_popup "[mc "Error getting merge diffs:"] $err"
5833        return
5834    }
5835    fconfigure $mdf -blocking 0
5836    set mdifffd($id) $mdf
5837    set np [llength $parents($curview,$id)]
5838    settabs $np
5839    filerun $mdf [list getmergediffline $mdf $id $np]
5840}
5841
5842proc getmergediffline {mdf id np} {
5843    global diffmergeid ctext cflist mergemax
5844    global difffilestart mdifffd
5845
5846    $ctext conf -state normal
5847    set nr 0
5848    while {[incr nr] <= 1000 && [gets $mdf line] >= 0} {
5849        if {![info exists diffmergeid] || $id != $diffmergeid
5850            || $mdf != $mdifffd($id)} {
5851            close $mdf
5852            return 0
5853        }
5854        if {[regexp {^diff --cc (.*)} $line match fname]} {
5855            # start of a new file
5856            $ctext insert end "\n"
5857            set here [$ctext index "end - 1c"]
5858            lappend difffilestart $here
5859            add_flist [list $fname]
5860            set l [expr {(78 - [string length $fname]) / 2}]
5861            set pad [string range "----------------------------------------" 1 $l]
5862            $ctext insert end "$pad $fname $pad\n" filesep
5863        } elseif {[regexp {^@@} $line]} {
5864            $ctext insert end "$line\n" hunksep
5865        } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
5866            # do nothing
5867        } else {
5868            # parse the prefix - one ' ', '-' or '+' for each parent
5869            set spaces {}
5870            set minuses {}
5871            set pluses {}
5872            set isbad 0
5873            for {set j 0} {$j < $np} {incr j} {
5874                set c [string range $line $j $j]
5875                if {$c == " "} {
5876                    lappend spaces $j
5877                } elseif {$c == "-"} {
5878                    lappend minuses $j
5879                } elseif {$c == "+"} {
5880                    lappend pluses $j
5881                } else {
5882                    set isbad 1
5883                    break
5884                }
5885            }
5886            set tags {}
5887            set num {}
5888            if {!$isbad && $minuses ne {} && $pluses eq {}} {
5889                # line doesn't appear in result, parents in $minuses have the line
5890                set num [lindex $minuses 0]
5891            } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
5892                # line appears in result, parents in $pluses don't have the line
5893                lappend tags mresult
5894                set num [lindex $spaces 0]
5895            }
5896            if {$num ne {}} {
5897                if {$num >= $mergemax} {
5898                    set num "max"
5899                }
5900                lappend tags m$num
5901            }
5902            $ctext insert end "$line\n" $tags
5903        }
5904    }
5905    $ctext conf -state disabled
5906    if {[eof $mdf]} {
5907        close $mdf
5908        return 0
5909    }
5910    return [expr {$nr >= 1000? 2: 1}]
5911}
5912
5913proc startdiff {ids} {
5914    global treediffs diffids treepending diffmergeid nullid nullid2
5915
5916    settabs 1
5917    set diffids $ids
5918    catch {unset diffmergeid}
5919    if {![info exists treediffs($ids)] ||
5920        [lsearch -exact $ids $nullid] >= 0 ||
5921        [lsearch -exact $ids $nullid2] >= 0} {
5922        if {![info exists treepending]} {
5923            gettreediffs $ids
5924        }
5925    } else {
5926        addtocflist $ids
5927    }
5928}
5929
5930proc path_filter {filter name} {
5931    foreach p $filter {
5932        set l [string length $p]
5933        if {[string index $p end] eq "/"} {
5934            if {[string compare -length $l $p $name] == 0} {
5935                return 1
5936            }
5937        } else {
5938            if {[string compare -length $l $p $name] == 0 &&
5939                ([string length $name] == $l ||
5940                 [string index $name $l] eq "/")} {
5941                return 1
5942            }
5943        }
5944    }
5945    return 0
5946}
5947
5948proc addtocflist {ids} {
5949    global treediffs
5950
5951    add_flist $treediffs($ids)
5952    getblobdiffs $ids
5953}
5954
5955proc diffcmd {ids flags} {
5956    global nullid nullid2
5957
5958    set i [lsearch -exact $ids $nullid]
5959    set j [lsearch -exact $ids $nullid2]
5960    if {$i >= 0} {
5961        if {[llength $ids] > 1 && $j < 0} {
5962            # comparing working directory with some specific revision
5963            set cmd [concat | git diff-index $flags]
5964            if {$i == 0} {
5965                lappend cmd -R [lindex $ids 1]
5966            } else {
5967                lappend cmd [lindex $ids 0]
5968            }
5969        } else {
5970            # comparing working directory with index
5971            set cmd [concat | git diff-files $flags]
5972            if {$j == 1} {
5973                lappend cmd -R
5974            }
5975        }
5976    } elseif {$j >= 0} {
5977        set cmd [concat | git diff-index --cached $flags]
5978        if {[llength $ids] > 1} {
5979            # comparing index with specific revision
5980            if {$i == 0} {
5981                lappend cmd -R [lindex $ids 1]
5982            } else {
5983                lappend cmd [lindex $ids 0]
5984            }
5985        } else {
5986            # comparing index with HEAD
5987            lappend cmd HEAD
5988        }
5989    } else {
5990        set cmd [concat | git diff-tree -r $flags $ids]
5991    }
5992    return $cmd
5993}
5994
5995proc gettreediffs {ids} {
5996    global treediff treepending
5997
5998    set treepending $ids
5999    set treediff {}
6000    if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
6001    fconfigure $gdtf -blocking 0
6002    filerun $gdtf [list gettreediffline $gdtf $ids]
6003}
6004
6005proc gettreediffline {gdtf ids} {
6006    global treediff treediffs treepending diffids diffmergeid
6007    global cmitmode viewfiles curview limitdiffs
6008
6009    set nr 0
6010    while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
6011        set i [string first "\t" $line]
6012        if {$i >= 0} {
6013            set file [string range $line [expr {$i+1}] end]
6014            if {[string index $file 0] eq "\""} {
6015                set file [lindex $file 0]
6016            }
6017            lappend treediff $file
6018        }
6019    }
6020    if {![eof $gdtf]} {
6021        return [expr {$nr >= 1000? 2: 1}]
6022    }
6023    close $gdtf
6024    if {$limitdiffs && $viewfiles($curview) ne {}} {
6025        set flist {}
6026        foreach f $treediff {
6027            if {[path_filter $viewfiles($curview) $f]} {
6028                lappend flist $f
6029            }
6030        }
6031        set treediffs($ids) $flist
6032    } else {
6033        set treediffs($ids) $treediff
6034    }
6035    unset treepending
6036    if {$cmitmode eq "tree"} {
6037        gettree $diffids
6038    } elseif {$ids != $diffids} {
6039        if {![info exists diffmergeid]} {
6040            gettreediffs $diffids
6041        }
6042    } else {
6043        addtocflist $ids
6044    }
6045    return 0
6046}
6047
6048# empty string or positive integer
6049proc diffcontextvalidate {v} {
6050    return [regexp {^(|[1-9][0-9]*)$} $v]
6051}
6052
6053proc diffcontextchange {n1 n2 op} {
6054    global diffcontextstring diffcontext
6055
6056    if {[string is integer -strict $diffcontextstring]} {
6057        if {$diffcontextstring > 0} {
6058            set diffcontext $diffcontextstring
6059            reselectline
6060        }
6061    }
6062}
6063
6064proc changeignorespace {} {
6065    reselectline
6066}
6067
6068proc getblobdiffs {ids} {
6069    global blobdifffd diffids env
6070    global diffinhdr treediffs
6071    global diffcontext
6072    global ignorespace
6073    global limitdiffs viewfiles curview
6074
6075    set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
6076    if {$ignorespace} {
6077        append cmd " -w"
6078    }
6079    if {$limitdiffs && $viewfiles($curview) ne {}} {
6080        set cmd [concat $cmd -- $viewfiles($curview)]
6081    }
6082    if {[catch {set bdf [open $cmd r]} err]} {
6083        puts "error getting diffs: $err"
6084        return
6085    }
6086    set diffinhdr 0
6087    fconfigure $bdf -blocking 0
6088    set blobdifffd($ids) $bdf
6089    filerun $bdf [list getblobdiffline $bdf $diffids]
6090}
6091
6092proc setinlist {var i val} {
6093    global $var
6094
6095    while {[llength [set $var]] < $i} {
6096        lappend $var {}
6097    }
6098    if {[llength [set $var]] == $i} {
6099        lappend $var $val
6100    } else {
6101        lset $var $i $val
6102    }
6103}
6104
6105proc makediffhdr {fname ids} {
6106    global ctext curdiffstart treediffs
6107
6108    set i [lsearch -exact $treediffs($ids) $fname]
6109    if {$i >= 0} {
6110        setinlist difffilestart $i $curdiffstart
6111    }
6112    set l [expr {(78 - [string length $fname]) / 2}]
6113    set pad [string range "----------------------------------------" 1 $l]
6114    $ctext insert $curdiffstart "$pad $fname $pad" filesep
6115}
6116
6117proc getblobdiffline {bdf ids} {
6118    global diffids blobdifffd ctext curdiffstart
6119    global diffnexthead diffnextnote difffilestart
6120    global diffinhdr treediffs
6121
6122    set nr 0
6123    $ctext conf -state normal
6124    while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
6125        if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
6126            close $bdf
6127            return 0
6128        }
6129        if {![string compare -length 11 "diff --git " $line]} {
6130            # trim off "diff --git "
6131            set line [string range $line 11 end]
6132            set diffinhdr 1
6133            # start of a new file
6134            $ctext insert end "\n"
6135            set curdiffstart [$ctext index "end - 1c"]
6136            $ctext insert end "\n" filesep
6137            # If the name hasn't changed the length will be odd,
6138            # the middle char will be a space, and the two bits either
6139            # side will be a/name and b/name, or "a/name" and "b/name".
6140            # If the name has changed we'll get "rename from" and
6141            # "rename to" or "copy from" and "copy to" lines following this,
6142            # and we'll use them to get the filenames.
6143            # This complexity is necessary because spaces in the filename(s)
6144            # don't get escaped.
6145            set l [string length $line]
6146            set i [expr {$l / 2}]
6147            if {!(($l & 1) && [string index $line $i] eq " " &&
6148                  [string range $line 2 [expr {$i - 1}]] eq \
6149                      [string range $line [expr {$i + 3}] end])} {
6150                continue
6151            }
6152            # unescape if quoted and chop off the a/ from the front
6153            if {[string index $line 0] eq "\""} {
6154                set fname [string range [lindex $line 0] 2 end]
6155            } else {
6156                set fname [string range $line 2 [expr {$i - 1}]]
6157            }
6158            makediffhdr $fname $ids
6159
6160        } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
6161                       $line match f1l f1c f2l f2c rest]} {
6162            $ctext insert end "$line\n" hunksep
6163            set diffinhdr 0
6164
6165        } elseif {$diffinhdr} {
6166            if {![string compare -length 12 "rename from " $line]} {
6167                set fname [string range $line [expr 6 + [string first " from " $line] ] end]
6168                if {[string index $fname 0] eq "\""} {
6169                    set fname [lindex $fname 0]
6170                }
6171                set i [lsearch -exact $treediffs($ids) $fname]
6172                if {$i >= 0} {
6173                    setinlist difffilestart $i $curdiffstart
6174                }
6175            } elseif {![string compare -length 10 $line "rename to "] ||
6176                      ![string compare -length 8 $line "copy to "]} {
6177                set fname [string range $line [expr 4 + [string first " to " $line] ] end]
6178                if {[string index $fname 0] eq "\""} {
6179                    set fname [lindex $fname 0]
6180                }
6181                makediffhdr $fname $ids
6182            } elseif {[string compare -length 3 $line "---"] == 0} {
6183                # do nothing
6184                continue
6185            } elseif {[string compare -length 3 $line "+++"] == 0} {
6186                set diffinhdr 0
6187                continue
6188            }
6189            $ctext insert end "$line\n" filesep
6190
6191        } else {
6192            set x [string range $line 0 0]
6193            if {$x == "-" || $x == "+"} {
6194                set tag [expr {$x == "+"}]
6195                $ctext insert end "$line\n" d$tag
6196            } elseif {$x == " "} {
6197                $ctext insert end "$line\n"
6198            } else {
6199                # "\ No newline at end of file",
6200                # or something else we don't recognize
6201                $ctext insert end "$line\n" hunksep
6202            }
6203        }
6204    }
6205    $ctext conf -state disabled
6206    if {[eof $bdf]} {
6207        close $bdf
6208        return 0
6209    }
6210    return [expr {$nr >= 1000? 2: 1}]
6211}
6212
6213proc changediffdisp {} {
6214    global ctext diffelide
6215
6216    $ctext tag conf d0 -elide [lindex $diffelide 0]
6217    $ctext tag conf d1 -elide [lindex $diffelide 1]
6218}
6219
6220proc prevfile {} {
6221    global difffilestart ctext
6222    set prev [lindex $difffilestart 0]
6223    set here [$ctext index @0,0]
6224    foreach loc $difffilestart {
6225        if {[$ctext compare $loc >= $here]} {
6226            $ctext yview $prev
6227            return
6228        }
6229        set prev $loc
6230    }
6231    $ctext yview $prev
6232}
6233
6234proc nextfile {} {
6235    global difffilestart ctext
6236    set here [$ctext index @0,0]
6237    foreach loc $difffilestart {
6238        if {[$ctext compare $loc > $here]} {
6239            $ctext yview $loc
6240            return
6241        }
6242    }
6243}
6244
6245proc clear_ctext {{first 1.0}} {
6246    global ctext smarktop smarkbot
6247    global pendinglinks
6248
6249    set l [lindex [split $first .] 0]
6250    if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
6251        set smarktop $l
6252    }
6253    if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
6254        set smarkbot $l
6255    }
6256    $ctext delete $first end
6257    if {$first eq "1.0"} {
6258        catch {unset pendinglinks}
6259    }
6260}
6261
6262proc settabs {{firstab {}}} {
6263    global firsttabstop tabstop ctext have_tk85
6264
6265    if {$firstab ne {} && $have_tk85} {
6266        set firsttabstop $firstab
6267    }
6268    set w [font measure textfont "0"]
6269    if {$firsttabstop != 0} {
6270        $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
6271                               [expr {($firsttabstop + 2 * $tabstop) * $w}]]
6272    } elseif {$have_tk85 || $tabstop != 8} {
6273        $ctext conf -tabs [expr {$tabstop * $w}]
6274    } else {
6275        $ctext conf -tabs {}
6276    }
6277}
6278
6279proc incrsearch {name ix op} {
6280    global ctext searchstring searchdirn
6281
6282    $ctext tag remove found 1.0 end
6283    if {[catch {$ctext index anchor}]} {
6284        # no anchor set, use start of selection, or of visible area
6285        set sel [$ctext tag ranges sel]
6286        if {$sel ne {}} {
6287            $ctext mark set anchor [lindex $sel 0]
6288        } elseif {$searchdirn eq "-forwards"} {
6289            $ctext mark set anchor @0,0
6290        } else {
6291            $ctext mark set anchor @0,[winfo height $ctext]
6292        }
6293    }
6294    if {$searchstring ne {}} {
6295        set here [$ctext search $searchdirn -- $searchstring anchor]
6296        if {$here ne {}} {
6297            $ctext see $here
6298        }
6299        searchmarkvisible 1
6300    }
6301}
6302
6303proc dosearch {} {
6304    global sstring ctext searchstring searchdirn
6305
6306    focus $sstring
6307    $sstring icursor end
6308    set searchdirn -forwards
6309    if {$searchstring ne {}} {
6310        set sel [$ctext tag ranges sel]
6311        if {$sel ne {}} {
6312            set start "[lindex $sel 0] + 1c"
6313        } elseif {[catch {set start [$ctext index anchor]}]} {
6314            set start "@0,0"
6315        }
6316        set match [$ctext search -count mlen -- $searchstring $start]
6317        $ctext tag remove sel 1.0 end
6318        if {$match eq {}} {
6319            bell
6320            return
6321        }
6322        $ctext see $match
6323        set mend "$match + $mlen c"
6324        $ctext tag add sel $match $mend
6325        $ctext mark unset anchor
6326    }
6327}
6328
6329proc dosearchback {} {
6330    global sstring ctext searchstring searchdirn
6331
6332    focus $sstring
6333    $sstring icursor end
6334    set searchdirn -backwards
6335    if {$searchstring ne {}} {
6336        set sel [$ctext tag ranges sel]
6337        if {$sel ne {}} {
6338            set start [lindex $sel 0]
6339        } elseif {[catch {set start [$ctext index anchor]}]} {
6340            set start @0,[winfo height $ctext]
6341        }
6342        set match [$ctext search -backwards -count ml -- $searchstring $start]
6343        $ctext tag remove sel 1.0 end
6344        if {$match eq {}} {
6345            bell
6346            return
6347        }
6348        $ctext see $match
6349        set mend "$match + $ml c"
6350        $ctext tag add sel $match $mend
6351        $ctext mark unset anchor
6352    }
6353}
6354
6355proc searchmark {first last} {
6356    global ctext searchstring
6357
6358    set mend $first.0
6359    while {1} {
6360        set match [$ctext search -count mlen -- $searchstring $mend $last.end]
6361        if {$match eq {}} break
6362        set mend "$match + $mlen c"
6363        $ctext tag add found $match $mend
6364    }
6365}
6366
6367proc searchmarkvisible {doall} {
6368    global ctext smarktop smarkbot
6369
6370    set topline [lindex [split [$ctext index @0,0] .] 0]
6371    set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
6372    if {$doall || $botline < $smarktop || $topline > $smarkbot} {
6373        # no overlap with previous
6374        searchmark $topline $botline
6375        set smarktop $topline
6376        set smarkbot $botline
6377    } else {
6378        if {$topline < $smarktop} {
6379            searchmark $topline [expr {$smarktop-1}]
6380            set smarktop $topline
6381        }
6382        if {$botline > $smarkbot} {
6383            searchmark [expr {$smarkbot+1}] $botline
6384            set smarkbot $botline
6385        }
6386    }
6387}
6388
6389proc scrolltext {f0 f1} {
6390    global searchstring
6391
6392    .bleft.sb set $f0 $f1
6393    if {$searchstring ne {}} {
6394        searchmarkvisible 0
6395    }
6396}
6397
6398proc setcoords {} {
6399    global linespc charspc canvx0 canvy0
6400    global xspc1 xspc2 lthickness
6401
6402    set linespc [font metrics mainfont -linespace]
6403    set charspc [font measure mainfont "m"]
6404    set canvy0 [expr {int(3 + 0.5 * $linespc)}]
6405    set canvx0 [expr {int(3 + 0.5 * $linespc)}]
6406    set lthickness [expr {int($linespc / 9) + 1}]
6407    set xspc1(0) $linespc
6408    set xspc2 $linespc
6409}
6410
6411proc redisplay {} {
6412    global canv
6413    global selectedline
6414
6415    set ymax [lindex [$canv cget -scrollregion] 3]
6416    if {$ymax eq {} || $ymax == 0} return
6417    set span [$canv yview]
6418    clear_display
6419    setcanvscroll
6420    allcanvs yview moveto [lindex $span 0]
6421    drawvisible
6422    if {[info exists selectedline]} {
6423        selectline $selectedline 0
6424        allcanvs yview moveto [lindex $span 0]
6425    }
6426}
6427
6428proc parsefont {f n} {
6429    global fontattr
6430
6431    set fontattr($f,family) [lindex $n 0]
6432    set s [lindex $n 1]
6433    if {$s eq {} || $s == 0} {
6434        set s 10
6435    } elseif {$s < 0} {
6436        set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
6437    }
6438    set fontattr($f,size) $s
6439    set fontattr($f,weight) normal
6440    set fontattr($f,slant) roman
6441    foreach style [lrange $n 2 end] {
6442        switch -- $style {
6443            "normal" -
6444            "bold"   {set fontattr($f,weight) $style}
6445            "roman" -
6446            "italic" {set fontattr($f,slant) $style}
6447        }
6448    }
6449}
6450
6451proc fontflags {f {isbold 0}} {
6452    global fontattr
6453
6454    return [list -family $fontattr($f,family) -size $fontattr($f,size) \
6455                -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
6456                -slant $fontattr($f,slant)]
6457}
6458
6459proc fontname {f} {
6460    global fontattr
6461
6462    set n [list $fontattr($f,family) $fontattr($f,size)]
6463    if {$fontattr($f,weight) eq "bold"} {
6464        lappend n "bold"
6465    }
6466    if {$fontattr($f,slant) eq "italic"} {
6467        lappend n "italic"
6468    }
6469    return $n
6470}
6471
6472proc incrfont {inc} {
6473    global mainfont textfont ctext canv cflist showrefstop
6474    global stopped entries fontattr
6475
6476    unmarkmatches
6477    set s $fontattr(mainfont,size)
6478    incr s $inc
6479    if {$s < 1} {
6480        set s 1
6481    }
6482    set fontattr(mainfont,size) $s
6483    font config mainfont -size $s
6484    font config mainfontbold -size $s
6485    set mainfont [fontname mainfont]
6486    set s $fontattr(textfont,size)
6487    incr s $inc
6488    if {$s < 1} {
6489        set s 1
6490    }
6491    set fontattr(textfont,size) $s
6492    font config textfont -size $s
6493    font config textfontbold -size $s
6494    set textfont [fontname textfont]
6495    setcoords
6496    settabs
6497    redisplay
6498}
6499
6500proc clearsha1 {} {
6501    global sha1entry sha1string
6502    if {[string length $sha1string] == 40} {
6503        $sha1entry delete 0 end
6504    }
6505}
6506
6507proc sha1change {n1 n2 op} {
6508    global sha1string currentid sha1but
6509    if {$sha1string == {}
6510        || ([info exists currentid] && $sha1string == $currentid)} {
6511        set state disabled
6512    } else {
6513        set state normal
6514    }
6515    if {[$sha1but cget -state] == $state} return
6516    if {$state == "normal"} {
6517        $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
6518    } else {
6519        $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
6520    }
6521}
6522
6523proc gotocommit {} {
6524    global sha1string tagids headids curview varcid
6525
6526    if {$sha1string == {}
6527        || ([info exists currentid] && $sha1string == $currentid)} return
6528    if {[info exists tagids($sha1string)]} {
6529        set id $tagids($sha1string)
6530    } elseif {[info exists headids($sha1string)]} {
6531        set id $headids($sha1string)
6532    } else {
6533        set id [string tolower $sha1string]
6534        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
6535            set matches [array names varcid "$curview,$id*"]
6536            if {$matches ne {}} {
6537                if {[llength $matches] > 1} {
6538                    error_popup [mc "Short SHA1 id %s is ambiguous" $id]
6539                    return
6540                }
6541                set id [lindex [split [lindex $matches 0] ","] 1]
6542            }
6543        }
6544    }
6545    if {[commitinview $id $curview]} {
6546        selectline [rowofcommit $id] 1
6547        return
6548    }
6549    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
6550        set msg [mc "SHA1 id %s is not known" $sha1string]
6551    } else {
6552        set msg [mc "Tag/Head %s is not known" $sha1string]
6553    }
6554    error_popup $msg
6555}
6556
6557proc lineenter {x y id} {
6558    global hoverx hovery hoverid hovertimer
6559    global commitinfo canv
6560
6561    if {![info exists commitinfo($id)] && ![getcommit $id]} return
6562    set hoverx $x
6563    set hovery $y
6564    set hoverid $id
6565    if {[info exists hovertimer]} {
6566        after cancel $hovertimer
6567    }
6568    set hovertimer [after 500 linehover]
6569    $canv delete hover
6570}
6571
6572proc linemotion {x y id} {
6573    global hoverx hovery hoverid hovertimer
6574
6575    if {[info exists hoverid] && $id == $hoverid} {
6576        set hoverx $x
6577        set hovery $y
6578        if {[info exists hovertimer]} {
6579            after cancel $hovertimer
6580        }
6581        set hovertimer [after 500 linehover]
6582    }
6583}
6584
6585proc lineleave {id} {
6586    global hoverid hovertimer canv
6587
6588    if {[info exists hoverid] && $id == $hoverid} {
6589        $canv delete hover
6590        if {[info exists hovertimer]} {
6591            after cancel $hovertimer
6592            unset hovertimer
6593        }
6594        unset hoverid
6595    }
6596}
6597
6598proc linehover {} {
6599    global hoverx hovery hoverid hovertimer
6600    global canv linespc lthickness
6601    global commitinfo
6602
6603    set text [lindex $commitinfo($hoverid) 0]
6604    set ymax [lindex [$canv cget -scrollregion] 3]
6605    if {$ymax == {}} return
6606    set yfrac [lindex [$canv yview] 0]
6607    set x [expr {$hoverx + 2 * $linespc}]
6608    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
6609    set x0 [expr {$x - 2 * $lthickness}]
6610    set y0 [expr {$y - 2 * $lthickness}]
6611    set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
6612    set y1 [expr {$y + $linespc + 2 * $lthickness}]
6613    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
6614               -fill \#ffff80 -outline black -width 1 -tags hover]
6615    $canv raise $t
6616    set t [$canv create text $x $y -anchor nw -text $text -tags hover \
6617               -font mainfont]
6618    $canv raise $t
6619}
6620
6621proc clickisonarrow {id y} {
6622    global lthickness
6623
6624    set ranges [rowranges $id]
6625    set thresh [expr {2 * $lthickness + 6}]
6626    set n [expr {[llength $ranges] - 1}]
6627    for {set i 1} {$i < $n} {incr i} {
6628        set row [lindex $ranges $i]
6629        if {abs([yc $row] - $y) < $thresh} {
6630            return $i
6631        }
6632    }
6633    return {}
6634}
6635
6636proc arrowjump {id n y} {
6637    global canv
6638
6639    # 1 <-> 2, 3 <-> 4, etc...
6640    set n [expr {(($n - 1) ^ 1) + 1}]
6641    set row [lindex [rowranges $id] $n]
6642    set yt [yc $row]
6643    set ymax [lindex [$canv cget -scrollregion] 3]
6644    if {$ymax eq {} || $ymax <= 0} return
6645    set view [$canv yview]
6646    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
6647    set yfrac [expr {$yt / $ymax - $yspan / 2}]
6648    if {$yfrac < 0} {
6649        set yfrac 0
6650    }
6651    allcanvs yview moveto $yfrac
6652}
6653
6654proc lineclick {x y id isnew} {
6655    global ctext commitinfo children canv thickerline curview
6656
6657    if {![info exists commitinfo($id)] && ![getcommit $id]} return
6658    unmarkmatches
6659    unselectline
6660    normalline
6661    $canv delete hover
6662    # draw this line thicker than normal
6663    set thickerline $id
6664    drawlines $id
6665    if {$isnew} {
6666        set ymax [lindex [$canv cget -scrollregion] 3]
6667        if {$ymax eq {}} return
6668        set yfrac [lindex [$canv yview] 0]
6669        set y [expr {$y + $yfrac * $ymax}]
6670    }
6671    set dirn [clickisonarrow $id $y]
6672    if {$dirn ne {}} {
6673        arrowjump $id $dirn $y
6674        return
6675    }
6676
6677    if {$isnew} {
6678        addtohistory [list lineclick $x $y $id 0]
6679    }
6680    # fill the details pane with info about this line
6681    $ctext conf -state normal
6682    clear_ctext
6683    settabs 0
6684    $ctext insert end "[mc "Parent"]:\t"
6685    $ctext insert end $id link0
6686    setlink $id link0
6687    set info $commitinfo($id)
6688    $ctext insert end "\n\t[lindex $info 0]\n"
6689    $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
6690    set date [formatdate [lindex $info 2]]
6691    $ctext insert end "\t[mc "Date"]:\t$date\n"
6692    set kids $children($curview,$id)
6693    if {$kids ne {}} {
6694        $ctext insert end "\n[mc "Children"]:"
6695        set i 0
6696        foreach child $kids {
6697            incr i
6698            if {![info exists commitinfo($child)] && ![getcommit $child]} continue
6699            set info $commitinfo($child)
6700            $ctext insert end "\n\t"
6701            $ctext insert end $child link$i
6702            setlink $child link$i
6703            $ctext insert end "\n\t[lindex $info 0]"
6704            $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
6705            set date [formatdate [lindex $info 2]]
6706            $ctext insert end "\n\t[mc "Date"]:\t$date\n"
6707        }
6708    }
6709    $ctext conf -state disabled
6710    init_flist {}
6711}
6712
6713proc normalline {} {
6714    global thickerline
6715    if {[info exists thickerline]} {
6716        set id $thickerline
6717        unset thickerline
6718        drawlines $id
6719    }
6720}
6721
6722proc selbyid {id} {
6723    global curview
6724    if {[commitinview $id $curview]} {
6725        selectline [rowofcommit $id] 1
6726    }
6727}
6728
6729proc mstime {} {
6730    global startmstime
6731    if {![info exists startmstime]} {
6732        set startmstime [clock clicks -milliseconds]
6733    }
6734    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
6735}
6736
6737proc rowmenu {x y id} {
6738    global rowctxmenu selectedline rowmenuid curview
6739    global nullid nullid2 fakerowmenu mainhead
6740
6741    stopfinding
6742    set rowmenuid $id
6743    if {![info exists selectedline]
6744        || [rowofcommit $id] eq $selectedline} {
6745        set state disabled
6746    } else {
6747        set state normal
6748    }
6749    if {$id ne $nullid && $id ne $nullid2} {
6750        set menu $rowctxmenu
6751        $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
6752    } else {
6753        set menu $fakerowmenu
6754    }
6755    $menu entryconfigure [mc "Diff this -> selected"] -state $state
6756    $menu entryconfigure [mc "Diff selected -> this"] -state $state
6757    $menu entryconfigure [mc "Make patch"] -state $state
6758    tk_popup $menu $x $y
6759}
6760
6761proc diffvssel {dirn} {
6762    global rowmenuid selectedline
6763
6764    if {![info exists selectedline]} return
6765    if {$dirn} {
6766        set oldid [commitonrow $selectedline]
6767        set newid $rowmenuid
6768    } else {
6769        set oldid $rowmenuid
6770        set newid [commitonrow $selectedline]
6771    }
6772    addtohistory [list doseldiff $oldid $newid]
6773    doseldiff $oldid $newid
6774}
6775
6776proc doseldiff {oldid newid} {
6777    global ctext
6778    global commitinfo
6779
6780    $ctext conf -state normal
6781    clear_ctext
6782    init_flist [mc "Top"]
6783    $ctext insert end "[mc "From"] "
6784    $ctext insert end $oldid link0
6785    setlink $oldid link0
6786    $ctext insert end "\n     "
6787    $ctext insert end [lindex $commitinfo($oldid) 0]
6788    $ctext insert end "\n\n[mc "To"]   "
6789    $ctext insert end $newid link1
6790    setlink $newid link1
6791    $ctext insert end "\n     "
6792    $ctext insert end [lindex $commitinfo($newid) 0]
6793    $ctext insert end "\n"
6794    $ctext conf -state disabled
6795    $ctext tag remove found 1.0 end
6796    startdiff [list $oldid $newid]
6797}
6798
6799proc mkpatch {} {
6800    global rowmenuid currentid commitinfo patchtop patchnum
6801
6802    if {![info exists currentid]} return
6803    set oldid $currentid
6804    set oldhead [lindex $commitinfo($oldid) 0]
6805    set newid $rowmenuid
6806    set newhead [lindex $commitinfo($newid) 0]
6807    set top .patch
6808    set patchtop $top
6809    catch {destroy $top}
6810    toplevel $top
6811    label $top.title -text [mc "Generate patch"]
6812    grid $top.title - -pady 10
6813    label $top.from -text [mc "From:"]
6814    entry $top.fromsha1 -width 40 -relief flat
6815    $top.fromsha1 insert 0 $oldid
6816    $top.fromsha1 conf -state readonly
6817    grid $top.from $top.fromsha1 -sticky w
6818    entry $top.fromhead -width 60 -relief flat
6819    $top.fromhead insert 0 $oldhead
6820    $top.fromhead conf -state readonly
6821    grid x $top.fromhead -sticky w
6822    label $top.to -text [mc "To:"]
6823    entry $top.tosha1 -width 40 -relief flat
6824    $top.tosha1 insert 0 $newid
6825    $top.tosha1 conf -state readonly
6826    grid $top.to $top.tosha1 -sticky w
6827    entry $top.tohead -width 60 -relief flat
6828    $top.tohead insert 0 $newhead
6829    $top.tohead conf -state readonly
6830    grid x $top.tohead -sticky w
6831    button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
6832    grid $top.rev x -pady 10
6833    label $top.flab -text [mc "Output file:"]
6834    entry $top.fname -width 60
6835    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
6836    incr patchnum
6837    grid $top.flab $top.fname -sticky w
6838    frame $top.buts
6839    button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
6840    button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
6841    grid $top.buts.gen $top.buts.can
6842    grid columnconfigure $top.buts 0 -weight 1 -uniform a
6843    grid columnconfigure $top.buts 1 -weight 1 -uniform a
6844    grid $top.buts - -pady 10 -sticky ew
6845    focus $top.fname
6846}
6847
6848proc mkpatchrev {} {
6849    global patchtop
6850
6851    set oldid [$patchtop.fromsha1 get]
6852    set oldhead [$patchtop.fromhead get]
6853    set newid [$patchtop.tosha1 get]
6854    set newhead [$patchtop.tohead get]
6855    foreach e [list fromsha1 fromhead tosha1 tohead] \
6856            v [list $newid $newhead $oldid $oldhead] {
6857        $patchtop.$e conf -state normal
6858        $patchtop.$e delete 0 end
6859        $patchtop.$e insert 0 $v
6860        $patchtop.$e conf -state readonly
6861    }
6862}
6863
6864proc mkpatchgo {} {
6865    global patchtop nullid nullid2
6866
6867    set oldid [$patchtop.fromsha1 get]
6868    set newid [$patchtop.tosha1 get]
6869    set fname [$patchtop.fname get]
6870    set cmd [diffcmd [list $oldid $newid] -p]
6871    # trim off the initial "|"
6872    set cmd [lrange $cmd 1 end]
6873    lappend cmd >$fname &
6874    if {[catch {eval exec $cmd} err]} {
6875        error_popup "[mc "Error creating patch:"] $err"
6876    }
6877    catch {destroy $patchtop}
6878    unset patchtop
6879}
6880
6881proc mkpatchcan {} {
6882    global patchtop
6883
6884    catch {destroy $patchtop}
6885    unset patchtop
6886}
6887
6888proc mktag {} {
6889    global rowmenuid mktagtop commitinfo
6890
6891    set top .maketag
6892    set mktagtop $top
6893    catch {destroy $top}
6894    toplevel $top
6895    label $top.title -text [mc "Create tag"]
6896    grid $top.title - -pady 10
6897    label $top.id -text [mc "ID:"]
6898    entry $top.sha1 -width 40 -relief flat
6899    $top.sha1 insert 0 $rowmenuid
6900    $top.sha1 conf -state readonly
6901    grid $top.id $top.sha1 -sticky w
6902    entry $top.head -width 60 -relief flat
6903    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6904    $top.head conf -state readonly
6905    grid x $top.head -sticky w
6906    label $top.tlab -text [mc "Tag name:"]
6907    entry $top.tag -width 60
6908    grid $top.tlab $top.tag -sticky w
6909    frame $top.buts
6910    button $top.buts.gen -text [mc "Create"] -command mktaggo
6911    button $top.buts.can -text [mc "Cancel"] -command mktagcan
6912    grid $top.buts.gen $top.buts.can
6913    grid columnconfigure $top.buts 0 -weight 1 -uniform a
6914    grid columnconfigure $top.buts 1 -weight 1 -uniform a
6915    grid $top.buts - -pady 10 -sticky ew
6916    focus $top.tag
6917}
6918
6919proc domktag {} {
6920    global mktagtop env tagids idtags
6921
6922    set id [$mktagtop.sha1 get]
6923    set tag [$mktagtop.tag get]
6924    if {$tag == {}} {
6925        error_popup [mc "No tag name specified"]
6926        return
6927    }
6928    if {[info exists tagids($tag)]} {
6929        error_popup [mc "Tag \"%s\" already exists" $tag]
6930        return
6931    }
6932    if {[catch {
6933        exec git tag $tag $id
6934    } err]} {
6935        error_popup "[mc "Error creating tag:"] $err"
6936        return
6937    }
6938
6939    set tagids($tag) $id
6940    lappend idtags($id) $tag
6941    redrawtags $id
6942    addedtag $id
6943    dispneartags 0
6944    run refill_reflist
6945}
6946
6947proc redrawtags {id} {
6948    global canv linehtag idpos currentid curview
6949    global canvxmax iddrawn
6950
6951    if {![commitinview $id $curview]} return
6952    if {![info exists iddrawn($id)]} return
6953    set row [rowofcommit $id]
6954    $canv delete tag.$id
6955    set xt [eval drawtags $id $idpos($id)]
6956    $canv coords $linehtag($row) $xt [lindex $idpos($id) 2]
6957    set text [$canv itemcget $linehtag($row) -text]
6958    set font [$canv itemcget $linehtag($row) -font]
6959    set xr [expr {$xt + [font measure $font $text]}]
6960    if {$xr > $canvxmax} {
6961        set canvxmax $xr
6962        setcanvscroll
6963    }
6964    if {[info exists currentid] && $currentid == $id} {
6965        make_secsel $row
6966    }
6967}
6968
6969proc mktagcan {} {
6970    global mktagtop
6971
6972    catch {destroy $mktagtop}
6973    unset mktagtop
6974}
6975
6976proc mktaggo {} {
6977    domktag
6978    mktagcan
6979}
6980
6981proc writecommit {} {
6982    global rowmenuid wrcomtop commitinfo wrcomcmd
6983
6984    set top .writecommit
6985    set wrcomtop $top
6986    catch {destroy $top}
6987    toplevel $top
6988    label $top.title -text [mc "Write commit to file"]
6989    grid $top.title - -pady 10
6990    label $top.id -text [mc "ID:"]
6991    entry $top.sha1 -width 40 -relief flat
6992    $top.sha1 insert 0 $rowmenuid
6993    $top.sha1 conf -state readonly
6994    grid $top.id $top.sha1 -sticky w
6995    entry $top.head -width 60 -relief flat
6996    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
6997    $top.head conf -state readonly
6998    grid x $top.head -sticky w
6999    label $top.clab -text [mc "Command:"]
7000    entry $top.cmd -width 60 -textvariable wrcomcmd
7001    grid $top.clab $top.cmd -sticky w -pady 10
7002    label $top.flab -text [mc "Output file:"]
7003    entry $top.fname -width 60
7004    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
7005    grid $top.flab $top.fname -sticky w
7006    frame $top.buts
7007    button $top.buts.gen -text [mc "Write"] -command wrcomgo
7008    button $top.buts.can -text [mc "Cancel"] -command wrcomcan
7009    grid $top.buts.gen $top.buts.can
7010    grid columnconfigure $top.buts 0 -weight 1 -uniform a
7011    grid columnconfigure $top.buts 1 -weight 1 -uniform a
7012    grid $top.buts - -pady 10 -sticky ew
7013    focus $top.fname
7014}
7015
7016proc wrcomgo {} {
7017    global wrcomtop
7018
7019    set id [$wrcomtop.sha1 get]
7020    set cmd "echo $id | [$wrcomtop.cmd get]"
7021    set fname [$wrcomtop.fname get]
7022    if {[catch {exec sh -c $cmd >$fname &} err]} {
7023        error_popup "[mc "Error writing commit:"] $err"
7024    }
7025    catch {destroy $wrcomtop}
7026    unset wrcomtop
7027}
7028
7029proc wrcomcan {} {
7030    global wrcomtop
7031
7032    catch {destroy $wrcomtop}
7033    unset wrcomtop
7034}
7035
7036proc mkbranch {} {
7037    global rowmenuid mkbrtop
7038
7039    set top .makebranch
7040    catch {destroy $top}
7041    toplevel $top
7042    label $top.title -text [mc "Create new branch"]
7043    grid $top.title - -pady 10
7044    label $top.id -text [mc "ID:"]
7045    entry $top.sha1 -width 40 -relief flat
7046    $top.sha1 insert 0 $rowmenuid
7047    $top.sha1 conf -state readonly
7048    grid $top.id $top.sha1 -sticky w
7049    label $top.nlab -text [mc "Name:"]
7050    entry $top.name -width 40
7051    grid $top.nlab $top.name -sticky w
7052    frame $top.buts
7053    button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
7054    button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
7055    grid $top.buts.go $top.buts.can
7056    grid columnconfigure $top.buts 0 -weight 1 -uniform a
7057    grid columnconfigure $top.buts 1 -weight 1 -uniform a
7058    grid $top.buts - -pady 10 -sticky ew
7059    focus $top.name
7060}
7061
7062proc mkbrgo {top} {
7063    global headids idheads
7064
7065    set name [$top.name get]
7066    set id [$top.sha1 get]
7067    if {$name eq {}} {
7068        error_popup [mc "Please specify a name for the new branch"]
7069        return
7070    }
7071    catch {destroy $top}
7072    nowbusy newbranch
7073    update
7074    if {[catch {
7075        exec git branch $name $id
7076    } err]} {
7077        notbusy newbranch
7078        error_popup $err
7079    } else {
7080        set headids($name) $id
7081        lappend idheads($id) $name
7082        addedhead $id $name
7083        notbusy newbranch
7084        redrawtags $id
7085        dispneartags 0
7086        run refill_reflist
7087    }
7088}
7089
7090proc cherrypick {} {
7091    global rowmenuid curview
7092    global mainhead mainheadid
7093
7094    set oldhead [exec git rev-parse HEAD]
7095    set dheads [descheads $rowmenuid]
7096    if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
7097        set ok [confirm_popup [mc "Commit %s is already\
7098                included in branch %s -- really re-apply it?" \
7099                                   [string range $rowmenuid 0 7] $mainhead]]
7100        if {!$ok} return
7101    }
7102    nowbusy cherrypick [mc "Cherry-picking"]
7103    update
7104    # Unfortunately git-cherry-pick writes stuff to stderr even when
7105    # no error occurs, and exec takes that as an indication of error...
7106    if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
7107        notbusy cherrypick
7108        error_popup $err
7109        return
7110    }
7111    set newhead [exec git rev-parse HEAD]
7112    if {$newhead eq $oldhead} {
7113        notbusy cherrypick
7114        error_popup [mc "No changes committed"]
7115        return
7116    }
7117    addnewchild $newhead $oldhead
7118    if {[commitinview $oldhead $curview]} {
7119        insertrow $newhead $oldhead $curview
7120        if {$mainhead ne {}} {
7121            movehead $newhead $mainhead
7122            movedhead $newhead $mainhead
7123            set mainheadid $newhead
7124        }
7125        redrawtags $oldhead
7126        redrawtags $newhead
7127        selbyid $newhead
7128    }
7129    notbusy cherrypick
7130}
7131
7132proc resethead {} {
7133    global mainhead rowmenuid confirm_ok resettype
7134
7135    set confirm_ok 0
7136    set w ".confirmreset"
7137    toplevel $w
7138    wm transient $w .
7139    wm title $w [mc "Confirm reset"]
7140    message $w.m -text \
7141        [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
7142        -justify center -aspect 1000
7143    pack $w.m -side top -fill x -padx 20 -pady 20
7144    frame $w.f -relief sunken -border 2
7145    message $w.f.rt -text [mc "Reset type:"] -aspect 1000
7146    grid $w.f.rt -sticky w
7147    set resettype mixed
7148    radiobutton $w.f.soft -value soft -variable resettype -justify left \
7149        -text [mc "Soft: Leave working tree and index untouched"]
7150    grid $w.f.soft -sticky w
7151    radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
7152        -text [mc "Mixed: Leave working tree untouched, reset index"]
7153    grid $w.f.mixed -sticky w
7154    radiobutton $w.f.hard -value hard -variable resettype -justify left \
7155        -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
7156    grid $w.f.hard -sticky w
7157    pack $w.f -side top -fill x
7158    button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
7159    pack $w.ok -side left -fill x -padx 20 -pady 20
7160    button $w.cancel -text [mc Cancel] -command "destroy $w"
7161    pack $w.cancel -side right -fill x -padx 20 -pady 20
7162    bind $w <Visibility> "grab $w; focus $w"
7163    tkwait window $w
7164    if {!$confirm_ok} return
7165    if {[catch {set fd [open \
7166            [list | sh -c "git reset --$resettype $rowmenuid 2>&1"] r]} err]} {
7167        error_popup $err
7168    } else {
7169        dohidelocalchanges
7170        filerun $fd [list readresetstat $fd]
7171        nowbusy reset [mc "Resetting"]
7172        selbyid $rowmenuid
7173    }
7174}
7175
7176proc readresetstat {fd} {
7177    global mainhead mainheadid showlocalchanges rprogcoord
7178
7179    if {[gets $fd line] >= 0} {
7180        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
7181            set rprogcoord [expr {1.0 * $m / $n}]
7182            adjustprogress
7183        }
7184        return 1
7185    }
7186    set rprogcoord 0
7187    adjustprogress
7188    notbusy reset
7189    if {[catch {close $fd} err]} {
7190        error_popup $err
7191    }
7192    set oldhead $mainheadid
7193    set newhead [exec git rev-parse HEAD]
7194    if {$newhead ne $oldhead} {
7195        movehead $newhead $mainhead
7196        movedhead $newhead $mainhead
7197        set mainheadid $newhead
7198        redrawtags $oldhead
7199        redrawtags $newhead
7200    }
7201    if {$showlocalchanges} {
7202        doshowlocalchanges
7203    }
7204    return 0
7205}
7206
7207# context menu for a head
7208proc headmenu {x y id head} {
7209    global headmenuid headmenuhead headctxmenu mainhead
7210
7211    stopfinding
7212    set headmenuid $id
7213    set headmenuhead $head
7214    set state normal
7215    if {$head eq $mainhead} {
7216        set state disabled
7217    }
7218    $headctxmenu entryconfigure 0 -state $state
7219    $headctxmenu entryconfigure 1 -state $state
7220    tk_popup $headctxmenu $x $y
7221}
7222
7223proc cobranch {} {
7224    global headmenuid headmenuhead mainhead headids
7225    global showlocalchanges mainheadid
7226
7227    # check the tree is clean first??
7228    set oldmainhead $mainhead
7229    nowbusy checkout [mc "Checking out"]
7230    update
7231    dohidelocalchanges
7232    if {[catch {
7233        exec git checkout -q $headmenuhead
7234    } err]} {
7235        notbusy checkout
7236        error_popup $err
7237    } else {
7238        notbusy checkout
7239        set mainhead $headmenuhead
7240        set mainheadid $headmenuid
7241        if {[info exists headids($oldmainhead)]} {
7242            redrawtags $headids($oldmainhead)
7243        }
7244        redrawtags $headmenuid
7245        selbyid $headmenuid
7246    }
7247    if {$showlocalchanges} {
7248        dodiffindex
7249    }
7250}
7251
7252proc rmbranch {} {
7253    global headmenuid headmenuhead mainhead
7254    global idheads
7255
7256    set head $headmenuhead
7257    set id $headmenuid
7258    # this check shouldn't be needed any more...
7259    if {$head eq $mainhead} {
7260        error_popup [mc "Cannot delete the currently checked-out branch"]
7261        return
7262    }
7263    set dheads [descheads $id]
7264    if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
7265        # the stuff on this branch isn't on any other branch
7266        if {![confirm_popup [mc "The commits on branch %s aren't on any other\
7267                        branch.\nReally delete branch %s?" $head $head]]} return
7268    }
7269    nowbusy rmbranch
7270    update
7271    if {[catch {exec git branch -D $head} err]} {
7272        notbusy rmbranch
7273        error_popup $err
7274        return
7275    }
7276    removehead $id $head
7277    removedhead $id $head
7278    redrawtags $id
7279    notbusy rmbranch
7280    dispneartags 0
7281    run refill_reflist
7282}
7283
7284# Display a list of tags and heads
7285proc showrefs {} {
7286    global showrefstop bgcolor fgcolor selectbgcolor
7287    global bglist fglist reflistfilter reflist maincursor
7288
7289    set top .showrefs
7290    set showrefstop $top
7291    if {[winfo exists $top]} {
7292        raise $top
7293        refill_reflist
7294        return
7295    }
7296    toplevel $top
7297    wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
7298    text $top.list -background $bgcolor -foreground $fgcolor \
7299        -selectbackground $selectbgcolor -font mainfont \
7300        -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
7301        -width 30 -height 20 -cursor $maincursor \
7302        -spacing1 1 -spacing3 1 -state disabled
7303    $top.list tag configure highlight -background $selectbgcolor
7304    lappend bglist $top.list
7305    lappend fglist $top.list
7306    scrollbar $top.ysb -command "$top.list yview" -orient vertical
7307    scrollbar $top.xsb -command "$top.list xview" -orient horizontal
7308    grid $top.list $top.ysb -sticky nsew
7309    grid $top.xsb x -sticky ew
7310    frame $top.f
7311    label $top.f.l -text "[mc "Filter"]: "
7312    entry $top.f.e -width 20 -textvariable reflistfilter
7313    set reflistfilter "*"
7314    trace add variable reflistfilter write reflistfilter_change
7315    pack $top.f.e -side right -fill x -expand 1
7316    pack $top.f.l -side left
7317    grid $top.f - -sticky ew -pady 2
7318    button $top.close -command [list destroy $top] -text [mc "Close"]
7319    grid $top.close -
7320    grid columnconfigure $top 0 -weight 1
7321    grid rowconfigure $top 0 -weight 1
7322    bind $top.list <1> {break}
7323    bind $top.list <B1-Motion> {break}
7324    bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
7325    set reflist {}
7326    refill_reflist
7327}
7328
7329proc sel_reflist {w x y} {
7330    global showrefstop reflist headids tagids otherrefids
7331
7332    if {![winfo exists $showrefstop]} return
7333    set l [lindex [split [$w index "@$x,$y"] "."] 0]
7334    set ref [lindex $reflist [expr {$l-1}]]
7335    set n [lindex $ref 0]
7336    switch -- [lindex $ref 1] {
7337        "H" {selbyid $headids($n)}
7338        "T" {selbyid $tagids($n)}
7339        "o" {selbyid $otherrefids($n)}
7340    }
7341    $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
7342}
7343
7344proc unsel_reflist {} {
7345    global showrefstop
7346
7347    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7348    $showrefstop.list tag remove highlight 0.0 end
7349}
7350
7351proc reflistfilter_change {n1 n2 op} {
7352    global reflistfilter
7353
7354    after cancel refill_reflist
7355    after 200 refill_reflist
7356}
7357
7358proc refill_reflist {} {
7359    global reflist reflistfilter showrefstop headids tagids otherrefids
7360    global curview commitinterest
7361
7362    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7363    set refs {}
7364    foreach n [array names headids] {
7365        if {[string match $reflistfilter $n]} {
7366            if {[commitinview $headids($n) $curview]} {
7367                lappend refs [list $n H]
7368            } else {
7369                set commitinterest($headids($n)) {run refill_reflist}
7370            }
7371        }
7372    }
7373    foreach n [array names tagids] {
7374        if {[string match $reflistfilter $n]} {
7375            if {[commitinview $tagids($n) $curview]} {
7376                lappend refs [list $n T]
7377            } else {
7378                set commitinterest($tagids($n)) {run refill_reflist}
7379            }
7380        }
7381    }
7382    foreach n [array names otherrefids] {
7383        if {[string match $reflistfilter $n]} {
7384            if {[commitinview $otherrefids($n) $curview]} {
7385                lappend refs [list $n o]
7386            } else {
7387                set commitinterest($otherrefids($n)) {run refill_reflist}
7388            }
7389        }
7390    }
7391    set refs [lsort -index 0 $refs]
7392    if {$refs eq $reflist} return
7393
7394    # Update the contents of $showrefstop.list according to the
7395    # differences between $reflist (old) and $refs (new)
7396    $showrefstop.list conf -state normal
7397    $showrefstop.list insert end "\n"
7398    set i 0
7399    set j 0
7400    while {$i < [llength $reflist] || $j < [llength $refs]} {
7401        if {$i < [llength $reflist]} {
7402            if {$j < [llength $refs]} {
7403                set cmp [string compare [lindex $reflist $i 0] \
7404                             [lindex $refs $j 0]]
7405                if {$cmp == 0} {
7406                    set cmp [string compare [lindex $reflist $i 1] \
7407                                 [lindex $refs $j 1]]
7408                }
7409            } else {
7410                set cmp -1
7411            }
7412        } else {
7413            set cmp 1
7414        }
7415        switch -- $cmp {
7416            -1 {
7417                $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
7418                incr i
7419            }
7420            0 {
7421                incr i
7422                incr j
7423            }
7424            1 {
7425                set l [expr {$j + 1}]
7426                $showrefstop.list image create $l.0 -align baseline \
7427                    -image reficon-[lindex $refs $j 1] -padx 2
7428                $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
7429                incr j
7430            }
7431        }
7432    }
7433    set reflist $refs
7434    # delete last newline
7435    $showrefstop.list delete end-2c end-1c
7436    $showrefstop.list conf -state disabled
7437}
7438
7439# Stuff for finding nearby tags
7440proc getallcommits {} {
7441    global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
7442    global idheads idtags idotherrefs allparents tagobjid
7443
7444    if {![info exists allcommits]} {
7445        set nextarc 0
7446        set allcommits 0
7447        set seeds {}
7448        set allcwait 0
7449        set cachedarcs 0
7450        set allccache [file join [gitdir] "gitk.cache"]
7451        if {![catch {
7452            set f [open $allccache r]
7453            set allcwait 1
7454            getcache $f
7455        }]} return
7456    }
7457
7458    if {$allcwait} {
7459        return
7460    }
7461    set cmd [list | git rev-list --parents]
7462    set allcupdate [expr {$seeds ne {}}]
7463    if {!$allcupdate} {
7464        set ids "--all"
7465    } else {
7466        set refs [concat [array names idheads] [array names idtags] \
7467                      [array names idotherrefs]]
7468        set ids {}
7469        set tagobjs {}
7470        foreach name [array names tagobjid] {
7471            lappend tagobjs $tagobjid($name)
7472        }
7473        foreach id [lsort -unique $refs] {
7474            if {![info exists allparents($id)] &&
7475                [lsearch -exact $tagobjs $id] < 0} {
7476                lappend ids $id
7477            }
7478        }
7479        if {$ids ne {}} {
7480            foreach id $seeds {
7481                lappend ids "^$id"
7482            }
7483        }
7484    }
7485    if {$ids ne {}} {
7486        set fd [open [concat $cmd $ids] r]
7487        fconfigure $fd -blocking 0
7488        incr allcommits
7489        nowbusy allcommits
7490        filerun $fd [list getallclines $fd]
7491    } else {
7492        dispneartags 0
7493    }
7494}
7495
7496# Since most commits have 1 parent and 1 child, we group strings of
7497# such commits into "arcs" joining branch/merge points (BMPs), which
7498# are commits that either don't have 1 parent or don't have 1 child.
7499#
7500# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
7501# arcout(id) - outgoing arcs for BMP
7502# arcids(a) - list of IDs on arc including end but not start
7503# arcstart(a) - BMP ID at start of arc
7504# arcend(a) - BMP ID at end of arc
7505# growing(a) - arc a is still growing
7506# arctags(a) - IDs out of arcids (excluding end) that have tags
7507# archeads(a) - IDs out of arcids (excluding end) that have heads
7508# The start of an arc is at the descendent end, so "incoming" means
7509# coming from descendents, and "outgoing" means going towards ancestors.
7510
7511proc getallclines {fd} {
7512    global allparents allchildren idtags idheads nextarc
7513    global arcnos arcids arctags arcout arcend arcstart archeads growing
7514    global seeds allcommits cachedarcs allcupdate
7515    
7516    set nid 0
7517    while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
7518        set id [lindex $line 0]
7519        if {[info exists allparents($id)]} {
7520            # seen it already
7521            continue
7522        }
7523        set cachedarcs 0
7524        set olds [lrange $line 1 end]
7525        set allparents($id) $olds
7526        if {![info exists allchildren($id)]} {
7527            set allchildren($id) {}
7528            set arcnos($id) {}
7529            lappend seeds $id
7530        } else {
7531            set a $arcnos($id)
7532            if {[llength $olds] == 1 && [llength $a] == 1} {
7533                lappend arcids($a) $id
7534                if {[info exists idtags($id)]} {
7535                    lappend arctags($a) $id
7536                }
7537                if {[info exists idheads($id)]} {
7538                    lappend archeads($a) $id
7539                }
7540                if {[info exists allparents($olds)]} {
7541                    # seen parent already
7542                    if {![info exists arcout($olds)]} {
7543                        splitarc $olds
7544                    }
7545                    lappend arcids($a) $olds
7546                    set arcend($a) $olds
7547                    unset growing($a)
7548                }
7549                lappend allchildren($olds) $id
7550                lappend arcnos($olds) $a
7551                continue
7552            }
7553        }
7554        foreach a $arcnos($id) {
7555            lappend arcids($a) $id
7556            set arcend($a) $id
7557            unset growing($a)
7558        }
7559
7560        set ao {}
7561        foreach p $olds {
7562            lappend allchildren($p) $id
7563            set a [incr nextarc]
7564            set arcstart($a) $id
7565            set archeads($a) {}
7566            set arctags($a) {}
7567            set archeads($a) {}
7568            set arcids($a) {}
7569            lappend ao $a
7570            set growing($a) 1
7571            if {[info exists allparents($p)]} {
7572                # seen it already, may need to make a new branch
7573                if {![info exists arcout($p)]} {
7574                    splitarc $p
7575                }
7576                lappend arcids($a) $p
7577                set arcend($a) $p
7578                unset growing($a)
7579            }
7580            lappend arcnos($p) $a
7581        }
7582        set arcout($id) $ao
7583    }
7584    if {$nid > 0} {
7585        global cached_dheads cached_dtags cached_atags
7586        catch {unset cached_dheads}
7587        catch {unset cached_dtags}
7588        catch {unset cached_atags}
7589    }
7590    if {![eof $fd]} {
7591        return [expr {$nid >= 1000? 2: 1}]
7592    }
7593    set cacheok 1
7594    if {[catch {
7595        fconfigure $fd -blocking 1
7596        close $fd
7597    } err]} {
7598        # got an error reading the list of commits
7599        # if we were updating, try rereading the whole thing again
7600        if {$allcupdate} {
7601            incr allcommits -1
7602            dropcache $err
7603            return
7604        }
7605        error_popup "[mc "Error reading commit topology information;\
7606                branch and preceding/following tag information\
7607                will be incomplete."]\n($err)"
7608        set cacheok 0
7609    }
7610    if {[incr allcommits -1] == 0} {
7611        notbusy allcommits
7612        if {$cacheok} {
7613            run savecache
7614        }
7615    }
7616    dispneartags 0
7617    return 0
7618}
7619
7620proc recalcarc {a} {
7621    global arctags archeads arcids idtags idheads
7622
7623    set at {}
7624    set ah {}
7625    foreach id [lrange $arcids($a) 0 end-1] {
7626        if {[info exists idtags($id)]} {
7627            lappend at $id
7628        }
7629        if {[info exists idheads($id)]} {
7630            lappend ah $id
7631        }
7632    }
7633    set arctags($a) $at
7634    set archeads($a) $ah
7635}
7636
7637proc splitarc {p} {
7638    global arcnos arcids nextarc arctags archeads idtags idheads
7639    global arcstart arcend arcout allparents growing
7640
7641    set a $arcnos($p)
7642    if {[llength $a] != 1} {
7643        puts "oops splitarc called but [llength $a] arcs already"
7644        return
7645    }
7646    set a [lindex $a 0]
7647    set i [lsearch -exact $arcids($a) $p]
7648    if {$i < 0} {
7649        puts "oops splitarc $p not in arc $a"
7650        return
7651    }
7652    set na [incr nextarc]
7653    if {[info exists arcend($a)]} {
7654        set arcend($na) $arcend($a)
7655    } else {
7656        set l [lindex $allparents([lindex $arcids($a) end]) 0]
7657        set j [lsearch -exact $arcnos($l) $a]
7658        set arcnos($l) [lreplace $arcnos($l) $j $j $na]
7659    }
7660    set tail [lrange $arcids($a) [expr {$i+1}] end]
7661    set arcids($a) [lrange $arcids($a) 0 $i]
7662    set arcend($a) $p
7663    set arcstart($na) $p
7664    set arcout($p) $na
7665    set arcids($na) $tail
7666    if {[info exists growing($a)]} {
7667        set growing($na) 1
7668        unset growing($a)
7669    }
7670
7671    foreach id $tail {
7672        if {[llength $arcnos($id)] == 1} {
7673            set arcnos($id) $na
7674        } else {
7675            set j [lsearch -exact $arcnos($id) $a]
7676            set arcnos($id) [lreplace $arcnos($id) $j $j $na]
7677        }
7678    }
7679
7680    # reconstruct tags and heads lists
7681    if {$arctags($a) ne {} || $archeads($a) ne {}} {
7682        recalcarc $a
7683        recalcarc $na
7684    } else {
7685        set arctags($na) {}
7686        set archeads($na) {}
7687    }
7688}
7689
7690# Update things for a new commit added that is a child of one
7691# existing commit.  Used when cherry-picking.
7692proc addnewchild {id p} {
7693    global allparents allchildren idtags nextarc
7694    global arcnos arcids arctags arcout arcend arcstart archeads growing
7695    global seeds allcommits
7696
7697    if {![info exists allcommits] || ![info exists arcnos($p)]} return
7698    set allparents($id) [list $p]
7699    set allchildren($id) {}
7700    set arcnos($id) {}
7701    lappend seeds $id
7702    lappend allchildren($p) $id
7703    set a [incr nextarc]
7704    set arcstart($a) $id
7705    set archeads($a) {}
7706    set arctags($a) {}
7707    set arcids($a) [list $p]
7708    set arcend($a) $p
7709    if {![info exists arcout($p)]} {
7710        splitarc $p
7711    }
7712    lappend arcnos($p) $a
7713    set arcout($id) [list $a]
7714}
7715
7716# This implements a cache for the topology information.
7717# The cache saves, for each arc, the start and end of the arc,
7718# the ids on the arc, and the outgoing arcs from the end.
7719proc readcache {f} {
7720    global arcnos arcids arcout arcstart arcend arctags archeads nextarc
7721    global idtags idheads allparents cachedarcs possible_seeds seeds growing
7722    global allcwait
7723
7724    set a $nextarc
7725    set lim $cachedarcs
7726    if {$lim - $a > 500} {
7727        set lim [expr {$a + 500}]
7728    }
7729    if {[catch {
7730        if {$a == $lim} {
7731            # finish reading the cache and setting up arctags, etc.
7732            set line [gets $f]
7733            if {$line ne "1"} {error "bad final version"}
7734            close $f
7735            foreach id [array names idtags] {
7736                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
7737                    [llength $allparents($id)] == 1} {
7738                    set a [lindex $arcnos($id) 0]
7739                    if {$arctags($a) eq {}} {
7740                        recalcarc $a
7741                    }
7742                }
7743            }
7744            foreach id [array names idheads] {
7745                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
7746                    [llength $allparents($id)] == 1} {
7747                    set a [lindex $arcnos($id) 0]
7748                    if {$archeads($a) eq {}} {
7749                        recalcarc $a
7750                    }
7751                }
7752            }
7753            foreach id [lsort -unique $possible_seeds] {
7754                if {$arcnos($id) eq {}} {
7755                    lappend seeds $id
7756                }
7757            }
7758            set allcwait 0
7759        } else {
7760            while {[incr a] <= $lim} {
7761                set line [gets $f]
7762                if {[llength $line] != 3} {error "bad line"}
7763                set s [lindex $line 0]
7764                set arcstart($a) $s
7765                lappend arcout($s) $a
7766                if {![info exists arcnos($s)]} {
7767                    lappend possible_seeds $s
7768                    set arcnos($s) {}
7769                }
7770                set e [lindex $line 1]
7771                if {$e eq {}} {
7772                    set growing($a) 1
7773                } else {
7774                    set arcend($a) $e
7775                    if {![info exists arcout($e)]} {
7776                        set arcout($e) {}
7777                    }
7778                }
7779                set arcids($a) [lindex $line 2]
7780                foreach id $arcids($a) {
7781                    lappend allparents($s) $id
7782                    set s $id
7783                    lappend arcnos($id) $a
7784                }
7785                if {![info exists allparents($s)]} {
7786                    set allparents($s) {}
7787                }
7788                set arctags($a) {}
7789                set archeads($a) {}
7790            }
7791            set nextarc [expr {$a - 1}]
7792        }
7793    } err]} {
7794        dropcache $err
7795        return 0
7796    }
7797    if {!$allcwait} {
7798        getallcommits
7799    }
7800    return $allcwait
7801}
7802
7803proc getcache {f} {
7804    global nextarc cachedarcs possible_seeds
7805
7806    if {[catch {
7807        set line [gets $f]
7808        if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
7809        # make sure it's an integer
7810        set cachedarcs [expr {int([lindex $line 1])}]
7811        if {$cachedarcs < 0} {error "bad number of arcs"}
7812        set nextarc 0
7813        set possible_seeds {}
7814        run readcache $f
7815    } err]} {
7816        dropcache $err
7817    }
7818    return 0
7819}
7820
7821proc dropcache {err} {
7822    global allcwait nextarc cachedarcs seeds
7823
7824    #puts "dropping cache ($err)"
7825    foreach v {arcnos arcout arcids arcstart arcend growing \
7826                   arctags archeads allparents allchildren} {
7827        global $v
7828        catch {unset $v}
7829    }
7830    set allcwait 0
7831    set nextarc 0
7832    set cachedarcs 0
7833    set seeds {}
7834    getallcommits
7835}
7836
7837proc writecache {f} {
7838    global cachearc cachedarcs allccache
7839    global arcstart arcend arcnos arcids arcout
7840
7841    set a $cachearc
7842    set lim $cachedarcs
7843    if {$lim - $a > 1000} {
7844        set lim [expr {$a + 1000}]
7845    }
7846    if {[catch {
7847        while {[incr a] <= $lim} {
7848            if {[info exists arcend($a)]} {
7849                puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
7850            } else {
7851                puts $f [list $arcstart($a) {} $arcids($a)]
7852            }
7853        }
7854    } err]} {
7855        catch {close $f}
7856        catch {file delete $allccache}
7857        #puts "writing cache failed ($err)"
7858        return 0
7859    }
7860    set cachearc [expr {$a - 1}]
7861    if {$a > $cachedarcs} {
7862        puts $f "1"
7863        close $f
7864        return 0
7865    }
7866    return 1
7867}
7868
7869proc savecache {} {
7870    global nextarc cachedarcs cachearc allccache
7871
7872    if {$nextarc == $cachedarcs} return
7873    set cachearc 0
7874    set cachedarcs $nextarc
7875    catch {
7876        set f [open $allccache w]
7877        puts $f [list 1 $cachedarcs]
7878        run writecache $f
7879    }
7880}
7881
7882# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
7883# or 0 if neither is true.
7884proc anc_or_desc {a b} {
7885    global arcout arcstart arcend arcnos cached_isanc
7886
7887    if {$arcnos($a) eq $arcnos($b)} {
7888        # Both are on the same arc(s); either both are the same BMP,
7889        # or if one is not a BMP, the other is also not a BMP or is
7890        # the BMP at end of the arc (and it only has 1 incoming arc).
7891        # Or both can be BMPs with no incoming arcs.
7892        if {$a eq $b || $arcnos($a) eq {}} {
7893            return 0
7894        }
7895        # assert {[llength $arcnos($a)] == 1}
7896        set arc [lindex $arcnos($a) 0]
7897        set i [lsearch -exact $arcids($arc) $a]
7898        set j [lsearch -exact $arcids($arc) $b]
7899        if {$i < 0 || $i > $j} {
7900            return 1
7901        } else {
7902            return -1
7903        }
7904    }
7905
7906    if {![info exists arcout($a)]} {
7907        set arc [lindex $arcnos($a) 0]
7908        if {[info exists arcend($arc)]} {
7909            set aend $arcend($arc)
7910        } else {
7911            set aend {}
7912        }
7913        set a $arcstart($arc)
7914    } else {
7915        set aend $a
7916    }
7917    if {![info exists arcout($b)]} {
7918        set arc [lindex $arcnos($b) 0]
7919        if {[info exists arcend($arc)]} {
7920            set bend $arcend($arc)
7921        } else {
7922            set bend {}
7923        }
7924        set b $arcstart($arc)
7925    } else {
7926        set bend $b
7927    }
7928    if {$a eq $bend} {
7929        return 1
7930    }
7931    if {$b eq $aend} {
7932        return -1
7933    }
7934    if {[info exists cached_isanc($a,$bend)]} {
7935        if {$cached_isanc($a,$bend)} {
7936            return 1
7937        }
7938    }
7939    if {[info exists cached_isanc($b,$aend)]} {
7940        if {$cached_isanc($b,$aend)} {
7941            return -1
7942        }
7943        if {[info exists cached_isanc($a,$bend)]} {
7944            return 0
7945        }
7946    }
7947
7948    set todo [list $a $b]
7949    set anc($a) a
7950    set anc($b) b
7951    for {set i 0} {$i < [llength $todo]} {incr i} {
7952        set x [lindex $todo $i]
7953        if {$anc($x) eq {}} {
7954            continue
7955        }
7956        foreach arc $arcnos($x) {
7957            set xd $arcstart($arc)
7958            if {$xd eq $bend} {
7959                set cached_isanc($a,$bend) 1
7960                set cached_isanc($b,$aend) 0
7961                return 1
7962            } elseif {$xd eq $aend} {
7963                set cached_isanc($b,$aend) 1
7964                set cached_isanc($a,$bend) 0
7965                return -1
7966            }
7967            if {![info exists anc($xd)]} {
7968                set anc($xd) $anc($x)
7969                lappend todo $xd
7970            } elseif {$anc($xd) ne $anc($x)} {
7971                set anc($xd) {}
7972            }
7973        }
7974    }
7975    set cached_isanc($a,$bend) 0
7976    set cached_isanc($b,$aend) 0
7977    return 0
7978}
7979
7980# This identifies whether $desc has an ancestor that is
7981# a growing tip of the graph and which is not an ancestor of $anc
7982# and returns 0 if so and 1 if not.
7983# If we subsequently discover a tag on such a growing tip, and that
7984# turns out to be a descendent of $anc (which it could, since we
7985# don't necessarily see children before parents), then $desc
7986# isn't a good choice to display as a descendent tag of
7987# $anc (since it is the descendent of another tag which is
7988# a descendent of $anc).  Similarly, $anc isn't a good choice to
7989# display as a ancestor tag of $desc.
7990#
7991proc is_certain {desc anc} {
7992    global arcnos arcout arcstart arcend growing problems
7993
7994    set certain {}
7995    if {[llength $arcnos($anc)] == 1} {
7996        # tags on the same arc are certain
7997        if {$arcnos($desc) eq $arcnos($anc)} {
7998            return 1
7999        }
8000        if {![info exists arcout($anc)]} {
8001            # if $anc is partway along an arc, use the start of the arc instead
8002            set a [lindex $arcnos($anc) 0]
8003            set anc $arcstart($a)
8004        }
8005    }
8006    if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
8007        set x $desc
8008    } else {
8009        set a [lindex $arcnos($desc) 0]
8010        set x $arcend($a)
8011    }
8012    if {$x == $anc} {
8013        return 1
8014    }
8015    set anclist [list $x]
8016    set dl($x) 1
8017    set nnh 1
8018    set ngrowanc 0
8019    for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
8020        set x [lindex $anclist $i]
8021        if {$dl($x)} {
8022            incr nnh -1
8023        }
8024        set done($x) 1
8025        foreach a $arcout($x) {
8026            if {[info exists growing($a)]} {
8027                if {![info exists growanc($x)] && $dl($x)} {
8028                    set growanc($x) 1
8029                    incr ngrowanc
8030                }
8031            } else {
8032                set y $arcend($a)
8033                if {[info exists dl($y)]} {
8034                    if {$dl($y)} {
8035                        if {!$dl($x)} {
8036                            set dl($y) 0
8037                            if {![info exists done($y)]} {
8038                                incr nnh -1
8039                            }
8040                            if {[info exists growanc($x)]} {
8041                                incr ngrowanc -1
8042                            }
8043                            set xl [list $y]
8044                            for {set k 0} {$k < [llength $xl]} {incr k} {
8045                                set z [lindex $xl $k]
8046                                foreach c $arcout($z) {
8047                                    if {[info exists arcend($c)]} {
8048                                        set v $arcend($c)
8049                                        if {[info exists dl($v)] && $dl($v)} {
8050                                            set dl($v) 0
8051                                            if {![info exists done($v)]} {
8052                                                incr nnh -1
8053                                            }
8054                                            if {[info exists growanc($v)]} {
8055                                                incr ngrowanc -1
8056                                            }
8057                                            lappend xl $v
8058                                        }
8059                                    }
8060                                }
8061                            }
8062                        }
8063                    }
8064                } elseif {$y eq $anc || !$dl($x)} {
8065                    set dl($y) 0
8066                    lappend anclist $y
8067                } else {
8068                    set dl($y) 1
8069                    lappend anclist $y
8070                    incr nnh
8071                }
8072            }
8073        }
8074    }
8075    foreach x [array names growanc] {
8076        if {$dl($x)} {
8077            return 0
8078        }
8079        return 0
8080    }
8081    return 1
8082}
8083
8084proc validate_arctags {a} {
8085    global arctags idtags
8086
8087    set i -1
8088    set na $arctags($a)
8089    foreach id $arctags($a) {
8090        incr i
8091        if {![info exists idtags($id)]} {
8092            set na [lreplace $na $i $i]
8093            incr i -1
8094        }
8095    }
8096    set arctags($a) $na
8097}
8098
8099proc validate_archeads {a} {
8100    global archeads idheads
8101
8102    set i -1
8103    set na $archeads($a)
8104    foreach id $archeads($a) {
8105        incr i
8106        if {![info exists idheads($id)]} {
8107            set na [lreplace $na $i $i]
8108            incr i -1
8109        }
8110    }
8111    set archeads($a) $na
8112}
8113
8114# Return the list of IDs that have tags that are descendents of id,
8115# ignoring IDs that are descendents of IDs already reported.
8116proc desctags {id} {
8117    global arcnos arcstart arcids arctags idtags allparents
8118    global growing cached_dtags
8119
8120    if {![info exists allparents($id)]} {
8121        return {}
8122    }
8123    set t1 [clock clicks -milliseconds]
8124    set argid $id
8125    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8126        # part-way along an arc; check that arc first
8127        set a [lindex $arcnos($id) 0]
8128        if {$arctags($a) ne {}} {
8129            validate_arctags $a
8130            set i [lsearch -exact $arcids($a) $id]
8131            set tid {}
8132            foreach t $arctags($a) {
8133                set j [lsearch -exact $arcids($a) $t]
8134                if {$j >= $i} break
8135                set tid $t
8136            }
8137            if {$tid ne {}} {
8138                return $tid
8139            }
8140        }
8141        set id $arcstart($a)
8142        if {[info exists idtags($id)]} {
8143            return $id
8144        }
8145    }
8146    if {[info exists cached_dtags($id)]} {
8147        return $cached_dtags($id)
8148    }
8149
8150    set origid $id
8151    set todo [list $id]
8152    set queued($id) 1
8153    set nc 1
8154    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8155        set id [lindex $todo $i]
8156        set done($id) 1
8157        set ta [info exists hastaggedancestor($id)]
8158        if {!$ta} {
8159            incr nc -1
8160        }
8161        # ignore tags on starting node
8162        if {!$ta && $i > 0} {
8163            if {[info exists idtags($id)]} {
8164                set tagloc($id) $id
8165                set ta 1
8166            } elseif {[info exists cached_dtags($id)]} {
8167                set tagloc($id) $cached_dtags($id)
8168                set ta 1
8169            }
8170        }
8171        foreach a $arcnos($id) {
8172            set d $arcstart($a)
8173            if {!$ta && $arctags($a) ne {}} {
8174                validate_arctags $a
8175                if {$arctags($a) ne {}} {
8176                    lappend tagloc($id) [lindex $arctags($a) end]
8177                }
8178            }
8179            if {$ta || $arctags($a) ne {}} {
8180                set tomark [list $d]
8181                for {set j 0} {$j < [llength $tomark]} {incr j} {
8182                    set dd [lindex $tomark $j]
8183                    if {![info exists hastaggedancestor($dd)]} {
8184                        if {[info exists done($dd)]} {
8185                            foreach b $arcnos($dd) {
8186                                lappend tomark $arcstart($b)
8187                            }
8188                            if {[info exists tagloc($dd)]} {
8189                                unset tagloc($dd)
8190                            }
8191                        } elseif {[info exists queued($dd)]} {
8192                            incr nc -1
8193                        }
8194                        set hastaggedancestor($dd) 1
8195                    }
8196                }
8197            }
8198            if {![info exists queued($d)]} {
8199                lappend todo $d
8200                set queued($d) 1
8201                if {![info exists hastaggedancestor($d)]} {
8202                    incr nc
8203                }
8204            }
8205        }
8206    }
8207    set tags {}
8208    foreach id [array names tagloc] {
8209        if {![info exists hastaggedancestor($id)]} {
8210            foreach t $tagloc($id) {
8211                if {[lsearch -exact $tags $t] < 0} {
8212                    lappend tags $t
8213                }
8214            }
8215        }
8216    }
8217    set t2 [clock clicks -milliseconds]
8218    set loopix $i
8219
8220    # remove tags that are descendents of other tags
8221    for {set i 0} {$i < [llength $tags]} {incr i} {
8222        set a [lindex $tags $i]
8223        for {set j 0} {$j < $i} {incr j} {
8224            set b [lindex $tags $j]
8225            set r [anc_or_desc $a $b]
8226            if {$r == 1} {
8227                set tags [lreplace $tags $j $j]
8228                incr j -1
8229                incr i -1
8230            } elseif {$r == -1} {
8231                set tags [lreplace $tags $i $i]
8232                incr i -1
8233                break
8234            }
8235        }
8236    }
8237
8238    if {[array names growing] ne {}} {
8239        # graph isn't finished, need to check if any tag could get
8240        # eclipsed by another tag coming later.  Simply ignore any
8241        # tags that could later get eclipsed.
8242        set ctags {}
8243        foreach t $tags {
8244            if {[is_certain $t $origid]} {
8245                lappend ctags $t
8246            }
8247        }
8248        if {$tags eq $ctags} {
8249            set cached_dtags($origid) $tags
8250        } else {
8251            set tags $ctags
8252        }
8253    } else {
8254        set cached_dtags($origid) $tags
8255    }
8256    set t3 [clock clicks -milliseconds]
8257    if {0 && $t3 - $t1 >= 100} {
8258        puts "iterating descendents ($loopix/[llength $todo] nodes) took\
8259            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8260    }
8261    return $tags
8262}
8263
8264proc anctags {id} {
8265    global arcnos arcids arcout arcend arctags idtags allparents
8266    global growing cached_atags
8267
8268    if {![info exists allparents($id)]} {
8269        return {}
8270    }
8271    set t1 [clock clicks -milliseconds]
8272    set argid $id
8273    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8274        # part-way along an arc; check that arc first
8275        set a [lindex $arcnos($id) 0]
8276        if {$arctags($a) ne {}} {
8277            validate_arctags $a
8278            set i [lsearch -exact $arcids($a) $id]
8279            foreach t $arctags($a) {
8280                set j [lsearch -exact $arcids($a) $t]
8281                if {$j > $i} {
8282                    return $t
8283                }
8284            }
8285        }
8286        if {![info exists arcend($a)]} {
8287            return {}
8288        }
8289        set id $arcend($a)
8290        if {[info exists idtags($id)]} {
8291            return $id
8292        }
8293    }
8294    if {[info exists cached_atags($id)]} {
8295        return $cached_atags($id)
8296    }
8297
8298    set origid $id
8299    set todo [list $id]
8300    set queued($id) 1
8301    set taglist {}
8302    set nc 1
8303    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8304        set id [lindex $todo $i]
8305        set done($id) 1
8306        set td [info exists hastaggeddescendent($id)]
8307        if {!$td} {
8308            incr nc -1
8309        }
8310        # ignore tags on starting node
8311        if {!$td && $i > 0} {
8312            if {[info exists idtags($id)]} {
8313                set tagloc($id) $id
8314                set td 1
8315            } elseif {[info exists cached_atags($id)]} {
8316                set tagloc($id) $cached_atags($id)
8317                set td 1
8318            }
8319        }
8320        foreach a $arcout($id) {
8321            if {!$td && $arctags($a) ne {}} {
8322                validate_arctags $a
8323                if {$arctags($a) ne {}} {
8324                    lappend tagloc($id) [lindex $arctags($a) 0]
8325                }
8326            }
8327            if {![info exists arcend($a)]} continue
8328            set d $arcend($a)
8329            if {$td || $arctags($a) ne {}} {
8330                set tomark [list $d]
8331                for {set j 0} {$j < [llength $tomark]} {incr j} {
8332                    set dd [lindex $tomark $j]
8333                    if {![info exists hastaggeddescendent($dd)]} {
8334                        if {[info exists done($dd)]} {
8335                            foreach b $arcout($dd) {
8336                                if {[info exists arcend($b)]} {
8337                                    lappend tomark $arcend($b)
8338                                }
8339                            }
8340                            if {[info exists tagloc($dd)]} {
8341                                unset tagloc($dd)
8342                            }
8343                        } elseif {[info exists queued($dd)]} {
8344                            incr nc -1
8345                        }
8346                        set hastaggeddescendent($dd) 1
8347                    }
8348                }
8349            }
8350            if {![info exists queued($d)]} {
8351                lappend todo $d
8352                set queued($d) 1
8353                if {![info exists hastaggeddescendent($d)]} {
8354                    incr nc
8355                }
8356            }
8357        }
8358    }
8359    set t2 [clock clicks -milliseconds]
8360    set loopix $i
8361    set tags {}
8362    foreach id [array names tagloc] {
8363        if {![info exists hastaggeddescendent($id)]} {
8364            foreach t $tagloc($id) {
8365                if {[lsearch -exact $tags $t] < 0} {
8366                    lappend tags $t
8367                }
8368            }
8369        }
8370    }
8371
8372    # remove tags that are ancestors of other tags
8373    for {set i 0} {$i < [llength $tags]} {incr i} {
8374        set a [lindex $tags $i]
8375        for {set j 0} {$j < $i} {incr j} {
8376            set b [lindex $tags $j]
8377            set r [anc_or_desc $a $b]
8378            if {$r == -1} {
8379                set tags [lreplace $tags $j $j]
8380                incr j -1
8381                incr i -1
8382            } elseif {$r == 1} {
8383                set tags [lreplace $tags $i $i]
8384                incr i -1
8385                break
8386            }
8387        }
8388    }
8389
8390    if {[array names growing] ne {}} {
8391        # graph isn't finished, need to check if any tag could get
8392        # eclipsed by another tag coming later.  Simply ignore any
8393        # tags that could later get eclipsed.
8394        set ctags {}
8395        foreach t $tags {
8396            if {[is_certain $origid $t]} {
8397                lappend ctags $t
8398            }
8399        }
8400        if {$tags eq $ctags} {
8401            set cached_atags($origid) $tags
8402        } else {
8403            set tags $ctags
8404        }
8405    } else {
8406        set cached_atags($origid) $tags
8407    }
8408    set t3 [clock clicks -milliseconds]
8409    if {0 && $t3 - $t1 >= 100} {
8410        puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
8411            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8412    }
8413    return $tags
8414}
8415
8416# Return the list of IDs that have heads that are descendents of id,
8417# including id itself if it has a head.
8418proc descheads {id} {
8419    global arcnos arcstart arcids archeads idheads cached_dheads
8420    global allparents
8421
8422    if {![info exists allparents($id)]} {
8423        return {}
8424    }
8425    set aret {}
8426    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8427        # part-way along an arc; check it first
8428        set a [lindex $arcnos($id) 0]
8429        if {$archeads($a) ne {}} {
8430            validate_archeads $a
8431            set i [lsearch -exact $arcids($a) $id]
8432            foreach t $archeads($a) {
8433                set j [lsearch -exact $arcids($a) $t]
8434                if {$j > $i} break
8435                lappend aret $t
8436            }
8437        }
8438        set id $arcstart($a)
8439    }
8440    set origid $id
8441    set todo [list $id]
8442    set seen($id) 1
8443    set ret {}
8444    for {set i 0} {$i < [llength $todo]} {incr i} {
8445        set id [lindex $todo $i]
8446        if {[info exists cached_dheads($id)]} {
8447            set ret [concat $ret $cached_dheads($id)]
8448        } else {
8449            if {[info exists idheads($id)]} {
8450                lappend ret $id
8451            }
8452            foreach a $arcnos($id) {
8453                if {$archeads($a) ne {}} {
8454                    validate_archeads $a
8455                    if {$archeads($a) ne {}} {
8456                        set ret [concat $ret $archeads($a)]
8457                    }
8458                }
8459                set d $arcstart($a)
8460                if {![info exists seen($d)]} {
8461                    lappend todo $d
8462                    set seen($d) 1
8463                }
8464            }
8465        }
8466    }
8467    set ret [lsort -unique $ret]
8468    set cached_dheads($origid) $ret
8469    return [concat $ret $aret]
8470}
8471
8472proc addedtag {id} {
8473    global arcnos arcout cached_dtags cached_atags
8474
8475    if {![info exists arcnos($id)]} return
8476    if {![info exists arcout($id)]} {
8477        recalcarc [lindex $arcnos($id) 0]
8478    }
8479    catch {unset cached_dtags}
8480    catch {unset cached_atags}
8481}
8482
8483proc addedhead {hid head} {
8484    global arcnos arcout cached_dheads
8485
8486    if {![info exists arcnos($hid)]} return
8487    if {![info exists arcout($hid)]} {
8488        recalcarc [lindex $arcnos($hid) 0]
8489    }
8490    catch {unset cached_dheads}
8491}
8492
8493proc removedhead {hid head} {
8494    global cached_dheads
8495
8496    catch {unset cached_dheads}
8497}
8498
8499proc movedhead {hid head} {
8500    global arcnos arcout cached_dheads
8501
8502    if {![info exists arcnos($hid)]} return
8503    if {![info exists arcout($hid)]} {
8504        recalcarc [lindex $arcnos($hid) 0]
8505    }
8506    catch {unset cached_dheads}
8507}
8508
8509proc changedrefs {} {
8510    global cached_dheads cached_dtags cached_atags
8511    global arctags archeads arcnos arcout idheads idtags
8512
8513    foreach id [concat [array names idheads] [array names idtags]] {
8514        if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
8515            set a [lindex $arcnos($id) 0]
8516            if {![info exists donearc($a)]} {
8517                recalcarc $a
8518                set donearc($a) 1
8519            }
8520        }
8521    }
8522    catch {unset cached_dtags}
8523    catch {unset cached_atags}
8524    catch {unset cached_dheads}
8525}
8526
8527proc rereadrefs {} {
8528    global idtags idheads idotherrefs mainheadid
8529
8530    set refids [concat [array names idtags] \
8531                    [array names idheads] [array names idotherrefs]]
8532    foreach id $refids {
8533        if {![info exists ref($id)]} {
8534            set ref($id) [listrefs $id]
8535        }
8536    }
8537    set oldmainhead $mainheadid
8538    readrefs
8539    changedrefs
8540    set refids [lsort -unique [concat $refids [array names idtags] \
8541                        [array names idheads] [array names idotherrefs]]]
8542    foreach id $refids {
8543        set v [listrefs $id]
8544        if {![info exists ref($id)] || $ref($id) != $v ||
8545            ($id eq $oldmainhead && $id ne $mainheadid) ||
8546            ($id eq $mainheadid && $id ne $oldmainhead)} {
8547            redrawtags $id
8548        }
8549    }
8550    run refill_reflist
8551}
8552
8553proc listrefs {id} {
8554    global idtags idheads idotherrefs
8555
8556    set x {}
8557    if {[info exists idtags($id)]} {
8558        set x $idtags($id)
8559    }
8560    set y {}
8561    if {[info exists idheads($id)]} {
8562        set y $idheads($id)
8563    }
8564    set z {}
8565    if {[info exists idotherrefs($id)]} {
8566        set z $idotherrefs($id)
8567    }
8568    return [list $x $y $z]
8569}
8570
8571proc showtag {tag isnew} {
8572    global ctext tagcontents tagids linknum tagobjid
8573
8574    if {$isnew} {
8575        addtohistory [list showtag $tag 0]
8576    }
8577    $ctext conf -state normal
8578    clear_ctext
8579    settabs 0
8580    set linknum 0
8581    if {![info exists tagcontents($tag)]} {
8582        catch {
8583            set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
8584        }
8585    }
8586    if {[info exists tagcontents($tag)]} {
8587        set text $tagcontents($tag)
8588    } else {
8589        set text "[mc "Tag"]: $tag\n[mc "Id"]:  $tagids($tag)"
8590    }
8591    appendwithlinks $text {}
8592    $ctext conf -state disabled
8593    init_flist {}
8594}
8595
8596proc doquit {} {
8597    global stopped
8598    set stopped 100
8599    savestuff .
8600    destroy .
8601}
8602
8603proc mkfontdisp {font top which} {
8604    global fontattr fontpref $font
8605
8606    set fontpref($font) [set $font]
8607    button $top.${font}but -text $which -font optionfont \
8608        -command [list choosefont $font $which]
8609    label $top.$font -relief flat -font $font \
8610        -text $fontattr($font,family) -justify left
8611    grid x $top.${font}but $top.$font -sticky w
8612}
8613
8614proc choosefont {font which} {
8615    global fontparam fontlist fonttop fontattr
8616
8617    set fontparam(which) $which
8618    set fontparam(font) $font
8619    set fontparam(family) [font actual $font -family]
8620    set fontparam(size) $fontattr($font,size)
8621    set fontparam(weight) $fontattr($font,weight)
8622    set fontparam(slant) $fontattr($font,slant)
8623    set top .gitkfont
8624    set fonttop $top
8625    if {![winfo exists $top]} {
8626        font create sample
8627        eval font config sample [font actual $font]
8628        toplevel $top
8629        wm title $top [mc "Gitk font chooser"]
8630        label $top.l -textvariable fontparam(which)
8631        pack $top.l -side top
8632        set fontlist [lsort [font families]]
8633        frame $top.f
8634        listbox $top.f.fam -listvariable fontlist \
8635            -yscrollcommand [list $top.f.sb set]
8636        bind $top.f.fam <<ListboxSelect>> selfontfam
8637        scrollbar $top.f.sb -command [list $top.f.fam yview]
8638        pack $top.f.sb -side right -fill y
8639        pack $top.f.fam -side left -fill both -expand 1
8640        pack $top.f -side top -fill both -expand 1
8641        frame $top.g
8642        spinbox $top.g.size -from 4 -to 40 -width 4 \
8643            -textvariable fontparam(size) \
8644            -validatecommand {string is integer -strict %s}
8645        checkbutton $top.g.bold -padx 5 \
8646            -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
8647            -variable fontparam(weight) -onvalue bold -offvalue normal
8648        checkbutton $top.g.ital -padx 5 \
8649            -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
8650            -variable fontparam(slant) -onvalue italic -offvalue roman
8651        pack $top.g.size $top.g.bold $top.g.ital -side left
8652        pack $top.g -side top
8653        canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
8654            -background white
8655        $top.c create text 100 25 -anchor center -text $which -font sample \
8656            -fill black -tags text
8657        bind $top.c <Configure> [list centertext $top.c]
8658        pack $top.c -side top -fill x
8659        frame $top.buts
8660        button $top.buts.ok -text [mc "OK"] -command fontok -default active
8661        button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
8662        grid $top.buts.ok $top.buts.can
8663        grid columnconfigure $top.buts 0 -weight 1 -uniform a
8664        grid columnconfigure $top.buts 1 -weight 1 -uniform a
8665        pack $top.buts -side bottom -fill x
8666        trace add variable fontparam write chg_fontparam
8667    } else {
8668        raise $top
8669        $top.c itemconf text -text $which
8670    }
8671    set i [lsearch -exact $fontlist $fontparam(family)]
8672    if {$i >= 0} {
8673        $top.f.fam selection set $i
8674        $top.f.fam see $i
8675    }
8676}
8677
8678proc centertext {w} {
8679    $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
8680}
8681
8682proc fontok {} {
8683    global fontparam fontpref prefstop
8684
8685    set f $fontparam(font)
8686    set fontpref($f) [list $fontparam(family) $fontparam(size)]
8687    if {$fontparam(weight) eq "bold"} {
8688        lappend fontpref($f) "bold"
8689    }
8690    if {$fontparam(slant) eq "italic"} {
8691        lappend fontpref($f) "italic"
8692    }
8693    set w $prefstop.$f
8694    $w conf -text $fontparam(family) -font $fontpref($f)
8695        
8696    fontcan
8697}
8698
8699proc fontcan {} {
8700    global fonttop fontparam
8701
8702    if {[info exists fonttop]} {
8703        catch {destroy $fonttop}
8704        catch {font delete sample}
8705        unset fonttop
8706        unset fontparam
8707    }
8708}
8709
8710proc selfontfam {} {
8711    global fonttop fontparam
8712
8713    set i [$fonttop.f.fam curselection]
8714    if {$i ne {}} {
8715        set fontparam(family) [$fonttop.f.fam get $i]
8716    }
8717}
8718
8719proc chg_fontparam {v sub op} {
8720    global fontparam
8721
8722    font config sample -$sub $fontparam($sub)
8723}
8724
8725proc doprefs {} {
8726    global maxwidth maxgraphpct
8727    global oldprefs prefstop showneartags showlocalchanges
8728    global bgcolor fgcolor ctext diffcolors selectbgcolor
8729    global tabstop limitdiffs
8730
8731    set top .gitkprefs
8732    set prefstop $top
8733    if {[winfo exists $top]} {
8734        raise $top
8735        return
8736    }
8737    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8738                   limitdiffs tabstop} {
8739        set oldprefs($v) [set $v]
8740    }
8741    toplevel $top
8742    wm title $top [mc "Gitk preferences"]
8743    label $top.ldisp -text [mc "Commit list display options"]
8744    grid $top.ldisp - -sticky w -pady 10
8745    label $top.spacer -text " "
8746    label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
8747        -font optionfont
8748    spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
8749    grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
8750    label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
8751        -font optionfont
8752    spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
8753    grid x $top.maxpctl $top.maxpct -sticky w
8754    frame $top.showlocal
8755    label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
8756    checkbutton $top.showlocal.b -variable showlocalchanges
8757    pack $top.showlocal.b $top.showlocal.l -side left
8758    grid x $top.showlocal -sticky w
8759
8760    label $top.ddisp -text [mc "Diff display options"]
8761    grid $top.ddisp - -sticky w -pady 10
8762    label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
8763    spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
8764    grid x $top.tabstopl $top.tabstop -sticky w
8765    frame $top.ntag
8766    label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
8767    checkbutton $top.ntag.b -variable showneartags
8768    pack $top.ntag.b $top.ntag.l -side left
8769    grid x $top.ntag -sticky w
8770    frame $top.ldiff
8771    label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
8772    checkbutton $top.ldiff.b -variable limitdiffs
8773    pack $top.ldiff.b $top.ldiff.l -side left
8774    grid x $top.ldiff -sticky w
8775
8776    label $top.cdisp -text [mc "Colors: press to choose"]
8777    grid $top.cdisp - -sticky w -pady 10
8778    label $top.bg -padx 40 -relief sunk -background $bgcolor
8779    button $top.bgbut -text [mc "Background"] -font optionfont \
8780        -command [list choosecolor bgcolor 0 $top.bg background setbg]
8781    grid x $top.bgbut $top.bg -sticky w
8782    label $top.fg -padx 40 -relief sunk -background $fgcolor
8783    button $top.fgbut -text [mc "Foreground"] -font optionfont \
8784        -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
8785    grid x $top.fgbut $top.fg -sticky w
8786    label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
8787    button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
8788        -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
8789                      [list $ctext tag conf d0 -foreground]]
8790    grid x $top.diffoldbut $top.diffold -sticky w
8791    label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
8792    button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
8793        -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
8794                      [list $ctext tag conf d1 -foreground]]
8795    grid x $top.diffnewbut $top.diffnew -sticky w
8796    label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
8797    button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
8798        -command [list choosecolor diffcolors 2 $top.hunksep \
8799                      "diff hunk header" \
8800                      [list $ctext tag conf hunksep -foreground]]
8801    grid x $top.hunksepbut $top.hunksep -sticky w
8802    label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
8803    button $top.selbgbut -text [mc "Select bg"] -font optionfont \
8804        -command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
8805    grid x $top.selbgbut $top.selbgsep -sticky w
8806
8807    label $top.cfont -text [mc "Fonts: press to choose"]
8808    grid $top.cfont - -sticky w -pady 10
8809    mkfontdisp mainfont $top [mc "Main font"]
8810    mkfontdisp textfont $top [mc "Diff display font"]
8811    mkfontdisp uifont $top [mc "User interface font"]
8812
8813    frame $top.buts
8814    button $top.buts.ok -text [mc "OK"] -command prefsok -default active
8815    button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
8816    grid $top.buts.ok $top.buts.can
8817    grid columnconfigure $top.buts 0 -weight 1 -uniform a
8818    grid columnconfigure $top.buts 1 -weight 1 -uniform a
8819    grid $top.buts - - -pady 10 -sticky ew
8820    bind $top <Visibility> "focus $top.buts.ok"
8821}
8822
8823proc choosecolor {v vi w x cmd} {
8824    global $v
8825
8826    set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
8827               -title [mc "Gitk: choose color for %s" $x]]
8828    if {$c eq {}} return
8829    $w conf -background $c
8830    lset $v $vi $c
8831    eval $cmd $c
8832}
8833
8834proc setselbg {c} {
8835    global bglist cflist
8836    foreach w $bglist {
8837        $w configure -selectbackground $c
8838    }
8839    $cflist tag configure highlight \
8840        -background [$cflist cget -selectbackground]
8841    allcanvs itemconf secsel -fill $c
8842}
8843
8844proc setbg {c} {
8845    global bglist
8846
8847    foreach w $bglist {
8848        $w conf -background $c
8849    }
8850}
8851
8852proc setfg {c} {
8853    global fglist canv
8854
8855    foreach w $fglist {
8856        $w conf -foreground $c
8857    }
8858    allcanvs itemconf text -fill $c
8859    $canv itemconf circle -outline $c
8860}
8861
8862proc prefscan {} {
8863    global oldprefs prefstop
8864
8865    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
8866                   limitdiffs tabstop} {
8867        global $v
8868        set $v $oldprefs($v)
8869    }
8870    catch {destroy $prefstop}
8871    unset prefstop
8872    fontcan
8873}
8874
8875proc prefsok {} {
8876    global maxwidth maxgraphpct
8877    global oldprefs prefstop showneartags showlocalchanges
8878    global fontpref mainfont textfont uifont
8879    global limitdiffs treediffs
8880
8881    catch {destroy $prefstop}
8882    unset prefstop
8883    fontcan
8884    set fontchanged 0
8885    if {$mainfont ne $fontpref(mainfont)} {
8886        set mainfont $fontpref(mainfont)
8887        parsefont mainfont $mainfont
8888        eval font configure mainfont [fontflags mainfont]
8889        eval font configure mainfontbold [fontflags mainfont 1]
8890        setcoords
8891        set fontchanged 1
8892    }
8893    if {$textfont ne $fontpref(textfont)} {
8894        set textfont $fontpref(textfont)
8895        parsefont textfont $textfont
8896        eval font configure textfont [fontflags textfont]
8897        eval font configure textfontbold [fontflags textfont 1]
8898    }
8899    if {$uifont ne $fontpref(uifont)} {
8900        set uifont $fontpref(uifont)
8901        parsefont uifont $uifont
8902        eval font configure uifont [fontflags uifont]
8903    }
8904    settabs
8905    if {$showlocalchanges != $oldprefs(showlocalchanges)} {
8906        if {$showlocalchanges} {
8907            doshowlocalchanges
8908        } else {
8909            dohidelocalchanges
8910        }
8911    }
8912    if {$limitdiffs != $oldprefs(limitdiffs)} {
8913        # treediffs elements are limited by path
8914        catch {unset treediffs}
8915    }
8916    if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
8917        || $maxgraphpct != $oldprefs(maxgraphpct)} {
8918        redisplay
8919    } elseif {$showneartags != $oldprefs(showneartags) ||
8920          $limitdiffs != $oldprefs(limitdiffs)} {
8921        reselectline
8922    }
8923}
8924
8925proc formatdate {d} {
8926    global datetimeformat
8927    if {$d ne {}} {
8928        set d [clock format $d -format $datetimeformat]
8929    }
8930    return $d
8931}
8932
8933# This list of encoding names and aliases is distilled from
8934# http://www.iana.org/assignments/character-sets.
8935# Not all of them are supported by Tcl.
8936set encoding_aliases {
8937    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
8938      ISO646-US US-ASCII us IBM367 cp367 csASCII }
8939    { ISO-10646-UTF-1 csISO10646UTF1 }
8940    { ISO_646.basic:1983 ref csISO646basic1983 }
8941    { INVARIANT csINVARIANT }
8942    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
8943    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
8944    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
8945    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
8946    { NATS-DANO iso-ir-9-1 csNATSDANO }
8947    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
8948    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
8949    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
8950    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
8951    { ISO-2022-KR csISO2022KR }
8952    { EUC-KR csEUCKR }
8953    { ISO-2022-JP csISO2022JP }
8954    { ISO-2022-JP-2 csISO2022JP2 }
8955    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
8956      csISO13JISC6220jp }
8957    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
8958    { IT iso-ir-15 ISO646-IT csISO15Italian }
8959    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
8960    { ES iso-ir-17 ISO646-ES csISO17Spanish }
8961    { greek7-old iso-ir-18 csISO18Greek7Old }
8962    { latin-greek iso-ir-19 csISO19LatinGreek }
8963    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
8964    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
8965    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
8966    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
8967    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
8968    { BS_viewdata iso-ir-47 csISO47BSViewdata }
8969    { INIS iso-ir-49 csISO49INIS }
8970    { INIS-8 iso-ir-50 csISO50INIS8 }
8971    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
8972    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
8973    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
8974    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
8975    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
8976    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
8977      csISO60Norwegian1 }
8978    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
8979    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
8980    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
8981    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
8982    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
8983    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
8984    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
8985    { greek7 iso-ir-88 csISO88Greek7 }
8986    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
8987    { iso-ir-90 csISO90 }
8988    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
8989    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
8990      csISO92JISC62991984b }
8991    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
8992    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
8993    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
8994      csISO95JIS62291984handadd }
8995    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
8996    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
8997    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
8998    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
8999      CP819 csISOLatin1 }
9000    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
9001    { T.61-7bit iso-ir-102 csISO102T617bit }
9002    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
9003    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
9004    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
9005    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
9006    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
9007    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
9008    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
9009    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
9010      arabic csISOLatinArabic }
9011    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
9012    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
9013    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
9014      greek greek8 csISOLatinGreek }
9015    { T.101-G2 iso-ir-128 csISO128T101G2 }
9016    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
9017      csISOLatinHebrew }
9018    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
9019    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
9020    { CSN_369103 iso-ir-139 csISO139CSN369103 }
9021    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
9022    { ISO_6937-2-add iso-ir-142 csISOTextComm }
9023    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
9024    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
9025      csISOLatinCyrillic }
9026    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
9027    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
9028    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
9029    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
9030    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
9031    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
9032    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
9033    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
9034    { ISO_10367-box iso-ir-155 csISO10367Box }
9035    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
9036    { latin-lap lap iso-ir-158 csISO158Lap }
9037    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
9038    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
9039    { us-dk csUSDK }
9040    { dk-us csDKUS }
9041    { JIS_X0201 X0201 csHalfWidthKatakana }
9042    { KSC5636 ISO646-KR csKSC5636 }
9043    { ISO-10646-UCS-2 csUnicode }
9044    { ISO-10646-UCS-4 csUCS4 }
9045    { DEC-MCS dec csDECMCS }
9046    { hp-roman8 roman8 r8 csHPRoman8 }
9047    { macintosh mac csMacintosh }
9048    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
9049      csIBM037 }
9050    { IBM038 EBCDIC-INT cp038 csIBM038 }
9051    { IBM273 CP273 csIBM273 }
9052    { IBM274 EBCDIC-BE CP274 csIBM274 }
9053    { IBM275 EBCDIC-BR cp275 csIBM275 }
9054    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
9055    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
9056    { IBM280 CP280 ebcdic-cp-it csIBM280 }
9057    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
9058    { IBM284 CP284 ebcdic-cp-es csIBM284 }
9059    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
9060    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
9061    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
9062    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
9063    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
9064    { IBM424 cp424 ebcdic-cp-he csIBM424 }
9065    { IBM437 cp437 437 csPC8CodePage437 }
9066    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
9067    { IBM775 cp775 csPC775Baltic }
9068    { IBM850 cp850 850 csPC850Multilingual }
9069    { IBM851 cp851 851 csIBM851 }
9070    { IBM852 cp852 852 csPCp852 }
9071    { IBM855 cp855 855 csIBM855 }
9072    { IBM857 cp857 857 csIBM857 }
9073    { IBM860 cp860 860 csIBM860 }
9074    { IBM861 cp861 861 cp-is csIBM861 }
9075    { IBM862 cp862 862 csPC862LatinHebrew }
9076    { IBM863 cp863 863 csIBM863 }
9077    { IBM864 cp864 csIBM864 }
9078    { IBM865 cp865 865 csIBM865 }
9079    { IBM866 cp866 866 csIBM866 }
9080    { IBM868 CP868 cp-ar csIBM868 }
9081    { IBM869 cp869 869 cp-gr csIBM869 }
9082    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
9083    { IBM871 CP871 ebcdic-cp-is csIBM871 }
9084    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
9085    { IBM891 cp891 csIBM891 }
9086    { IBM903 cp903 csIBM903 }
9087    { IBM904 cp904 904 csIBBM904 }
9088    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
9089    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
9090    { IBM1026 CP1026 csIBM1026 }
9091    { EBCDIC-AT-DE csIBMEBCDICATDE }
9092    { EBCDIC-AT-DE-A csEBCDICATDEA }
9093    { EBCDIC-CA-FR csEBCDICCAFR }
9094    { EBCDIC-DK-NO csEBCDICDKNO }
9095    { EBCDIC-DK-NO-A csEBCDICDKNOA }
9096    { EBCDIC-FI-SE csEBCDICFISE }
9097    { EBCDIC-FI-SE-A csEBCDICFISEA }
9098    { EBCDIC-FR csEBCDICFR }
9099    { EBCDIC-IT csEBCDICIT }
9100    { EBCDIC-PT csEBCDICPT }
9101    { EBCDIC-ES csEBCDICES }
9102    { EBCDIC-ES-A csEBCDICESA }
9103    { EBCDIC-ES-S csEBCDICESS }
9104    { EBCDIC-UK csEBCDICUK }
9105    { EBCDIC-US csEBCDICUS }
9106    { UNKNOWN-8BIT csUnknown8BiT }
9107    { MNEMONIC csMnemonic }
9108    { MNEM csMnem }
9109    { VISCII csVISCII }
9110    { VIQR csVIQR }
9111    { KOI8-R csKOI8R }
9112    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
9113    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
9114    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
9115    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
9116    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
9117    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
9118    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
9119    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
9120    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
9121    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
9122    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
9123    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
9124    { IBM1047 IBM-1047 }
9125    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
9126    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
9127    { UNICODE-1-1 csUnicode11 }
9128    { CESU-8 csCESU-8 }
9129    { BOCU-1 csBOCU-1 }
9130    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
9131    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
9132      l8 }
9133    { ISO-8859-15 ISO_8859-15 Latin-9 }
9134    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
9135    { GBK CP936 MS936 windows-936 }
9136    { JIS_Encoding csJISEncoding }
9137    { Shift_JIS MS_Kanji csShiftJIS }
9138    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
9139      EUC-JP }
9140    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
9141    { ISO-10646-UCS-Basic csUnicodeASCII }
9142    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
9143    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
9144    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
9145    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
9146    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
9147    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
9148    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
9149    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
9150    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
9151    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
9152    { Adobe-Standard-Encoding csAdobeStandardEncoding }
9153    { Ventura-US csVenturaUS }
9154    { Ventura-International csVenturaInternational }
9155    { PC8-Danish-Norwegian csPC8DanishNorwegian }
9156    { PC8-Turkish csPC8Turkish }
9157    { IBM-Symbols csIBMSymbols }
9158    { IBM-Thai csIBMThai }
9159    { HP-Legal csHPLegal }
9160    { HP-Pi-font csHPPiFont }
9161    { HP-Math8 csHPMath8 }
9162    { Adobe-Symbol-Encoding csHPPSMath }
9163    { HP-DeskTop csHPDesktop }
9164    { Ventura-Math csVenturaMath }
9165    { Microsoft-Publishing csMicrosoftPublishing }
9166    { Windows-31J csWindows31J }
9167    { GB2312 csGB2312 }
9168    { Big5 csBig5 }
9169}
9170
9171proc tcl_encoding {enc} {
9172    global encoding_aliases
9173    set names [encoding names]
9174    set lcnames [string tolower $names]
9175    set enc [string tolower $enc]
9176    set i [lsearch -exact $lcnames $enc]
9177    if {$i < 0} {
9178        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
9179        if {[regsub {^iso[-_]} $enc iso encx]} {
9180            set i [lsearch -exact $lcnames $encx]
9181        }
9182    }
9183    if {$i < 0} {
9184        foreach l $encoding_aliases {
9185            set ll [string tolower $l]
9186            if {[lsearch -exact $ll $enc] < 0} continue
9187            # look through the aliases for one that tcl knows about
9188            foreach e $ll {
9189                set i [lsearch -exact $lcnames $e]
9190                if {$i < 0} {
9191                    if {[regsub {^iso[-_]} $e iso ex]} {
9192                        set i [lsearch -exact $lcnames $ex]
9193                    }
9194                }
9195                if {$i >= 0} break
9196            }
9197            break
9198        }
9199    }
9200    if {$i >= 0} {
9201        return [lindex $names $i]
9202    }
9203    return {}
9204}
9205
9206# First check that Tcl/Tk is recent enough
9207if {[catch {package require Tk 8.4} err]} {
9208    show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
9209                     Gitk requires at least Tcl/Tk 8.4."]
9210    exit 1
9211}
9212
9213# defaults...
9214set datemode 0
9215set wrcomcmd "git diff-tree --stdin -p --pretty"
9216
9217set gitencoding {}
9218catch {
9219    set gitencoding [exec git config --get i18n.commitencoding]
9220}
9221if {$gitencoding == ""} {
9222    set gitencoding "utf-8"
9223}
9224set tclencoding [tcl_encoding $gitencoding]
9225if {$tclencoding == {}} {
9226    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
9227}
9228
9229set mainfont {Helvetica 9}
9230set textfont {Courier 9}
9231set uifont {Helvetica 9 bold}
9232set tabstop 8
9233set findmergefiles 0
9234set maxgraphpct 50
9235set maxwidth 16
9236set revlistorder 0
9237set fastdate 0
9238set uparrowlen 5
9239set downarrowlen 5
9240set mingaplen 100
9241set cmitmode "patch"
9242set wrapcomment "none"
9243set showneartags 1
9244set maxrefs 20
9245set maxlinelen 200
9246set showlocalchanges 1
9247set limitdiffs 1
9248set datetimeformat "%Y-%m-%d %H:%M:%S"
9249
9250set colors {green red blue magenta darkgrey brown orange}
9251set bgcolor white
9252set fgcolor black
9253set diffcolors {red "#00a000" blue}
9254set diffcontext 3
9255set ignorespace 0
9256set selectbgcolor gray85
9257
9258## For msgcat loading, first locate the installation location.
9259if { [info exists ::env(GITK_MSGSDIR)] } {
9260    ## Msgsdir was manually set in the environment.
9261    set gitk_msgsdir $::env(GITK_MSGSDIR)
9262} else {
9263    ## Let's guess the prefix from argv0.
9264    set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
9265    set gitk_libdir [file join $gitk_prefix share gitk lib]
9266    set gitk_msgsdir [file join $gitk_libdir msgs]
9267    unset gitk_prefix
9268}
9269
9270## Internationalization (i18n) through msgcat and gettext. See
9271## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
9272package require msgcat
9273namespace import ::msgcat::mc
9274## And eventually load the actual message catalog
9275::msgcat::mcload $gitk_msgsdir
9276
9277catch {source ~/.gitk}
9278
9279font create optionfont -family sans-serif -size -12
9280
9281parsefont mainfont $mainfont
9282eval font create mainfont [fontflags mainfont]
9283eval font create mainfontbold [fontflags mainfont 1]
9284
9285parsefont textfont $textfont
9286eval font create textfont [fontflags textfont]
9287eval font create textfontbold [fontflags textfont 1]
9288
9289parsefont uifont $uifont
9290eval font create uifont [fontflags uifont]
9291
9292setoptions
9293
9294# check that we can find a .git directory somewhere...
9295if {[catch {set gitdir [gitdir]}]} {
9296    show_error {} . [mc "Cannot find a git repository here."]
9297    exit 1
9298}
9299if {![file isdirectory $gitdir]} {
9300    show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
9301    exit 1
9302}
9303
9304set mergeonly 0
9305set revtreeargs {}
9306set cmdline_files {}
9307set i 0
9308foreach arg $argv {
9309    switch -- $arg {
9310        "" { }
9311        "-d" { set datemode 1 }
9312        "--merge" {
9313            set mergeonly 1
9314            lappend revtreeargs $arg
9315        }
9316        "--" {
9317            set cmdline_files [lrange $argv [expr {$i + 1}] end]
9318            break
9319        }
9320        default {
9321            lappend revtreeargs $arg
9322        }
9323    }
9324    incr i
9325}
9326
9327if {$i >= [llength $argv] && $revtreeargs ne {}} {
9328    # no -- on command line, but some arguments (other than -d)
9329    if {[catch {
9330        set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
9331        set cmdline_files [split $f "\n"]
9332        set n [llength $cmdline_files]
9333        set revtreeargs [lrange $revtreeargs 0 end-$n]
9334        # Unfortunately git rev-parse doesn't produce an error when
9335        # something is both a revision and a filename.  To be consistent
9336        # with git log and git rev-list, check revtreeargs for filenames.
9337        foreach arg $revtreeargs {
9338            if {[file exists $arg]} {
9339                show_error {} . [mc "Ambiguous argument '%s': both revision\
9340                                 and filename" $arg]
9341                exit 1
9342            }
9343        }
9344    } err]} {
9345        # unfortunately we get both stdout and stderr in $err,
9346        # so look for "fatal:".
9347        set i [string first "fatal:" $err]
9348        if {$i > 0} {
9349            set err [string range $err [expr {$i + 6}] end]
9350        }
9351        show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
9352        exit 1
9353    }
9354}
9355
9356if {$mergeonly} {
9357    # find the list of unmerged files
9358    set mlist {}
9359    set nr_unmerged 0
9360    if {[catch {
9361        set fd [open "| git ls-files -u" r]
9362    } err]} {
9363        show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
9364        exit 1
9365    }
9366    while {[gets $fd line] >= 0} {
9367        set i [string first "\t" $line]
9368        if {$i < 0} continue
9369        set fname [string range $line [expr {$i+1}] end]
9370        if {[lsearch -exact $mlist $fname] >= 0} continue
9371        incr nr_unmerged
9372        if {$cmdline_files eq {} || [path_filter $cmdline_files $fname]} {
9373            lappend mlist $fname
9374        }
9375    }
9376    catch {close $fd}
9377    if {$mlist eq {}} {
9378        if {$nr_unmerged == 0} {
9379            show_error {} . [mc "No files selected: --merge specified but\
9380                             no files are unmerged."]
9381        } else {
9382            show_error {} . [mc "No files selected: --merge specified but\
9383                             no unmerged files are within file limit."]
9384        }
9385        exit 1
9386    }
9387    set cmdline_files $mlist
9388}
9389
9390set nullid "0000000000000000000000000000000000000000"
9391set nullid2 "0000000000000000000000000000000000000001"
9392
9393set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
9394
9395set runq {}
9396set history {}
9397set historyindex 0
9398set fh_serial 0
9399set nhl_names {}
9400set highlight_paths {}
9401set findpattern {}
9402set searchdirn -forwards
9403set boldrows {}
9404set boldnamerows {}
9405set diffelide {0 0}
9406set markingmatches 0
9407set linkentercount 0
9408set need_redisplay 0
9409set nrows_drawn 0
9410set firsttabstop 0
9411
9412set nextviewnum 1
9413set curview 0
9414set selectedview 0
9415set selectedhlview [mc "None"]
9416set highlight_related [mc "None"]
9417set highlight_files {}
9418set viewfiles(0) {}
9419set viewperm(0) 0
9420set viewargs(0) {}
9421
9422set loginstance 0
9423set cmdlineok 0
9424set stopped 0
9425set stuffsaved 0
9426set patchnum 0
9427set lserial 0
9428setcoords
9429makewindow
9430# wait for the window to become visible
9431tkwait visibility .
9432wm title . "[file tail $argv0]: [file tail [pwd]]"
9433readrefs
9434
9435if {$cmdline_files ne {} || $revtreeargs ne {}} {
9436    # create a view for the files/dirs specified on the command line
9437    set curview 1
9438    set selectedview 1
9439    set nextviewnum 2
9440    set viewname(1) [mc "Command line"]
9441    set viewfiles(1) $cmdline_files
9442    set viewargs(1) $revtreeargs
9443    set viewperm(1) 0
9444    addviewmenu 1
9445    .bar.view entryconf [mc "Edit view..."] -state normal
9446    .bar.view entryconf [mc "Delete view"] -state normal
9447}
9448
9449if {[info exists permviews]} {
9450    foreach v $permviews {
9451        set n $nextviewnum
9452        incr nextviewnum
9453        set viewname($n) [lindex $v 0]
9454        set viewfiles($n) [lindex $v 1]
9455        set viewargs($n) [lindex $v 2]
9456        set viewperm($n) 1
9457        addviewmenu $n
9458    }
9459}
9460getcommits