5f35f612c7dbebb4d9a66d4b8695599fc69f4eee
   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    while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
6535        set i [string first "\t" $line]
6536        if {$i >= 0} {
6537            set file [string range $line [expr {$i+1}] end]
6538            if {[string index $file 0] eq "\""} {
6539                set file [lindex $file 0]
6540            }
6541            set file [encoding convertfrom $file]
6542            lappend treediff $file
6543        }
6544    }
6545    if {![eof $gdtf]} {
6546        return [expr {$nr >= 1000? 2: 1}]
6547    }
6548    close $gdtf
6549    if {$limitdiffs && $vfilelimit($curview) ne {}} {
6550        set flist {}
6551        foreach f $treediff {
6552            if {[path_filter $vfilelimit($curview) $f]} {
6553                lappend flist $f
6554            }
6555        }
6556        set treediffs($ids) $flist
6557    } else {
6558        set treediffs($ids) $treediff
6559    }
6560    unset treepending
6561    if {$cmitmode eq "tree"} {
6562        gettree $diffids
6563    } elseif {$ids != $diffids} {
6564        if {![info exists diffmergeid]} {
6565            gettreediffs $diffids
6566        }
6567    } else {
6568        addtocflist $ids
6569    }
6570    return 0
6571}
6572
6573# empty string or positive integer
6574proc diffcontextvalidate {v} {
6575    return [regexp {^(|[1-9][0-9]*)$} $v]
6576}
6577
6578proc diffcontextchange {n1 n2 op} {
6579    global diffcontextstring diffcontext
6580
6581    if {[string is integer -strict $diffcontextstring]} {
6582        if {$diffcontextstring > 0} {
6583            set diffcontext $diffcontextstring
6584            reselectline
6585        }
6586    }
6587}
6588
6589proc changeignorespace {} {
6590    reselectline
6591}
6592
6593proc getblobdiffs {ids} {
6594    global blobdifffd diffids env
6595    global diffinhdr treediffs
6596    global diffcontext
6597    global ignorespace
6598    global limitdiffs vfilelimit curview
6599    global diffencoding
6600
6601    set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
6602    if {$ignorespace} {
6603        append cmd " -w"
6604    }
6605    if {$limitdiffs && $vfilelimit($curview) ne {}} {
6606        set cmd [concat $cmd -- $vfilelimit($curview)]
6607    }
6608    if {[catch {set bdf [open $cmd r]} err]} {
6609        puts "error getting diffs: $err"
6610        return
6611    }
6612    set diffinhdr 0
6613    set diffencoding [get_path_encoding {}]
6614    fconfigure $bdf -blocking 0 -encoding binary
6615    set blobdifffd($ids) $bdf
6616    filerun $bdf [list getblobdiffline $bdf $diffids]
6617}
6618
6619proc setinlist {var i val} {
6620    global $var
6621
6622    while {[llength [set $var]] < $i} {
6623        lappend $var {}
6624    }
6625    if {[llength [set $var]] == $i} {
6626        lappend $var $val
6627    } else {
6628        lset $var $i $val
6629    }
6630}
6631
6632proc makediffhdr {fname ids} {
6633    global ctext curdiffstart treediffs
6634
6635    set i [lsearch -exact $treediffs($ids) $fname]
6636    if {$i >= 0} {
6637        setinlist difffilestart $i $curdiffstart
6638    }
6639    set l [expr {(78 - [string length $fname]) / 2}]
6640    set pad [string range "----------------------------------------" 1 $l]
6641    $ctext insert $curdiffstart "$pad $fname $pad" filesep
6642}
6643
6644proc getblobdiffline {bdf ids} {
6645    global diffids blobdifffd ctext curdiffstart
6646    global diffnexthead diffnextnote difffilestart
6647    global diffinhdr treediffs
6648    global diffencoding
6649
6650    set nr 0
6651    $ctext conf -state normal
6652    while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
6653        if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
6654            close $bdf
6655            return 0
6656        }
6657        if {![string compare -length 11 "diff --git " $line]} {
6658            # trim off "diff --git "
6659            set line [string range $line 11 end]
6660            set diffinhdr 1
6661            # start of a new file
6662            $ctext insert end "\n"
6663            set curdiffstart [$ctext index "end - 1c"]
6664            $ctext insert end "\n" filesep
6665            # If the name hasn't changed the length will be odd,
6666            # the middle char will be a space, and the two bits either
6667            # side will be a/name and b/name, or "a/name" and "b/name".
6668            # If the name has changed we'll get "rename from" and
6669            # "rename to" or "copy from" and "copy to" lines following this,
6670            # and we'll use them to get the filenames.
6671            # This complexity is necessary because spaces in the filename(s)
6672            # don't get escaped.
6673            set l [string length $line]
6674            set i [expr {$l / 2}]
6675            if {!(($l & 1) && [string index $line $i] eq " " &&
6676                  [string range $line 2 [expr {$i - 1}]] eq \
6677                      [string range $line [expr {$i + 3}] end])} {
6678                continue
6679            }
6680            # unescape if quoted and chop off the a/ from the front
6681            if {[string index $line 0] eq "\""} {
6682                set fname [string range [lindex $line 0] 2 end]
6683            } else {
6684                set fname [string range $line 2 [expr {$i - 1}]]
6685            }
6686            set fname [encoding convertfrom $fname]
6687            set diffencoding [get_path_encoding $fname]
6688            makediffhdr $fname $ids
6689
6690        } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
6691                       $line match f1l f1c f2l f2c rest]} {
6692            set line [encoding convertfrom $diffencoding $line]
6693            $ctext insert end "$line\n" hunksep
6694            set diffinhdr 0
6695
6696        } elseif {$diffinhdr} {
6697            if {![string compare -length 12 "rename from " $line]} {
6698                set fname [string range $line [expr 6 + [string first " from " $line] ] end]
6699                if {[string index $fname 0] eq "\""} {
6700                    set fname [lindex $fname 0]
6701                }
6702                set fname [encoding convertfrom $fname]
6703                set i [lsearch -exact $treediffs($ids) $fname]
6704                if {$i >= 0} {
6705                    setinlist difffilestart $i $curdiffstart
6706                }
6707            } elseif {![string compare -length 10 $line "rename to "] ||
6708                      ![string compare -length 8 $line "copy to "]} {
6709                set fname [string range $line [expr 4 + [string first " to " $line] ] end]
6710                if {[string index $fname 0] eq "\""} {
6711                    set fname [lindex $fname 0]
6712                }
6713                set fname [encoding convertfrom $fname]
6714                set diffencoding [get_path_encoding $fname]
6715                makediffhdr $fname $ids
6716            } elseif {[string compare -length 3 $line "---"] == 0} {
6717                # do nothing
6718                continue
6719            } elseif {[string compare -length 3 $line "+++"] == 0} {
6720                set diffinhdr 0
6721                continue
6722            }
6723            $ctext insert end "$line\n" filesep
6724
6725        } else {
6726            set line [encoding convertfrom $diffencoding $line]
6727            set x [string range $line 0 0]
6728            if {$x == "-" || $x == "+"} {
6729                set tag [expr {$x == "+"}]
6730                $ctext insert end "$line\n" d$tag
6731            } elseif {$x == " "} {
6732                $ctext insert end "$line\n"
6733            } else {
6734                # "\ No newline at end of file",
6735                # or something else we don't recognize
6736                $ctext insert end "$line\n" hunksep
6737            }
6738        }
6739    }
6740    $ctext conf -state disabled
6741    if {[eof $bdf]} {
6742        close $bdf
6743        return 0
6744    }
6745    return [expr {$nr >= 1000? 2: 1}]
6746}
6747
6748proc changediffdisp {} {
6749    global ctext diffelide
6750
6751    $ctext tag conf d0 -elide [lindex $diffelide 0]
6752    $ctext tag conf d1 -elide [lindex $diffelide 1]
6753}
6754
6755proc highlightfile {loc cline} {
6756    global ctext cflist cflist_top
6757
6758    $ctext yview $loc
6759    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
6760    $cflist tag add highlight $cline.0 "$cline.0 lineend"
6761    $cflist see $cline.0
6762    set cflist_top $cline
6763}
6764
6765proc prevfile {} {
6766    global difffilestart ctext cmitmode
6767
6768    if {$cmitmode eq "tree"} return
6769    set prev 0.0
6770    set prevline 1
6771    set here [$ctext index @0,0]
6772    foreach loc $difffilestart {
6773        if {[$ctext compare $loc >= $here]} {
6774            highlightfile $prev $prevline
6775            return
6776        }
6777        set prev $loc
6778        incr prevline
6779    }
6780    highlightfile $prev $prevline
6781}
6782
6783proc nextfile {} {
6784    global difffilestart ctext cmitmode
6785
6786    if {$cmitmode eq "tree"} return
6787    set here [$ctext index @0,0]
6788    set line 1
6789    foreach loc $difffilestart {
6790        incr line
6791        if {[$ctext compare $loc > $here]} {
6792            highlightfile $loc $line
6793            return
6794        }
6795    }
6796}
6797
6798proc clear_ctext {{first 1.0}} {
6799    global ctext smarktop smarkbot
6800    global pendinglinks
6801
6802    set l [lindex [split $first .] 0]
6803    if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
6804        set smarktop $l
6805    }
6806    if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
6807        set smarkbot $l
6808    }
6809    $ctext delete $first end
6810    if {$first eq "1.0"} {
6811        catch {unset pendinglinks}
6812    }
6813}
6814
6815proc settabs {{firstab {}}} {
6816    global firsttabstop tabstop ctext have_tk85
6817
6818    if {$firstab ne {} && $have_tk85} {
6819        set firsttabstop $firstab
6820    }
6821    set w [font measure textfont "0"]
6822    if {$firsttabstop != 0} {
6823        $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
6824                               [expr {($firsttabstop + 2 * $tabstop) * $w}]]
6825    } elseif {$have_tk85 || $tabstop != 8} {
6826        $ctext conf -tabs [expr {$tabstop * $w}]
6827    } else {
6828        $ctext conf -tabs {}
6829    }
6830}
6831
6832proc incrsearch {name ix op} {
6833    global ctext searchstring searchdirn
6834
6835    $ctext tag remove found 1.0 end
6836    if {[catch {$ctext index anchor}]} {
6837        # no anchor set, use start of selection, or of visible area
6838        set sel [$ctext tag ranges sel]
6839        if {$sel ne {}} {
6840            $ctext mark set anchor [lindex $sel 0]
6841        } elseif {$searchdirn eq "-forwards"} {
6842            $ctext mark set anchor @0,0
6843        } else {
6844            $ctext mark set anchor @0,[winfo height $ctext]
6845        }
6846    }
6847    if {$searchstring ne {}} {
6848        set here [$ctext search $searchdirn -- $searchstring anchor]
6849        if {$here ne {}} {
6850            $ctext see $here
6851        }
6852        searchmarkvisible 1
6853    }
6854}
6855
6856proc dosearch {} {
6857    global sstring ctext searchstring searchdirn
6858
6859    focus $sstring
6860    $sstring icursor end
6861    set searchdirn -forwards
6862    if {$searchstring ne {}} {
6863        set sel [$ctext tag ranges sel]
6864        if {$sel ne {}} {
6865            set start "[lindex $sel 0] + 1c"
6866        } elseif {[catch {set start [$ctext index anchor]}]} {
6867            set start "@0,0"
6868        }
6869        set match [$ctext search -count mlen -- $searchstring $start]
6870        $ctext tag remove sel 1.0 end
6871        if {$match eq {}} {
6872            bell
6873            return
6874        }
6875        $ctext see $match
6876        set mend "$match + $mlen c"
6877        $ctext tag add sel $match $mend
6878        $ctext mark unset anchor
6879    }
6880}
6881
6882proc dosearchback {} {
6883    global sstring ctext searchstring searchdirn
6884
6885    focus $sstring
6886    $sstring icursor end
6887    set searchdirn -backwards
6888    if {$searchstring ne {}} {
6889        set sel [$ctext tag ranges sel]
6890        if {$sel ne {}} {
6891            set start [lindex $sel 0]
6892        } elseif {[catch {set start [$ctext index anchor]}]} {
6893            set start @0,[winfo height $ctext]
6894        }
6895        set match [$ctext search -backwards -count ml -- $searchstring $start]
6896        $ctext tag remove sel 1.0 end
6897        if {$match eq {}} {
6898            bell
6899            return
6900        }
6901        $ctext see $match
6902        set mend "$match + $ml c"
6903        $ctext tag add sel $match $mend
6904        $ctext mark unset anchor
6905    }
6906}
6907
6908proc searchmark {first last} {
6909    global ctext searchstring
6910
6911    set mend $first.0
6912    while {1} {
6913        set match [$ctext search -count mlen -- $searchstring $mend $last.end]
6914        if {$match eq {}} break
6915        set mend "$match + $mlen c"
6916        $ctext tag add found $match $mend
6917    }
6918}
6919
6920proc searchmarkvisible {doall} {
6921    global ctext smarktop smarkbot
6922
6923    set topline [lindex [split [$ctext index @0,0] .] 0]
6924    set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
6925    if {$doall || $botline < $smarktop || $topline > $smarkbot} {
6926        # no overlap with previous
6927        searchmark $topline $botline
6928        set smarktop $topline
6929        set smarkbot $botline
6930    } else {
6931        if {$topline < $smarktop} {
6932            searchmark $topline [expr {$smarktop-1}]
6933            set smarktop $topline
6934        }
6935        if {$botline > $smarkbot} {
6936            searchmark [expr {$smarkbot+1}] $botline
6937            set smarkbot $botline
6938        }
6939    }
6940}
6941
6942proc scrolltext {f0 f1} {
6943    global searchstring
6944
6945    .bleft.bottom.sb set $f0 $f1
6946    if {$searchstring ne {}} {
6947        searchmarkvisible 0
6948    }
6949}
6950
6951proc setcoords {} {
6952    global linespc charspc canvx0 canvy0
6953    global xspc1 xspc2 lthickness
6954
6955    set linespc [font metrics mainfont -linespace]
6956    set charspc [font measure mainfont "m"]
6957    set canvy0 [expr {int(3 + 0.5 * $linespc)}]
6958    set canvx0 [expr {int(3 + 0.5 * $linespc)}]
6959    set lthickness [expr {int($linespc / 9) + 1}]
6960    set xspc1(0) $linespc
6961    set xspc2 $linespc
6962}
6963
6964proc redisplay {} {
6965    global canv
6966    global selectedline
6967
6968    set ymax [lindex [$canv cget -scrollregion] 3]
6969    if {$ymax eq {} || $ymax == 0} return
6970    set span [$canv yview]
6971    clear_display
6972    setcanvscroll
6973    allcanvs yview moveto [lindex $span 0]
6974    drawvisible
6975    if {$selectedline ne {}} {
6976        selectline $selectedline 0
6977        allcanvs yview moveto [lindex $span 0]
6978    }
6979}
6980
6981proc parsefont {f n} {
6982    global fontattr
6983
6984    set fontattr($f,family) [lindex $n 0]
6985    set s [lindex $n 1]
6986    if {$s eq {} || $s == 0} {
6987        set s 10
6988    } elseif {$s < 0} {
6989        set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
6990    }
6991    set fontattr($f,size) $s
6992    set fontattr($f,weight) normal
6993    set fontattr($f,slant) roman
6994    foreach style [lrange $n 2 end] {
6995        switch -- $style {
6996            "normal" -
6997            "bold"   {set fontattr($f,weight) $style}
6998            "roman" -
6999            "italic" {set fontattr($f,slant) $style}
7000        }
7001    }
7002}
7003
7004proc fontflags {f {isbold 0}} {
7005    global fontattr
7006
7007    return [list -family $fontattr($f,family) -size $fontattr($f,size) \
7008                -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
7009                -slant $fontattr($f,slant)]
7010}
7011
7012proc fontname {f} {
7013    global fontattr
7014
7015    set n [list $fontattr($f,family) $fontattr($f,size)]
7016    if {$fontattr($f,weight) eq "bold"} {
7017        lappend n "bold"
7018    }
7019    if {$fontattr($f,slant) eq "italic"} {
7020        lappend n "italic"
7021    }
7022    return $n
7023}
7024
7025proc incrfont {inc} {
7026    global mainfont textfont ctext canv cflist showrefstop
7027    global stopped entries fontattr
7028
7029    unmarkmatches
7030    set s $fontattr(mainfont,size)
7031    incr s $inc
7032    if {$s < 1} {
7033        set s 1
7034    }
7035    set fontattr(mainfont,size) $s
7036    font config mainfont -size $s
7037    font config mainfontbold -size $s
7038    set mainfont [fontname mainfont]
7039    set s $fontattr(textfont,size)
7040    incr s $inc
7041    if {$s < 1} {
7042        set s 1
7043    }
7044    set fontattr(textfont,size) $s
7045    font config textfont -size $s
7046    font config textfontbold -size $s
7047    set textfont [fontname textfont]
7048    setcoords
7049    settabs
7050    redisplay
7051}
7052
7053proc clearsha1 {} {
7054    global sha1entry sha1string
7055    if {[string length $sha1string] == 40} {
7056        $sha1entry delete 0 end
7057    }
7058}
7059
7060proc sha1change {n1 n2 op} {
7061    global sha1string currentid sha1but
7062    if {$sha1string == {}
7063        || ([info exists currentid] && $sha1string == $currentid)} {
7064        set state disabled
7065    } else {
7066        set state normal
7067    }
7068    if {[$sha1but cget -state] == $state} return
7069    if {$state == "normal"} {
7070        $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
7071    } else {
7072        $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
7073    }
7074}
7075
7076proc gotocommit {} {
7077    global sha1string tagids headids curview varcid
7078
7079    if {$sha1string == {}
7080        || ([info exists currentid] && $sha1string == $currentid)} return
7081    if {[info exists tagids($sha1string)]} {
7082        set id $tagids($sha1string)
7083    } elseif {[info exists headids($sha1string)]} {
7084        set id $headids($sha1string)
7085    } else {
7086        set id [string tolower $sha1string]
7087        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
7088            set matches [array names varcid "$curview,$id*"]
7089            if {$matches ne {}} {
7090                if {[llength $matches] > 1} {
7091                    error_popup [mc "Short SHA1 id %s is ambiguous" $id]
7092                    return
7093                }
7094                set id [lindex [split [lindex $matches 0] ","] 1]
7095            }
7096        }
7097    }
7098    if {[commitinview $id $curview]} {
7099        selectline [rowofcommit $id] 1
7100        return
7101    }
7102    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
7103        set msg [mc "SHA1 id %s is not known" $sha1string]
7104    } else {
7105        set msg [mc "Tag/Head %s is not known" $sha1string]
7106    }
7107    error_popup $msg
7108}
7109
7110proc lineenter {x y id} {
7111    global hoverx hovery hoverid hovertimer
7112    global commitinfo canv
7113
7114    if {![info exists commitinfo($id)] && ![getcommit $id]} return
7115    set hoverx $x
7116    set hovery $y
7117    set hoverid $id
7118    if {[info exists hovertimer]} {
7119        after cancel $hovertimer
7120    }
7121    set hovertimer [after 500 linehover]
7122    $canv delete hover
7123}
7124
7125proc linemotion {x y id} {
7126    global hoverx hovery hoverid hovertimer
7127
7128    if {[info exists hoverid] && $id == $hoverid} {
7129        set hoverx $x
7130        set hovery $y
7131        if {[info exists hovertimer]} {
7132            after cancel $hovertimer
7133        }
7134        set hovertimer [after 500 linehover]
7135    }
7136}
7137
7138proc lineleave {id} {
7139    global hoverid hovertimer canv
7140
7141    if {[info exists hoverid] && $id == $hoverid} {
7142        $canv delete hover
7143        if {[info exists hovertimer]} {
7144            after cancel $hovertimer
7145            unset hovertimer
7146        }
7147        unset hoverid
7148    }
7149}
7150
7151proc linehover {} {
7152    global hoverx hovery hoverid hovertimer
7153    global canv linespc lthickness
7154    global commitinfo
7155
7156    set text [lindex $commitinfo($hoverid) 0]
7157    set ymax [lindex [$canv cget -scrollregion] 3]
7158    if {$ymax == {}} return
7159    set yfrac [lindex [$canv yview] 0]
7160    set x [expr {$hoverx + 2 * $linespc}]
7161    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
7162    set x0 [expr {$x - 2 * $lthickness}]
7163    set y0 [expr {$y - 2 * $lthickness}]
7164    set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
7165    set y1 [expr {$y + $linespc + 2 * $lthickness}]
7166    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
7167               -fill \#ffff80 -outline black -width 1 -tags hover]
7168    $canv raise $t
7169    set t [$canv create text $x $y -anchor nw -text $text -tags hover \
7170               -font mainfont]
7171    $canv raise $t
7172}
7173
7174proc clickisonarrow {id y} {
7175    global lthickness
7176
7177    set ranges [rowranges $id]
7178    set thresh [expr {2 * $lthickness + 6}]
7179    set n [expr {[llength $ranges] - 1}]
7180    for {set i 1} {$i < $n} {incr i} {
7181        set row [lindex $ranges $i]
7182        if {abs([yc $row] - $y) < $thresh} {
7183            return $i
7184        }
7185    }
7186    return {}
7187}
7188
7189proc arrowjump {id n y} {
7190    global canv
7191
7192    # 1 <-> 2, 3 <-> 4, etc...
7193    set n [expr {(($n - 1) ^ 1) + 1}]
7194    set row [lindex [rowranges $id] $n]
7195    set yt [yc $row]
7196    set ymax [lindex [$canv cget -scrollregion] 3]
7197    if {$ymax eq {} || $ymax <= 0} return
7198    set view [$canv yview]
7199    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
7200    set yfrac [expr {$yt / $ymax - $yspan / 2}]
7201    if {$yfrac < 0} {
7202        set yfrac 0
7203    }
7204    allcanvs yview moveto $yfrac
7205}
7206
7207proc lineclick {x y id isnew} {
7208    global ctext commitinfo children canv thickerline curview
7209
7210    if {![info exists commitinfo($id)] && ![getcommit $id]} return
7211    unmarkmatches
7212    unselectline
7213    normalline
7214    $canv delete hover
7215    # draw this line thicker than normal
7216    set thickerline $id
7217    drawlines $id
7218    if {$isnew} {
7219        set ymax [lindex [$canv cget -scrollregion] 3]
7220        if {$ymax eq {}} return
7221        set yfrac [lindex [$canv yview] 0]
7222        set y [expr {$y + $yfrac * $ymax}]
7223    }
7224    set dirn [clickisonarrow $id $y]
7225    if {$dirn ne {}} {
7226        arrowjump $id $dirn $y
7227        return
7228    }
7229
7230    if {$isnew} {
7231        addtohistory [list lineclick $x $y $id 0]
7232    }
7233    # fill the details pane with info about this line
7234    $ctext conf -state normal
7235    clear_ctext
7236    settabs 0
7237    $ctext insert end "[mc "Parent"]:\t"
7238    $ctext insert end $id link0
7239    setlink $id link0
7240    set info $commitinfo($id)
7241    $ctext insert end "\n\t[lindex $info 0]\n"
7242    $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
7243    set date [formatdate [lindex $info 2]]
7244    $ctext insert end "\t[mc "Date"]:\t$date\n"
7245    set kids $children($curview,$id)
7246    if {$kids ne {}} {
7247        $ctext insert end "\n[mc "Children"]:"
7248        set i 0
7249        foreach child $kids {
7250            incr i
7251            if {![info exists commitinfo($child)] && ![getcommit $child]} continue
7252            set info $commitinfo($child)
7253            $ctext insert end "\n\t"
7254            $ctext insert end $child link$i
7255            setlink $child link$i
7256            $ctext insert end "\n\t[lindex $info 0]"
7257            $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
7258            set date [formatdate [lindex $info 2]]
7259            $ctext insert end "\n\t[mc "Date"]:\t$date\n"
7260        }
7261    }
7262    $ctext conf -state disabled
7263    init_flist {}
7264}
7265
7266proc normalline {} {
7267    global thickerline
7268    if {[info exists thickerline]} {
7269        set id $thickerline
7270        unset thickerline
7271        drawlines $id
7272    }
7273}
7274
7275proc selbyid {id} {
7276    global curview
7277    if {[commitinview $id $curview]} {
7278        selectline [rowofcommit $id] 1
7279    }
7280}
7281
7282proc mstime {} {
7283    global startmstime
7284    if {![info exists startmstime]} {
7285        set startmstime [clock clicks -milliseconds]
7286    }
7287    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
7288}
7289
7290proc rowmenu {x y id} {
7291    global rowctxmenu selectedline rowmenuid curview
7292    global nullid nullid2 fakerowmenu mainhead
7293
7294    stopfinding
7295    set rowmenuid $id
7296    if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
7297        set state disabled
7298    } else {
7299        set state normal
7300    }
7301    if {$id ne $nullid && $id ne $nullid2} {
7302        set menu $rowctxmenu
7303        if {$mainhead ne {}} {
7304            $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
7305        } else {
7306            $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
7307        }
7308    } else {
7309        set menu $fakerowmenu
7310    }
7311    $menu entryconfigure [mc "Diff this -> selected"] -state $state
7312    $menu entryconfigure [mc "Diff selected -> this"] -state $state
7313    $menu entryconfigure [mc "Make patch"] -state $state
7314    tk_popup $menu $x $y
7315}
7316
7317proc diffvssel {dirn} {
7318    global rowmenuid selectedline
7319
7320    if {$selectedline eq {}} return
7321    if {$dirn} {
7322        set oldid [commitonrow $selectedline]
7323        set newid $rowmenuid
7324    } else {
7325        set oldid $rowmenuid
7326        set newid [commitonrow $selectedline]
7327    }
7328    addtohistory [list doseldiff $oldid $newid]
7329    doseldiff $oldid $newid
7330}
7331
7332proc doseldiff {oldid newid} {
7333    global ctext
7334    global commitinfo
7335
7336    $ctext conf -state normal
7337    clear_ctext
7338    init_flist [mc "Top"]
7339    $ctext insert end "[mc "From"] "
7340    $ctext insert end $oldid link0
7341    setlink $oldid link0
7342    $ctext insert end "\n     "
7343    $ctext insert end [lindex $commitinfo($oldid) 0]
7344    $ctext insert end "\n\n[mc "To"]   "
7345    $ctext insert end $newid link1
7346    setlink $newid link1
7347    $ctext insert end "\n     "
7348    $ctext insert end [lindex $commitinfo($newid) 0]
7349    $ctext insert end "\n"
7350    $ctext conf -state disabled
7351    $ctext tag remove found 1.0 end
7352    startdiff [list $oldid $newid]
7353}
7354
7355proc mkpatch {} {
7356    global rowmenuid currentid commitinfo patchtop patchnum
7357
7358    if {![info exists currentid]} return
7359    set oldid $currentid
7360    set oldhead [lindex $commitinfo($oldid) 0]
7361    set newid $rowmenuid
7362    set newhead [lindex $commitinfo($newid) 0]
7363    set top .patch
7364    set patchtop $top
7365    catch {destroy $top}
7366    toplevel $top
7367    label $top.title -text [mc "Generate patch"]
7368    grid $top.title - -pady 10
7369    label $top.from -text [mc "From:"]
7370    entry $top.fromsha1 -width 40 -relief flat
7371    $top.fromsha1 insert 0 $oldid
7372    $top.fromsha1 conf -state readonly
7373    grid $top.from $top.fromsha1 -sticky w
7374    entry $top.fromhead -width 60 -relief flat
7375    $top.fromhead insert 0 $oldhead
7376    $top.fromhead conf -state readonly
7377    grid x $top.fromhead -sticky w
7378    label $top.to -text [mc "To:"]
7379    entry $top.tosha1 -width 40 -relief flat
7380    $top.tosha1 insert 0 $newid
7381    $top.tosha1 conf -state readonly
7382    grid $top.to $top.tosha1 -sticky w
7383    entry $top.tohead -width 60 -relief flat
7384    $top.tohead insert 0 $newhead
7385    $top.tohead conf -state readonly
7386    grid x $top.tohead -sticky w
7387    button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
7388    grid $top.rev x -pady 10
7389    label $top.flab -text [mc "Output file:"]
7390    entry $top.fname -width 60
7391    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
7392    incr patchnum
7393    grid $top.flab $top.fname -sticky w
7394    frame $top.buts
7395    button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
7396    button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
7397    grid $top.buts.gen $top.buts.can
7398    grid columnconfigure $top.buts 0 -weight 1 -uniform a
7399    grid columnconfigure $top.buts 1 -weight 1 -uniform a
7400    grid $top.buts - -pady 10 -sticky ew
7401    focus $top.fname
7402}
7403
7404proc mkpatchrev {} {
7405    global patchtop
7406
7407    set oldid [$patchtop.fromsha1 get]
7408    set oldhead [$patchtop.fromhead get]
7409    set newid [$patchtop.tosha1 get]
7410    set newhead [$patchtop.tohead get]
7411    foreach e [list fromsha1 fromhead tosha1 tohead] \
7412            v [list $newid $newhead $oldid $oldhead] {
7413        $patchtop.$e conf -state normal
7414        $patchtop.$e delete 0 end
7415        $patchtop.$e insert 0 $v
7416        $patchtop.$e conf -state readonly
7417    }
7418}
7419
7420proc mkpatchgo {} {
7421    global patchtop nullid nullid2
7422
7423    set oldid [$patchtop.fromsha1 get]
7424    set newid [$patchtop.tosha1 get]
7425    set fname [$patchtop.fname get]
7426    set cmd [diffcmd [list $oldid $newid] -p]
7427    # trim off the initial "|"
7428    set cmd [lrange $cmd 1 end]
7429    lappend cmd >$fname &
7430    if {[catch {eval exec $cmd} err]} {
7431        error_popup "[mc "Error creating patch:"] $err"
7432    }
7433    catch {destroy $patchtop}
7434    unset patchtop
7435}
7436
7437proc mkpatchcan {} {
7438    global patchtop
7439
7440    catch {destroy $patchtop}
7441    unset patchtop
7442}
7443
7444proc mktag {} {
7445    global rowmenuid mktagtop commitinfo
7446
7447    set top .maketag
7448    set mktagtop $top
7449    catch {destroy $top}
7450    toplevel $top
7451    label $top.title -text [mc "Create tag"]
7452    grid $top.title - -pady 10
7453    label $top.id -text [mc "ID:"]
7454    entry $top.sha1 -width 40 -relief flat
7455    $top.sha1 insert 0 $rowmenuid
7456    $top.sha1 conf -state readonly
7457    grid $top.id $top.sha1 -sticky w
7458    entry $top.head -width 60 -relief flat
7459    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
7460    $top.head conf -state readonly
7461    grid x $top.head -sticky w
7462    label $top.tlab -text [mc "Tag name:"]
7463    entry $top.tag -width 60
7464    grid $top.tlab $top.tag -sticky w
7465    frame $top.buts
7466    button $top.buts.gen -text [mc "Create"] -command mktaggo
7467    button $top.buts.can -text [mc "Cancel"] -command mktagcan
7468    grid $top.buts.gen $top.buts.can
7469    grid columnconfigure $top.buts 0 -weight 1 -uniform a
7470    grid columnconfigure $top.buts 1 -weight 1 -uniform a
7471    grid $top.buts - -pady 10 -sticky ew
7472    focus $top.tag
7473}
7474
7475proc domktag {} {
7476    global mktagtop env tagids idtags
7477
7478    set id [$mktagtop.sha1 get]
7479    set tag [$mktagtop.tag get]
7480    if {$tag == {}} {
7481        error_popup [mc "No tag name specified"]
7482        return
7483    }
7484    if {[info exists tagids($tag)]} {
7485        error_popup [mc "Tag \"%s\" already exists" $tag]
7486        return
7487    }
7488    if {[catch {
7489        exec git tag $tag $id
7490    } err]} {
7491        error_popup "[mc "Error creating tag:"] $err"
7492        return
7493    }
7494
7495    set tagids($tag) $id
7496    lappend idtags($id) $tag
7497    redrawtags $id
7498    addedtag $id
7499    dispneartags 0
7500    run refill_reflist
7501}
7502
7503proc redrawtags {id} {
7504    global canv linehtag idpos currentid curview cmitlisted
7505    global canvxmax iddrawn circleitem mainheadid circlecolors
7506
7507    if {![commitinview $id $curview]} return
7508    if {![info exists iddrawn($id)]} return
7509    set row [rowofcommit $id]
7510    if {$id eq $mainheadid} {
7511        set ofill yellow
7512    } else {
7513        set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
7514    }
7515    $canv itemconf $circleitem($row) -fill $ofill
7516    $canv delete tag.$id
7517    set xt [eval drawtags $id $idpos($id)]
7518    $canv coords $linehtag($row) $xt [lindex $idpos($id) 2]
7519    set text [$canv itemcget $linehtag($row) -text]
7520    set font [$canv itemcget $linehtag($row) -font]
7521    set xr [expr {$xt + [font measure $font $text]}]
7522    if {$xr > $canvxmax} {
7523        set canvxmax $xr
7524        setcanvscroll
7525    }
7526    if {[info exists currentid] && $currentid == $id} {
7527        make_secsel $row
7528    }
7529}
7530
7531proc mktagcan {} {
7532    global mktagtop
7533
7534    catch {destroy $mktagtop}
7535    unset mktagtop
7536}
7537
7538proc mktaggo {} {
7539    domktag
7540    mktagcan
7541}
7542
7543proc writecommit {} {
7544    global rowmenuid wrcomtop commitinfo wrcomcmd
7545
7546    set top .writecommit
7547    set wrcomtop $top
7548    catch {destroy $top}
7549    toplevel $top
7550    label $top.title -text [mc "Write commit to file"]
7551    grid $top.title - -pady 10
7552    label $top.id -text [mc "ID:"]
7553    entry $top.sha1 -width 40 -relief flat
7554    $top.sha1 insert 0 $rowmenuid
7555    $top.sha1 conf -state readonly
7556    grid $top.id $top.sha1 -sticky w
7557    entry $top.head -width 60 -relief flat
7558    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
7559    $top.head conf -state readonly
7560    grid x $top.head -sticky w
7561    label $top.clab -text [mc "Command:"]
7562    entry $top.cmd -width 60 -textvariable wrcomcmd
7563    grid $top.clab $top.cmd -sticky w -pady 10
7564    label $top.flab -text [mc "Output file:"]
7565    entry $top.fname -width 60
7566    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
7567    grid $top.flab $top.fname -sticky w
7568    frame $top.buts
7569    button $top.buts.gen -text [mc "Write"] -command wrcomgo
7570    button $top.buts.can -text [mc "Cancel"] -command wrcomcan
7571    grid $top.buts.gen $top.buts.can
7572    grid columnconfigure $top.buts 0 -weight 1 -uniform a
7573    grid columnconfigure $top.buts 1 -weight 1 -uniform a
7574    grid $top.buts - -pady 10 -sticky ew
7575    focus $top.fname
7576}
7577
7578proc wrcomgo {} {
7579    global wrcomtop
7580
7581    set id [$wrcomtop.sha1 get]
7582    set cmd "echo $id | [$wrcomtop.cmd get]"
7583    set fname [$wrcomtop.fname get]
7584    if {[catch {exec sh -c $cmd >$fname &} err]} {
7585        error_popup "[mc "Error writing commit:"] $err"
7586    }
7587    catch {destroy $wrcomtop}
7588    unset wrcomtop
7589}
7590
7591proc wrcomcan {} {
7592    global wrcomtop
7593
7594    catch {destroy $wrcomtop}
7595    unset wrcomtop
7596}
7597
7598proc mkbranch {} {
7599    global rowmenuid mkbrtop
7600
7601    set top .makebranch
7602    catch {destroy $top}
7603    toplevel $top
7604    label $top.title -text [mc "Create new branch"]
7605    grid $top.title - -pady 10
7606    label $top.id -text [mc "ID:"]
7607    entry $top.sha1 -width 40 -relief flat
7608    $top.sha1 insert 0 $rowmenuid
7609    $top.sha1 conf -state readonly
7610    grid $top.id $top.sha1 -sticky w
7611    label $top.nlab -text [mc "Name:"]
7612    entry $top.name -width 40
7613    grid $top.nlab $top.name -sticky w
7614    frame $top.buts
7615    button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
7616    button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
7617    grid $top.buts.go $top.buts.can
7618    grid columnconfigure $top.buts 0 -weight 1 -uniform a
7619    grid columnconfigure $top.buts 1 -weight 1 -uniform a
7620    grid $top.buts - -pady 10 -sticky ew
7621    focus $top.name
7622}
7623
7624proc mkbrgo {top} {
7625    global headids idheads
7626
7627    set name [$top.name get]
7628    set id [$top.sha1 get]
7629    if {$name eq {}} {
7630        error_popup [mc "Please specify a name for the new branch"]
7631        return
7632    }
7633    catch {destroy $top}
7634    nowbusy newbranch
7635    update
7636    if {[catch {
7637        exec git branch $name $id
7638    } err]} {
7639        notbusy newbranch
7640        error_popup $err
7641    } else {
7642        set headids($name) $id
7643        lappend idheads($id) $name
7644        addedhead $id $name
7645        notbusy newbranch
7646        redrawtags $id
7647        dispneartags 0
7648        run refill_reflist
7649    }
7650}
7651
7652proc cherrypick {} {
7653    global rowmenuid curview
7654    global mainhead mainheadid
7655
7656    set oldhead [exec git rev-parse HEAD]
7657    set dheads [descheads $rowmenuid]
7658    if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
7659        set ok [confirm_popup [mc "Commit %s is already\
7660                included in branch %s -- really re-apply it?" \
7661                                   [string range $rowmenuid 0 7] $mainhead]]
7662        if {!$ok} return
7663    }
7664    nowbusy cherrypick [mc "Cherry-picking"]
7665    update
7666    # Unfortunately git-cherry-pick writes stuff to stderr even when
7667    # no error occurs, and exec takes that as an indication of error...
7668    if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
7669        notbusy cherrypick
7670        error_popup $err
7671        return
7672    }
7673    set newhead [exec git rev-parse HEAD]
7674    if {$newhead eq $oldhead} {
7675        notbusy cherrypick
7676        error_popup [mc "No changes committed"]
7677        return
7678    }
7679    addnewchild $newhead $oldhead
7680    if {[commitinview $oldhead $curview]} {
7681        insertrow $newhead $oldhead $curview
7682        if {$mainhead ne {}} {
7683            movehead $newhead $mainhead
7684            movedhead $newhead $mainhead
7685        }
7686        set mainheadid $newhead
7687        redrawtags $oldhead
7688        redrawtags $newhead
7689        selbyid $newhead
7690    }
7691    notbusy cherrypick
7692}
7693
7694proc resethead {} {
7695    global mainhead rowmenuid confirm_ok resettype
7696
7697    set confirm_ok 0
7698    set w ".confirmreset"
7699    toplevel $w
7700    wm transient $w .
7701    wm title $w [mc "Confirm reset"]
7702    message $w.m -text \
7703        [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
7704        -justify center -aspect 1000
7705    pack $w.m -side top -fill x -padx 20 -pady 20
7706    frame $w.f -relief sunken -border 2
7707    message $w.f.rt -text [mc "Reset type:"] -aspect 1000
7708    grid $w.f.rt -sticky w
7709    set resettype mixed
7710    radiobutton $w.f.soft -value soft -variable resettype -justify left \
7711        -text [mc "Soft: Leave working tree and index untouched"]
7712    grid $w.f.soft -sticky w
7713    radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
7714        -text [mc "Mixed: Leave working tree untouched, reset index"]
7715    grid $w.f.mixed -sticky w
7716    radiobutton $w.f.hard -value hard -variable resettype -justify left \
7717        -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
7718    grid $w.f.hard -sticky w
7719    pack $w.f -side top -fill x
7720    button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
7721    pack $w.ok -side left -fill x -padx 20 -pady 20
7722    button $w.cancel -text [mc Cancel] -command "destroy $w"
7723    pack $w.cancel -side right -fill x -padx 20 -pady 20
7724    bind $w <Visibility> "grab $w; focus $w"
7725    tkwait window $w
7726    if {!$confirm_ok} return
7727    if {[catch {set fd [open \
7728            [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
7729        error_popup $err
7730    } else {
7731        dohidelocalchanges
7732        filerun $fd [list readresetstat $fd]
7733        nowbusy reset [mc "Resetting"]
7734        selbyid $rowmenuid
7735    }
7736}
7737
7738proc readresetstat {fd} {
7739    global mainhead mainheadid showlocalchanges rprogcoord
7740
7741    if {[gets $fd line] >= 0} {
7742        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
7743            set rprogcoord [expr {1.0 * $m / $n}]
7744            adjustprogress
7745        }
7746        return 1
7747    }
7748    set rprogcoord 0
7749    adjustprogress
7750    notbusy reset
7751    if {[catch {close $fd} err]} {
7752        error_popup $err
7753    }
7754    set oldhead $mainheadid
7755    set newhead [exec git rev-parse HEAD]
7756    if {$newhead ne $oldhead} {
7757        movehead $newhead $mainhead
7758        movedhead $newhead $mainhead
7759        set mainheadid $newhead
7760        redrawtags $oldhead
7761        redrawtags $newhead
7762    }
7763    if {$showlocalchanges} {
7764        doshowlocalchanges
7765    }
7766    return 0
7767}
7768
7769# context menu for a head
7770proc headmenu {x y id head} {
7771    global headmenuid headmenuhead headctxmenu mainhead
7772
7773    stopfinding
7774    set headmenuid $id
7775    set headmenuhead $head
7776    set state normal
7777    if {$head eq $mainhead} {
7778        set state disabled
7779    }
7780    $headctxmenu entryconfigure 0 -state $state
7781    $headctxmenu entryconfigure 1 -state $state
7782    tk_popup $headctxmenu $x $y
7783}
7784
7785proc cobranch {} {
7786    global headmenuid headmenuhead headids
7787    global showlocalchanges mainheadid
7788
7789    # check the tree is clean first??
7790    nowbusy checkout [mc "Checking out"]
7791    update
7792    dohidelocalchanges
7793    if {[catch {
7794        set fd [open [list | git checkout $headmenuhead 2>@1] r]
7795    } err]} {
7796        notbusy checkout
7797        error_popup $err
7798        if {$showlocalchanges} {
7799            dodiffindex
7800        }
7801    } else {
7802        filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
7803    }
7804}
7805
7806proc readcheckoutstat {fd newhead newheadid} {
7807    global mainhead mainheadid headids showlocalchanges progresscoords
7808
7809    if {[gets $fd line] >= 0} {
7810        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
7811            set progresscoords [list 0 [expr {1.0 * $m / $n}]]
7812            adjustprogress
7813        }
7814        return 1
7815    }
7816    set progresscoords {0 0}
7817    adjustprogress
7818    notbusy checkout
7819    if {[catch {close $fd} err]} {
7820        error_popup $err
7821    }
7822    set oldmainid $mainheadid
7823    set mainhead $newhead
7824    set mainheadid $newheadid
7825    redrawtags $oldmainid
7826    redrawtags $newheadid
7827    selbyid $newheadid
7828    if {$showlocalchanges} {
7829        dodiffindex
7830    }
7831}
7832
7833proc rmbranch {} {
7834    global headmenuid headmenuhead mainhead
7835    global idheads
7836
7837    set head $headmenuhead
7838    set id $headmenuid
7839    # this check shouldn't be needed any more...
7840    if {$head eq $mainhead} {
7841        error_popup [mc "Cannot delete the currently checked-out branch"]
7842        return
7843    }
7844    set dheads [descheads $id]
7845    if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
7846        # the stuff on this branch isn't on any other branch
7847        if {![confirm_popup [mc "The commits on branch %s aren't on any other\
7848                        branch.\nReally delete branch %s?" $head $head]]} return
7849    }
7850    nowbusy rmbranch
7851    update
7852    if {[catch {exec git branch -D $head} err]} {
7853        notbusy rmbranch
7854        error_popup $err
7855        return
7856    }
7857    removehead $id $head
7858    removedhead $id $head
7859    redrawtags $id
7860    notbusy rmbranch
7861    dispneartags 0
7862    run refill_reflist
7863}
7864
7865# Display a list of tags and heads
7866proc showrefs {} {
7867    global showrefstop bgcolor fgcolor selectbgcolor
7868    global bglist fglist reflistfilter reflist maincursor
7869
7870    set top .showrefs
7871    set showrefstop $top
7872    if {[winfo exists $top]} {
7873        raise $top
7874        refill_reflist
7875        return
7876    }
7877    toplevel $top
7878    wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
7879    text $top.list -background $bgcolor -foreground $fgcolor \
7880        -selectbackground $selectbgcolor -font mainfont \
7881        -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
7882        -width 30 -height 20 -cursor $maincursor \
7883        -spacing1 1 -spacing3 1 -state disabled
7884    $top.list tag configure highlight -background $selectbgcolor
7885    lappend bglist $top.list
7886    lappend fglist $top.list
7887    scrollbar $top.ysb -command "$top.list yview" -orient vertical
7888    scrollbar $top.xsb -command "$top.list xview" -orient horizontal
7889    grid $top.list $top.ysb -sticky nsew
7890    grid $top.xsb x -sticky ew
7891    frame $top.f
7892    label $top.f.l -text "[mc "Filter"]: "
7893    entry $top.f.e -width 20 -textvariable reflistfilter
7894    set reflistfilter "*"
7895    trace add variable reflistfilter write reflistfilter_change
7896    pack $top.f.e -side right -fill x -expand 1
7897    pack $top.f.l -side left
7898    grid $top.f - -sticky ew -pady 2
7899    button $top.close -command [list destroy $top] -text [mc "Close"]
7900    grid $top.close -
7901    grid columnconfigure $top 0 -weight 1
7902    grid rowconfigure $top 0 -weight 1
7903    bind $top.list <1> {break}
7904    bind $top.list <B1-Motion> {break}
7905    bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
7906    set reflist {}
7907    refill_reflist
7908}
7909
7910proc sel_reflist {w x y} {
7911    global showrefstop reflist headids tagids otherrefids
7912
7913    if {![winfo exists $showrefstop]} return
7914    set l [lindex [split [$w index "@$x,$y"] "."] 0]
7915    set ref [lindex $reflist [expr {$l-1}]]
7916    set n [lindex $ref 0]
7917    switch -- [lindex $ref 1] {
7918        "H" {selbyid $headids($n)}
7919        "T" {selbyid $tagids($n)}
7920        "o" {selbyid $otherrefids($n)}
7921    }
7922    $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
7923}
7924
7925proc unsel_reflist {} {
7926    global showrefstop
7927
7928    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7929    $showrefstop.list tag remove highlight 0.0 end
7930}
7931
7932proc reflistfilter_change {n1 n2 op} {
7933    global reflistfilter
7934
7935    after cancel refill_reflist
7936    after 200 refill_reflist
7937}
7938
7939proc refill_reflist {} {
7940    global reflist reflistfilter showrefstop headids tagids otherrefids
7941    global curview commitinterest
7942
7943    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7944    set refs {}
7945    foreach n [array names headids] {
7946        if {[string match $reflistfilter $n]} {
7947            if {[commitinview $headids($n) $curview]} {
7948                lappend refs [list $n H]
7949            } else {
7950                set commitinterest($headids($n)) {run refill_reflist}
7951            }
7952        }
7953    }
7954    foreach n [array names tagids] {
7955        if {[string match $reflistfilter $n]} {
7956            if {[commitinview $tagids($n) $curview]} {
7957                lappend refs [list $n T]
7958            } else {
7959                set commitinterest($tagids($n)) {run refill_reflist}
7960            }
7961        }
7962    }
7963    foreach n [array names otherrefids] {
7964        if {[string match $reflistfilter $n]} {
7965            if {[commitinview $otherrefids($n) $curview]} {
7966                lappend refs [list $n o]
7967            } else {
7968                set commitinterest($otherrefids($n)) {run refill_reflist}
7969            }
7970        }
7971    }
7972    set refs [lsort -index 0 $refs]
7973    if {$refs eq $reflist} return
7974
7975    # Update the contents of $showrefstop.list according to the
7976    # differences between $reflist (old) and $refs (new)
7977    $showrefstop.list conf -state normal
7978    $showrefstop.list insert end "\n"
7979    set i 0
7980    set j 0
7981    while {$i < [llength $reflist] || $j < [llength $refs]} {
7982        if {$i < [llength $reflist]} {
7983            if {$j < [llength $refs]} {
7984                set cmp [string compare [lindex $reflist $i 0] \
7985                             [lindex $refs $j 0]]
7986                if {$cmp == 0} {
7987                    set cmp [string compare [lindex $reflist $i 1] \
7988                                 [lindex $refs $j 1]]
7989                }
7990            } else {
7991                set cmp -1
7992            }
7993        } else {
7994            set cmp 1
7995        }
7996        switch -- $cmp {
7997            -1 {
7998                $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
7999                incr i
8000            }
8001            0 {
8002                incr i
8003                incr j
8004            }
8005            1 {
8006                set l [expr {$j + 1}]
8007                $showrefstop.list image create $l.0 -align baseline \
8008                    -image reficon-[lindex $refs $j 1] -padx 2
8009                $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
8010                incr j
8011            }
8012        }
8013    }
8014    set reflist $refs
8015    # delete last newline
8016    $showrefstop.list delete end-2c end-1c
8017    $showrefstop.list conf -state disabled
8018}
8019
8020# Stuff for finding nearby tags
8021proc getallcommits {} {
8022    global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
8023    global idheads idtags idotherrefs allparents tagobjid
8024
8025    if {![info exists allcommits]} {
8026        set nextarc 0
8027        set allcommits 0
8028        set seeds {}
8029        set allcwait 0
8030        set cachedarcs 0
8031        set allccache [file join [gitdir] "gitk.cache"]
8032        if {![catch {
8033            set f [open $allccache r]
8034            set allcwait 1
8035            getcache $f
8036        }]} return
8037    }
8038
8039    if {$allcwait} {
8040        return
8041    }
8042    set cmd [list | git rev-list --parents]
8043    set allcupdate [expr {$seeds ne {}}]
8044    if {!$allcupdate} {
8045        set ids "--all"
8046    } else {
8047        set refs [concat [array names idheads] [array names idtags] \
8048                      [array names idotherrefs]]
8049        set ids {}
8050        set tagobjs {}
8051        foreach name [array names tagobjid] {
8052            lappend tagobjs $tagobjid($name)
8053        }
8054        foreach id [lsort -unique $refs] {
8055            if {![info exists allparents($id)] &&
8056                [lsearch -exact $tagobjs $id] < 0} {
8057                lappend ids $id
8058            }
8059        }
8060        if {$ids ne {}} {
8061            foreach id $seeds {
8062                lappend ids "^$id"
8063            }
8064        }
8065    }
8066    if {$ids ne {}} {
8067        set fd [open [concat $cmd $ids] r]
8068        fconfigure $fd -blocking 0
8069        incr allcommits
8070        nowbusy allcommits
8071        filerun $fd [list getallclines $fd]
8072    } else {
8073        dispneartags 0
8074    }
8075}
8076
8077# Since most commits have 1 parent and 1 child, we group strings of
8078# such commits into "arcs" joining branch/merge points (BMPs), which
8079# are commits that either don't have 1 parent or don't have 1 child.
8080#
8081# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
8082# arcout(id) - outgoing arcs for BMP
8083# arcids(a) - list of IDs on arc including end but not start
8084# arcstart(a) - BMP ID at start of arc
8085# arcend(a) - BMP ID at end of arc
8086# growing(a) - arc a is still growing
8087# arctags(a) - IDs out of arcids (excluding end) that have tags
8088# archeads(a) - IDs out of arcids (excluding end) that have heads
8089# The start of an arc is at the descendent end, so "incoming" means
8090# coming from descendents, and "outgoing" means going towards ancestors.
8091
8092proc getallclines {fd} {
8093    global allparents allchildren idtags idheads nextarc
8094    global arcnos arcids arctags arcout arcend arcstart archeads growing
8095    global seeds allcommits cachedarcs allcupdate
8096    
8097    set nid 0
8098    while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
8099        set id [lindex $line 0]
8100        if {[info exists allparents($id)]} {
8101            # seen it already
8102            continue
8103        }
8104        set cachedarcs 0
8105        set olds [lrange $line 1 end]
8106        set allparents($id) $olds
8107        if {![info exists allchildren($id)]} {
8108            set allchildren($id) {}
8109            set arcnos($id) {}
8110            lappend seeds $id
8111        } else {
8112            set a $arcnos($id)
8113            if {[llength $olds] == 1 && [llength $a] == 1} {
8114                lappend arcids($a) $id
8115                if {[info exists idtags($id)]} {
8116                    lappend arctags($a) $id
8117                }
8118                if {[info exists idheads($id)]} {
8119                    lappend archeads($a) $id
8120                }
8121                if {[info exists allparents($olds)]} {
8122                    # seen parent already
8123                    if {![info exists arcout($olds)]} {
8124                        splitarc $olds
8125                    }
8126                    lappend arcids($a) $olds
8127                    set arcend($a) $olds
8128                    unset growing($a)
8129                }
8130                lappend allchildren($olds) $id
8131                lappend arcnos($olds) $a
8132                continue
8133            }
8134        }
8135        foreach a $arcnos($id) {
8136            lappend arcids($a) $id
8137            set arcend($a) $id
8138            unset growing($a)
8139        }
8140
8141        set ao {}
8142        foreach p $olds {
8143            lappend allchildren($p) $id
8144            set a [incr nextarc]
8145            set arcstart($a) $id
8146            set archeads($a) {}
8147            set arctags($a) {}
8148            set archeads($a) {}
8149            set arcids($a) {}
8150            lappend ao $a
8151            set growing($a) 1
8152            if {[info exists allparents($p)]} {
8153                # seen it already, may need to make a new branch
8154                if {![info exists arcout($p)]} {
8155                    splitarc $p
8156                }
8157                lappend arcids($a) $p
8158                set arcend($a) $p
8159                unset growing($a)
8160            }
8161            lappend arcnos($p) $a
8162        }
8163        set arcout($id) $ao
8164    }
8165    if {$nid > 0} {
8166        global cached_dheads cached_dtags cached_atags
8167        catch {unset cached_dheads}
8168        catch {unset cached_dtags}
8169        catch {unset cached_atags}
8170    }
8171    if {![eof $fd]} {
8172        return [expr {$nid >= 1000? 2: 1}]
8173    }
8174    set cacheok 1
8175    if {[catch {
8176        fconfigure $fd -blocking 1
8177        close $fd
8178    } err]} {
8179        # got an error reading the list of commits
8180        # if we were updating, try rereading the whole thing again
8181        if {$allcupdate} {
8182            incr allcommits -1
8183            dropcache $err
8184            return
8185        }
8186        error_popup "[mc "Error reading commit topology information;\
8187                branch and preceding/following tag information\
8188                will be incomplete."]\n($err)"
8189        set cacheok 0
8190    }
8191    if {[incr allcommits -1] == 0} {
8192        notbusy allcommits
8193        if {$cacheok} {
8194            run savecache
8195        }
8196    }
8197    dispneartags 0
8198    return 0
8199}
8200
8201proc recalcarc {a} {
8202    global arctags archeads arcids idtags idheads
8203
8204    set at {}
8205    set ah {}
8206    foreach id [lrange $arcids($a) 0 end-1] {
8207        if {[info exists idtags($id)]} {
8208            lappend at $id
8209        }
8210        if {[info exists idheads($id)]} {
8211            lappend ah $id
8212        }
8213    }
8214    set arctags($a) $at
8215    set archeads($a) $ah
8216}
8217
8218proc splitarc {p} {
8219    global arcnos arcids nextarc arctags archeads idtags idheads
8220    global arcstart arcend arcout allparents growing
8221
8222    set a $arcnos($p)
8223    if {[llength $a] != 1} {
8224        puts "oops splitarc called but [llength $a] arcs already"
8225        return
8226    }
8227    set a [lindex $a 0]
8228    set i [lsearch -exact $arcids($a) $p]
8229    if {$i < 0} {
8230        puts "oops splitarc $p not in arc $a"
8231        return
8232    }
8233    set na [incr nextarc]
8234    if {[info exists arcend($a)]} {
8235        set arcend($na) $arcend($a)
8236    } else {
8237        set l [lindex $allparents([lindex $arcids($a) end]) 0]
8238        set j [lsearch -exact $arcnos($l) $a]
8239        set arcnos($l) [lreplace $arcnos($l) $j $j $na]
8240    }
8241    set tail [lrange $arcids($a) [expr {$i+1}] end]
8242    set arcids($a) [lrange $arcids($a) 0 $i]
8243    set arcend($a) $p
8244    set arcstart($na) $p
8245    set arcout($p) $na
8246    set arcids($na) $tail
8247    if {[info exists growing($a)]} {
8248        set growing($na) 1
8249        unset growing($a)
8250    }
8251
8252    foreach id $tail {
8253        if {[llength $arcnos($id)] == 1} {
8254            set arcnos($id) $na
8255        } else {
8256            set j [lsearch -exact $arcnos($id) $a]
8257            set arcnos($id) [lreplace $arcnos($id) $j $j $na]
8258        }
8259    }
8260
8261    # reconstruct tags and heads lists
8262    if {$arctags($a) ne {} || $archeads($a) ne {}} {
8263        recalcarc $a
8264        recalcarc $na
8265    } else {
8266        set arctags($na) {}
8267        set archeads($na) {}
8268    }
8269}
8270
8271# Update things for a new commit added that is a child of one
8272# existing commit.  Used when cherry-picking.
8273proc addnewchild {id p} {
8274    global allparents allchildren idtags nextarc
8275    global arcnos arcids arctags arcout arcend arcstart archeads growing
8276    global seeds allcommits
8277
8278    if {![info exists allcommits] || ![info exists arcnos($p)]} return
8279    set allparents($id) [list $p]
8280    set allchildren($id) {}
8281    set arcnos($id) {}
8282    lappend seeds $id
8283    lappend allchildren($p) $id
8284    set a [incr nextarc]
8285    set arcstart($a) $id
8286    set archeads($a) {}
8287    set arctags($a) {}
8288    set arcids($a) [list $p]
8289    set arcend($a) $p
8290    if {![info exists arcout($p)]} {
8291        splitarc $p
8292    }
8293    lappend arcnos($p) $a
8294    set arcout($id) [list $a]
8295}
8296
8297# This implements a cache for the topology information.
8298# The cache saves, for each arc, the start and end of the arc,
8299# the ids on the arc, and the outgoing arcs from the end.
8300proc readcache {f} {
8301    global arcnos arcids arcout arcstart arcend arctags archeads nextarc
8302    global idtags idheads allparents cachedarcs possible_seeds seeds growing
8303    global allcwait
8304
8305    set a $nextarc
8306    set lim $cachedarcs
8307    if {$lim - $a > 500} {
8308        set lim [expr {$a + 500}]
8309    }
8310    if {[catch {
8311        if {$a == $lim} {
8312            # finish reading the cache and setting up arctags, etc.
8313            set line [gets $f]
8314            if {$line ne "1"} {error "bad final version"}
8315            close $f
8316            foreach id [array names idtags] {
8317                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
8318                    [llength $allparents($id)] == 1} {
8319                    set a [lindex $arcnos($id) 0]
8320                    if {$arctags($a) eq {}} {
8321                        recalcarc $a
8322                    }
8323                }
8324            }
8325            foreach id [array names idheads] {
8326                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
8327                    [llength $allparents($id)] == 1} {
8328                    set a [lindex $arcnos($id) 0]
8329                    if {$archeads($a) eq {}} {
8330                        recalcarc $a
8331                    }
8332                }
8333            }
8334            foreach id [lsort -unique $possible_seeds] {
8335                if {$arcnos($id) eq {}} {
8336                    lappend seeds $id
8337                }
8338            }
8339            set allcwait 0
8340        } else {
8341            while {[incr a] <= $lim} {
8342                set line [gets $f]
8343                if {[llength $line] != 3} {error "bad line"}
8344                set s [lindex $line 0]
8345                set arcstart($a) $s
8346                lappend arcout($s) $a
8347                if {![info exists arcnos($s)]} {
8348                    lappend possible_seeds $s
8349                    set arcnos($s) {}
8350                }
8351                set e [lindex $line 1]
8352                if {$e eq {}} {
8353                    set growing($a) 1
8354                } else {
8355                    set arcend($a) $e
8356                    if {![info exists arcout($e)]} {
8357                        set arcout($e) {}
8358                    }
8359                }
8360                set arcids($a) [lindex $line 2]
8361                foreach id $arcids($a) {
8362                    lappend allparents($s) $id
8363                    set s $id
8364                    lappend arcnos($id) $a
8365                }
8366                if {![info exists allparents($s)]} {
8367                    set allparents($s) {}
8368                }
8369                set arctags($a) {}
8370                set archeads($a) {}
8371            }
8372            set nextarc [expr {$a - 1}]
8373        }
8374    } err]} {
8375        dropcache $err
8376        return 0
8377    }
8378    if {!$allcwait} {
8379        getallcommits
8380    }
8381    return $allcwait
8382}
8383
8384proc getcache {f} {
8385    global nextarc cachedarcs possible_seeds
8386
8387    if {[catch {
8388        set line [gets $f]
8389        if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
8390        # make sure it's an integer
8391        set cachedarcs [expr {int([lindex $line 1])}]
8392        if {$cachedarcs < 0} {error "bad number of arcs"}
8393        set nextarc 0
8394        set possible_seeds {}
8395        run readcache $f
8396    } err]} {
8397        dropcache $err
8398    }
8399    return 0
8400}
8401
8402proc dropcache {err} {
8403    global allcwait nextarc cachedarcs seeds
8404
8405    #puts "dropping cache ($err)"
8406    foreach v {arcnos arcout arcids arcstart arcend growing \
8407                   arctags archeads allparents allchildren} {
8408        global $v
8409        catch {unset $v}
8410    }
8411    set allcwait 0
8412    set nextarc 0
8413    set cachedarcs 0
8414    set seeds {}
8415    getallcommits
8416}
8417
8418proc writecache {f} {
8419    global cachearc cachedarcs allccache
8420    global arcstart arcend arcnos arcids arcout
8421
8422    set a $cachearc
8423    set lim $cachedarcs
8424    if {$lim - $a > 1000} {
8425        set lim [expr {$a + 1000}]
8426    }
8427    if {[catch {
8428        while {[incr a] <= $lim} {
8429            if {[info exists arcend($a)]} {
8430                puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
8431            } else {
8432                puts $f [list $arcstart($a) {} $arcids($a)]
8433            }
8434        }
8435    } err]} {
8436        catch {close $f}
8437        catch {file delete $allccache}
8438        #puts "writing cache failed ($err)"
8439        return 0
8440    }
8441    set cachearc [expr {$a - 1}]
8442    if {$a > $cachedarcs} {
8443        puts $f "1"
8444        close $f
8445        return 0
8446    }
8447    return 1
8448}
8449
8450proc savecache {} {
8451    global nextarc cachedarcs cachearc allccache
8452
8453    if {$nextarc == $cachedarcs} return
8454    set cachearc 0
8455    set cachedarcs $nextarc
8456    catch {
8457        set f [open $allccache w]
8458        puts $f [list 1 $cachedarcs]
8459        run writecache $f
8460    }
8461}
8462
8463# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
8464# or 0 if neither is true.
8465proc anc_or_desc {a b} {
8466    global arcout arcstart arcend arcnos cached_isanc
8467
8468    if {$arcnos($a) eq $arcnos($b)} {
8469        # Both are on the same arc(s); either both are the same BMP,
8470        # or if one is not a BMP, the other is also not a BMP or is
8471        # the BMP at end of the arc (and it only has 1 incoming arc).
8472        # Or both can be BMPs with no incoming arcs.
8473        if {$a eq $b || $arcnos($a) eq {}} {
8474            return 0
8475        }
8476        # assert {[llength $arcnos($a)] == 1}
8477        set arc [lindex $arcnos($a) 0]
8478        set i [lsearch -exact $arcids($arc) $a]
8479        set j [lsearch -exact $arcids($arc) $b]
8480        if {$i < 0 || $i > $j} {
8481            return 1
8482        } else {
8483            return -1
8484        }
8485    }
8486
8487    if {![info exists arcout($a)]} {
8488        set arc [lindex $arcnos($a) 0]
8489        if {[info exists arcend($arc)]} {
8490            set aend $arcend($arc)
8491        } else {
8492            set aend {}
8493        }
8494        set a $arcstart($arc)
8495    } else {
8496        set aend $a
8497    }
8498    if {![info exists arcout($b)]} {
8499        set arc [lindex $arcnos($b) 0]
8500        if {[info exists arcend($arc)]} {
8501            set bend $arcend($arc)
8502        } else {
8503            set bend {}
8504        }
8505        set b $arcstart($arc)
8506    } else {
8507        set bend $b
8508    }
8509    if {$a eq $bend} {
8510        return 1
8511    }
8512    if {$b eq $aend} {
8513        return -1
8514    }
8515    if {[info exists cached_isanc($a,$bend)]} {
8516        if {$cached_isanc($a,$bend)} {
8517            return 1
8518        }
8519    }
8520    if {[info exists cached_isanc($b,$aend)]} {
8521        if {$cached_isanc($b,$aend)} {
8522            return -1
8523        }
8524        if {[info exists cached_isanc($a,$bend)]} {
8525            return 0
8526        }
8527    }
8528
8529    set todo [list $a $b]
8530    set anc($a) a
8531    set anc($b) b
8532    for {set i 0} {$i < [llength $todo]} {incr i} {
8533        set x [lindex $todo $i]
8534        if {$anc($x) eq {}} {
8535            continue
8536        }
8537        foreach arc $arcnos($x) {
8538            set xd $arcstart($arc)
8539            if {$xd eq $bend} {
8540                set cached_isanc($a,$bend) 1
8541                set cached_isanc($b,$aend) 0
8542                return 1
8543            } elseif {$xd eq $aend} {
8544                set cached_isanc($b,$aend) 1
8545                set cached_isanc($a,$bend) 0
8546                return -1
8547            }
8548            if {![info exists anc($xd)]} {
8549                set anc($xd) $anc($x)
8550                lappend todo $xd
8551            } elseif {$anc($xd) ne $anc($x)} {
8552                set anc($xd) {}
8553            }
8554        }
8555    }
8556    set cached_isanc($a,$bend) 0
8557    set cached_isanc($b,$aend) 0
8558    return 0
8559}
8560
8561# This identifies whether $desc has an ancestor that is
8562# a growing tip of the graph and which is not an ancestor of $anc
8563# and returns 0 if so and 1 if not.
8564# If we subsequently discover a tag on such a growing tip, and that
8565# turns out to be a descendent of $anc (which it could, since we
8566# don't necessarily see children before parents), then $desc
8567# isn't a good choice to display as a descendent tag of
8568# $anc (since it is the descendent of another tag which is
8569# a descendent of $anc).  Similarly, $anc isn't a good choice to
8570# display as a ancestor tag of $desc.
8571#
8572proc is_certain {desc anc} {
8573    global arcnos arcout arcstart arcend growing problems
8574
8575    set certain {}
8576    if {[llength $arcnos($anc)] == 1} {
8577        # tags on the same arc are certain
8578        if {$arcnos($desc) eq $arcnos($anc)} {
8579            return 1
8580        }
8581        if {![info exists arcout($anc)]} {
8582            # if $anc is partway along an arc, use the start of the arc instead
8583            set a [lindex $arcnos($anc) 0]
8584            set anc $arcstart($a)
8585        }
8586    }
8587    if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
8588        set x $desc
8589    } else {
8590        set a [lindex $arcnos($desc) 0]
8591        set x $arcend($a)
8592    }
8593    if {$x == $anc} {
8594        return 1
8595    }
8596    set anclist [list $x]
8597    set dl($x) 1
8598    set nnh 1
8599    set ngrowanc 0
8600    for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
8601        set x [lindex $anclist $i]
8602        if {$dl($x)} {
8603            incr nnh -1
8604        }
8605        set done($x) 1
8606        foreach a $arcout($x) {
8607            if {[info exists growing($a)]} {
8608                if {![info exists growanc($x)] && $dl($x)} {
8609                    set growanc($x) 1
8610                    incr ngrowanc
8611                }
8612            } else {
8613                set y $arcend($a)
8614                if {[info exists dl($y)]} {
8615                    if {$dl($y)} {
8616                        if {!$dl($x)} {
8617                            set dl($y) 0
8618                            if {![info exists done($y)]} {
8619                                incr nnh -1
8620                            }
8621                            if {[info exists growanc($x)]} {
8622                                incr ngrowanc -1
8623                            }
8624                            set xl [list $y]
8625                            for {set k 0} {$k < [llength $xl]} {incr k} {
8626                                set z [lindex $xl $k]
8627                                foreach c $arcout($z) {
8628                                    if {[info exists arcend($c)]} {
8629                                        set v $arcend($c)
8630                                        if {[info exists dl($v)] && $dl($v)} {
8631                                            set dl($v) 0
8632                                            if {![info exists done($v)]} {
8633                                                incr nnh -1
8634                                            }
8635                                            if {[info exists growanc($v)]} {
8636                                                incr ngrowanc -1
8637                                            }
8638                                            lappend xl $v
8639                                        }
8640                                    }
8641                                }
8642                            }
8643                        }
8644                    }
8645                } elseif {$y eq $anc || !$dl($x)} {
8646                    set dl($y) 0
8647                    lappend anclist $y
8648                } else {
8649                    set dl($y) 1
8650                    lappend anclist $y
8651                    incr nnh
8652                }
8653            }
8654        }
8655    }
8656    foreach x [array names growanc] {
8657        if {$dl($x)} {
8658            return 0
8659        }
8660        return 0
8661    }
8662    return 1
8663}
8664
8665proc validate_arctags {a} {
8666    global arctags idtags
8667
8668    set i -1
8669    set na $arctags($a)
8670    foreach id $arctags($a) {
8671        incr i
8672        if {![info exists idtags($id)]} {
8673            set na [lreplace $na $i $i]
8674            incr i -1
8675        }
8676    }
8677    set arctags($a) $na
8678}
8679
8680proc validate_archeads {a} {
8681    global archeads idheads
8682
8683    set i -1
8684    set na $archeads($a)
8685    foreach id $archeads($a) {
8686        incr i
8687        if {![info exists idheads($id)]} {
8688            set na [lreplace $na $i $i]
8689            incr i -1
8690        }
8691    }
8692    set archeads($a) $na
8693}
8694
8695# Return the list of IDs that have tags that are descendents of id,
8696# ignoring IDs that are descendents of IDs already reported.
8697proc desctags {id} {
8698    global arcnos arcstart arcids arctags idtags allparents
8699    global growing cached_dtags
8700
8701    if {![info exists allparents($id)]} {
8702        return {}
8703    }
8704    set t1 [clock clicks -milliseconds]
8705    set argid $id
8706    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8707        # part-way along an arc; check that arc first
8708        set a [lindex $arcnos($id) 0]
8709        if {$arctags($a) ne {}} {
8710            validate_arctags $a
8711            set i [lsearch -exact $arcids($a) $id]
8712            set tid {}
8713            foreach t $arctags($a) {
8714                set j [lsearch -exact $arcids($a) $t]
8715                if {$j >= $i} break
8716                set tid $t
8717            }
8718            if {$tid ne {}} {
8719                return $tid
8720            }
8721        }
8722        set id $arcstart($a)
8723        if {[info exists idtags($id)]} {
8724            return $id
8725        }
8726    }
8727    if {[info exists cached_dtags($id)]} {
8728        return $cached_dtags($id)
8729    }
8730
8731    set origid $id
8732    set todo [list $id]
8733    set queued($id) 1
8734    set nc 1
8735    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8736        set id [lindex $todo $i]
8737        set done($id) 1
8738        set ta [info exists hastaggedancestor($id)]
8739        if {!$ta} {
8740            incr nc -1
8741        }
8742        # ignore tags on starting node
8743        if {!$ta && $i > 0} {
8744            if {[info exists idtags($id)]} {
8745                set tagloc($id) $id
8746                set ta 1
8747            } elseif {[info exists cached_dtags($id)]} {
8748                set tagloc($id) $cached_dtags($id)
8749                set ta 1
8750            }
8751        }
8752        foreach a $arcnos($id) {
8753            set d $arcstart($a)
8754            if {!$ta && $arctags($a) ne {}} {
8755                validate_arctags $a
8756                if {$arctags($a) ne {}} {
8757                    lappend tagloc($id) [lindex $arctags($a) end]
8758                }
8759            }
8760            if {$ta || $arctags($a) ne {}} {
8761                set tomark [list $d]
8762                for {set j 0} {$j < [llength $tomark]} {incr j} {
8763                    set dd [lindex $tomark $j]
8764                    if {![info exists hastaggedancestor($dd)]} {
8765                        if {[info exists done($dd)]} {
8766                            foreach b $arcnos($dd) {
8767                                lappend tomark $arcstart($b)
8768                            }
8769                            if {[info exists tagloc($dd)]} {
8770                                unset tagloc($dd)
8771                            }
8772                        } elseif {[info exists queued($dd)]} {
8773                            incr nc -1
8774                        }
8775                        set hastaggedancestor($dd) 1
8776                    }
8777                }
8778            }
8779            if {![info exists queued($d)]} {
8780                lappend todo $d
8781                set queued($d) 1
8782                if {![info exists hastaggedancestor($d)]} {
8783                    incr nc
8784                }
8785            }
8786        }
8787    }
8788    set tags {}
8789    foreach id [array names tagloc] {
8790        if {![info exists hastaggedancestor($id)]} {
8791            foreach t $tagloc($id) {
8792                if {[lsearch -exact $tags $t] < 0} {
8793                    lappend tags $t
8794                }
8795            }
8796        }
8797    }
8798    set t2 [clock clicks -milliseconds]
8799    set loopix $i
8800
8801    # remove tags that are descendents of other tags
8802    for {set i 0} {$i < [llength $tags]} {incr i} {
8803        set a [lindex $tags $i]
8804        for {set j 0} {$j < $i} {incr j} {
8805            set b [lindex $tags $j]
8806            set r [anc_or_desc $a $b]
8807            if {$r == 1} {
8808                set tags [lreplace $tags $j $j]
8809                incr j -1
8810                incr i -1
8811            } elseif {$r == -1} {
8812                set tags [lreplace $tags $i $i]
8813                incr i -1
8814                break
8815            }
8816        }
8817    }
8818
8819    if {[array names growing] ne {}} {
8820        # graph isn't finished, need to check if any tag could get
8821        # eclipsed by another tag coming later.  Simply ignore any
8822        # tags that could later get eclipsed.
8823        set ctags {}
8824        foreach t $tags {
8825            if {[is_certain $t $origid]} {
8826                lappend ctags $t
8827            }
8828        }
8829        if {$tags eq $ctags} {
8830            set cached_dtags($origid) $tags
8831        } else {
8832            set tags $ctags
8833        }
8834    } else {
8835        set cached_dtags($origid) $tags
8836    }
8837    set t3 [clock clicks -milliseconds]
8838    if {0 && $t3 - $t1 >= 100} {
8839        puts "iterating descendents ($loopix/[llength $todo] nodes) took\
8840            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8841    }
8842    return $tags
8843}
8844
8845proc anctags {id} {
8846    global arcnos arcids arcout arcend arctags idtags allparents
8847    global growing cached_atags
8848
8849    if {![info exists allparents($id)]} {
8850        return {}
8851    }
8852    set t1 [clock clicks -milliseconds]
8853    set argid $id
8854    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8855        # part-way along an arc; check that arc first
8856        set a [lindex $arcnos($id) 0]
8857        if {$arctags($a) ne {}} {
8858            validate_arctags $a
8859            set i [lsearch -exact $arcids($a) $id]
8860            foreach t $arctags($a) {
8861                set j [lsearch -exact $arcids($a) $t]
8862                if {$j > $i} {
8863                    return $t
8864                }
8865            }
8866        }
8867        if {![info exists arcend($a)]} {
8868            return {}
8869        }
8870        set id $arcend($a)
8871        if {[info exists idtags($id)]} {
8872            return $id
8873        }
8874    }
8875    if {[info exists cached_atags($id)]} {
8876        return $cached_atags($id)
8877    }
8878
8879    set origid $id
8880    set todo [list $id]
8881    set queued($id) 1
8882    set taglist {}
8883    set nc 1
8884    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8885        set id [lindex $todo $i]
8886        set done($id) 1
8887        set td [info exists hastaggeddescendent($id)]
8888        if {!$td} {
8889            incr nc -1
8890        }
8891        # ignore tags on starting node
8892        if {!$td && $i > 0} {
8893            if {[info exists idtags($id)]} {
8894                set tagloc($id) $id
8895                set td 1
8896            } elseif {[info exists cached_atags($id)]} {
8897                set tagloc($id) $cached_atags($id)
8898                set td 1
8899            }
8900        }
8901        foreach a $arcout($id) {
8902            if {!$td && $arctags($a) ne {}} {
8903                validate_arctags $a
8904                if {$arctags($a) ne {}} {
8905                    lappend tagloc($id) [lindex $arctags($a) 0]
8906                }
8907            }
8908            if {![info exists arcend($a)]} continue
8909            set d $arcend($a)
8910            if {$td || $arctags($a) ne {}} {
8911                set tomark [list $d]
8912                for {set j 0} {$j < [llength $tomark]} {incr j} {
8913                    set dd [lindex $tomark $j]
8914                    if {![info exists hastaggeddescendent($dd)]} {
8915                        if {[info exists done($dd)]} {
8916                            foreach b $arcout($dd) {
8917                                if {[info exists arcend($b)]} {
8918                                    lappend tomark $arcend($b)
8919                                }
8920                            }
8921                            if {[info exists tagloc($dd)]} {
8922                                unset tagloc($dd)
8923                            }
8924                        } elseif {[info exists queued($dd)]} {
8925                            incr nc -1
8926                        }
8927                        set hastaggeddescendent($dd) 1
8928                    }
8929                }
8930            }
8931            if {![info exists queued($d)]} {
8932                lappend todo $d
8933                set queued($d) 1
8934                if {![info exists hastaggeddescendent($d)]} {
8935                    incr nc
8936                }
8937            }
8938        }
8939    }
8940    set t2 [clock clicks -milliseconds]
8941    set loopix $i
8942    set tags {}
8943    foreach id [array names tagloc] {
8944        if {![info exists hastaggeddescendent($id)]} {
8945            foreach t $tagloc($id) {
8946                if {[lsearch -exact $tags $t] < 0} {
8947                    lappend tags $t
8948                }
8949            }
8950        }
8951    }
8952
8953    # remove tags that are ancestors of other tags
8954    for {set i 0} {$i < [llength $tags]} {incr i} {
8955        set a [lindex $tags $i]
8956        for {set j 0} {$j < $i} {incr j} {
8957            set b [lindex $tags $j]
8958            set r [anc_or_desc $a $b]
8959            if {$r == -1} {
8960                set tags [lreplace $tags $j $j]
8961                incr j -1
8962                incr i -1
8963            } elseif {$r == 1} {
8964                set tags [lreplace $tags $i $i]
8965                incr i -1
8966                break
8967            }
8968        }
8969    }
8970
8971    if {[array names growing] ne {}} {
8972        # graph isn't finished, need to check if any tag could get
8973        # eclipsed by another tag coming later.  Simply ignore any
8974        # tags that could later get eclipsed.
8975        set ctags {}
8976        foreach t $tags {
8977            if {[is_certain $origid $t]} {
8978                lappend ctags $t
8979            }
8980        }
8981        if {$tags eq $ctags} {
8982            set cached_atags($origid) $tags
8983        } else {
8984            set tags $ctags
8985        }
8986    } else {
8987        set cached_atags($origid) $tags
8988    }
8989    set t3 [clock clicks -milliseconds]
8990    if {0 && $t3 - $t1 >= 100} {
8991        puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
8992            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8993    }
8994    return $tags
8995}
8996
8997# Return the list of IDs that have heads that are descendents of id,
8998# including id itself if it has a head.
8999proc descheads {id} {
9000    global arcnos arcstart arcids archeads idheads cached_dheads
9001    global allparents
9002
9003    if {![info exists allparents($id)]} {
9004        return {}
9005    }
9006    set aret {}
9007    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9008        # part-way along an arc; check it first
9009        set a [lindex $arcnos($id) 0]
9010        if {$archeads($a) ne {}} {
9011            validate_archeads $a
9012            set i [lsearch -exact $arcids($a) $id]
9013            foreach t $archeads($a) {
9014                set j [lsearch -exact $arcids($a) $t]
9015                if {$j > $i} break
9016                lappend aret $t
9017            }
9018        }
9019        set id $arcstart($a)
9020    }
9021    set origid $id
9022    set todo [list $id]
9023    set seen($id) 1
9024    set ret {}
9025    for {set i 0} {$i < [llength $todo]} {incr i} {
9026        set id [lindex $todo $i]
9027        if {[info exists cached_dheads($id)]} {
9028            set ret [concat $ret $cached_dheads($id)]
9029        } else {
9030            if {[info exists idheads($id)]} {
9031                lappend ret $id
9032            }
9033            foreach a $arcnos($id) {
9034                if {$archeads($a) ne {}} {
9035                    validate_archeads $a
9036                    if {$archeads($a) ne {}} {
9037                        set ret [concat $ret $archeads($a)]
9038                    }
9039                }
9040                set d $arcstart($a)
9041                if {![info exists seen($d)]} {
9042                    lappend todo $d
9043                    set seen($d) 1
9044                }
9045            }
9046        }
9047    }
9048    set ret [lsort -unique $ret]
9049    set cached_dheads($origid) $ret
9050    return [concat $ret $aret]
9051}
9052
9053proc addedtag {id} {
9054    global arcnos arcout cached_dtags cached_atags
9055
9056    if {![info exists arcnos($id)]} return
9057    if {![info exists arcout($id)]} {
9058        recalcarc [lindex $arcnos($id) 0]
9059    }
9060    catch {unset cached_dtags}
9061    catch {unset cached_atags}
9062}
9063
9064proc addedhead {hid head} {
9065    global arcnos arcout cached_dheads
9066
9067    if {![info exists arcnos($hid)]} return
9068    if {![info exists arcout($hid)]} {
9069        recalcarc [lindex $arcnos($hid) 0]
9070    }
9071    catch {unset cached_dheads}
9072}
9073
9074proc removedhead {hid head} {
9075    global cached_dheads
9076
9077    catch {unset cached_dheads}
9078}
9079
9080proc movedhead {hid head} {
9081    global arcnos arcout cached_dheads
9082
9083    if {![info exists arcnos($hid)]} return
9084    if {![info exists arcout($hid)]} {
9085        recalcarc [lindex $arcnos($hid) 0]
9086    }
9087    catch {unset cached_dheads}
9088}
9089
9090proc changedrefs {} {
9091    global cached_dheads cached_dtags cached_atags
9092    global arctags archeads arcnos arcout idheads idtags
9093
9094    foreach id [concat [array names idheads] [array names idtags]] {
9095        if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
9096            set a [lindex $arcnos($id) 0]
9097            if {![info exists donearc($a)]} {
9098                recalcarc $a
9099                set donearc($a) 1
9100            }
9101        }
9102    }
9103    catch {unset cached_dtags}
9104    catch {unset cached_atags}
9105    catch {unset cached_dheads}
9106}
9107
9108proc rereadrefs {} {
9109    global idtags idheads idotherrefs mainheadid
9110
9111    set refids [concat [array names idtags] \
9112                    [array names idheads] [array names idotherrefs]]
9113    foreach id $refids {
9114        if {![info exists ref($id)]} {
9115            set ref($id) [listrefs $id]
9116        }
9117    }
9118    set oldmainhead $mainheadid
9119    readrefs
9120    changedrefs
9121    set refids [lsort -unique [concat $refids [array names idtags] \
9122                        [array names idheads] [array names idotherrefs]]]
9123    foreach id $refids {
9124        set v [listrefs $id]
9125        if {![info exists ref($id)] || $ref($id) != $v} {
9126            redrawtags $id
9127        }
9128    }
9129    if {$oldmainhead ne $mainheadid} {
9130        redrawtags $oldmainhead
9131        redrawtags $mainheadid
9132    }
9133    run refill_reflist
9134}
9135
9136proc listrefs {id} {
9137    global idtags idheads idotherrefs
9138
9139    set x {}
9140    if {[info exists idtags($id)]} {
9141        set x $idtags($id)
9142    }
9143    set y {}
9144    if {[info exists idheads($id)]} {
9145        set y $idheads($id)
9146    }
9147    set z {}
9148    if {[info exists idotherrefs($id)]} {
9149        set z $idotherrefs($id)
9150    }
9151    return [list $x $y $z]
9152}
9153
9154proc showtag {tag isnew} {
9155    global ctext tagcontents tagids linknum tagobjid
9156
9157    if {$isnew} {
9158        addtohistory [list showtag $tag 0]
9159    }
9160    $ctext conf -state normal
9161    clear_ctext
9162    settabs 0
9163    set linknum 0
9164    if {![info exists tagcontents($tag)]} {
9165        catch {
9166            set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
9167        }
9168    }
9169    if {[info exists tagcontents($tag)]} {
9170        set text $tagcontents($tag)
9171    } else {
9172        set text "[mc "Tag"]: $tag\n[mc "Id"]:  $tagids($tag)"
9173    }
9174    appendwithlinks $text {}
9175    $ctext conf -state disabled
9176    init_flist {}
9177}
9178
9179proc doquit {} {
9180    global stopped
9181    global gitktmpdir
9182
9183    set stopped 100
9184    savestuff .
9185    destroy .
9186
9187    if {[info exists gitktmpdir]} {
9188        catch {file delete -force $gitktmpdir}
9189    }
9190}
9191
9192proc mkfontdisp {font top which} {
9193    global fontattr fontpref $font
9194
9195    set fontpref($font) [set $font]
9196    button $top.${font}but -text $which -font optionfont \
9197        -command [list choosefont $font $which]
9198    label $top.$font -relief flat -font $font \
9199        -text $fontattr($font,family) -justify left
9200    grid x $top.${font}but $top.$font -sticky w
9201}
9202
9203proc choosefont {font which} {
9204    global fontparam fontlist fonttop fontattr
9205
9206    set fontparam(which) $which
9207    set fontparam(font) $font
9208    set fontparam(family) [font actual $font -family]
9209    set fontparam(size) $fontattr($font,size)
9210    set fontparam(weight) $fontattr($font,weight)
9211    set fontparam(slant) $fontattr($font,slant)
9212    set top .gitkfont
9213    set fonttop $top
9214    if {![winfo exists $top]} {
9215        font create sample
9216        eval font config sample [font actual $font]
9217        toplevel $top
9218        wm title $top [mc "Gitk font chooser"]
9219        label $top.l -textvariable fontparam(which)
9220        pack $top.l -side top
9221        set fontlist [lsort [font families]]
9222        frame $top.f
9223        listbox $top.f.fam -listvariable fontlist \
9224            -yscrollcommand [list $top.f.sb set]
9225        bind $top.f.fam <<ListboxSelect>> selfontfam
9226        scrollbar $top.f.sb -command [list $top.f.fam yview]
9227        pack $top.f.sb -side right -fill y
9228        pack $top.f.fam -side left -fill both -expand 1
9229        pack $top.f -side top -fill both -expand 1
9230        frame $top.g
9231        spinbox $top.g.size -from 4 -to 40 -width 4 \
9232            -textvariable fontparam(size) \
9233            -validatecommand {string is integer -strict %s}
9234        checkbutton $top.g.bold -padx 5 \
9235            -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
9236            -variable fontparam(weight) -onvalue bold -offvalue normal
9237        checkbutton $top.g.ital -padx 5 \
9238            -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
9239            -variable fontparam(slant) -onvalue italic -offvalue roman
9240        pack $top.g.size $top.g.bold $top.g.ital -side left
9241        pack $top.g -side top
9242        canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
9243            -background white
9244        $top.c create text 100 25 -anchor center -text $which -font sample \
9245            -fill black -tags text
9246        bind $top.c <Configure> [list centertext $top.c]
9247        pack $top.c -side top -fill x
9248        frame $top.buts
9249        button $top.buts.ok -text [mc "OK"] -command fontok -default active
9250        button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
9251        grid $top.buts.ok $top.buts.can
9252        grid columnconfigure $top.buts 0 -weight 1 -uniform a
9253        grid columnconfigure $top.buts 1 -weight 1 -uniform a
9254        pack $top.buts -side bottom -fill x
9255        trace add variable fontparam write chg_fontparam
9256    } else {
9257        raise $top
9258        $top.c itemconf text -text $which
9259    }
9260    set i [lsearch -exact $fontlist $fontparam(family)]
9261    if {$i >= 0} {
9262        $top.f.fam selection set $i
9263        $top.f.fam see $i
9264    }
9265}
9266
9267proc centertext {w} {
9268    $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
9269}
9270
9271proc fontok {} {
9272    global fontparam fontpref prefstop
9273
9274    set f $fontparam(font)
9275    set fontpref($f) [list $fontparam(family) $fontparam(size)]
9276    if {$fontparam(weight) eq "bold"} {
9277        lappend fontpref($f) "bold"
9278    }
9279    if {$fontparam(slant) eq "italic"} {
9280        lappend fontpref($f) "italic"
9281    }
9282    set w $prefstop.$f
9283    $w conf -text $fontparam(family) -font $fontpref($f)
9284        
9285    fontcan
9286}
9287
9288proc fontcan {} {
9289    global fonttop fontparam
9290
9291    if {[info exists fonttop]} {
9292        catch {destroy $fonttop}
9293        catch {font delete sample}
9294        unset fonttop
9295        unset fontparam
9296    }
9297}
9298
9299proc selfontfam {} {
9300    global fonttop fontparam
9301
9302    set i [$fonttop.f.fam curselection]
9303    if {$i ne {}} {
9304        set fontparam(family) [$fonttop.f.fam get $i]
9305    }
9306}
9307
9308proc chg_fontparam {v sub op} {
9309    global fontparam
9310
9311    font config sample -$sub $fontparam($sub)
9312}
9313
9314proc doprefs {} {
9315    global maxwidth maxgraphpct
9316    global oldprefs prefstop showneartags showlocalchanges
9317    global bgcolor fgcolor ctext diffcolors selectbgcolor
9318    global tabstop limitdiffs autoselect extdifftool
9319
9320    set top .gitkprefs
9321    set prefstop $top
9322    if {[winfo exists $top]} {
9323        raise $top
9324        return
9325    }
9326    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
9327                   limitdiffs tabstop} {
9328        set oldprefs($v) [set $v]
9329    }
9330    toplevel $top
9331    wm title $top [mc "Gitk preferences"]
9332    label $top.ldisp -text [mc "Commit list display options"]
9333    grid $top.ldisp - -sticky w -pady 10
9334    label $top.spacer -text " "
9335    label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
9336        -font optionfont
9337    spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
9338    grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
9339    label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
9340        -font optionfont
9341    spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
9342    grid x $top.maxpctl $top.maxpct -sticky w
9343    frame $top.showlocal
9344    label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
9345    checkbutton $top.showlocal.b -variable showlocalchanges
9346    pack $top.showlocal.b $top.showlocal.l -side left
9347    grid x $top.showlocal -sticky w
9348    frame $top.autoselect
9349    label $top.autoselect.l -text [mc "Auto-select SHA1"] -font optionfont
9350    checkbutton $top.autoselect.b -variable autoselect
9351    pack $top.autoselect.b $top.autoselect.l -side left
9352    grid x $top.autoselect -sticky w
9353
9354    label $top.ddisp -text [mc "Diff display options"]
9355    grid $top.ddisp - -sticky w -pady 10
9356    label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
9357    spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
9358    grid x $top.tabstopl $top.tabstop -sticky w
9359    frame $top.ntag
9360    label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
9361    checkbutton $top.ntag.b -variable showneartags
9362    pack $top.ntag.b $top.ntag.l -side left
9363    grid x $top.ntag -sticky w
9364    frame $top.ldiff
9365    label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
9366    checkbutton $top.ldiff.b -variable limitdiffs
9367    pack $top.ldiff.b $top.ldiff.l -side left
9368    grid x $top.ldiff -sticky w
9369
9370    entry $top.extdifft -textvariable extdifftool
9371    frame $top.extdifff
9372    label $top.extdifff.l -text [mc "External diff tool" ] -font optionfont \
9373        -padx 10
9374    button $top.extdifff.b -text [mc "Choose..."] -font optionfont \
9375        -command choose_extdiff
9376    pack $top.extdifff.l $top.extdifff.b -side left
9377    grid x $top.extdifff $top.extdifft -sticky w
9378
9379    label $top.cdisp -text [mc "Colors: press to choose"]
9380    grid $top.cdisp - -sticky w -pady 10
9381    label $top.bg -padx 40 -relief sunk -background $bgcolor
9382    button $top.bgbut -text [mc "Background"] -font optionfont \
9383        -command [list choosecolor bgcolor {} $top.bg background setbg]
9384    grid x $top.bgbut $top.bg -sticky w
9385    label $top.fg -padx 40 -relief sunk -background $fgcolor
9386    button $top.fgbut -text [mc "Foreground"] -font optionfont \
9387        -command [list choosecolor fgcolor {} $top.fg foreground setfg]
9388    grid x $top.fgbut $top.fg -sticky w
9389    label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
9390    button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
9391        -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
9392                      [list $ctext tag conf d0 -foreground]]
9393    grid x $top.diffoldbut $top.diffold -sticky w
9394    label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
9395    button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
9396        -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
9397                      [list $ctext tag conf d1 -foreground]]
9398    grid x $top.diffnewbut $top.diffnew -sticky w
9399    label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
9400    button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
9401        -command [list choosecolor diffcolors 2 $top.hunksep \
9402                      "diff hunk header" \
9403                      [list $ctext tag conf hunksep -foreground]]
9404    grid x $top.hunksepbut $top.hunksep -sticky w
9405    label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
9406    button $top.selbgbut -text [mc "Select bg"] -font optionfont \
9407        -command [list choosecolor selectbgcolor {} $top.selbgsep background setselbg]
9408    grid x $top.selbgbut $top.selbgsep -sticky w
9409
9410    label $top.cfont -text [mc "Fonts: press to choose"]
9411    grid $top.cfont - -sticky w -pady 10
9412    mkfontdisp mainfont $top [mc "Main font"]
9413    mkfontdisp textfont $top [mc "Diff display font"]
9414    mkfontdisp uifont $top [mc "User interface font"]
9415
9416    frame $top.buts
9417    button $top.buts.ok -text [mc "OK"] -command prefsok -default active
9418    button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
9419    grid $top.buts.ok $top.buts.can
9420    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9421    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9422    grid $top.buts - - -pady 10 -sticky ew
9423    bind $top <Visibility> "focus $top.buts.ok"
9424}
9425
9426proc choose_extdiff {} {
9427    global extdifftool
9428
9429    set prog [tk_getOpenFile -title "External diff tool" -multiple false]
9430    if {$prog ne {}} {
9431        set extdifftool $prog
9432    }
9433}
9434
9435proc choosecolor {v vi w x cmd} {
9436    global $v
9437
9438    set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
9439               -title [mc "Gitk: choose color for %s" $x]]
9440    if {$c eq {}} return
9441    $w conf -background $c
9442    lset $v $vi $c
9443    eval $cmd $c
9444}
9445
9446proc setselbg {c} {
9447    global bglist cflist
9448    foreach w $bglist {
9449        $w configure -selectbackground $c
9450    }
9451    $cflist tag configure highlight \
9452        -background [$cflist cget -selectbackground]
9453    allcanvs itemconf secsel -fill $c
9454}
9455
9456proc setbg {c} {
9457    global bglist
9458
9459    foreach w $bglist {
9460        $w conf -background $c
9461    }
9462}
9463
9464proc setfg {c} {
9465    global fglist canv
9466
9467    foreach w $fglist {
9468        $w conf -foreground $c
9469    }
9470    allcanvs itemconf text -fill $c
9471    $canv itemconf circle -outline $c
9472}
9473
9474proc prefscan {} {
9475    global oldprefs prefstop
9476
9477    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
9478                   limitdiffs tabstop} {
9479        global $v
9480        set $v $oldprefs($v)
9481    }
9482    catch {destroy $prefstop}
9483    unset prefstop
9484    fontcan
9485}
9486
9487proc prefsok {} {
9488    global maxwidth maxgraphpct
9489    global oldprefs prefstop showneartags showlocalchanges
9490    global fontpref mainfont textfont uifont
9491    global limitdiffs treediffs
9492
9493    catch {destroy $prefstop}
9494    unset prefstop
9495    fontcan
9496    set fontchanged 0
9497    if {$mainfont ne $fontpref(mainfont)} {
9498        set mainfont $fontpref(mainfont)
9499        parsefont mainfont $mainfont
9500        eval font configure mainfont [fontflags mainfont]
9501        eval font configure mainfontbold [fontflags mainfont 1]
9502        setcoords
9503        set fontchanged 1
9504    }
9505    if {$textfont ne $fontpref(textfont)} {
9506        set textfont $fontpref(textfont)
9507        parsefont textfont $textfont
9508        eval font configure textfont [fontflags textfont]
9509        eval font configure textfontbold [fontflags textfont 1]
9510    }
9511    if {$uifont ne $fontpref(uifont)} {
9512        set uifont $fontpref(uifont)
9513        parsefont uifont $uifont
9514        eval font configure uifont [fontflags uifont]
9515    }
9516    settabs
9517    if {$showlocalchanges != $oldprefs(showlocalchanges)} {
9518        if {$showlocalchanges} {
9519            doshowlocalchanges
9520        } else {
9521            dohidelocalchanges
9522        }
9523    }
9524    if {$limitdiffs != $oldprefs(limitdiffs)} {
9525        # treediffs elements are limited by path
9526        catch {unset treediffs}
9527    }
9528    if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
9529        || $maxgraphpct != $oldprefs(maxgraphpct)} {
9530        redisplay
9531    } elseif {$showneartags != $oldprefs(showneartags) ||
9532          $limitdiffs != $oldprefs(limitdiffs)} {
9533        reselectline
9534    }
9535}
9536
9537proc formatdate {d} {
9538    global datetimeformat
9539    if {$d ne {}} {
9540        set d [clock format $d -format $datetimeformat]
9541    }
9542    return $d
9543}
9544
9545# This list of encoding names and aliases is distilled from
9546# http://www.iana.org/assignments/character-sets.
9547# Not all of them are supported by Tcl.
9548set encoding_aliases {
9549    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
9550      ISO646-US US-ASCII us IBM367 cp367 csASCII }
9551    { ISO-10646-UTF-1 csISO10646UTF1 }
9552    { ISO_646.basic:1983 ref csISO646basic1983 }
9553    { INVARIANT csINVARIANT }
9554    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
9555    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
9556    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
9557    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
9558    { NATS-DANO iso-ir-9-1 csNATSDANO }
9559    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
9560    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
9561    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
9562    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
9563    { ISO-2022-KR csISO2022KR }
9564    { EUC-KR csEUCKR }
9565    { ISO-2022-JP csISO2022JP }
9566    { ISO-2022-JP-2 csISO2022JP2 }
9567    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
9568      csISO13JISC6220jp }
9569    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
9570    { IT iso-ir-15 ISO646-IT csISO15Italian }
9571    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
9572    { ES iso-ir-17 ISO646-ES csISO17Spanish }
9573    { greek7-old iso-ir-18 csISO18Greek7Old }
9574    { latin-greek iso-ir-19 csISO19LatinGreek }
9575    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
9576    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
9577    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
9578    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
9579    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
9580    { BS_viewdata iso-ir-47 csISO47BSViewdata }
9581    { INIS iso-ir-49 csISO49INIS }
9582    { INIS-8 iso-ir-50 csISO50INIS8 }
9583    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
9584    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
9585    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
9586    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
9587    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
9588    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
9589      csISO60Norwegian1 }
9590    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
9591    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
9592    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
9593    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
9594    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
9595    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
9596    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
9597    { greek7 iso-ir-88 csISO88Greek7 }
9598    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
9599    { iso-ir-90 csISO90 }
9600    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
9601    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
9602      csISO92JISC62991984b }
9603    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
9604    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
9605    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
9606      csISO95JIS62291984handadd }
9607    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
9608    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
9609    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
9610    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
9611      CP819 csISOLatin1 }
9612    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
9613    { T.61-7bit iso-ir-102 csISO102T617bit }
9614    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
9615    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
9616    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
9617    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
9618    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
9619    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
9620    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
9621    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
9622      arabic csISOLatinArabic }
9623    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
9624    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
9625    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
9626      greek greek8 csISOLatinGreek }
9627    { T.101-G2 iso-ir-128 csISO128T101G2 }
9628    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
9629      csISOLatinHebrew }
9630    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
9631    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
9632    { CSN_369103 iso-ir-139 csISO139CSN369103 }
9633    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
9634    { ISO_6937-2-add iso-ir-142 csISOTextComm }
9635    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
9636    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
9637      csISOLatinCyrillic }
9638    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
9639    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
9640    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
9641    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
9642    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
9643    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
9644    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
9645    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
9646    { ISO_10367-box iso-ir-155 csISO10367Box }
9647    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
9648    { latin-lap lap iso-ir-158 csISO158Lap }
9649    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
9650    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
9651    { us-dk csUSDK }
9652    { dk-us csDKUS }
9653    { JIS_X0201 X0201 csHalfWidthKatakana }
9654    { KSC5636 ISO646-KR csKSC5636 }
9655    { ISO-10646-UCS-2 csUnicode }
9656    { ISO-10646-UCS-4 csUCS4 }
9657    { DEC-MCS dec csDECMCS }
9658    { hp-roman8 roman8 r8 csHPRoman8 }
9659    { macintosh mac csMacintosh }
9660    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
9661      csIBM037 }
9662    { IBM038 EBCDIC-INT cp038 csIBM038 }
9663    { IBM273 CP273 csIBM273 }
9664    { IBM274 EBCDIC-BE CP274 csIBM274 }
9665    { IBM275 EBCDIC-BR cp275 csIBM275 }
9666    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
9667    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
9668    { IBM280 CP280 ebcdic-cp-it csIBM280 }
9669    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
9670    { IBM284 CP284 ebcdic-cp-es csIBM284 }
9671    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
9672    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
9673    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
9674    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
9675    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
9676    { IBM424 cp424 ebcdic-cp-he csIBM424 }
9677    { IBM437 cp437 437 csPC8CodePage437 }
9678    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
9679    { IBM775 cp775 csPC775Baltic }
9680    { IBM850 cp850 850 csPC850Multilingual }
9681    { IBM851 cp851 851 csIBM851 }
9682    { IBM852 cp852 852 csPCp852 }
9683    { IBM855 cp855 855 csIBM855 }
9684    { IBM857 cp857 857 csIBM857 }
9685    { IBM860 cp860 860 csIBM860 }
9686    { IBM861 cp861 861 cp-is csIBM861 }
9687    { IBM862 cp862 862 csPC862LatinHebrew }
9688    { IBM863 cp863 863 csIBM863 }
9689    { IBM864 cp864 csIBM864 }
9690    { IBM865 cp865 865 csIBM865 }
9691    { IBM866 cp866 866 csIBM866 }
9692    { IBM868 CP868 cp-ar csIBM868 }
9693    { IBM869 cp869 869 cp-gr csIBM869 }
9694    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
9695    { IBM871 CP871 ebcdic-cp-is csIBM871 }
9696    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
9697    { IBM891 cp891 csIBM891 }
9698    { IBM903 cp903 csIBM903 }
9699    { IBM904 cp904 904 csIBBM904 }
9700    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
9701    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
9702    { IBM1026 CP1026 csIBM1026 }
9703    { EBCDIC-AT-DE csIBMEBCDICATDE }
9704    { EBCDIC-AT-DE-A csEBCDICATDEA }
9705    { EBCDIC-CA-FR csEBCDICCAFR }
9706    { EBCDIC-DK-NO csEBCDICDKNO }
9707    { EBCDIC-DK-NO-A csEBCDICDKNOA }
9708    { EBCDIC-FI-SE csEBCDICFISE }
9709    { EBCDIC-FI-SE-A csEBCDICFISEA }
9710    { EBCDIC-FR csEBCDICFR }
9711    { EBCDIC-IT csEBCDICIT }
9712    { EBCDIC-PT csEBCDICPT }
9713    { EBCDIC-ES csEBCDICES }
9714    { EBCDIC-ES-A csEBCDICESA }
9715    { EBCDIC-ES-S csEBCDICESS }
9716    { EBCDIC-UK csEBCDICUK }
9717    { EBCDIC-US csEBCDICUS }
9718    { UNKNOWN-8BIT csUnknown8BiT }
9719    { MNEMONIC csMnemonic }
9720    { MNEM csMnem }
9721    { VISCII csVISCII }
9722    { VIQR csVIQR }
9723    { KOI8-R csKOI8R }
9724    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
9725    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
9726    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
9727    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
9728    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
9729    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
9730    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
9731    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
9732    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
9733    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
9734    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
9735    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
9736    { IBM1047 IBM-1047 }
9737    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
9738    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
9739    { UNICODE-1-1 csUnicode11 }
9740    { CESU-8 csCESU-8 }
9741    { BOCU-1 csBOCU-1 }
9742    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
9743    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
9744      l8 }
9745    { ISO-8859-15 ISO_8859-15 Latin-9 }
9746    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
9747    { GBK CP936 MS936 windows-936 }
9748    { JIS_Encoding csJISEncoding }
9749    { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
9750    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
9751      EUC-JP }
9752    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
9753    { ISO-10646-UCS-Basic csUnicodeASCII }
9754    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
9755    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
9756    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
9757    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
9758    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
9759    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
9760    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
9761    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
9762    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
9763    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
9764    { Adobe-Standard-Encoding csAdobeStandardEncoding }
9765    { Ventura-US csVenturaUS }
9766    { Ventura-International csVenturaInternational }
9767    { PC8-Danish-Norwegian csPC8DanishNorwegian }
9768    { PC8-Turkish csPC8Turkish }
9769    { IBM-Symbols csIBMSymbols }
9770    { IBM-Thai csIBMThai }
9771    { HP-Legal csHPLegal }
9772    { HP-Pi-font csHPPiFont }
9773    { HP-Math8 csHPMath8 }
9774    { Adobe-Symbol-Encoding csHPPSMath }
9775    { HP-DeskTop csHPDesktop }
9776    { Ventura-Math csVenturaMath }
9777    { Microsoft-Publishing csMicrosoftPublishing }
9778    { Windows-31J csWindows31J }
9779    { GB2312 csGB2312 }
9780    { Big5 csBig5 }
9781}
9782
9783proc tcl_encoding {enc} {
9784    global encoding_aliases
9785    set names [encoding names]
9786    set lcnames [string tolower $names]
9787    set enc [string tolower $enc]
9788    set i [lsearch -exact $lcnames $enc]
9789    if {$i < 0} {
9790        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
9791        if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
9792            set i [lsearch -exact $lcnames $encx]
9793        }
9794    }
9795    if {$i < 0} {
9796        foreach l $encoding_aliases {
9797            set ll [string tolower $l]
9798            if {[lsearch -exact $ll $enc] < 0} continue
9799            # look through the aliases for one that tcl knows about
9800            foreach e $ll {
9801                set i [lsearch -exact $lcnames $e]
9802                if {$i < 0} {
9803                    if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
9804                        set i [lsearch -exact $lcnames $ex]
9805                    }
9806                }
9807                if {$i >= 0} break
9808            }
9809            break
9810        }
9811    }
9812    if {$i >= 0} {
9813        return [lindex $names $i]
9814    }
9815    return {}
9816}
9817
9818proc gitattr {path attr default} {
9819        if {[catch {set r [exec git check-attr $attr -- $path]}]} {
9820                set r unspecified
9821        } else {
9822                set r [join [lrange [split $r :] 2 end] :]
9823                regsub {^ } $r {} r
9824        }
9825        if {$r eq {unspecified}} {
9826                return $default
9827        }
9828        return $r
9829}
9830
9831proc get_path_encoding {path} {
9832        global gui_encoding
9833        set tcl_enc [tcl_encoding $gui_encoding]
9834        if {$tcl_enc eq {}} {
9835                set tcl_enc [encoding system]
9836        }
9837        if {$path ne {}} {
9838                set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
9839                if {$enc2 ne {}} {
9840                        set tcl_enc $enc2
9841                }
9842        }
9843        return $tcl_enc
9844}
9845
9846# First check that Tcl/Tk is recent enough
9847if {[catch {package require Tk 8.4} err]} {
9848    show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
9849                     Gitk requires at least Tcl/Tk 8.4."]
9850    exit 1
9851}
9852
9853# defaults...
9854set wrcomcmd "git diff-tree --stdin -p --pretty"
9855
9856set gitencoding {}
9857catch {
9858    set gitencoding [exec git config --get i18n.commitencoding]
9859}
9860if {$gitencoding == ""} {
9861    set gitencoding "utf-8"
9862}
9863set tclencoding [tcl_encoding $gitencoding]
9864if {$tclencoding == {}} {
9865    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
9866}
9867
9868set gui_encoding [encoding system]
9869catch {
9870        set gui_encoding [exec git config --get gui.encoding]
9871}
9872
9873set mainfont {Helvetica 9}
9874set textfont {Courier 9}
9875set uifont {Helvetica 9 bold}
9876set tabstop 8
9877set findmergefiles 0
9878set maxgraphpct 50
9879set maxwidth 16
9880set revlistorder 0
9881set fastdate 0
9882set uparrowlen 5
9883set downarrowlen 5
9884set mingaplen 100
9885set cmitmode "patch"
9886set wrapcomment "none"
9887set showneartags 1
9888set maxrefs 20
9889set maxlinelen 200
9890set showlocalchanges 1
9891set limitdiffs 1
9892set datetimeformat "%Y-%m-%d %H:%M:%S"
9893set autoselect 1
9894
9895set extdifftool "meld"
9896
9897set colors {green red blue magenta darkgrey brown orange}
9898set bgcolor white
9899set fgcolor black
9900set diffcolors {red "#00a000" blue}
9901set diffcontext 3
9902set ignorespace 0
9903set selectbgcolor gray85
9904
9905set circlecolors {white blue gray blue blue}
9906
9907# button for popping up context menus
9908if {[tk windowingsystem] eq "aqua"} {
9909    set ctxbut <Button-2>
9910} else {
9911    set ctxbut <Button-3>
9912}
9913
9914## For msgcat loading, first locate the installation location.
9915if { [info exists ::env(GITK_MSGSDIR)] } {
9916    ## Msgsdir was manually set in the environment.
9917    set gitk_msgsdir $::env(GITK_MSGSDIR)
9918} else {
9919    ## Let's guess the prefix from argv0.
9920    set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
9921    set gitk_libdir [file join $gitk_prefix share gitk lib]
9922    set gitk_msgsdir [file join $gitk_libdir msgs]
9923    unset gitk_prefix
9924}
9925
9926## Internationalization (i18n) through msgcat and gettext. See
9927## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
9928package require msgcat
9929namespace import ::msgcat::mc
9930## And eventually load the actual message catalog
9931::msgcat::mcload $gitk_msgsdir
9932
9933catch {source ~/.gitk}
9934
9935font create optionfont -family sans-serif -size -12
9936
9937parsefont mainfont $mainfont
9938eval font create mainfont [fontflags mainfont]
9939eval font create mainfontbold [fontflags mainfont 1]
9940
9941parsefont textfont $textfont
9942eval font create textfont [fontflags textfont]
9943eval font create textfontbold [fontflags textfont 1]
9944
9945parsefont uifont $uifont
9946eval font create uifont [fontflags uifont]
9947
9948setoptions
9949
9950# check that we can find a .git directory somewhere...
9951if {[catch {set gitdir [gitdir]}]} {
9952    show_error {} . [mc "Cannot find a git repository here."]
9953    exit 1
9954}
9955if {![file isdirectory $gitdir]} {
9956    show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
9957    exit 1
9958}
9959
9960set selecthead {}
9961set selectheadid {}
9962
9963set revtreeargs {}
9964set cmdline_files {}
9965set i 0
9966set revtreeargscmd {}
9967foreach arg $argv {
9968    switch -glob -- $arg {
9969        "" { }
9970        "--" {
9971            set cmdline_files [lrange $argv [expr {$i + 1}] end]
9972            break
9973        }
9974        "--select-commit=*" {
9975            set selecthead [string range $arg 16 end]
9976        }
9977        "--argscmd=*" {
9978            set revtreeargscmd [string range $arg 10 end]
9979        }
9980        default {
9981            lappend revtreeargs $arg
9982        }
9983    }
9984    incr i
9985}
9986
9987if {$selecthead eq "HEAD"} {
9988    set selecthead {}
9989}
9990
9991if {$i >= [llength $argv] && $revtreeargs ne {}} {
9992    # no -- on command line, but some arguments (other than --argscmd)
9993    if {[catch {
9994        set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
9995        set cmdline_files [split $f "\n"]
9996        set n [llength $cmdline_files]
9997        set revtreeargs [lrange $revtreeargs 0 end-$n]
9998        # Unfortunately git rev-parse doesn't produce an error when
9999        # something is both a revision and a filename.  To be consistent
10000        # with git log and git rev-list, check revtreeargs for filenames.
10001        foreach arg $revtreeargs {
10002            if {[file exists $arg]} {
10003                show_error {} . [mc "Ambiguous argument '%s': both revision\
10004                                 and filename" $arg]
10005                exit 1
10006            }
10007        }
10008    } err]} {
10009        # unfortunately we get both stdout and stderr in $err,
10010        # so look for "fatal:".
10011        set i [string first "fatal:" $err]
10012        if {$i > 0} {
10013            set err [string range $err [expr {$i + 6}] end]
10014        }
10015        show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
10016        exit 1
10017    }
10018}
10019
10020set nullid "0000000000000000000000000000000000000000"
10021set nullid2 "0000000000000000000000000000000000000001"
10022set nullfile "/dev/null"
10023
10024set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
10025
10026set runq {}
10027set history {}
10028set historyindex 0
10029set fh_serial 0
10030set nhl_names {}
10031set highlight_paths {}
10032set findpattern {}
10033set searchdirn -forwards
10034set boldrows {}
10035set boldnamerows {}
10036set diffelide {0 0}
10037set markingmatches 0
10038set linkentercount 0
10039set need_redisplay 0
10040set nrows_drawn 0
10041set firsttabstop 0
10042
10043set nextviewnum 1
10044set curview 0
10045set selectedview 0
10046set selectedhlview [mc "None"]
10047set highlight_related [mc "None"]
10048set highlight_files {}
10049set viewfiles(0) {}
10050set viewperm(0) 0
10051set viewargs(0) {}
10052set viewargscmd(0) {}
10053
10054set selectedline {}
10055set numcommits 0
10056set loginstance 0
10057set cmdlineok 0
10058set stopped 0
10059set stuffsaved 0
10060set patchnum 0
10061set lserial 0
10062set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
10063setcoords
10064makewindow
10065# wait for the window to become visible
10066tkwait visibility .
10067wm title . "[file tail $argv0]: [file tail [pwd]]"
10068readrefs
10069
10070if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
10071    # create a view for the files/dirs specified on the command line
10072    set curview 1
10073    set selectedview 1
10074    set nextviewnum 2
10075    set viewname(1) [mc "Command line"]
10076    set viewfiles(1) $cmdline_files
10077    set viewargs(1) $revtreeargs
10078    set viewargscmd(1) $revtreeargscmd
10079    set viewperm(1) 0
10080    set vdatemode(1) 0
10081    addviewmenu 1
10082    .bar.view entryconf [mc "Edit view..."] -state normal
10083    .bar.view entryconf [mc "Delete view"] -state normal
10084}
10085
10086if {[info exists permviews]} {
10087    foreach v $permviews {
10088        set n $nextviewnum
10089        incr nextviewnum
10090        set viewname($n) [lindex $v 0]
10091        set viewfiles($n) [lindex $v 1]
10092        set viewargs($n) [lindex $v 2]
10093        set viewargscmd($n) [lindex $v 3]
10094        set viewperm($n) 1
10095        addviewmenu $n
10096    }
10097}
10098getcommits {}