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