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