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