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