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