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