08ff7ceb2bddd7d12df43ef0f5fc847d7b3e8bb4
   1#!/bin/sh
   2# Tcl ignores the next line -*- tcl -*- \
   3exec wish "$0" -- "$@"
   4
   5# Copyright © 2005-2014 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
  10package require Tk
  11
  12proc hasworktree {} {
  13    return [expr {[exec git rev-parse --is-bare-repository] == "false" &&
  14                  [exec git rev-parse --is-inside-git-dir] == "false"}]
  15}
  16
  17proc reponame {} {
  18    global gitdir
  19    set n [file normalize $gitdir]
  20    if {[string match "*/.git" $n]} {
  21        set n [string range $n 0 end-5]
  22    }
  23    return [file tail $n]
  24}
  25
  26proc gitworktree {} {
  27    variable _gitworktree
  28    if {[info exists _gitworktree]} {
  29        return $_gitworktree
  30    }
  31    # v1.7.0 introduced --show-toplevel to return the canonical work-tree
  32    if {[catch {set _gitworktree [exec git rev-parse --show-toplevel]}]} {
  33        # try to set work tree from environment, core.worktree or use
  34        # cdup to obtain a relative path to the top of the worktree. If
  35        # run from the top, the ./ prefix ensures normalize expands pwd.
  36        if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
  37            catch {set _gitworktree [exec git config --get core.worktree]}
  38            if {$_gitworktree eq ""} {
  39                set _gitworktree [file normalize ./[exec git rev-parse --show-cdup]]
  40            }
  41        }
  42    }
  43    return $_gitworktree
  44}
  45
  46# A simple scheduler for compute-intensive stuff.
  47# The aim is to make sure that event handlers for GUI actions can
  48# run at least every 50-100 ms.  Unfortunately fileevent handlers are
  49# run before X event handlers, so reading from a fast source can
  50# make the GUI completely unresponsive.
  51proc run args {
  52    global isonrunq runq currunq
  53
  54    set script $args
  55    if {[info exists isonrunq($script)]} return
  56    if {$runq eq {} && ![info exists currunq]} {
  57        after idle dorunq
  58    }
  59    lappend runq [list {} $script]
  60    set isonrunq($script) 1
  61}
  62
  63proc filerun {fd script} {
  64    fileevent $fd readable [list filereadable $fd $script]
  65}
  66
  67proc filereadable {fd script} {
  68    global runq currunq
  69
  70    fileevent $fd readable {}
  71    if {$runq eq {} && ![info exists currunq]} {
  72        after idle dorunq
  73    }
  74    lappend runq [list $fd $script]
  75}
  76
  77proc nukefile {fd} {
  78    global runq
  79
  80    for {set i 0} {$i < [llength $runq]} {} {
  81        if {[lindex $runq $i 0] eq $fd} {
  82            set runq [lreplace $runq $i $i]
  83        } else {
  84            incr i
  85        }
  86    }
  87}
  88
  89proc dorunq {} {
  90    global isonrunq runq currunq
  91
  92    set tstart [clock clicks -milliseconds]
  93    set t0 $tstart
  94    while {[llength $runq] > 0} {
  95        set fd [lindex $runq 0 0]
  96        set script [lindex $runq 0 1]
  97        set currunq [lindex $runq 0]
  98        set runq [lrange $runq 1 end]
  99        set repeat [eval $script]
 100        unset currunq
 101        set t1 [clock clicks -milliseconds]
 102        set t [expr {$t1 - $t0}]
 103        if {$repeat ne {} && $repeat} {
 104            if {$fd eq {} || $repeat == 2} {
 105                # script returns 1 if it wants to be readded
 106                # file readers return 2 if they could do more straight away
 107                lappend runq [list $fd $script]
 108            } else {
 109                fileevent $fd readable [list filereadable $fd $script]
 110            }
 111        } elseif {$fd eq {}} {
 112            unset isonrunq($script)
 113        }
 114        set t0 $t1
 115        if {$t1 - $tstart >= 80} break
 116    }
 117    if {$runq ne {}} {
 118        after idle dorunq
 119    }
 120}
 121
 122proc reg_instance {fd} {
 123    global commfd leftover loginstance
 124
 125    set i [incr loginstance]
 126    set commfd($i) $fd
 127    set leftover($i) {}
 128    return $i
 129}
 130
 131proc unmerged_files {files} {
 132    global nr_unmerged
 133
 134    # find the list of unmerged files
 135    set mlist {}
 136    set nr_unmerged 0
 137    if {[catch {
 138        set fd [open "| git ls-files -u" r]
 139    } err]} {
 140        show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
 141        exit 1
 142    }
 143    while {[gets $fd line] >= 0} {
 144        set i [string first "\t" $line]
 145        if {$i < 0} continue
 146        set fname [string range $line [expr {$i+1}] end]
 147        if {[lsearch -exact $mlist $fname] >= 0} continue
 148        incr nr_unmerged
 149        if {$files eq {} || [path_filter $files $fname]} {
 150            lappend mlist $fname
 151        }
 152    }
 153    catch {close $fd}
 154    return $mlist
 155}
 156
 157proc parseviewargs {n arglist} {
 158    global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs env
 159    global vinlinediff
 160    global worddiff git_version
 161
 162    set vdatemode($n) 0
 163    set vmergeonly($n) 0
 164    set vinlinediff($n) 0
 165    set glflags {}
 166    set diffargs {}
 167    set nextisval 0
 168    set revargs {}
 169    set origargs $arglist
 170    set allknown 1
 171    set filtered 0
 172    set i -1
 173    foreach arg $arglist {
 174        incr i
 175        if {$nextisval} {
 176            lappend glflags $arg
 177            set nextisval 0
 178            continue
 179        }
 180        switch -glob -- $arg {
 181            "-d" -
 182            "--date-order" {
 183                set vdatemode($n) 1
 184                # remove from origargs in case we hit an unknown option
 185                set origargs [lreplace $origargs $i $i]
 186                incr i -1
 187            }
 188            "-[puabwcrRBMC]" -
 189            "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
 190            "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
 191            "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
 192            "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
 193            "--ignore-space-change" - "-U*" - "--unified=*" {
 194                # These request or affect diff output, which we don't want.
 195                # Some could be used to set our defaults for diff display.
 196                lappend diffargs $arg
 197            }
 198            "--raw" - "--patch-with-raw" - "--patch-with-stat" -
 199            "--name-only" - "--name-status" - "--color" -
 200            "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
 201            "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
 202            "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
 203            "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
 204            "--objects" - "--objects-edge" - "--reverse" {
 205                # These cause our parsing of git log's output to fail, or else
 206                # they're options we want to set ourselves, so ignore them.
 207            }
 208            "--color-words*" - "--word-diff=color" {
 209                # These trigger a word diff in the console interface,
 210                # so help the user by enabling our own support
 211                if {[package vcompare $git_version "1.7.2"] >= 0} {
 212                    set worddiff [mc "Color words"]
 213                }
 214            }
 215            "--word-diff*" {
 216                if {[package vcompare $git_version "1.7.2"] >= 0} {
 217                    set worddiff [mc "Markup words"]
 218                }
 219            }
 220            "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
 221            "--check" - "--exit-code" - "--quiet" - "--topo-order" -
 222            "--full-history" - "--dense" - "--sparse" -
 223            "--follow" - "--left-right" - "--encoding=*" {
 224                # These are harmless, and some are even useful
 225                lappend glflags $arg
 226            }
 227            "--diff-filter=*" - "--no-merges" - "--unpacked" -
 228            "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
 229            "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
 230            "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
 231            "--remove-empty" - "--first-parent" - "--cherry-pick" -
 232            "-S*" - "-G*" - "--pickaxe-all" - "--pickaxe-regex" -
 233            "--simplify-by-decoration" {
 234                # These mean that we get a subset of the commits
 235                set filtered 1
 236                lappend glflags $arg
 237            }
 238            "-L*" {
 239                # Line-log with 'stuck' argument (unstuck form is
 240                # not supported)
 241                set filtered 1
 242                set vinlinediff($n) 1
 243                set allknown 0
 244                lappend glflags $arg
 245            }
 246            "-n" {
 247                # This appears to be the only one that has a value as a
 248                # separate word following it
 249                set filtered 1
 250                set nextisval 1
 251                lappend glflags $arg
 252            }
 253            "--not" - "--all" {
 254                lappend revargs $arg
 255            }
 256            "--merge" {
 257                set vmergeonly($n) 1
 258                # git rev-parse doesn't understand --merge
 259                lappend revargs --gitk-symmetric-diff-marker MERGE_HEAD...HEAD
 260            }
 261            "--no-replace-objects" {
 262                set env(GIT_NO_REPLACE_OBJECTS) "1"
 263            }
 264            "-*" {
 265                # Other flag arguments including -<n>
 266                if {[string is digit -strict [string range $arg 1 end]]} {
 267                    set filtered 1
 268                } else {
 269                    # a flag argument that we don't recognize;
 270                    # that means we can't optimize
 271                    set allknown 0
 272                }
 273                lappend glflags $arg
 274            }
 275            default {
 276                # Non-flag arguments specify commits or ranges of commits
 277                if {[string match "*...*" $arg]} {
 278                    lappend revargs --gitk-symmetric-diff-marker
 279                }
 280                lappend revargs $arg
 281            }
 282        }
 283    }
 284    set vdflags($n) $diffargs
 285    set vflags($n) $glflags
 286    set vrevs($n) $revargs
 287    set vfiltered($n) $filtered
 288    set vorigargs($n) $origargs
 289    return $allknown
 290}
 291
 292proc parseviewrevs {view revs} {
 293    global vposids vnegids
 294
 295    if {$revs eq {}} {
 296        set revs HEAD
 297    } elseif {[lsearch -exact $revs --all] >= 0} {
 298        lappend revs HEAD
 299    }
 300    if {[catch {set ids [eval exec git rev-parse $revs]} err]} {
 301        # we get stdout followed by stderr in $err
 302        # for an unknown rev, git rev-parse echoes it and then errors out
 303        set errlines [split $err "\n"]
 304        set badrev {}
 305        for {set l 0} {$l < [llength $errlines]} {incr l} {
 306            set line [lindex $errlines $l]
 307            if {!([string length $line] == 40 && [string is xdigit $line])} {
 308                if {[string match "fatal:*" $line]} {
 309                    if {[string match "fatal: ambiguous argument*" $line]
 310                        && $badrev ne {}} {
 311                        if {[llength $badrev] == 1} {
 312                            set err "unknown revision $badrev"
 313                        } else {
 314                            set err "unknown revisions: [join $badrev ", "]"
 315                        }
 316                    } else {
 317                        set err [join [lrange $errlines $l end] "\n"]
 318                    }
 319                    break
 320                }
 321                lappend badrev $line
 322            }
 323        }
 324        error_popup "[mc "Error parsing revisions:"] $err"
 325        return {}
 326    }
 327    set ret {}
 328    set pos {}
 329    set neg {}
 330    set sdm 0
 331    foreach id [split $ids "\n"] {
 332        if {$id eq "--gitk-symmetric-diff-marker"} {
 333            set sdm 4
 334        } elseif {[string match "^*" $id]} {
 335            if {$sdm != 1} {
 336                lappend ret $id
 337                if {$sdm == 3} {
 338                    set sdm 0
 339                }
 340            }
 341            lappend neg [string range $id 1 end]
 342        } else {
 343            if {$sdm != 2} {
 344                lappend ret $id
 345            } else {
 346                lset ret end $id...[lindex $ret end]
 347            }
 348            lappend pos $id
 349        }
 350        incr sdm -1
 351    }
 352    set vposids($view) $pos
 353    set vnegids($view) $neg
 354    return $ret
 355}
 356
 357# Start off a git log process and arrange to read its output
 358proc start_rev_list {view} {
 359    global startmsecs commitidx viewcomplete curview
 360    global tclencoding
 361    global viewargs viewargscmd viewfiles vfilelimit
 362    global showlocalchanges
 363    global viewactive viewinstances vmergeonly
 364    global mainheadid viewmainheadid viewmainheadid_orig
 365    global vcanopt vflags vrevs vorigargs
 366    global show_notes
 367
 368    set startmsecs [clock clicks -milliseconds]
 369    set commitidx($view) 0
 370    # these are set this way for the error exits
 371    set viewcomplete($view) 1
 372    set viewactive($view) 0
 373    varcinit $view
 374
 375    set args $viewargs($view)
 376    if {$viewargscmd($view) ne {}} {
 377        if {[catch {
 378            set str [exec sh -c $viewargscmd($view)]
 379        } err]} {
 380            error_popup "[mc "Error executing --argscmd command:"] $err"
 381            return 0
 382        }
 383        set args [concat $args [split $str "\n"]]
 384    }
 385    set vcanopt($view) [parseviewargs $view $args]
 386
 387    set files $viewfiles($view)
 388    if {$vmergeonly($view)} {
 389        set files [unmerged_files $files]
 390        if {$files eq {}} {
 391            global nr_unmerged
 392            if {$nr_unmerged == 0} {
 393                error_popup [mc "No files selected: --merge specified but\
 394                             no files are unmerged."]
 395            } else {
 396                error_popup [mc "No files selected: --merge specified but\
 397                             no unmerged files are within file limit."]
 398            }
 399            return 0
 400        }
 401    }
 402    set vfilelimit($view) $files
 403
 404    if {$vcanopt($view)} {
 405        set revs [parseviewrevs $view $vrevs($view)]
 406        if {$revs eq {}} {
 407            return 0
 408        }
 409        set args [concat $vflags($view) $revs]
 410    } else {
 411        set args $vorigargs($view)
 412    }
 413
 414    if {[catch {
 415        set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
 416                        --parents --boundary $args "--" $files] r]
 417    } err]} {
 418        error_popup "[mc "Error executing git log:"] $err"
 419        return 0
 420    }
 421    set i [reg_instance $fd]
 422    set viewinstances($view) [list $i]
 423    set viewmainheadid($view) $mainheadid
 424    set viewmainheadid_orig($view) $mainheadid
 425    if {$files ne {} && $mainheadid ne {}} {
 426        get_viewmainhead $view
 427    }
 428    if {$showlocalchanges && $viewmainheadid($view) ne {}} {
 429        interestedin $viewmainheadid($view) dodiffindex
 430    }
 431    fconfigure $fd -blocking 0 -translation lf -eofchar {}
 432    if {$tclencoding != {}} {
 433        fconfigure $fd -encoding $tclencoding
 434    }
 435    filerun $fd [list getcommitlines $fd $i $view 0]
 436    nowbusy $view [mc "Reading"]
 437    set viewcomplete($view) 0
 438    set viewactive($view) 1
 439    return 1
 440}
 441
 442proc stop_instance {inst} {
 443    global commfd leftover
 444
 445    set fd $commfd($inst)
 446    catch {
 447        set pid [pid $fd]
 448
 449        if {$::tcl_platform(platform) eq {windows}} {
 450            exec taskkill /pid $pid
 451        } else {
 452            exec kill $pid
 453        }
 454    }
 455    catch {close $fd}
 456    nukefile $fd
 457    unset commfd($inst)
 458    unset leftover($inst)
 459}
 460
 461proc stop_backends {} {
 462    global commfd
 463
 464    foreach inst [array names commfd] {
 465        stop_instance $inst
 466    }
 467}
 468
 469proc stop_rev_list {view} {
 470    global viewinstances
 471
 472    foreach inst $viewinstances($view) {
 473        stop_instance $inst
 474    }
 475    set viewinstances($view) {}
 476}
 477
 478proc reset_pending_select {selid} {
 479    global pending_select mainheadid selectheadid
 480
 481    if {$selid ne {}} {
 482        set pending_select $selid
 483    } elseif {$selectheadid ne {}} {
 484        set pending_select $selectheadid
 485    } else {
 486        set pending_select $mainheadid
 487    }
 488}
 489
 490proc getcommits {selid} {
 491    global canv curview need_redisplay viewactive
 492
 493    initlayout
 494    if {[start_rev_list $curview]} {
 495        reset_pending_select $selid
 496        show_status [mc "Reading commits..."]
 497        set need_redisplay 1
 498    } else {
 499        show_status [mc "No commits selected"]
 500    }
 501}
 502
 503proc updatecommits {} {
 504    global curview vcanopt vorigargs vfilelimit viewinstances
 505    global viewactive viewcomplete tclencoding
 506    global startmsecs showneartags showlocalchanges
 507    global mainheadid viewmainheadid viewmainheadid_orig pending_select
 508    global hasworktree
 509    global varcid vposids vnegids vflags vrevs
 510    global show_notes
 511
 512    set hasworktree [hasworktree]
 513    rereadrefs
 514    set view $curview
 515    if {$mainheadid ne $viewmainheadid_orig($view)} {
 516        if {$showlocalchanges} {
 517            dohidelocalchanges
 518        }
 519        set viewmainheadid($view) $mainheadid
 520        set viewmainheadid_orig($view) $mainheadid
 521        if {$vfilelimit($view) ne {}} {
 522            get_viewmainhead $view
 523        }
 524    }
 525    if {$showlocalchanges} {
 526        doshowlocalchanges
 527    }
 528    if {$vcanopt($view)} {
 529        set oldpos $vposids($view)
 530        set oldneg $vnegids($view)
 531        set revs [parseviewrevs $view $vrevs($view)]
 532        if {$revs eq {}} {
 533            return
 534        }
 535        # note: getting the delta when negative refs change is hard,
 536        # and could require multiple git log invocations, so in that
 537        # case we ask git log for all the commits (not just the delta)
 538        if {$oldneg eq $vnegids($view)} {
 539            set newrevs {}
 540            set npos 0
 541            # take out positive refs that we asked for before or
 542            # that we have already seen
 543            foreach rev $revs {
 544                if {[string length $rev] == 40} {
 545                    if {[lsearch -exact $oldpos $rev] < 0
 546                        && ![info exists varcid($view,$rev)]} {
 547                        lappend newrevs $rev
 548                        incr npos
 549                    }
 550                } else {
 551                    lappend $newrevs $rev
 552                }
 553            }
 554            if {$npos == 0} return
 555            set revs $newrevs
 556            set vposids($view) [lsort -unique [concat $oldpos $vposids($view)]]
 557        }
 558        set args [concat $vflags($view) $revs --not $oldpos]
 559    } else {
 560        set args $vorigargs($view)
 561    }
 562    if {[catch {
 563        set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
 564                        --parents --boundary $args "--" $vfilelimit($view)] r]
 565    } err]} {
 566        error_popup "[mc "Error executing git log:"] $err"
 567        return
 568    }
 569    if {$viewactive($view) == 0} {
 570        set startmsecs [clock clicks -milliseconds]
 571    }
 572    set i [reg_instance $fd]
 573    lappend viewinstances($view) $i
 574    fconfigure $fd -blocking 0 -translation lf -eofchar {}
 575    if {$tclencoding != {}} {
 576        fconfigure $fd -encoding $tclencoding
 577    }
 578    filerun $fd [list getcommitlines $fd $i $view 1]
 579    incr viewactive($view)
 580    set viewcomplete($view) 0
 581    reset_pending_select {}
 582    nowbusy $view [mc "Reading"]
 583    if {$showneartags} {
 584        getallcommits
 585    }
 586}
 587
 588proc reloadcommits {} {
 589    global curview viewcomplete selectedline currentid thickerline
 590    global showneartags treediffs commitinterest cached_commitrow
 591    global targetid
 592
 593    set selid {}
 594    if {$selectedline ne {}} {
 595        set selid $currentid
 596    }
 597
 598    if {!$viewcomplete($curview)} {
 599        stop_rev_list $curview
 600    }
 601    resetvarcs $curview
 602    set selectedline {}
 603    unset -nocomplain currentid
 604    unset -nocomplain thickerline
 605    unset -nocomplain treediffs
 606    readrefs
 607    changedrefs
 608    if {$showneartags} {
 609        getallcommits
 610    }
 611    clear_display
 612    unset -nocomplain commitinterest
 613    unset -nocomplain cached_commitrow
 614    unset -nocomplain targetid
 615    setcanvscroll
 616    getcommits $selid
 617    return 0
 618}
 619
 620# This makes a string representation of a positive integer which
 621# sorts as a string in numerical order
 622proc strrep {n} {
 623    if {$n < 16} {
 624        return [format "%x" $n]
 625    } elseif {$n < 256} {
 626        return [format "x%.2x" $n]
 627    } elseif {$n < 65536} {
 628        return [format "y%.4x" $n]
 629    }
 630    return [format "z%.8x" $n]
 631}
 632
 633# Procedures used in reordering commits from git log (without
 634# --topo-order) into the order for display.
 635
 636proc varcinit {view} {
 637    global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
 638    global vtokmod varcmod vrowmod varcix vlastins
 639
 640    set varcstart($view) {{}}
 641    set vupptr($view) {0}
 642    set vdownptr($view) {0}
 643    set vleftptr($view) {0}
 644    set vbackptr($view) {0}
 645    set varctok($view) {{}}
 646    set varcrow($view) {{}}
 647    set vtokmod($view) {}
 648    set varcmod($view) 0
 649    set vrowmod($view) 0
 650    set varcix($view) {{}}
 651    set vlastins($view) {0}
 652}
 653
 654proc resetvarcs {view} {
 655    global varcid varccommits parents children vseedcount ordertok
 656    global vshortids
 657
 658    foreach vid [array names varcid $view,*] {
 659        unset varcid($vid)
 660        unset children($vid)
 661        unset parents($vid)
 662    }
 663    foreach vid [array names vshortids $view,*] {
 664        unset vshortids($vid)
 665    }
 666    # some commits might have children but haven't been seen yet
 667    foreach vid [array names children $view,*] {
 668        unset children($vid)
 669    }
 670    foreach va [array names varccommits $view,*] {
 671        unset varccommits($va)
 672    }
 673    foreach vd [array names vseedcount $view,*] {
 674        unset vseedcount($vd)
 675    }
 676    unset -nocomplain ordertok
 677}
 678
 679# returns a list of the commits with no children
 680proc seeds {v} {
 681    global vdownptr vleftptr varcstart
 682
 683    set ret {}
 684    set a [lindex $vdownptr($v) 0]
 685    while {$a != 0} {
 686        lappend ret [lindex $varcstart($v) $a]
 687        set a [lindex $vleftptr($v) $a]
 688    }
 689    return $ret
 690}
 691
 692proc newvarc {view id} {
 693    global varcid varctok parents children vdatemode
 694    global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
 695    global commitdata commitinfo vseedcount varccommits vlastins
 696
 697    set a [llength $varctok($view)]
 698    set vid $view,$id
 699    if {[llength $children($vid)] == 0 || $vdatemode($view)} {
 700        if {![info exists commitinfo($id)]} {
 701            parsecommit $id $commitdata($id) 1
 702        }
 703        set cdate [lindex [lindex $commitinfo($id) 4] 0]
 704        if {![string is integer -strict $cdate]} {
 705            set cdate 0
 706        }
 707        if {![info exists vseedcount($view,$cdate)]} {
 708            set vseedcount($view,$cdate) -1
 709        }
 710        set c [incr vseedcount($view,$cdate)]
 711        set cdate [expr {$cdate ^ 0xffffffff}]
 712        set tok "s[strrep $cdate][strrep $c]"
 713    } else {
 714        set tok {}
 715    }
 716    set ka 0
 717    if {[llength $children($vid)] > 0} {
 718        set kid [lindex $children($vid) end]
 719        set k $varcid($view,$kid)
 720        if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
 721            set ki $kid
 722            set ka $k
 723            set tok [lindex $varctok($view) $k]
 724        }
 725    }
 726    if {$ka != 0} {
 727        set i [lsearch -exact $parents($view,$ki) $id]
 728        set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
 729        append tok [strrep $j]
 730    }
 731    set c [lindex $vlastins($view) $ka]
 732    if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
 733        set c $ka
 734        set b [lindex $vdownptr($view) $ka]
 735    } else {
 736        set b [lindex $vleftptr($view) $c]
 737    }
 738    while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
 739        set c $b
 740        set b [lindex $vleftptr($view) $c]
 741    }
 742    if {$c == $ka} {
 743        lset vdownptr($view) $ka $a
 744        lappend vbackptr($view) 0
 745    } else {
 746        lset vleftptr($view) $c $a
 747        lappend vbackptr($view) $c
 748    }
 749    lset vlastins($view) $ka $a
 750    lappend vupptr($view) $ka
 751    lappend vleftptr($view) $b
 752    if {$b != 0} {
 753        lset vbackptr($view) $b $a
 754    }
 755    lappend varctok($view) $tok
 756    lappend varcstart($view) $id
 757    lappend vdownptr($view) 0
 758    lappend varcrow($view) {}
 759    lappend varcix($view) {}
 760    set varccommits($view,$a) {}
 761    lappend vlastins($view) 0
 762    return $a
 763}
 764
 765proc splitvarc {p v} {
 766    global varcid varcstart varccommits varctok vtokmod
 767    global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
 768
 769    set oa $varcid($v,$p)
 770    set otok [lindex $varctok($v) $oa]
 771    set ac $varccommits($v,$oa)
 772    set i [lsearch -exact $varccommits($v,$oa) $p]
 773    if {$i <= 0} return
 774    set na [llength $varctok($v)]
 775    # "%" sorts before "0"...
 776    set tok "$otok%[strrep $i]"
 777    lappend varctok($v) $tok
 778    lappend varcrow($v) {}
 779    lappend varcix($v) {}
 780    set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
 781    set varccommits($v,$na) [lrange $ac $i end]
 782    lappend varcstart($v) $p
 783    foreach id $varccommits($v,$na) {
 784        set varcid($v,$id) $na
 785    }
 786    lappend vdownptr($v) [lindex $vdownptr($v) $oa]
 787    lappend vlastins($v) [lindex $vlastins($v) $oa]
 788    lset vdownptr($v) $oa $na
 789    lset vlastins($v) $oa 0
 790    lappend vupptr($v) $oa
 791    lappend vleftptr($v) 0
 792    lappend vbackptr($v) 0
 793    for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
 794        lset vupptr($v) $b $na
 795    }
 796    if {[string compare $otok $vtokmod($v)] <= 0} {
 797        modify_arc $v $oa
 798    }
 799}
 800
 801proc renumbervarc {a v} {
 802    global parents children varctok varcstart varccommits
 803    global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
 804
 805    set t1 [clock clicks -milliseconds]
 806    set todo {}
 807    set isrelated($a) 1
 808    set kidchanged($a) 1
 809    set ntot 0
 810    while {$a != 0} {
 811        if {[info exists isrelated($a)]} {
 812            lappend todo $a
 813            set id [lindex $varccommits($v,$a) end]
 814            foreach p $parents($v,$id) {
 815                if {[info exists varcid($v,$p)]} {
 816                    set isrelated($varcid($v,$p)) 1
 817                }
 818            }
 819        }
 820        incr ntot
 821        set b [lindex $vdownptr($v) $a]
 822        if {$b == 0} {
 823            while {$a != 0} {
 824                set b [lindex $vleftptr($v) $a]
 825                if {$b != 0} break
 826                set a [lindex $vupptr($v) $a]
 827            }
 828        }
 829        set a $b
 830    }
 831    foreach a $todo {
 832        if {![info exists kidchanged($a)]} continue
 833        set id [lindex $varcstart($v) $a]
 834        if {[llength $children($v,$id)] > 1} {
 835            set children($v,$id) [lsort -command [list vtokcmp $v] \
 836                                      $children($v,$id)]
 837        }
 838        set oldtok [lindex $varctok($v) $a]
 839        if {!$vdatemode($v)} {
 840            set tok {}
 841        } else {
 842            set tok $oldtok
 843        }
 844        set ka 0
 845        set kid [last_real_child $v,$id]
 846        if {$kid ne {}} {
 847            set k $varcid($v,$kid)
 848            if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
 849                set ki $kid
 850                set ka $k
 851                set tok [lindex $varctok($v) $k]
 852            }
 853        }
 854        if {$ka != 0} {
 855            set i [lsearch -exact $parents($v,$ki) $id]
 856            set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
 857            append tok [strrep $j]
 858        }
 859        if {$tok eq $oldtok} {
 860            continue
 861        }
 862        set id [lindex $varccommits($v,$a) end]
 863        foreach p $parents($v,$id) {
 864            if {[info exists varcid($v,$p)]} {
 865                set kidchanged($varcid($v,$p)) 1
 866            } else {
 867                set sortkids($p) 1
 868            }
 869        }
 870        lset varctok($v) $a $tok
 871        set b [lindex $vupptr($v) $a]
 872        if {$b != $ka} {
 873            if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
 874                modify_arc $v $ka
 875            }
 876            if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
 877                modify_arc $v $b
 878            }
 879            set c [lindex $vbackptr($v) $a]
 880            set d [lindex $vleftptr($v) $a]
 881            if {$c == 0} {
 882                lset vdownptr($v) $b $d
 883            } else {
 884                lset vleftptr($v) $c $d
 885            }
 886            if {$d != 0} {
 887                lset vbackptr($v) $d $c
 888            }
 889            if {[lindex $vlastins($v) $b] == $a} {
 890                lset vlastins($v) $b $c
 891            }
 892            lset vupptr($v) $a $ka
 893            set c [lindex $vlastins($v) $ka]
 894            if {$c == 0 || \
 895                    [string compare $tok [lindex $varctok($v) $c]] < 0} {
 896                set c $ka
 897                set b [lindex $vdownptr($v) $ka]
 898            } else {
 899                set b [lindex $vleftptr($v) $c]
 900            }
 901            while {$b != 0 && \
 902                      [string compare $tok [lindex $varctok($v) $b]] >= 0} {
 903                set c $b
 904                set b [lindex $vleftptr($v) $c]
 905            }
 906            if {$c == $ka} {
 907                lset vdownptr($v) $ka $a
 908                lset vbackptr($v) $a 0
 909            } else {
 910                lset vleftptr($v) $c $a
 911                lset vbackptr($v) $a $c
 912            }
 913            lset vleftptr($v) $a $b
 914            if {$b != 0} {
 915                lset vbackptr($v) $b $a
 916            }
 917            lset vlastins($v) $ka $a
 918        }
 919    }
 920    foreach id [array names sortkids] {
 921        if {[llength $children($v,$id)] > 1} {
 922            set children($v,$id) [lsort -command [list vtokcmp $v] \
 923                                      $children($v,$id)]
 924        }
 925    }
 926    set t2 [clock clicks -milliseconds]
 927    #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
 928}
 929
 930# Fix up the graph after we have found out that in view $v,
 931# $p (a commit that we have already seen) is actually the parent
 932# of the last commit in arc $a.
 933proc fix_reversal {p a v} {
 934    global varcid varcstart varctok vupptr
 935
 936    set pa $varcid($v,$p)
 937    if {$p ne [lindex $varcstart($v) $pa]} {
 938        splitvarc $p $v
 939        set pa $varcid($v,$p)
 940    }
 941    # seeds always need to be renumbered
 942    if {[lindex $vupptr($v) $pa] == 0 ||
 943        [string compare [lindex $varctok($v) $a] \
 944             [lindex $varctok($v) $pa]] > 0} {
 945        renumbervarc $pa $v
 946    }
 947}
 948
 949proc insertrow {id p v} {
 950    global cmitlisted children parents varcid varctok vtokmod
 951    global varccommits ordertok commitidx numcommits curview
 952    global targetid targetrow vshortids
 953
 954    readcommit $id
 955    set vid $v,$id
 956    set cmitlisted($vid) 1
 957    set children($vid) {}
 958    set parents($vid) [list $p]
 959    set a [newvarc $v $id]
 960    set varcid($vid) $a
 961    lappend vshortids($v,[string range $id 0 3]) $id
 962    if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
 963        modify_arc $v $a
 964    }
 965    lappend varccommits($v,$a) $id
 966    set vp $v,$p
 967    if {[llength [lappend children($vp) $id]] > 1} {
 968        set children($vp) [lsort -command [list vtokcmp $v] $children($vp)]
 969        unset -nocomplain ordertok
 970    }
 971    fix_reversal $p $a $v
 972    incr commitidx($v)
 973    if {$v == $curview} {
 974        set numcommits $commitidx($v)
 975        setcanvscroll
 976        if {[info exists targetid]} {
 977            if {![comes_before $targetid $p]} {
 978                incr targetrow
 979            }
 980        }
 981    }
 982}
 983
 984proc insertfakerow {id p} {
 985    global varcid varccommits parents children cmitlisted
 986    global commitidx varctok vtokmod targetid targetrow curview numcommits
 987
 988    set v $curview
 989    set a $varcid($v,$p)
 990    set i [lsearch -exact $varccommits($v,$a) $p]
 991    if {$i < 0} {
 992        puts "oops: insertfakerow can't find [shortids $p] on arc $a"
 993        return
 994    }
 995    set children($v,$id) {}
 996    set parents($v,$id) [list $p]
 997    set varcid($v,$id) $a
 998    lappend children($v,$p) $id
 999    set cmitlisted($v,$id) 1
1000    set numcommits [incr commitidx($v)]
1001    # note we deliberately don't update varcstart($v) even if $i == 0
1002    set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
1003    modify_arc $v $a $i
1004    if {[info exists targetid]} {
1005        if {![comes_before $targetid $p]} {
1006            incr targetrow
1007        }
1008    }
1009    setcanvscroll
1010    drawvisible
1011}
1012
1013proc removefakerow {id} {
1014    global varcid varccommits parents children commitidx
1015    global varctok vtokmod cmitlisted currentid selectedline
1016    global targetid curview numcommits
1017
1018    set v $curview
1019    if {[llength $parents($v,$id)] != 1} {
1020        puts "oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
1021        return
1022    }
1023    set p [lindex $parents($v,$id) 0]
1024    set a $varcid($v,$id)
1025    set i [lsearch -exact $varccommits($v,$a) $id]
1026    if {$i < 0} {
1027        puts "oops: removefakerow can't find [shortids $id] on arc $a"
1028        return
1029    }
1030    unset varcid($v,$id)
1031    set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
1032    unset parents($v,$id)
1033    unset children($v,$id)
1034    unset cmitlisted($v,$id)
1035    set numcommits [incr commitidx($v) -1]
1036    set j [lsearch -exact $children($v,$p) $id]
1037    if {$j >= 0} {
1038        set children($v,$p) [lreplace $children($v,$p) $j $j]
1039    }
1040    modify_arc $v $a $i
1041    if {[info exist currentid] && $id eq $currentid} {
1042        unset currentid
1043        set selectedline {}
1044    }
1045    if {[info exists targetid] && $targetid eq $id} {
1046        set targetid $p
1047    }
1048    setcanvscroll
1049    drawvisible
1050}
1051
1052proc real_children {vp} {
1053    global children nullid nullid2
1054
1055    set kids {}
1056    foreach id $children($vp) {
1057        if {$id ne $nullid && $id ne $nullid2} {
1058            lappend kids $id
1059        }
1060    }
1061    return $kids
1062}
1063
1064proc first_real_child {vp} {
1065    global children nullid nullid2
1066
1067    foreach id $children($vp) {
1068        if {$id ne $nullid && $id ne $nullid2} {
1069            return $id
1070        }
1071    }
1072    return {}
1073}
1074
1075proc last_real_child {vp} {
1076    global children nullid nullid2
1077
1078    set kids $children($vp)
1079    for {set i [llength $kids]} {[incr i -1] >= 0} {} {
1080        set id [lindex $kids $i]
1081        if {$id ne $nullid && $id ne $nullid2} {
1082            return $id
1083        }
1084    }
1085    return {}
1086}
1087
1088proc vtokcmp {v a b} {
1089    global varctok varcid
1090
1091    return [string compare [lindex $varctok($v) $varcid($v,$a)] \
1092                [lindex $varctok($v) $varcid($v,$b)]]
1093}
1094
1095# This assumes that if lim is not given, the caller has checked that
1096# arc a's token is less than $vtokmod($v)
1097proc modify_arc {v a {lim {}}} {
1098    global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
1099
1100    if {$lim ne {}} {
1101        set c [string compare [lindex $varctok($v) $a] $vtokmod($v)]
1102        if {$c > 0} return
1103        if {$c == 0} {
1104            set r [lindex $varcrow($v) $a]
1105            if {$r ne {} && $vrowmod($v) <= $r + $lim} return
1106        }
1107    }
1108    set vtokmod($v) [lindex $varctok($v) $a]
1109    set varcmod($v) $a
1110    if {$v == $curview} {
1111        while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
1112            set a [lindex $vupptr($v) $a]
1113            set lim {}
1114        }
1115        set r 0
1116        if {$a != 0} {
1117            if {$lim eq {}} {
1118                set lim [llength $varccommits($v,$a)]
1119            }
1120            set r [expr {[lindex $varcrow($v) $a] + $lim}]
1121        }
1122        set vrowmod($v) $r
1123        undolayout $r
1124    }
1125}
1126
1127proc update_arcrows {v} {
1128    global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
1129    global varcid vrownum varcorder varcix varccommits
1130    global vupptr vdownptr vleftptr varctok
1131    global displayorder parentlist curview cached_commitrow
1132
1133    if {$vrowmod($v) == $commitidx($v)} return
1134    if {$v == $curview} {
1135        if {[llength $displayorder] > $vrowmod($v)} {
1136            set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
1137            set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
1138        }
1139        unset -nocomplain cached_commitrow
1140    }
1141    set narctot [expr {[llength $varctok($v)] - 1}]
1142    set a $varcmod($v)
1143    while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
1144        # go up the tree until we find something that has a row number,
1145        # or we get to a seed
1146        set a [lindex $vupptr($v) $a]
1147    }
1148    if {$a == 0} {
1149        set a [lindex $vdownptr($v) 0]
1150        if {$a == 0} return
1151        set vrownum($v) {0}
1152        set varcorder($v) [list $a]
1153        lset varcix($v) $a 0
1154        lset varcrow($v) $a 0
1155        set arcn 0
1156        set row 0
1157    } else {
1158        set arcn [lindex $varcix($v) $a]
1159        if {[llength $vrownum($v)] > $arcn + 1} {
1160            set vrownum($v) [lrange $vrownum($v) 0 $arcn]
1161            set varcorder($v) [lrange $varcorder($v) 0 $arcn]
1162        }
1163        set row [lindex $varcrow($v) $a]
1164    }
1165    while {1} {
1166        set p $a
1167        incr row [llength $varccommits($v,$a)]
1168        # go down if possible
1169        set b [lindex $vdownptr($v) $a]
1170        if {$b == 0} {
1171            # if not, go left, or go up until we can go left
1172            while {$a != 0} {
1173                set b [lindex $vleftptr($v) $a]
1174                if {$b != 0} break
1175                set a [lindex $vupptr($v) $a]
1176            }
1177            if {$a == 0} break
1178        }
1179        set a $b
1180        incr arcn
1181        lappend vrownum($v) $row
1182        lappend varcorder($v) $a
1183        lset varcix($v) $a $arcn
1184        lset varcrow($v) $a $row
1185    }
1186    set vtokmod($v) [lindex $varctok($v) $p]
1187    set varcmod($v) $p
1188    set vrowmod($v) $row
1189    if {[info exists currentid]} {
1190        set selectedline [rowofcommit $currentid]
1191    }
1192}
1193
1194# Test whether view $v contains commit $id
1195proc commitinview {id v} {
1196    global varcid
1197
1198    return [info exists varcid($v,$id)]
1199}
1200
1201# Return the row number for commit $id in the current view
1202proc rowofcommit {id} {
1203    global varcid varccommits varcrow curview cached_commitrow
1204    global varctok vtokmod
1205
1206    set v $curview
1207    if {![info exists varcid($v,$id)]} {
1208        puts "oops rowofcommit no arc for [shortids $id]"
1209        return {}
1210    }
1211    set a $varcid($v,$id)
1212    if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
1213        update_arcrows $v
1214    }
1215    if {[info exists cached_commitrow($id)]} {
1216        return $cached_commitrow($id)
1217    }
1218    set i [lsearch -exact $varccommits($v,$a) $id]
1219    if {$i < 0} {
1220        puts "oops didn't find commit [shortids $id] in arc $a"
1221        return {}
1222    }
1223    incr i [lindex $varcrow($v) $a]
1224    set cached_commitrow($id) $i
1225    return $i
1226}
1227
1228# Returns 1 if a is on an earlier row than b, otherwise 0
1229proc comes_before {a b} {
1230    global varcid varctok curview
1231
1232    set v $curview
1233    if {$a eq $b || ![info exists varcid($v,$a)] || \
1234            ![info exists varcid($v,$b)]} {
1235        return 0
1236    }
1237    if {$varcid($v,$a) != $varcid($v,$b)} {
1238        return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
1239                           [lindex $varctok($v) $varcid($v,$b)]] < 0}]
1240    }
1241    return [expr {[rowofcommit $a] < [rowofcommit $b]}]
1242}
1243
1244proc bsearch {l elt} {
1245    if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
1246        return 0
1247    }
1248    set lo 0
1249    set hi [llength $l]
1250    while {$hi - $lo > 1} {
1251        set mid [expr {int(($lo + $hi) / 2)}]
1252        set t [lindex $l $mid]
1253        if {$elt < $t} {
1254            set hi $mid
1255        } elseif {$elt > $t} {
1256            set lo $mid
1257        } else {
1258            return $mid
1259        }
1260    }
1261    return $lo
1262}
1263
1264# Make sure rows $start..$end-1 are valid in displayorder and parentlist
1265proc make_disporder {start end} {
1266    global vrownum curview commitidx displayorder parentlist
1267    global varccommits varcorder parents vrowmod varcrow
1268    global d_valid_start d_valid_end
1269
1270    if {$end > $vrowmod($curview)} {
1271        update_arcrows $curview
1272    }
1273    set ai [bsearch $vrownum($curview) $start]
1274    set start [lindex $vrownum($curview) $ai]
1275    set narc [llength $vrownum($curview)]
1276    for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
1277        set a [lindex $varcorder($curview) $ai]
1278        set l [llength $displayorder]
1279        set al [llength $varccommits($curview,$a)]
1280        if {$l < $r + $al} {
1281            if {$l < $r} {
1282                set pad [ntimes [expr {$r - $l}] {}]
1283                set displayorder [concat $displayorder $pad]
1284                set parentlist [concat $parentlist $pad]
1285            } elseif {$l > $r} {
1286                set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
1287                set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
1288            }
1289            foreach id $varccommits($curview,$a) {
1290                lappend displayorder $id
1291                lappend parentlist $parents($curview,$id)
1292            }
1293        } elseif {[lindex $displayorder [expr {$r + $al - 1}]] eq {}} {
1294            set i $r
1295            foreach id $varccommits($curview,$a) {
1296                lset displayorder $i $id
1297                lset parentlist $i $parents($curview,$id)
1298                incr i
1299            }
1300        }
1301        incr r $al
1302    }
1303}
1304
1305proc commitonrow {row} {
1306    global displayorder
1307
1308    set id [lindex $displayorder $row]
1309    if {$id eq {}} {
1310        make_disporder $row [expr {$row + 1}]
1311        set id [lindex $displayorder $row]
1312    }
1313    return $id
1314}
1315
1316proc closevarcs {v} {
1317    global varctok varccommits varcid parents children
1318    global cmitlisted commitidx vtokmod curview numcommits
1319
1320    set missing_parents 0
1321    set scripts {}
1322    set narcs [llength $varctok($v)]
1323    for {set a 1} {$a < $narcs} {incr a} {
1324        set id [lindex $varccommits($v,$a) end]
1325        foreach p $parents($v,$id) {
1326            if {[info exists varcid($v,$p)]} continue
1327            # add p as a new commit
1328            incr missing_parents
1329            set cmitlisted($v,$p) 0
1330            set parents($v,$p) {}
1331            if {[llength $children($v,$p)] == 1 &&
1332                [llength $parents($v,$id)] == 1} {
1333                set b $a
1334            } else {
1335                set b [newvarc $v $p]
1336            }
1337            set varcid($v,$p) $b
1338            if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
1339                modify_arc $v $b
1340            }
1341            lappend varccommits($v,$b) $p
1342            incr commitidx($v)
1343            if {$v == $curview} {
1344                set numcommits $commitidx($v)
1345            }
1346            set scripts [check_interest $p $scripts]
1347        }
1348    }
1349    if {$missing_parents > 0} {
1350        foreach s $scripts {
1351            eval $s
1352        }
1353    }
1354}
1355
1356# Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1357# Assumes we already have an arc for $rwid.
1358proc rewrite_commit {v id rwid} {
1359    global children parents varcid varctok vtokmod varccommits
1360
1361    foreach ch $children($v,$id) {
1362        # make $rwid be $ch's parent in place of $id
1363        set i [lsearch -exact $parents($v,$ch) $id]
1364        if {$i < 0} {
1365            puts "oops rewrite_commit didn't find $id in parent list for $ch"
1366        }
1367        set parents($v,$ch) [lreplace $parents($v,$ch) $i $i $rwid]
1368        # add $ch to $rwid's children and sort the list if necessary
1369        if {[llength [lappend children($v,$rwid) $ch]] > 1} {
1370            set children($v,$rwid) [lsort -command [list vtokcmp $v] \
1371                                        $children($v,$rwid)]
1372        }
1373        # fix the graph after joining $id to $rwid
1374        set a $varcid($v,$ch)
1375        fix_reversal $rwid $a $v
1376        # parentlist is wrong for the last element of arc $a
1377        # even if displayorder is right, hence the 3rd arg here
1378        modify_arc $v $a [expr {[llength $varccommits($v,$a)] - 1}]
1379    }
1380}
1381
1382# Mechanism for registering a command to be executed when we come
1383# across a particular commit.  To handle the case when only the
1384# prefix of the commit is known, the commitinterest array is now
1385# indexed by the first 4 characters of the ID.  Each element is a
1386# list of id, cmd pairs.
1387proc interestedin {id cmd} {
1388    global commitinterest
1389
1390    lappend commitinterest([string range $id 0 3]) $id $cmd
1391}
1392
1393proc check_interest {id scripts} {
1394    global commitinterest
1395
1396    set prefix [string range $id 0 3]
1397    if {[info exists commitinterest($prefix)]} {
1398        set newlist {}
1399        foreach {i script} $commitinterest($prefix) {
1400            if {[string match "$i*" $id]} {
1401                lappend scripts [string map [list "%I" $id "%P" $i] $script]
1402            } else {
1403                lappend newlist $i $script
1404            }
1405        }
1406        if {$newlist ne {}} {
1407            set commitinterest($prefix) $newlist
1408        } else {
1409            unset commitinterest($prefix)
1410        }
1411    }
1412    return $scripts
1413}
1414
1415proc getcommitlines {fd inst view updating}  {
1416    global cmitlisted leftover
1417    global commitidx commitdata vdatemode
1418    global parents children curview hlview
1419    global idpending ordertok
1420    global varccommits varcid varctok vtokmod vfilelimit vshortids
1421
1422    set stuff [read $fd 500000]
1423    # git log doesn't terminate the last commit with a null...
1424    if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
1425        set stuff "\0"
1426    }
1427    if {$stuff == {}} {
1428        if {![eof $fd]} {
1429            return 1
1430        }
1431        global commfd viewcomplete viewactive viewname
1432        global viewinstances
1433        unset commfd($inst)
1434        set i [lsearch -exact $viewinstances($view) $inst]
1435        if {$i >= 0} {
1436            set viewinstances($view) [lreplace $viewinstances($view) $i $i]
1437        }
1438        # set it blocking so we wait for the process to terminate
1439        fconfigure $fd -blocking 1
1440        if {[catch {close $fd} err]} {
1441            set fv {}
1442            if {$view != $curview} {
1443                set fv " for the \"$viewname($view)\" view"
1444            }
1445            if {[string range $err 0 4] == "usage"} {
1446                set err "Gitk: error reading commits$fv:\
1447                        bad arguments to git log."
1448                if {$viewname($view) eq [mc "Command line"]} {
1449                    append err \
1450                        "  (Note: arguments to gitk are passed to git log\
1451                         to allow selection of commits to be displayed.)"
1452                }
1453            } else {
1454                set err "Error reading commits$fv: $err"
1455            }
1456            error_popup $err
1457        }
1458        if {[incr viewactive($view) -1] <= 0} {
1459            set viewcomplete($view) 1
1460            # Check if we have seen any ids listed as parents that haven't
1461            # appeared in the list
1462            closevarcs $view
1463            notbusy $view
1464        }
1465        if {$view == $curview} {
1466            run chewcommits
1467        }
1468        return 0
1469    }
1470    set start 0
1471    set gotsome 0
1472    set scripts {}
1473    while 1 {
1474        set i [string first "\0" $stuff $start]
1475        if {$i < 0} {
1476            append leftover($inst) [string range $stuff $start end]
1477            break
1478        }
1479        if {$start == 0} {
1480            set cmit $leftover($inst)
1481            append cmit [string range $stuff 0 [expr {$i - 1}]]
1482            set leftover($inst) {}
1483        } else {
1484            set cmit [string range $stuff $start [expr {$i - 1}]]
1485        }
1486        set start [expr {$i + 1}]
1487        set j [string first "\n" $cmit]
1488        set ok 0
1489        set listed 1
1490        if {$j >= 0 && [string match "commit *" $cmit]} {
1491            set ids [string range $cmit 7 [expr {$j - 1}]]
1492            if {[string match {[-^<>]*} $ids]} {
1493                switch -- [string index $ids 0] {
1494                    "-" {set listed 0}
1495                    "^" {set listed 2}
1496                    "<" {set listed 3}
1497                    ">" {set listed 4}
1498                }
1499                set ids [string range $ids 1 end]
1500            }
1501            set ok 1
1502            foreach id $ids {
1503                if {[string length $id] != 40} {
1504                    set ok 0
1505                    break
1506                }
1507            }
1508        }
1509        if {!$ok} {
1510            set shortcmit $cmit
1511            if {[string length $shortcmit] > 80} {
1512                set shortcmit "[string range $shortcmit 0 80]..."
1513            }
1514            error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
1515            exit 1
1516        }
1517        set id [lindex $ids 0]
1518        set vid $view,$id
1519
1520        lappend vshortids($view,[string range $id 0 3]) $id
1521
1522        if {!$listed && $updating && ![info exists varcid($vid)] &&
1523            $vfilelimit($view) ne {}} {
1524            # git log doesn't rewrite parents for unlisted commits
1525            # when doing path limiting, so work around that here
1526            # by working out the rewritten parent with git rev-list
1527            # and if we already know about it, using the rewritten
1528            # parent as a substitute parent for $id's children.
1529            if {![catch {
1530                set rwid [exec git rev-list --first-parent --max-count=1 \
1531                              $id -- $vfilelimit($view)]
1532            }]} {
1533                if {$rwid ne {} && [info exists varcid($view,$rwid)]} {
1534                    # use $rwid in place of $id
1535                    rewrite_commit $view $id $rwid
1536                    continue
1537                }
1538            }
1539        }
1540
1541        set a 0
1542        if {[info exists varcid($vid)]} {
1543            if {$cmitlisted($vid) || !$listed} continue
1544            set a $varcid($vid)
1545        }
1546        if {$listed} {
1547            set olds [lrange $ids 1 end]
1548        } else {
1549            set olds {}
1550        }
1551        set commitdata($id) [string range $cmit [expr {$j + 1}] end]
1552        set cmitlisted($vid) $listed
1553        set parents($vid) $olds
1554        if {![info exists children($vid)]} {
1555            set children($vid) {}
1556        } elseif {$a == 0 && [llength $children($vid)] == 1} {
1557            set k [lindex $children($vid) 0]
1558            if {[llength $parents($view,$k)] == 1 &&
1559                (!$vdatemode($view) ||
1560                 $varcid($view,$k) == [llength $varctok($view)] - 1)} {
1561                set a $varcid($view,$k)
1562            }
1563        }
1564        if {$a == 0} {
1565            # new arc
1566            set a [newvarc $view $id]
1567        }
1568        if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
1569            modify_arc $view $a
1570        }
1571        if {![info exists varcid($vid)]} {
1572            set varcid($vid) $a
1573            lappend varccommits($view,$a) $id
1574            incr commitidx($view)
1575        }
1576
1577        set i 0
1578        foreach p $olds {
1579            if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
1580                set vp $view,$p
1581                if {[llength [lappend children($vp) $id]] > 1 &&
1582                    [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
1583                    set children($vp) [lsort -command [list vtokcmp $view] \
1584                                           $children($vp)]
1585                    unset -nocomplain ordertok
1586                }
1587                if {[info exists varcid($view,$p)]} {
1588                    fix_reversal $p $a $view
1589                }
1590            }
1591            incr i
1592        }
1593
1594        set scripts [check_interest $id $scripts]
1595        set gotsome 1
1596    }
1597    if {$gotsome} {
1598        global numcommits hlview
1599
1600        if {$view == $curview} {
1601            set numcommits $commitidx($view)
1602            run chewcommits
1603        }
1604        if {[info exists hlview] && $view == $hlview} {
1605            # we never actually get here...
1606            run vhighlightmore
1607        }
1608        foreach s $scripts {
1609            eval $s
1610        }
1611    }
1612    return 2
1613}
1614
1615proc chewcommits {} {
1616    global curview hlview viewcomplete
1617    global pending_select
1618
1619    layoutmore
1620    if {$viewcomplete($curview)} {
1621        global commitidx varctok
1622        global numcommits startmsecs
1623
1624        if {[info exists pending_select]} {
1625            update
1626            reset_pending_select {}
1627
1628            if {[commitinview $pending_select $curview]} {
1629                selectline [rowofcommit $pending_select] 1
1630            } else {
1631                set row [first_real_row]
1632                selectline $row 1
1633            }
1634        }
1635        if {$commitidx($curview) > 0} {
1636            #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1637            #puts "overall $ms ms for $numcommits commits"
1638            #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1639        } else {
1640            show_status [mc "No commits selected"]
1641        }
1642        notbusy layout
1643    }
1644    return 0
1645}
1646
1647proc do_readcommit {id} {
1648    global tclencoding
1649
1650    # Invoke git-log to handle automatic encoding conversion
1651    set fd [open [concat | git log --no-color --pretty=raw -1 $id] r]
1652    # Read the results using i18n.logoutputencoding
1653    fconfigure $fd -translation lf -eofchar {}
1654    if {$tclencoding != {}} {
1655        fconfigure $fd -encoding $tclencoding
1656    }
1657    set contents [read $fd]
1658    close $fd
1659    # Remove the heading line
1660    regsub {^commit [0-9a-f]+\n} $contents {} contents
1661
1662    return $contents
1663}
1664
1665proc readcommit {id} {
1666    if {[catch {set contents [do_readcommit $id]}]} return
1667    parsecommit $id $contents 1
1668}
1669
1670proc parsecommit {id contents listed} {
1671    global commitinfo
1672
1673    set inhdr 1
1674    set comment {}
1675    set headline {}
1676    set auname {}
1677    set audate {}
1678    set comname {}
1679    set comdate {}
1680    set hdrend [string first "\n\n" $contents]
1681    if {$hdrend < 0} {
1682        # should never happen...
1683        set hdrend [string length $contents]
1684    }
1685    set header [string range $contents 0 [expr {$hdrend - 1}]]
1686    set comment [string range $contents [expr {$hdrend + 2}] end]
1687    foreach line [split $header "\n"] {
1688        set line [split $line " "]
1689        set tag [lindex $line 0]
1690        if {$tag == "author"} {
1691            set audate [lrange $line end-1 end]
1692            set auname [join [lrange $line 1 end-2] " "]
1693        } elseif {$tag == "committer"} {
1694            set comdate [lrange $line end-1 end]
1695            set comname [join [lrange $line 1 end-2] " "]
1696        }
1697    }
1698    set headline {}
1699    # take the first non-blank line of the comment as the headline
1700    set headline [string trimleft $comment]
1701    set i [string first "\n" $headline]
1702    if {$i >= 0} {
1703        set headline [string range $headline 0 $i]
1704    }
1705    set headline [string trimright $headline]
1706    set i [string first "\r" $headline]
1707    if {$i >= 0} {
1708        set headline [string trimright [string range $headline 0 $i]]
1709    }
1710    if {!$listed} {
1711        # git log indents the comment by 4 spaces;
1712        # if we got this via git cat-file, add the indentation
1713        set newcomment {}
1714        foreach line [split $comment "\n"] {
1715            append newcomment "    "
1716            append newcomment $line
1717            append newcomment "\n"
1718        }
1719        set comment $newcomment
1720    }
1721    set hasnote [string first "\nNotes:\n" $contents]
1722    set diff ""
1723    # If there is diff output shown in the git-log stream, split it
1724    # out.  But get rid of the empty line that always precedes the
1725    # diff.
1726    set i [string first "\n\ndiff" $comment]
1727    if {$i >= 0} {
1728        set diff [string range $comment $i+1 end]
1729        set comment [string range $comment 0 $i-1]
1730    }
1731    set commitinfo($id) [list $headline $auname $audate \
1732                             $comname $comdate $comment $hasnote $diff]
1733}
1734
1735proc getcommit {id} {
1736    global commitdata commitinfo
1737
1738    if {[info exists commitdata($id)]} {
1739        parsecommit $id $commitdata($id) 1
1740    } else {
1741        readcommit $id
1742        if {![info exists commitinfo($id)]} {
1743            set commitinfo($id) [list [mc "No commit information available"]]
1744        }
1745    }
1746    return 1
1747}
1748
1749# Expand an abbreviated commit ID to a list of full 40-char IDs that match
1750# and are present in the current view.
1751# This is fairly slow...
1752proc longid {prefix} {
1753    global varcid curview vshortids
1754
1755    set ids {}
1756    if {[string length $prefix] >= 4} {
1757        set vshortid $curview,[string range $prefix 0 3]
1758        if {[info exists vshortids($vshortid)]} {
1759            foreach id $vshortids($vshortid) {
1760                if {[string match "$prefix*" $id]} {
1761                    if {[lsearch -exact $ids $id] < 0} {
1762                        lappend ids $id
1763                        if {[llength $ids] >= 2} break
1764                    }
1765                }
1766            }
1767        }
1768    } else {
1769        foreach match [array names varcid "$curview,$prefix*"] {
1770            lappend ids [lindex [split $match ","] 1]
1771            if {[llength $ids] >= 2} break
1772        }
1773    }
1774    return $ids
1775}
1776
1777proc readrefs {} {
1778    global tagids idtags headids idheads tagobjid
1779    global otherrefids idotherrefs mainhead mainheadid
1780    global selecthead selectheadid
1781    global hideremotes
1782
1783    foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
1784        unset -nocomplain $v
1785    }
1786    set refd [open [list | git show-ref -d] r]
1787    while {[gets $refd line] >= 0} {
1788        if {[string index $line 40] ne " "} continue
1789        set id [string range $line 0 39]
1790        set ref [string range $line 41 end]
1791        if {![string match "refs/*" $ref]} continue
1792        set name [string range $ref 5 end]
1793        if {[string match "remotes/*" $name]} {
1794            if {![string match "*/HEAD" $name] && !$hideremotes} {
1795                set headids($name) $id
1796                lappend idheads($id) $name
1797            }
1798        } elseif {[string match "heads/*" $name]} {
1799            set name [string range $name 6 end]
1800            set headids($name) $id
1801            lappend idheads($id) $name
1802        } elseif {[string match "tags/*" $name]} {
1803            # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1804            # which is what we want since the former is the commit ID
1805            set name [string range $name 5 end]
1806            if {[string match "*^{}" $name]} {
1807                set name [string range $name 0 end-3]
1808            } else {
1809                set tagobjid($name) $id
1810            }
1811            set tagids($name) $id
1812            lappend idtags($id) $name
1813        } else {
1814            set otherrefids($name) $id
1815            lappend idotherrefs($id) $name
1816        }
1817    }
1818    catch {close $refd}
1819    set mainhead {}
1820    set mainheadid {}
1821    catch {
1822        set mainheadid [exec git rev-parse HEAD]
1823        set thehead [exec git symbolic-ref HEAD]
1824        if {[string match "refs/heads/*" $thehead]} {
1825            set mainhead [string range $thehead 11 end]
1826        }
1827    }
1828    set selectheadid {}
1829    if {$selecthead ne {}} {
1830        catch {
1831            set selectheadid [exec git rev-parse --verify $selecthead]
1832        }
1833    }
1834}
1835
1836# skip over fake commits
1837proc first_real_row {} {
1838    global nullid nullid2 numcommits
1839
1840    for {set row 0} {$row < $numcommits} {incr row} {
1841        set id [commitonrow $row]
1842        if {$id ne $nullid && $id ne $nullid2} {
1843            break
1844        }
1845    }
1846    return $row
1847}
1848
1849# update things for a head moved to a child of its previous location
1850proc movehead {id name} {
1851    global headids idheads
1852
1853    removehead $headids($name) $name
1854    set headids($name) $id
1855    lappend idheads($id) $name
1856}
1857
1858# update things when a head has been removed
1859proc removehead {id name} {
1860    global headids idheads
1861
1862    if {$idheads($id) eq $name} {
1863        unset idheads($id)
1864    } else {
1865        set i [lsearch -exact $idheads($id) $name]
1866        if {$i >= 0} {
1867            set idheads($id) [lreplace $idheads($id) $i $i]
1868        }
1869    }
1870    unset headids($name)
1871}
1872
1873proc ttk_toplevel {w args} {
1874    global use_ttk
1875    eval [linsert $args 0 ::toplevel $w]
1876    if {$use_ttk} {
1877        place [ttk::frame $w._toplevel_background] -x 0 -y 0 -relwidth 1 -relheight 1
1878    }
1879    return $w
1880}
1881
1882proc make_transient {window origin} {
1883    global have_tk85
1884
1885    # In MacOS Tk 8.4 transient appears to work by setting
1886    # overrideredirect, which is utterly useless, since the
1887    # windows get no border, and are not even kept above
1888    # the parent.
1889    if {!$have_tk85 && [tk windowingsystem] eq {aqua}} return
1890
1891    wm transient $window $origin
1892
1893    # Windows fails to place transient windows normally, so
1894    # schedule a callback to center them on the parent.
1895    if {[tk windowingsystem] eq {win32}} {
1896        after idle [list tk::PlaceWindow $window widget $origin]
1897    }
1898}
1899
1900proc show_error {w top msg} {
1901    global NS
1902    if {![info exists NS]} {set NS ""}
1903    if {[wm state $top] eq "withdrawn"} { wm deiconify $top }
1904    message $w.m -text $msg -justify center -aspect 400
1905    pack $w.m -side top -fill x -padx 20 -pady 20
1906    ${NS}::button $w.ok -default active -text [mc OK] -command "destroy $top"
1907    pack $w.ok -side bottom -fill x
1908    bind $top <Visibility> "grab $top; focus $top"
1909    bind $top <Key-Return> "destroy $top"
1910    bind $top <Key-space>  "destroy $top"
1911    bind $top <Key-Escape> "destroy $top"
1912    tkwait window $top
1913}
1914
1915proc error_popup {msg {owner .}} {
1916    if {[tk windowingsystem] eq "win32"} {
1917        tk_messageBox -icon error -type ok -title [wm title .] \
1918            -parent $owner -message $msg
1919    } else {
1920        set w .error
1921        ttk_toplevel $w
1922        make_transient $w $owner
1923        show_error $w $w $msg
1924    }
1925}
1926
1927proc confirm_popup {msg {owner .}} {
1928    global confirm_ok NS
1929    set confirm_ok 0
1930    set w .confirm
1931    ttk_toplevel $w
1932    make_transient $w $owner
1933    message $w.m -text $msg -justify center -aspect 400
1934    pack $w.m -side top -fill x -padx 20 -pady 20
1935    ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
1936    pack $w.ok -side left -fill x
1937    ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
1938    pack $w.cancel -side right -fill x
1939    bind $w <Visibility> "grab $w; focus $w"
1940    bind $w <Key-Return> "set confirm_ok 1; destroy $w"
1941    bind $w <Key-space>  "set confirm_ok 1; destroy $w"
1942    bind $w <Key-Escape> "destroy $w"
1943    tk::PlaceWindow $w widget $owner
1944    tkwait window $w
1945    return $confirm_ok
1946}
1947
1948proc setoptions {} {
1949    global use_ttk
1950
1951    if {[tk windowingsystem] ne "win32"} {
1952        option add *Panedwindow.showHandle 1 startupFile
1953        option add *Panedwindow.sashRelief raised startupFile
1954        if {[tk windowingsystem] ne "aqua"} {
1955            option add *Menu.font uifont startupFile
1956        }
1957    } else {
1958        option add *Menu.TearOff 0 startupFile
1959    }
1960    option add *Button.font uifont startupFile
1961    option add *Checkbutton.font uifont startupFile
1962    option add *Radiobutton.font uifont startupFile
1963    option add *Menubutton.font uifont startupFile
1964    option add *Label.font uifont startupFile
1965    option add *Message.font uifont startupFile
1966    option add *Entry.font textfont startupFile
1967    option add *Text.font textfont startupFile
1968    option add *Labelframe.font uifont startupFile
1969    option add *Spinbox.font textfont startupFile
1970    option add *Listbox.font mainfont startupFile
1971}
1972
1973proc setttkstyle {} {
1974    eval font configure TkDefaultFont [fontflags mainfont]
1975    eval font configure TkTextFont [fontflags textfont]
1976    eval font configure TkHeadingFont [fontflags mainfont]
1977    eval font configure TkCaptionFont [fontflags mainfont] -weight bold
1978    eval font configure TkTooltipFont [fontflags uifont]
1979    eval font configure TkFixedFont   [fontflags textfont]
1980    eval font configure TkIconFont    [fontflags uifont]
1981    eval font configure TkMenuFont    [fontflags uifont]
1982    eval font configure TkSmallCaptionFont [fontflags uifont]
1983}
1984
1985# Make a menu and submenus.
1986# m is the window name for the menu, items is the list of menu items to add.
1987# Each item is a list {mc label type description options...}
1988# mc is ignored; it's so we can put mc there to alert xgettext
1989# label is the string that appears in the menu
1990# type is cascade, command or radiobutton (should add checkbutton)
1991# description depends on type; it's the sublist for cascade, the
1992# command to invoke for command, or {variable value} for radiobutton
1993proc makemenu {m items} {
1994    menu $m
1995    if {[tk windowingsystem] eq {aqua}} {
1996        set Meta1 Cmd
1997    } else {
1998        set Meta1 Ctrl
1999    }
2000    foreach i $items {
2001        set name [mc [lindex $i 1]]
2002        set type [lindex $i 2]
2003        set thing [lindex $i 3]
2004        set params [list $type]
2005        if {$name ne {}} {
2006            set u [string first "&" [string map {&& x} $name]]
2007            lappend params -label [string map {&& & & {}} $name]
2008            if {$u >= 0} {
2009                lappend params -underline $u
2010            }
2011        }
2012        switch -- $type {
2013            "cascade" {
2014                set submenu [string tolower [string map {& ""} [lindex $i 1]]]
2015                lappend params -menu $m.$submenu
2016            }
2017            "command" {
2018                lappend params -command $thing
2019            }
2020            "radiobutton" {
2021                lappend params -variable [lindex $thing 0] \
2022                    -value [lindex $thing 1]
2023            }
2024        }
2025        set tail [lrange $i 4 end]
2026        regsub -all {\yMeta1\y} $tail $Meta1 tail
2027        eval $m add $params $tail
2028        if {$type eq "cascade"} {
2029            makemenu $m.$submenu $thing
2030        }
2031    }
2032}
2033
2034# translate string and remove ampersands
2035proc mca {str} {
2036    return [string map {&& & & {}} [mc $str]]
2037}
2038
2039proc cleardropsel {w} {
2040    $w selection clear
2041}
2042proc makedroplist {w varname args} {
2043    global use_ttk
2044    if {$use_ttk} {
2045        set width 0
2046        foreach label $args {
2047            set cx [string length $label]
2048            if {$cx > $width} {set width $cx}
2049        }
2050        set gm [ttk::combobox $w -width $width -state readonly\
2051                    -textvariable $varname -values $args \
2052                    -exportselection false]
2053        bind $gm <<ComboboxSelected>> [list $gm selection clear]
2054    } else {
2055        set gm [eval [linsert $args 0 tk_optionMenu $w $varname]]
2056    }
2057    return $gm
2058}
2059
2060proc makewindow {} {
2061    global canv canv2 canv3 linespc charspc ctext cflist cscroll
2062    global tabstop
2063    global findtype findtypemenu findloc findstring fstring geometry
2064    global entries sha1entry sha1string sha1but
2065    global diffcontextstring diffcontext
2066    global ignorespace
2067    global maincursor textcursor curtextcursor
2068    global rowctxmenu fakerowmenu mergemax wrapcomment
2069    global highlight_files gdttype
2070    global searchstring sstring
2071    global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
2072    global uifgcolor uifgdisabledcolor
2073    global filesepbgcolor filesepfgcolor
2074    global mergecolors foundbgcolor currentsearchhitbgcolor
2075    global headctxmenu progresscanv progressitem progresscoords statusw
2076    global fprogitem fprogcoord lastprogupdate progupdatepending
2077    global rprogitem rprogcoord rownumsel numcommits
2078    global have_tk85 use_ttk NS
2079    global git_version
2080    global worddiff
2081
2082    # The "mc" arguments here are purely so that xgettext
2083    # sees the following string as needing to be translated
2084    set file {
2085        mc "&File" cascade {
2086            {mc "&Update" command updatecommits -accelerator F5}
2087            {mc "&Reload" command reloadcommits -accelerator Shift-F5}
2088            {mc "Reread re&ferences" command rereadrefs}
2089            {mc "&List references" command showrefs -accelerator F2}
2090            {xx "" separator}
2091            {mc "Start git &gui" command {exec git gui &}}
2092            {xx "" separator}
2093            {mc "&Quit" command doquit -accelerator Meta1-Q}
2094        }}
2095    set edit {
2096        mc "&Edit" cascade {
2097            {mc "&Preferences" command doprefs}
2098        }}
2099    set view {
2100        mc "&View" cascade {
2101            {mc "&New view..." command {newview 0} -accelerator Shift-F4}
2102            {mc "&Edit view..." command editview -state disabled -accelerator F4}
2103            {mc "&Delete view" command delview -state disabled}
2104            {xx "" separator}
2105            {mc "&All files" radiobutton {selectedview 0} -command {showview 0}}
2106        }}
2107    if {[tk windowingsystem] ne "aqua"} {
2108        set help {
2109        mc "&Help" cascade {
2110            {mc "&About gitk" command about}
2111            {mc "&Key bindings" command keys}
2112        }}
2113        set bar [list $file $edit $view $help]
2114    } else {
2115        proc ::tk::mac::ShowPreferences {} {doprefs}
2116        proc ::tk::mac::Quit {} {doquit}
2117        lset file end [lreplace [lindex $file end] end-1 end]
2118        set apple {
2119        xx "&Apple" cascade {
2120            {mc "&About gitk" command about}
2121            {xx "" separator}
2122        }}
2123        set help {
2124        mc "&Help" cascade {
2125            {mc "&Key bindings" command keys}
2126        }}
2127        set bar [list $apple $file $view $help]
2128    }
2129    makemenu .bar $bar
2130    . configure -menu .bar
2131
2132    if {$use_ttk} {
2133        # cover the non-themed toplevel with a themed frame.
2134        place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1
2135    }
2136
2137    # the gui has upper and lower half, parts of a paned window.
2138    ${NS}::panedwindow .ctop -orient vertical
2139
2140    # possibly use assumed geometry
2141    if {![info exists geometry(pwsash0)]} {
2142        set geometry(topheight) [expr {15 * $linespc}]
2143        set geometry(topwidth) [expr {80 * $charspc}]
2144        set geometry(botheight) [expr {15 * $linespc}]
2145        set geometry(botwidth) [expr {50 * $charspc}]
2146        set geometry(pwsash0) [list [expr {40 * $charspc}] 2]
2147        set geometry(pwsash1) [list [expr {60 * $charspc}] 2]
2148    }
2149
2150    # the upper half will have a paned window, a scroll bar to the right, and some stuff below
2151    ${NS}::frame .tf -height $geometry(topheight) -width $geometry(topwidth)
2152    ${NS}::frame .tf.histframe
2153    ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal
2154    if {!$use_ttk} {
2155        .tf.histframe.pwclist configure -sashpad 0 -handlesize 4
2156    }
2157
2158    # create three canvases
2159    set cscroll .tf.histframe.csb
2160    set canv .tf.histframe.pwclist.canv
2161    canvas $canv \
2162        -selectbackground $selectbgcolor \
2163        -background $bgcolor -bd 0 \
2164        -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
2165    .tf.histframe.pwclist add $canv
2166    set canv2 .tf.histframe.pwclist.canv2
2167    canvas $canv2 \
2168        -selectbackground $selectbgcolor \
2169        -background $bgcolor -bd 0 -yscrollincr $linespc
2170    .tf.histframe.pwclist add $canv2
2171    set canv3 .tf.histframe.pwclist.canv3
2172    canvas $canv3 \
2173        -selectbackground $selectbgcolor \
2174        -background $bgcolor -bd 0 -yscrollincr $linespc
2175    .tf.histframe.pwclist add $canv3
2176    if {$use_ttk} {
2177        bind .tf.histframe.pwclist <Map> {
2178            bind %W <Map> {}
2179            .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0]
2180            .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0]
2181        }
2182    } else {
2183        eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
2184        eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
2185    }
2186
2187    # a scroll bar to rule them
2188    ${NS}::scrollbar $cscroll -command {allcanvs yview}
2189    if {!$use_ttk} {$cscroll configure -highlightthickness 0}
2190    pack $cscroll -side right -fill y
2191    bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
2192    lappend bglist $canv $canv2 $canv3
2193    pack .tf.histframe.pwclist -fill both -expand 1 -side left
2194
2195    # we have two button bars at bottom of top frame. Bar 1
2196    ${NS}::frame .tf.bar
2197    ${NS}::frame .tf.lbar -height 15
2198
2199    set sha1entry .tf.bar.sha1
2200    set entries $sha1entry
2201    set sha1but .tf.bar.sha1label
2202    button $sha1but -text "[mc "SHA1 ID:"] " -state disabled -relief flat \
2203        -command gotocommit -width 8
2204    $sha1but conf -disabledforeground [$sha1but cget -foreground]
2205    pack .tf.bar.sha1label -side left
2206    ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string
2207    trace add variable sha1string write sha1change
2208    pack $sha1entry -side left -pady 2
2209
2210    set bm_left_data {
2211        #define left_width 16
2212        #define left_height 16
2213        static unsigned char left_bits[] = {
2214        0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
2215        0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
2216        0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
2217    }
2218    set bm_right_data {
2219        #define right_width 16
2220        #define right_height 16
2221        static unsigned char right_bits[] = {
2222        0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
2223        0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
2224        0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
2225    }
2226    image create bitmap bm-left -data $bm_left_data -foreground $uifgcolor
2227    image create bitmap bm-left-gray -data $bm_left_data -foreground $uifgdisabledcolor
2228    image create bitmap bm-right -data $bm_right_data -foreground $uifgcolor
2229    image create bitmap bm-right-gray -data $bm_right_data -foreground $uifgdisabledcolor
2230
2231    ${NS}::button .tf.bar.leftbut -command goback -state disabled -width 26
2232    if {$use_ttk} {
2233        .tf.bar.leftbut configure -image [list bm-left disabled bm-left-gray]
2234    } else {
2235        .tf.bar.leftbut configure -image bm-left
2236    }
2237    pack .tf.bar.leftbut -side left -fill y
2238    ${NS}::button .tf.bar.rightbut -command goforw -state disabled -width 26
2239    if {$use_ttk} {
2240        .tf.bar.rightbut configure -image [list bm-right disabled bm-right-gray]
2241    } else {
2242        .tf.bar.rightbut configure -image bm-right
2243    }
2244    pack .tf.bar.rightbut -side left -fill y
2245
2246    ${NS}::label .tf.bar.rowlabel -text [mc "Row"]
2247    set rownumsel {}
2248    ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \
2249        -relief sunken -anchor e
2250    ${NS}::label .tf.bar.rowlabel2 -text "/"
2251    ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \
2252        -relief sunken -anchor e
2253    pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
2254        -side left
2255    if {!$use_ttk} {
2256        foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont}
2257    }
2258    global selectedline
2259    trace add variable selectedline write selectedline_change
2260
2261    # Status label and progress bar
2262    set statusw .tf.bar.status
2263    ${NS}::label $statusw -width 15 -relief sunken
2264    pack $statusw -side left -padx 5
2265    if {$use_ttk} {
2266        set progresscanv [ttk::progressbar .tf.bar.progress]
2267    } else {
2268        set h [expr {[font metrics uifont -linespace] + 2}]
2269        set progresscanv .tf.bar.progress
2270        canvas $progresscanv -relief sunken -height $h -borderwidth 2
2271        set progressitem [$progresscanv create rect -1 0 0 $h -fill "#00ff00"]
2272        set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
2273        set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
2274    }
2275    pack $progresscanv -side right -expand 1 -fill x -padx {0 2}
2276    set progresscoords {0 0}
2277    set fprogcoord 0
2278    set rprogcoord 0
2279    bind $progresscanv <Configure> adjustprogress
2280    set lastprogupdate [clock clicks -milliseconds]
2281    set progupdatepending 0
2282
2283    # build up the bottom bar of upper window
2284    ${NS}::label .tf.lbar.flabel -text "[mc "Find"] "
2285
2286    set bm_down_data {
2287        #define down_width 16
2288        #define down_height 16
2289        static unsigned char down_bits[] = {
2290        0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2291        0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2292        0x87, 0xe1, 0x8e, 0x71, 0x9c, 0x39, 0xb8, 0x1d,
2293        0xf0, 0x0f, 0xe0, 0x07, 0xc0, 0x03, 0x80, 0x01};
2294    }
2295    image create bitmap bm-down -data $bm_down_data -foreground $uifgcolor
2296    ${NS}::button .tf.lbar.fnext -width 26 -command {dofind 1 1}
2297    .tf.lbar.fnext configure -image bm-down
2298
2299    set bm_up_data {
2300        #define up_width 16
2301        #define up_height 16
2302        static unsigned char up_bits[] = {
2303        0x80, 0x01, 0xc0, 0x03, 0xe0, 0x07, 0xf0, 0x0f,
2304        0xb8, 0x1d, 0x9c, 0x39, 0x8e, 0x71, 0x87, 0xe1,
2305        0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2306        0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01};
2307    }
2308    image create bitmap bm-up -data $bm_up_data -foreground $uifgcolor
2309    ${NS}::button .tf.lbar.fprev -width 26 -command {dofind -1 1}
2310    .tf.lbar.fprev configure -image bm-up
2311
2312    ${NS}::label .tf.lbar.flab2 -text " [mc "commit"] "
2313
2314    pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
2315        -side left -fill y
2316    set gdttype [mc "containing:"]
2317    set gm [makedroplist .tf.lbar.gdttype gdttype \
2318                [mc "containing:"] \
2319                [mc "touching paths:"] \
2320                [mc "adding/removing string:"] \
2321                [mc "changing lines matching:"]]
2322    trace add variable gdttype write gdttype_change
2323    pack .tf.lbar.gdttype -side left -fill y
2324
2325    set findstring {}
2326    set fstring .tf.lbar.findstring
2327    lappend entries $fstring
2328    ${NS}::entry $fstring -width 30 -textvariable findstring
2329    trace add variable findstring write find_change
2330    set findtype [mc "Exact"]
2331    set findtypemenu [makedroplist .tf.lbar.findtype \
2332                          findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
2333    trace add variable findtype write findcom_change
2334    set findloc [mc "All fields"]
2335    makedroplist .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
2336        [mc "Comments"] [mc "Author"] [mc "Committer"]
2337    trace add variable findloc write find_change
2338    pack .tf.lbar.findloc -side right
2339    pack .tf.lbar.findtype -side right
2340    pack $fstring -side left -expand 1 -fill x
2341
2342    # Finish putting the upper half of the viewer together
2343    pack .tf.lbar -in .tf -side bottom -fill x
2344    pack .tf.bar -in .tf -side bottom -fill x
2345    pack .tf.histframe -fill both -side top -expand 1
2346    .ctop add .tf
2347    if {!$use_ttk} {
2348        .ctop paneconfigure .tf -height $geometry(topheight)
2349        .ctop paneconfigure .tf -width $geometry(topwidth)
2350    }
2351
2352    # now build up the bottom
2353    ${NS}::panedwindow .pwbottom -orient horizontal
2354
2355    # lower left, a text box over search bar, scroll bar to the right
2356    # if we know window height, then that will set the lower text height, otherwise
2357    # we set lower text height which will drive window height
2358    if {[info exists geometry(main)]} {
2359        ${NS}::frame .bleft -width $geometry(botwidth)
2360    } else {
2361        ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
2362    }
2363    ${NS}::frame .bleft.top
2364    ${NS}::frame .bleft.mid
2365    ${NS}::frame .bleft.bottom
2366
2367    # gap between sub-widgets
2368    set wgap [font measure uifont "i"]
2369
2370    ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch
2371    pack .bleft.top.search -side left -padx 5
2372    set sstring .bleft.top.sstring
2373    set searchstring ""
2374    ${NS}::entry $sstring -width 20 -textvariable searchstring
2375    lappend entries $sstring
2376    trace add variable searchstring write incrsearch
2377    pack $sstring -side left -expand 1 -fill x
2378    ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \
2379        -command changediffdisp -variable diffelide -value {0 0}
2380    ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \
2381        -command changediffdisp -variable diffelide -value {0 1}
2382    ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \
2383        -command changediffdisp -variable diffelide -value {1 0}
2384
2385    ${NS}::label .bleft.mid.labeldiffcontext -text "      [mc "Lines of context"]: "
2386    pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left -ipadx $wgap
2387    spinbox .bleft.mid.diffcontext -width 5 \
2388        -from 0 -increment 1 -to 10000000 \
2389        -validate all -validatecommand "diffcontextvalidate %P" \
2390        -textvariable diffcontextstring
2391    .bleft.mid.diffcontext set $diffcontext
2392    trace add variable diffcontextstring write diffcontextchange
2393    lappend entries .bleft.mid.diffcontext
2394    pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left -ipadx $wgap
2395    ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
2396        -command changeignorespace -variable ignorespace
2397    pack .bleft.mid.ignspace -side left -padx 5
2398
2399    set worddiff [mc "Line diff"]
2400    if {[package vcompare $git_version "1.7.2"] >= 0} {
2401        makedroplist .bleft.mid.worddiff worddiff [mc "Line diff"] \
2402            [mc "Markup words"] [mc "Color words"]
2403        trace add variable worddiff write changeworddiff
2404        pack .bleft.mid.worddiff -side left -padx 5
2405    }
2406
2407    set ctext .bleft.bottom.ctext
2408    text $ctext -background $bgcolor -foreground $fgcolor \
2409        -state disabled -undo 0 -font textfont \
2410        -yscrollcommand scrolltext -wrap none \
2411        -xscrollcommand ".bleft.bottom.sbhorizontal set"
2412    if {$have_tk85} {
2413        $ctext conf -tabstyle wordprocessor
2414    }
2415    ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview"
2416    ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h
2417    pack .bleft.top -side top -fill x
2418    pack .bleft.mid -side top -fill x
2419    grid $ctext .bleft.bottom.sb -sticky nsew
2420    grid .bleft.bottom.sbhorizontal -sticky ew
2421    grid columnconfigure .bleft.bottom 0 -weight 1
2422    grid rowconfigure .bleft.bottom 0 -weight 1
2423    grid rowconfigure .bleft.bottom 1 -weight 0
2424    pack .bleft.bottom -side top -fill both -expand 1
2425    lappend bglist $ctext
2426    lappend fglist $ctext
2427
2428    $ctext tag conf comment -wrap $wrapcomment
2429    $ctext tag conf filesep -font textfontbold -fore $filesepfgcolor -back $filesepbgcolor
2430    $ctext tag conf hunksep -fore [lindex $diffcolors 2]
2431    $ctext tag conf d0 -fore [lindex $diffcolors 0]
2432    $ctext tag conf dresult -fore [lindex $diffcolors 1]
2433    $ctext tag conf m0 -fore [lindex $mergecolors 0]
2434    $ctext tag conf m1 -fore [lindex $mergecolors 1]
2435    $ctext tag conf m2 -fore [lindex $mergecolors 2]
2436    $ctext tag conf m3 -fore [lindex $mergecolors 3]
2437    $ctext tag conf m4 -fore [lindex $mergecolors 4]
2438    $ctext tag conf m5 -fore [lindex $mergecolors 5]
2439    $ctext tag conf m6 -fore [lindex $mergecolors 6]
2440    $ctext tag conf m7 -fore [lindex $mergecolors 7]
2441    $ctext tag conf m8 -fore [lindex $mergecolors 8]
2442    $ctext tag conf m9 -fore [lindex $mergecolors 9]
2443    $ctext tag conf m10 -fore [lindex $mergecolors 10]
2444    $ctext tag conf m11 -fore [lindex $mergecolors 11]
2445    $ctext tag conf m12 -fore [lindex $mergecolors 12]
2446    $ctext tag conf m13 -fore [lindex $mergecolors 13]
2447    $ctext tag conf m14 -fore [lindex $mergecolors 14]
2448    $ctext tag conf m15 -fore [lindex $mergecolors 15]
2449    $ctext tag conf mmax -fore darkgrey
2450    set mergemax 16
2451    $ctext tag conf mresult -font textfontbold
2452    $ctext tag conf msep -font textfontbold
2453    $ctext tag conf found -back $foundbgcolor
2454    $ctext tag conf currentsearchhit -back $currentsearchhitbgcolor
2455    $ctext tag conf wwrap -wrap word -lmargin2 1c
2456    $ctext tag conf bold -font textfontbold
2457
2458    .pwbottom add .bleft
2459    if {!$use_ttk} {
2460        .pwbottom paneconfigure .bleft -width $geometry(botwidth)
2461    }
2462
2463    # lower right
2464    ${NS}::frame .bright
2465    ${NS}::frame .bright.mode
2466    ${NS}::radiobutton .bright.mode.patch -text [mc "Patch"] \
2467        -command reselectline -variable cmitmode -value "patch"
2468    ${NS}::radiobutton .bright.mode.tree -text [mc "Tree"] \
2469        -command reselectline -variable cmitmode -value "tree"
2470    grid .bright.mode.patch .bright.mode.tree -sticky ew
2471    pack .bright.mode -side top -fill x
2472    set cflist .bright.cfiles
2473    set indent [font measure mainfont "nn"]
2474    text $cflist \
2475        -selectbackground $selectbgcolor \
2476        -background $bgcolor -foreground $fgcolor \
2477        -font mainfont \
2478        -tabs [list $indent [expr {2 * $indent}]] \
2479        -yscrollcommand ".bright.sb set" \
2480        -cursor [. cget -cursor] \
2481        -spacing1 1 -spacing3 1
2482    lappend bglist $cflist
2483    lappend fglist $cflist
2484    ${NS}::scrollbar .bright.sb -command "$cflist yview"
2485    pack .bright.sb -side right -fill y
2486    pack $cflist -side left -fill both -expand 1
2487    $cflist tag configure highlight \
2488        -background [$cflist cget -selectbackground]
2489    $cflist tag configure bold -font mainfontbold
2490
2491    .pwbottom add .bright
2492    .ctop add .pwbottom
2493
2494    # restore window width & height if known
2495    if {[info exists geometry(main)]} {
2496        if {[scan $geometry(main) "%dx%d" w h] >= 2} {
2497            if {$w > [winfo screenwidth .]} {
2498                set w [winfo screenwidth .]
2499            }
2500            if {$h > [winfo screenheight .]} {
2501                set h [winfo screenheight .]
2502            }
2503            wm geometry . "${w}x$h"
2504        }
2505    }
2506
2507    if {[info exists geometry(state)] && $geometry(state) eq "zoomed"} {
2508        wm state . $geometry(state)
2509    }
2510
2511    if {[tk windowingsystem] eq {aqua}} {
2512        set M1B M1
2513        set ::BM "3"
2514    } else {
2515        set M1B Control
2516        set ::BM "2"
2517    }
2518
2519    if {$use_ttk} {
2520        bind .ctop <Map> {
2521            bind %W <Map> {}
2522            %W sashpos 0 $::geometry(topheight)
2523        }
2524        bind .pwbottom <Map> {
2525            bind %W <Map> {}
2526            %W sashpos 0 $::geometry(botwidth)
2527        }
2528    }
2529
2530    bind .pwbottom <Configure> {resizecdetpanes %W %w}
2531    pack .ctop -fill both -expand 1
2532    bindall <1> {selcanvline %W %x %y}
2533    #bindall <B1-Motion> {selcanvline %W %x %y}
2534    if {[tk windowingsystem] == "win32"} {
2535        bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
2536        bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
2537    } else {
2538        bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
2539        bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
2540        bind $ctext <Button> {
2541            if {"%b" eq 6} {
2542                $ctext xview scroll -5 units
2543            } elseif {"%b" eq 7} {
2544                $ctext xview scroll 5 units
2545            }
2546        }
2547        if {[tk windowingsystem] eq "aqua"} {
2548            bindall <MouseWheel> {
2549                set delta [expr {- (%D)}]
2550                allcanvs yview scroll $delta units
2551            }
2552            bindall <Shift-MouseWheel> {
2553                set delta [expr {- (%D)}]
2554                $canv xview scroll $delta units
2555            }
2556        }
2557    }
2558    bindall <$::BM> "canvscan mark %W %x %y"
2559    bindall <B$::BM-Motion> "canvscan dragto %W %x %y"
2560    bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2561    bind . <$M1B-Key-w> doquit
2562    bindkey <Home> selfirstline
2563    bindkey <End> sellastline
2564    bind . <Key-Up> "selnextline -1"
2565    bind . <Key-Down> "selnextline 1"
2566    bind . <Shift-Key-Up> "dofind -1 0"
2567    bind . <Shift-Key-Down> "dofind 1 0"
2568    bindkey <Key-Right> "goforw"
2569    bindkey <Key-Left> "goback"
2570    bind . <Key-Prior> "selnextpage -1"
2571    bind . <Key-Next> "selnextpage 1"
2572    bind . <$M1B-Home> "allcanvs yview moveto 0.0"
2573    bind . <$M1B-End> "allcanvs yview moveto 1.0"
2574    bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
2575    bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
2576    bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2577    bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
2578    bindkey <Key-Delete> "$ctext yview scroll -1 pages"
2579    bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
2580    bindkey <Key-space> "$ctext yview scroll 1 pages"
2581    bindkey p "selnextline -1"
2582    bindkey n "selnextline 1"
2583    bindkey z "goback"
2584    bindkey x "goforw"
2585    bindkey k "selnextline -1"
2586    bindkey j "selnextline 1"
2587    bindkey h "goback"
2588    bindkey l "goforw"
2589    bindkey b prevfile
2590    bindkey d "$ctext yview scroll 18 units"
2591    bindkey u "$ctext yview scroll -18 units"
2592    bindkey g {$sha1entry delete 0 end; focus $sha1entry}
2593    bindkey / {focus $fstring}
2594    bindkey <Key-KP_Divide> {focus $fstring}
2595    bindkey <Key-Return> {dofind 1 1}
2596    bindkey ? {dofind -1 1}
2597    bindkey f nextfile
2598    bind . <F5> updatecommits
2599    bindmodfunctionkey Shift 5 reloadcommits
2600    bind . <F2> showrefs
2601    bindmodfunctionkey Shift 4 {newview 0}
2602    bind . <F4> edit_or_newview
2603    bind . <$M1B-q> doquit
2604    bind . <$M1B-f> {dofind 1 1}
2605    bind . <$M1B-g> {dofind 1 0}
2606    bind . <$M1B-r> dosearchback
2607    bind . <$M1B-s> dosearch
2608    bind . <$M1B-equal> {incrfont 1}
2609    bind . <$M1B-plus> {incrfont 1}
2610    bind . <$M1B-KP_Add> {incrfont 1}
2611    bind . <$M1B-minus> {incrfont -1}
2612    bind . <$M1B-KP_Subtract> {incrfont -1}
2613    wm protocol . WM_DELETE_WINDOW doquit
2614    bind . <Destroy> {stop_backends}
2615    bind . <Button-1> "click %W"
2616    bind $fstring <Key-Return> {dofind 1 1}
2617    bind $sha1entry <Key-Return> {gotocommit; break}
2618    bind $sha1entry <<PasteSelection>> clearsha1
2619    bind $sha1entry <<Paste>> clearsha1
2620    bind $cflist <1> {sel_flist %W %x %y; break}
2621    bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
2622    bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
2623    global ctxbut
2624    bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
2625    bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
2626    bind $ctext <Button-1> {focus %W}
2627    bind $ctext <<Selection>> rehighlight_search_results
2628    for {set i 1} {$i < 10} {incr i} {
2629        bind . <$M1B-Key-$i> [list go_to_parent $i]
2630    }
2631
2632    set maincursor [. cget -cursor]
2633    set textcursor [$ctext cget -cursor]
2634    set curtextcursor $textcursor
2635
2636    set rowctxmenu .rowctxmenu
2637    makemenu $rowctxmenu {
2638        {mc "Diff this -> selected" command {diffvssel 0}}
2639        {mc "Diff selected -> this" command {diffvssel 1}}
2640        {mc "Make patch" command mkpatch}
2641        {mc "Create tag" command mktag}
2642        {mc "Copy commit summary" command copysummary}
2643        {mc "Write commit to file" command writecommit}
2644        {mc "Create new branch" command mkbranch}
2645        {mc "Cherry-pick this commit" command cherrypick}
2646        {mc "Reset HEAD branch to here" command resethead}
2647        {mc "Mark this commit" command markhere}
2648        {mc "Return to mark" command gotomark}
2649        {mc "Find descendant of this and mark" command find_common_desc}
2650        {mc "Compare with marked commit" command compare_commits}
2651        {mc "Diff this -> marked commit" command {diffvsmark 0}}
2652        {mc "Diff marked commit -> this" command {diffvsmark 1}}
2653        {mc "Revert this commit" command revert}
2654    }
2655    $rowctxmenu configure -tearoff 0
2656
2657    set fakerowmenu .fakerowmenu
2658    makemenu $fakerowmenu {
2659        {mc "Diff this -> selected" command {diffvssel 0}}
2660        {mc "Diff selected -> this" command {diffvssel 1}}
2661        {mc "Make patch" command mkpatch}
2662        {mc "Diff this -> marked commit" command {diffvsmark 0}}
2663        {mc "Diff marked commit -> this" command {diffvsmark 1}}
2664    }
2665    $fakerowmenu configure -tearoff 0
2666
2667    set headctxmenu .headctxmenu
2668    makemenu $headctxmenu {
2669        {mc "Check out this branch" command cobranch}
2670        {mc "Rename this branch" command mvbranch}
2671        {mc "Remove this branch" command rmbranch}
2672        {mc "Copy branch name" command {clipboard clear; clipboard append $headmenuhead}}
2673    }
2674    $headctxmenu configure -tearoff 0
2675
2676    global flist_menu
2677    set flist_menu .flistctxmenu
2678    makemenu $flist_menu {
2679        {mc "Highlight this too" command {flist_hl 0}}
2680        {mc "Highlight this only" command {flist_hl 1}}
2681        {mc "External diff" command {external_diff}}
2682        {mc "Blame parent commit" command {external_blame 1}}
2683        {mc "Copy path" command {clipboard clear; clipboard append $flist_menu_file}}
2684    }
2685    $flist_menu configure -tearoff 0
2686
2687    global diff_menu
2688    set diff_menu .diffctxmenu
2689    makemenu $diff_menu {
2690        {mc "Show origin of this line" command show_line_source}
2691        {mc "Run git gui blame on this line" command {external_blame_diff}}
2692    }
2693    $diff_menu configure -tearoff 0
2694}
2695
2696# Windows sends all mouse wheel events to the current focused window, not
2697# the one where the mouse hovers, so bind those events here and redirect
2698# to the correct window
2699proc windows_mousewheel_redirector {W X Y D} {
2700    global canv canv2 canv3
2701    set w [winfo containing -displayof $W $X $Y]
2702    if {$w ne ""} {
2703        set u [expr {$D < 0 ? 5 : -5}]
2704        if {$w == $canv || $w == $canv2 || $w == $canv3} {
2705            allcanvs yview scroll $u units
2706        } else {
2707            catch {
2708                $w yview scroll $u units
2709            }
2710        }
2711    }
2712}
2713
2714# Update row number label when selectedline changes
2715proc selectedline_change {n1 n2 op} {
2716    global selectedline rownumsel
2717
2718    if {$selectedline eq {}} {
2719        set rownumsel {}
2720    } else {
2721        set rownumsel [expr {$selectedline + 1}]
2722    }
2723}
2724
2725# mouse-2 makes all windows scan vertically, but only the one
2726# the cursor is in scans horizontally
2727proc canvscan {op w x y} {
2728    global canv canv2 canv3
2729    foreach c [list $canv $canv2 $canv3] {
2730        if {$c == $w} {
2731            $c scan $op $x $y
2732        } else {
2733            $c scan $op 0 $y
2734        }
2735    }
2736}
2737
2738proc scrollcanv {cscroll f0 f1} {
2739    $cscroll set $f0 $f1
2740    drawvisible
2741    flushhighlights
2742}
2743
2744# when we make a key binding for the toplevel, make sure
2745# it doesn't get triggered when that key is pressed in the
2746# find string entry widget.
2747proc bindkey {ev script} {
2748    global entries
2749    bind . $ev $script
2750    set escript [bind Entry $ev]
2751    if {$escript == {}} {
2752        set escript [bind Entry <Key>]
2753    }
2754    foreach e $entries {
2755        bind $e $ev "$escript; break"
2756    }
2757}
2758
2759proc bindmodfunctionkey {mod n script} {
2760    bind . <$mod-F$n> $script
2761    catch { bind . <$mod-XF86_Switch_VT_$n> $script }
2762}
2763
2764# set the focus back to the toplevel for any click outside
2765# the entry widgets
2766proc click {w} {
2767    global ctext entries
2768    foreach e [concat $entries $ctext] {
2769        if {$w == $e} return
2770    }
2771    focus .
2772}
2773
2774# Adjust the progress bar for a change in requested extent or canvas size
2775proc adjustprogress {} {
2776    global progresscanv progressitem progresscoords
2777    global fprogitem fprogcoord lastprogupdate progupdatepending
2778    global rprogitem rprogcoord use_ttk
2779
2780    if {$use_ttk} {
2781        $progresscanv configure -value [expr {int($fprogcoord * 100)}]
2782        return
2783    }
2784
2785    set w [expr {[winfo width $progresscanv] - 4}]
2786    set x0 [expr {$w * [lindex $progresscoords 0]}]
2787    set x1 [expr {$w * [lindex $progresscoords 1]}]
2788    set h [winfo height $progresscanv]
2789    $progresscanv coords $progressitem $x0 0 $x1 $h
2790    $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2791    $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2792    set now [clock clicks -milliseconds]
2793    if {$now >= $lastprogupdate + 100} {
2794        set progupdatepending 0
2795        update
2796    } elseif {!$progupdatepending} {
2797        set progupdatepending 1
2798        after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2799    }
2800}
2801
2802proc doprogupdate {} {
2803    global lastprogupdate progupdatepending
2804
2805    if {$progupdatepending} {
2806        set progupdatepending 0
2807        set lastprogupdate [clock clicks -milliseconds]
2808        update
2809    }
2810}
2811
2812proc config_check_tmp_exists {tries_left} {
2813    global config_file_tmp
2814
2815    if {[file exists $config_file_tmp]} {
2816        incr tries_left -1
2817        if {$tries_left > 0} {
2818            after 100 [list config_check_tmp_exists $tries_left]
2819        } else {
2820            error_popup "There appears to be a stale $config_file_tmp\
2821 file, which will prevent gitk from saving its configuration on exit.\
2822 Please remove it if it is not being used by any existing gitk process."
2823        }
2824    }
2825}
2826
2827proc config_init_trace {name} {
2828    global config_variable_changed config_variable_original
2829
2830    upvar #0 $name var
2831    set config_variable_changed($name) 0
2832    set config_variable_original($name) $var
2833}
2834
2835proc config_variable_change_cb {name name2 op} {
2836    global config_variable_changed config_variable_original
2837
2838    upvar #0 $name var
2839    if {$op eq "write" &&
2840        (![info exists config_variable_original($name)] ||
2841         $config_variable_original($name) ne $var)} {
2842        set config_variable_changed($name) 1
2843    }
2844}
2845
2846proc savestuff {w} {
2847    global stuffsaved
2848    global config_file config_file_tmp
2849    global config_variables config_variable_changed
2850    global viewchanged
2851
2852    upvar #0 viewname current_viewname
2853    upvar #0 viewfiles current_viewfiles
2854    upvar #0 viewargs current_viewargs
2855    upvar #0 viewargscmd current_viewargscmd
2856    upvar #0 viewperm current_viewperm
2857    upvar #0 nextviewnum current_nextviewnum
2858    upvar #0 use_ttk current_use_ttk
2859
2860    if {$stuffsaved} return
2861    if {![winfo viewable .]} return
2862    set remove_tmp 0
2863    if {[catch {
2864        set try_count 0
2865        while {[catch {set f [open $config_file_tmp {WRONLY CREAT EXCL}]}]} {
2866            if {[incr try_count] > 50} {
2867                error "Unable to write config file: $config_file_tmp exists"
2868            }
2869            after 100
2870        }
2871        set remove_tmp 1
2872        if {$::tcl_platform(platform) eq {windows}} {
2873            file attributes $config_file_tmp -hidden true
2874        }
2875        if {[file exists $config_file]} {
2876            source $config_file
2877        }
2878        foreach var_name $config_variables {
2879            upvar #0 $var_name var
2880            upvar 0 $var_name old_var
2881            if {!$config_variable_changed($var_name) && [info exists old_var]} {
2882                puts $f [list set $var_name $old_var]
2883            } else {
2884                puts $f [list set $var_name $var]
2885            }
2886        }
2887
2888        puts $f "set geometry(main) [wm geometry .]"
2889        puts $f "set geometry(state) [wm state .]"
2890        puts $f "set geometry(topwidth) [winfo width .tf]"
2891        puts $f "set geometry(topheight) [winfo height .tf]"
2892        if {$current_use_ttk} {
2893            puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
2894            puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
2895        } else {
2896            puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2897            puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2898        }
2899        puts $f "set geometry(botwidth) [winfo width .bleft]"
2900        puts $f "set geometry(botheight) [winfo height .bleft]"
2901
2902        array set view_save {}
2903        array set views {}
2904        if {![info exists permviews]} { set permviews {} }
2905        foreach view $permviews {
2906            set view_save([lindex $view 0]) 1
2907            set views([lindex $view 0]) $view
2908        }
2909        puts -nonewline $f "set permviews {"
2910        for {set v 1} {$v < $current_nextviewnum} {incr v} {
2911            if {$viewchanged($v)} {
2912                if {$current_viewperm($v)} {
2913                    set views($current_viewname($v)) [list $current_viewname($v) $current_viewfiles($v) $current_viewargs($v) $current_viewargscmd($v)]
2914                } else {
2915                    set view_save($current_viewname($v)) 0
2916                }
2917            }
2918        }
2919        # write old and updated view to their places and append remaining to the end
2920        foreach view $permviews {
2921            set view_name [lindex $view 0]
2922            if {$view_save($view_name)} {
2923                puts $f "{$views($view_name)}"
2924            }
2925            unset views($view_name)
2926        }
2927        foreach view_name [array names views] {
2928            puts $f "{$views($view_name)}"
2929        }
2930        puts $f "}"
2931        close $f
2932        file rename -force $config_file_tmp $config_file
2933        set remove_tmp 0
2934    } err]} {
2935        puts "Error saving config: $err"
2936    }
2937    if {$remove_tmp} {
2938        file delete -force $config_file_tmp
2939    }
2940    set stuffsaved 1
2941}
2942
2943proc resizeclistpanes {win w} {
2944    global oldwidth use_ttk
2945    if {[info exists oldwidth($win)]} {
2946        if {$use_ttk} {
2947            set s0 [$win sashpos 0]
2948            set s1 [$win sashpos 1]
2949        } else {
2950            set s0 [$win sash coord 0]
2951            set s1 [$win sash coord 1]
2952        }
2953        if {$w < 60} {
2954            set sash0 [expr {int($w/2 - 2)}]
2955            set sash1 [expr {int($w*5/6 - 2)}]
2956        } else {
2957            set factor [expr {1.0 * $w / $oldwidth($win)}]
2958            set sash0 [expr {int($factor * [lindex $s0 0])}]
2959            set sash1 [expr {int($factor * [lindex $s1 0])}]
2960            if {$sash0 < 30} {
2961                set sash0 30
2962            }
2963            if {$sash1 < $sash0 + 20} {
2964                set sash1 [expr {$sash0 + 20}]
2965            }
2966            if {$sash1 > $w - 10} {
2967                set sash1 [expr {$w - 10}]
2968                if {$sash0 > $sash1 - 20} {
2969                    set sash0 [expr {$sash1 - 20}]
2970                }
2971            }
2972        }
2973        if {$use_ttk} {
2974            $win sashpos 0 $sash0
2975            $win sashpos 1 $sash1
2976        } else {
2977            $win sash place 0 $sash0 [lindex $s0 1]
2978            $win sash place 1 $sash1 [lindex $s1 1]
2979        }
2980    }
2981    set oldwidth($win) $w
2982}
2983
2984proc resizecdetpanes {win w} {
2985    global oldwidth use_ttk
2986    if {[info exists oldwidth($win)]} {
2987        if {$use_ttk} {
2988            set s0 [$win sashpos 0]
2989        } else {
2990            set s0 [$win sash coord 0]
2991        }
2992        if {$w < 60} {
2993            set sash0 [expr {int($w*3/4 - 2)}]
2994        } else {
2995            set factor [expr {1.0 * $w / $oldwidth($win)}]
2996            set sash0 [expr {int($factor * [lindex $s0 0])}]
2997            if {$sash0 < 45} {
2998                set sash0 45
2999            }
3000            if {$sash0 > $w - 15} {
3001                set sash0 [expr {$w - 15}]
3002            }
3003        }
3004        if {$use_ttk} {
3005            $win sashpos 0 $sash0
3006        } else {
3007            $win sash place 0 $sash0 [lindex $s0 1]
3008        }
3009    }
3010    set oldwidth($win) $w
3011}
3012
3013proc allcanvs args {
3014    global canv canv2 canv3
3015    eval $canv $args
3016    eval $canv2 $args
3017    eval $canv3 $args
3018}
3019
3020proc bindall {event action} {
3021    global canv canv2 canv3
3022    bind $canv $event $action
3023    bind $canv2 $event $action
3024    bind $canv3 $event $action
3025}
3026
3027proc about {} {
3028    global bgcolor NS
3029    set w .about
3030    if {[winfo exists $w]} {
3031        raise $w
3032        return
3033    }
3034    ttk_toplevel $w
3035    wm title $w [mc "About gitk"]
3036    make_transient $w .
3037    message $w.m -text [mc "
3038Gitk - a commit viewer for git
3039
3040Copyright \u00a9 2005-2014 Paul Mackerras
3041
3042Use and redistribute under the terms of the GNU General Public License"] \
3043            -justify center -aspect 400 -border 2 -bg $bgcolor -relief groove
3044    pack $w.m -side top -fill x -padx 2 -pady 2
3045    ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
3046    pack $w.ok -side bottom
3047    bind $w <Visibility> "focus $w.ok"
3048    bind $w <Key-Escape> "destroy $w"
3049    bind $w <Key-Return> "destroy $w"
3050    tk::PlaceWindow $w widget .
3051}
3052
3053proc keys {} {
3054    global bgcolor NS
3055    set w .keys
3056    if {[winfo exists $w]} {
3057        raise $w
3058        return
3059    }
3060    if {[tk windowingsystem] eq {aqua}} {
3061        set M1T Cmd
3062    } else {
3063        set M1T Ctrl
3064    }
3065    ttk_toplevel $w
3066    wm title $w [mc "Gitk key bindings"]
3067    make_transient $w .
3068    message $w.m -text "
3069[mc "Gitk key bindings:"]
3070
3071[mc "<%s-Q>             Quit" $M1T]
3072[mc "<%s-W>             Close window" $M1T]
3073[mc "<Home>             Move to first commit"]
3074[mc "<End>              Move to last commit"]
3075[mc "<Up>, p, k Move up one commit"]
3076[mc "<Down>, n, j       Move down one commit"]
3077[mc "<Left>, z, h       Go back in history list"]
3078[mc "<Right>, x, l      Go forward in history list"]
3079[mc "<%s-n>     Go to n-th parent of current commit in history list" $M1T]
3080[mc "<PageUp>   Move up one page in commit list"]
3081[mc "<PageDown> Move down one page in commit list"]
3082[mc "<%s-Home>  Scroll to top of commit list" $M1T]
3083[mc "<%s-End>   Scroll to bottom of commit list" $M1T]
3084[mc "<%s-Up>    Scroll commit list up one line" $M1T]
3085[mc "<%s-Down>  Scroll commit list down one line" $M1T]
3086[mc "<%s-PageUp>        Scroll commit list up one page" $M1T]
3087[mc "<%s-PageDown>      Scroll commit list down one page" $M1T]
3088[mc "<Shift-Up> Find backwards (upwards, later commits)"]
3089[mc "<Shift-Down>       Find forwards (downwards, earlier commits)"]
3090[mc "<Delete>, b        Scroll diff view up one page"]
3091[mc "<Backspace>        Scroll diff view up one page"]
3092[mc "<Space>            Scroll diff view down one page"]
3093[mc "u          Scroll diff view up 18 lines"]
3094[mc "d          Scroll diff view down 18 lines"]
3095[mc "<%s-F>             Find" $M1T]
3096[mc "<%s-G>             Move to next find hit" $M1T]
3097[mc "<Return>   Move to next find hit"]
3098[mc "g          Go to commit"]
3099[mc "/          Focus the search box"]
3100[mc "?          Move to previous find hit"]
3101[mc "f          Scroll diff view to next file"]
3102[mc "<%s-S>             Search for next hit in diff view" $M1T]
3103[mc "<%s-R>             Search for previous hit in diff view" $M1T]
3104[mc "<%s-KP+>   Increase font size" $M1T]
3105[mc "<%s-plus>  Increase font size" $M1T]
3106[mc "<%s-KP->   Decrease font size" $M1T]
3107[mc "<%s-minus> Decrease font size" $M1T]
3108[mc "<F5>               Update"]
3109" \
3110            -justify left -bg $bgcolor -border 2 -relief groove
3111    pack $w.m -side top -fill both -padx 2 -pady 2
3112    ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
3113    bind $w <Key-Escape> [list destroy $w]
3114    pack $w.ok -side bottom
3115    bind $w <Visibility> "focus $w.ok"
3116    bind $w <Key-Escape> "destroy $w"
3117    bind $w <Key-Return> "destroy $w"
3118}
3119
3120# Procedures for manipulating the file list window at the
3121# bottom right of the overall window.
3122
3123proc treeview {w l openlevs} {
3124    global treecontents treediropen treeheight treeparent treeindex
3125
3126    set ix 0
3127    set treeindex() 0
3128    set lev 0
3129    set prefix {}
3130    set prefixend -1
3131    set prefendstack {}
3132    set htstack {}
3133    set ht 0
3134    set treecontents() {}
3135    $w conf -state normal
3136    foreach f $l {
3137        while {[string range $f 0 $prefixend] ne $prefix} {
3138            if {$lev <= $openlevs} {
3139                $w mark set e:$treeindex($prefix) "end -1c"
3140                $w mark gravity e:$treeindex($prefix) left
3141            }
3142            set treeheight($prefix) $ht
3143            incr ht [lindex $htstack end]
3144            set htstack [lreplace $htstack end end]
3145            set prefixend [lindex $prefendstack end]
3146            set prefendstack [lreplace $prefendstack end end]
3147            set prefix [string range $prefix 0 $prefixend]
3148            incr lev -1
3149        }
3150        set tail [string range $f [expr {$prefixend+1}] end]
3151        while {[set slash [string first "/" $tail]] >= 0} {
3152            lappend htstack $ht
3153            set ht 0
3154            lappend prefendstack $prefixend
3155            incr prefixend [expr {$slash + 1}]
3156            set d [string range $tail 0 $slash]
3157            lappend treecontents($prefix) $d
3158            set oldprefix $prefix
3159            append prefix $d
3160            set treecontents($prefix) {}
3161            set treeindex($prefix) [incr ix]
3162            set treeparent($prefix) $oldprefix
3163            set tail [string range $tail [expr {$slash+1}] end]
3164            if {$lev <= $openlevs} {
3165                set ht 1
3166                set treediropen($prefix) [expr {$lev < $openlevs}]
3167                set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
3168                $w mark set d:$ix "end -1c"
3169                $w mark gravity d:$ix left
3170                set str "\n"
3171                for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3172                $w insert end $str
3173                $w image create end -align center -image $bm -padx 1 \
3174                    -name a:$ix
3175                $w insert end $d [highlight_tag $prefix]
3176                $w mark set s:$ix "end -1c"
3177                $w mark gravity s:$ix left
3178            }
3179            incr lev
3180        }
3181        if {$tail ne {}} {
3182            if {$lev <= $openlevs} {
3183                incr ht
3184                set str "\n"
3185                for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3186                $w insert end $str
3187                $w insert end $tail [highlight_tag $f]
3188            }
3189            lappend treecontents($prefix) $tail
3190        }
3191    }
3192    while {$htstack ne {}} {
3193        set treeheight($prefix) $ht
3194        incr ht [lindex $htstack end]
3195        set htstack [lreplace $htstack end end]
3196        set prefixend [lindex $prefendstack end]
3197        set prefendstack [lreplace $prefendstack end end]
3198        set prefix [string range $prefix 0 $prefixend]
3199    }
3200    $w conf -state disabled
3201}
3202
3203proc linetoelt {l} {
3204    global treeheight treecontents
3205
3206    set y 2
3207    set prefix {}
3208    while {1} {
3209        foreach e $treecontents($prefix) {
3210            if {$y == $l} {
3211                return "$prefix$e"
3212            }
3213            set n 1
3214            if {[string index $e end] eq "/"} {
3215                set n $treeheight($prefix$e)
3216                if {$y + $n > $l} {
3217                    append prefix $e
3218                    incr y
3219                    break
3220                }
3221            }
3222            incr y $n
3223        }
3224    }
3225}
3226
3227proc highlight_tree {y prefix} {
3228    global treeheight treecontents cflist
3229
3230    foreach e $treecontents($prefix) {
3231        set path $prefix$e
3232        if {[highlight_tag $path] ne {}} {
3233            $cflist tag add bold $y.0 "$y.0 lineend"
3234        }
3235        incr y
3236        if {[string index $e end] eq "/" && $treeheight($path) > 1} {
3237            set y [highlight_tree $y $path]
3238        }
3239    }
3240    return $y
3241}
3242
3243proc treeclosedir {w dir} {
3244    global treediropen treeheight treeparent treeindex
3245
3246    set ix $treeindex($dir)
3247    $w conf -state normal
3248    $w delete s:$ix e:$ix
3249    set treediropen($dir) 0
3250    $w image configure a:$ix -image tri-rt
3251    $w conf -state disabled
3252    set n [expr {1 - $treeheight($dir)}]
3253    while {$dir ne {}} {
3254        incr treeheight($dir) $n
3255        set dir $treeparent($dir)
3256    }
3257}
3258
3259proc treeopendir {w dir} {
3260    global treediropen treeheight treeparent treecontents treeindex
3261
3262    set ix $treeindex($dir)
3263    $w conf -state normal
3264    $w image configure a:$ix -image tri-dn
3265    $w mark set e:$ix s:$ix
3266    $w mark gravity e:$ix right
3267    set lev 0
3268    set str "\n"
3269    set n [llength $treecontents($dir)]
3270    for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
3271        incr lev
3272        append str "\t"
3273        incr treeheight($x) $n
3274    }
3275    foreach e $treecontents($dir) {
3276        set de $dir$e
3277        if {[string index $e end] eq "/"} {
3278            set iy $treeindex($de)
3279            $w mark set d:$iy e:$ix
3280            $w mark gravity d:$iy left
3281            $w insert e:$ix $str
3282            set treediropen($de) 0
3283            $w image create e:$ix -align center -image tri-rt -padx 1 \
3284                -name a:$iy
3285            $w insert e:$ix $e [highlight_tag $de]
3286            $w mark set s:$iy e:$ix
3287            $w mark gravity s:$iy left
3288            set treeheight($de) 1
3289        } else {
3290            $w insert e:$ix $str
3291            $w insert e:$ix $e [highlight_tag $de]
3292        }
3293    }
3294    $w mark gravity e:$ix right
3295    $w conf -state disabled
3296    set treediropen($dir) 1
3297    set top [lindex [split [$w index @0,0] .] 0]
3298    set ht [$w cget -height]
3299    set l [lindex [split [$w index s:$ix] .] 0]
3300    if {$l < $top} {
3301        $w yview $l.0
3302    } elseif {$l + $n + 1 > $top + $ht} {
3303        set top [expr {$l + $n + 2 - $ht}]
3304        if {$l < $top} {
3305            set top $l
3306        }
3307        $w yview $top.0
3308    }
3309}
3310
3311proc treeclick {w x y} {
3312    global treediropen cmitmode ctext cflist cflist_top
3313
3314    if {$cmitmode ne "tree"} return
3315    if {![info exists cflist_top]} return
3316    set l [lindex [split [$w index "@$x,$y"] "."] 0]
3317    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3318    $cflist tag add highlight $l.0 "$l.0 lineend"
3319    set cflist_top $l
3320    if {$l == 1} {
3321        $ctext yview 1.0
3322        return
3323    }
3324    set e [linetoelt $l]
3325    if {[string index $e end] ne "/"} {
3326        showfile $e
3327    } elseif {$treediropen($e)} {
3328        treeclosedir $w $e
3329    } else {
3330        treeopendir $w $e
3331    }
3332}
3333
3334proc setfilelist {id} {
3335    global treefilelist cflist jump_to_here
3336
3337    treeview $cflist $treefilelist($id) 0
3338    if {$jump_to_here ne {}} {
3339        set f [lindex $jump_to_here 0]
3340        if {[lsearch -exact $treefilelist($id) $f] >= 0} {
3341            showfile $f
3342        }
3343    }
3344}
3345
3346image create bitmap tri-rt -background black -foreground blue -data {
3347    #define tri-rt_width 13
3348    #define tri-rt_height 13
3349    static unsigned char tri-rt_bits[] = {
3350       0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
3351       0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
3352       0x00, 0x00};
3353} -maskdata {
3354    #define tri-rt-mask_width 13
3355    #define tri-rt-mask_height 13
3356    static unsigned char tri-rt-mask_bits[] = {
3357       0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
3358       0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
3359       0x08, 0x00};
3360}
3361image create bitmap tri-dn -background black -foreground blue -data {
3362    #define tri-dn_width 13
3363    #define tri-dn_height 13
3364    static unsigned char tri-dn_bits[] = {
3365       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
3366       0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3367       0x00, 0x00};
3368} -maskdata {
3369    #define tri-dn-mask_width 13
3370    #define tri-dn-mask_height 13
3371    static unsigned char tri-dn-mask_bits[] = {
3372       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
3373       0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
3374       0x00, 0x00};
3375}
3376
3377image create bitmap reficon-T -background black -foreground yellow -data {
3378    #define tagicon_width 13
3379    #define tagicon_height 9
3380    static unsigned char tagicon_bits[] = {
3381       0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
3382       0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
3383} -maskdata {
3384    #define tagicon-mask_width 13
3385    #define tagicon-mask_height 9
3386    static unsigned char tagicon-mask_bits[] = {
3387       0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
3388       0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
3389}
3390set rectdata {
3391    #define headicon_width 13
3392    #define headicon_height 9
3393    static unsigned char headicon_bits[] = {
3394       0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3395       0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3396}
3397set rectmask {
3398    #define headicon-mask_width 13
3399    #define headicon-mask_height 9
3400    static unsigned char headicon-mask_bits[] = {
3401       0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3402       0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3403}
3404image create bitmap reficon-H -background black -foreground "#00ff00" \
3405    -data $rectdata -maskdata $rectmask
3406image create bitmap reficon-o -background black -foreground "#ddddff" \
3407    -data $rectdata -maskdata $rectmask
3408
3409proc init_flist {first} {
3410    global cflist cflist_top difffilestart
3411
3412    $cflist conf -state normal
3413    $cflist delete 0.0 end
3414    if {$first ne {}} {
3415        $cflist insert end $first
3416        set cflist_top 1
3417        $cflist tag add highlight 1.0 "1.0 lineend"
3418    } else {
3419        unset -nocomplain cflist_top
3420    }
3421    $cflist conf -state disabled
3422    set difffilestart {}
3423}
3424
3425proc highlight_tag {f} {
3426    global highlight_paths
3427
3428    foreach p $highlight_paths {
3429        if {[string match $p $f]} {
3430            return "bold"
3431        }
3432    }
3433    return {}
3434}
3435
3436proc highlight_filelist {} {
3437    global cmitmode cflist
3438
3439    $cflist conf -state normal
3440    if {$cmitmode ne "tree"} {
3441        set end [lindex [split [$cflist index end] .] 0]
3442        for {set l 2} {$l < $end} {incr l} {
3443            set line [$cflist get $l.0 "$l.0 lineend"]
3444            if {[highlight_tag $line] ne {}} {
3445                $cflist tag add bold $l.0 "$l.0 lineend"
3446            }
3447        }
3448    } else {
3449        highlight_tree 2 {}
3450    }
3451    $cflist conf -state disabled
3452}
3453
3454proc unhighlight_filelist {} {
3455    global cflist
3456
3457    $cflist conf -state normal
3458    $cflist tag remove bold 1.0 end
3459    $cflist conf -state disabled
3460}
3461
3462proc add_flist {fl} {
3463    global cflist
3464
3465    $cflist conf -state normal
3466    foreach f $fl {
3467        $cflist insert end "\n"
3468        $cflist insert end $f [highlight_tag $f]
3469    }
3470    $cflist conf -state disabled
3471}
3472
3473proc sel_flist {w x y} {
3474    global ctext difffilestart cflist cflist_top cmitmode
3475
3476    if {$cmitmode eq "tree"} return
3477    if {![info exists cflist_top]} return
3478    set l [lindex [split [$w index "@$x,$y"] "."] 0]
3479    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3480    $cflist tag add highlight $l.0 "$l.0 lineend"
3481    set cflist_top $l
3482    if {$l == 1} {
3483        $ctext yview 1.0
3484    } else {
3485        catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
3486    }
3487    suppress_highlighting_file_for_current_scrollpos
3488}
3489
3490proc pop_flist_menu {w X Y x y} {
3491    global ctext cflist cmitmode flist_menu flist_menu_file
3492    global treediffs diffids
3493
3494    stopfinding
3495    set l [lindex [split [$w index "@$x,$y"] "."] 0]
3496    if {$l <= 1} return
3497    if {$cmitmode eq "tree"} {
3498        set e [linetoelt $l]
3499        if {[string index $e end] eq "/"} return
3500    } else {
3501        set e [lindex $treediffs($diffids) [expr {$l-2}]]
3502    }
3503    set flist_menu_file $e
3504    set xdiffstate "normal"
3505    if {$cmitmode eq "tree"} {
3506        set xdiffstate "disabled"
3507    }
3508    # Disable "External diff" item in tree mode
3509    $flist_menu entryconf 2 -state $xdiffstate
3510    tk_popup $flist_menu $X $Y
3511}
3512
3513proc find_ctext_fileinfo {line} {
3514    global ctext_file_names ctext_file_lines
3515
3516    set ok [bsearch $ctext_file_lines $line]
3517    set tline [lindex $ctext_file_lines $ok]
3518
3519    if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3520        return {}
3521    } else {
3522        return [list [lindex $ctext_file_names $ok] $tline]
3523    }
3524}
3525
3526proc pop_diff_menu {w X Y x y} {
3527    global ctext diff_menu flist_menu_file
3528    global diff_menu_txtpos diff_menu_line
3529    global diff_menu_filebase
3530
3531    set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3532    set diff_menu_line [lindex $diff_menu_txtpos 0]
3533    # don't pop up the menu on hunk-separator or file-separator lines
3534    if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3535        return
3536    }
3537    stopfinding
3538    set f [find_ctext_fileinfo $diff_menu_line]
3539    if {$f eq {}} return
3540    set flist_menu_file [lindex $f 0]
3541    set diff_menu_filebase [lindex $f 1]
3542    tk_popup $diff_menu $X $Y
3543}
3544
3545proc flist_hl {only} {
3546    global flist_menu_file findstring gdttype
3547
3548    set x [shellquote $flist_menu_file]
3549    if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
3550        set findstring $x
3551    } else {
3552        append findstring " " $x
3553    }
3554    set gdttype [mc "touching paths:"]
3555}
3556
3557proc gitknewtmpdir {} {
3558    global diffnum gitktmpdir gitdir env
3559
3560    if {![info exists gitktmpdir]} {
3561        if {[info exists env(GITK_TMPDIR)]} {
3562            set tmpdir $env(GITK_TMPDIR)
3563        } elseif {[info exists env(TMPDIR)]} {
3564            set tmpdir $env(TMPDIR)
3565        } else {
3566            set tmpdir $gitdir
3567        }
3568        set gitktmpformat [file join $tmpdir ".gitk-tmp.XXXXXX"]
3569        if {[catch {set gitktmpdir [exec mktemp -d $gitktmpformat]}]} {
3570            set gitktmpdir [file join $gitdir [format ".gitk-tmp.%s" [pid]]]
3571        }
3572        if {[catch {file mkdir $gitktmpdir} err]} {
3573            error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3574            unset gitktmpdir
3575            return {}
3576        }
3577        set diffnum 0
3578    }
3579    incr diffnum
3580    set diffdir [file join $gitktmpdir $diffnum]
3581    if {[catch {file mkdir $diffdir} err]} {
3582        error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3583        return {}
3584    }
3585    return $diffdir
3586}
3587
3588proc save_file_from_commit {filename output what} {
3589    global nullfile
3590
3591    if {[catch {exec git show $filename -- > $output} err]} {
3592        if {[string match "fatal: bad revision *" $err]} {
3593            return $nullfile
3594        }
3595        error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
3596        return {}
3597    }
3598    return $output
3599}
3600
3601proc external_diff_get_one_file {diffid filename diffdir} {
3602    global nullid nullid2 nullfile
3603    global worktree
3604
3605    if {$diffid == $nullid} {
3606        set difffile [file join $worktree $filename]
3607        if {[file exists $difffile]} {
3608            return $difffile
3609        }
3610        return $nullfile
3611    }
3612    if {$diffid == $nullid2} {
3613        set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3614        return [save_file_from_commit :$filename $difffile index]
3615    }
3616    set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3617    return [save_file_from_commit $diffid:$filename $difffile \
3618               "revision $diffid"]
3619}
3620
3621proc external_diff {} {
3622    global nullid nullid2
3623    global flist_menu_file
3624    global diffids
3625    global extdifftool
3626
3627    if {[llength $diffids] == 1} {
3628        # no reference commit given
3629        set diffidto [lindex $diffids 0]
3630        if {$diffidto eq $nullid} {
3631            # diffing working copy with index
3632            set diffidfrom $nullid2
3633        } elseif {$diffidto eq $nullid2} {
3634            # diffing index with HEAD
3635            set diffidfrom "HEAD"
3636        } else {
3637            # use first parent commit
3638            global parentlist selectedline
3639            set diffidfrom [lindex $parentlist $selectedline 0]
3640        }
3641    } else {
3642        set diffidfrom [lindex $diffids 0]
3643        set diffidto [lindex $diffids 1]
3644    }
3645
3646    # make sure that several diffs wont collide
3647    set diffdir [gitknewtmpdir]
3648    if {$diffdir eq {}} return
3649
3650    # gather files to diff
3651    set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3652    set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3653
3654    if {$difffromfile ne {} && $difftofile ne {}} {
3655        set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
3656        if {[catch {set fl [open |$cmd r]} err]} {
3657            file delete -force $diffdir
3658            error_popup "$extdifftool: [mc "command failed:"] $err"
3659        } else {
3660            fconfigure $fl -blocking 0
3661            filerun $fl [list delete_at_eof $fl $diffdir]
3662        }
3663    }
3664}
3665
3666proc find_hunk_blamespec {base line} {
3667    global ctext
3668
3669    # Find and parse the hunk header
3670    set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3671    if {$s_lix eq {}} return
3672
3673    set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3674    if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3675            s_line old_specs osz osz1 new_line nsz]} {
3676        return
3677    }
3678
3679    # base lines for the parents
3680    set base_lines [list $new_line]
3681    foreach old_spec [lrange [split $old_specs " "] 1 end] {
3682        if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3683                old_spec old_line osz]} {
3684            return
3685        }
3686        lappend base_lines $old_line
3687    }
3688
3689    # Now scan the lines to determine offset within the hunk
3690    set max_parent [expr {[llength $base_lines]-2}]
3691    set dline 0
3692    set s_lno [lindex [split $s_lix "."] 0]
3693
3694    # Determine if the line is removed
3695    set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3696    if {[string match {[-+ ]*} $chunk]} {
3697        set removed_idx [string first "-" $chunk]
3698        # Choose a parent index
3699        if {$removed_idx >= 0} {
3700            set parent $removed_idx
3701        } else {
3702            set unchanged_idx [string first " " $chunk]
3703            if {$unchanged_idx >= 0} {
3704                set parent $unchanged_idx
3705            } else {
3706                # blame the current commit
3707                set parent -1
3708            }
3709        }
3710        # then count other lines that belong to it
3711        for {set i $line} {[incr i -1] > $s_lno} {} {
3712            set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3713            # Determine if the line is removed
3714            set removed_idx [string first "-" $chunk]
3715            if {$parent >= 0} {
3716                set code [string index $chunk $parent]
3717                if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3718                    incr dline
3719                }
3720            } else {
3721                if {$removed_idx < 0} {
3722                    incr dline
3723                }
3724            }
3725        }
3726        incr parent
3727    } else {
3728        set parent 0
3729    }
3730
3731    incr dline [lindex $base_lines $parent]
3732    return [list $parent $dline]
3733}
3734
3735proc external_blame_diff {} {
3736    global currentid cmitmode
3737    global diff_menu_txtpos diff_menu_line
3738    global diff_menu_filebase flist_menu_file
3739
3740    if {$cmitmode eq "tree"} {
3741        set parent_idx 0
3742        set line [expr {$diff_menu_line - $diff_menu_filebase}]
3743    } else {
3744        set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3745        if {$hinfo ne {}} {
3746            set parent_idx [lindex $hinfo 0]
3747            set line [lindex $hinfo 1]
3748        } else {
3749            set parent_idx 0
3750            set line 0
3751        }
3752    }
3753
3754    external_blame $parent_idx $line
3755}
3756
3757# Find the SHA1 ID of the blob for file $fname in the index
3758# at stage 0 or 2
3759proc index_sha1 {fname} {
3760    set f [open [list | git ls-files -s $fname] r]
3761    while {[gets $f line] >= 0} {
3762        set info [lindex [split $line "\t"] 0]
3763        set stage [lindex $info 2]
3764        if {$stage eq "0" || $stage eq "2"} {
3765            close $f
3766            return [lindex $info 1]
3767        }
3768    }
3769    close $f
3770    return {}
3771}
3772
3773# Turn an absolute path into one relative to the current directory
3774proc make_relative {f} {
3775    if {[file pathtype $f] eq "relative"} {
3776        return $f
3777    }
3778    set elts [file split $f]
3779    set here [file split [pwd]]
3780    set ei 0
3781    set hi 0
3782    set res {}
3783    foreach d $here {
3784        if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3785            lappend res ".."
3786        } else {
3787            incr ei
3788        }
3789        incr hi
3790    }
3791    set elts [concat $res [lrange $elts $ei end]]
3792    return [eval file join $elts]
3793}
3794
3795proc external_blame {parent_idx {line {}}} {
3796    global flist_menu_file cdup
3797    global nullid nullid2
3798    global parentlist selectedline currentid
3799
3800    if {$parent_idx > 0} {
3801        set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3802    } else {
3803        set base_commit $currentid
3804    }
3805
3806    if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3807        error_popup [mc "No such commit"]
3808        return
3809    }
3810
3811    set cmdline [list git gui blame]
3812    if {$line ne {} && $line > 1} {
3813        lappend cmdline "--line=$line"
3814    }
3815    set f [file join $cdup $flist_menu_file]
3816    # Unfortunately it seems git gui blame doesn't like
3817    # being given an absolute path...
3818    set f [make_relative $f]
3819    lappend cmdline $base_commit $f
3820    if {[catch {eval exec $cmdline &} err]} {
3821        error_popup "[mc "git gui blame: command failed:"] $err"
3822    }
3823}
3824
3825proc show_line_source {} {
3826    global cmitmode currentid parents curview blamestuff blameinst
3827    global diff_menu_line diff_menu_filebase flist_menu_file
3828    global nullid nullid2 gitdir cdup
3829
3830    set from_index {}
3831    if {$cmitmode eq "tree"} {
3832        set id $currentid
3833        set line [expr {$diff_menu_line - $diff_menu_filebase}]
3834    } else {
3835        set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3836        if {$h eq {}} return
3837        set pi [lindex $h 0]
3838        if {$pi == 0} {
3839            mark_ctext_line $diff_menu_line
3840            return
3841        }
3842        incr pi -1
3843        if {$currentid eq $nullid} {
3844            if {$pi > 0} {
3845                # must be a merge in progress...
3846                if {[catch {
3847                    # get the last line from .git/MERGE_HEAD
3848                    set f [open [file join $gitdir MERGE_HEAD] r]
3849                    set id [lindex [split [read $f] "\n"] end-1]
3850                    close $f
3851                } err]} {
3852                    error_popup [mc "Couldn't read merge head: %s" $err]
3853                    return
3854                }
3855            } elseif {$parents($curview,$currentid) eq $nullid2} {
3856                # need to do the blame from the index
3857                if {[catch {
3858                    set from_index [index_sha1 $flist_menu_file]
3859                } err]} {
3860                    error_popup [mc "Error reading index: %s" $err]
3861                    return
3862                }
3863            } else {
3864                set id $parents($curview,$currentid)
3865            }
3866        } else {
3867            set id [lindex $parents($curview,$currentid) $pi]
3868        }
3869        set line [lindex $h 1]
3870    }
3871    set blameargs {}
3872    if {$from_index ne {}} {
3873        lappend blameargs | git cat-file blob $from_index
3874    }
3875    lappend blameargs | git blame -p -L$line,+1
3876    if {$from_index ne {}} {
3877        lappend blameargs --contents -
3878    } else {
3879        lappend blameargs $id
3880    }
3881    lappend blameargs -- [file join $cdup $flist_menu_file]
3882    if {[catch {
3883        set f [open $blameargs r]
3884    } err]} {
3885        error_popup [mc "Couldn't start git blame: %s" $err]
3886        return
3887    }
3888    nowbusy blaming [mc "Searching"]
3889    fconfigure $f -blocking 0
3890    set i [reg_instance $f]
3891    set blamestuff($i) {}
3892    set blameinst $i
3893    filerun $f [list read_line_source $f $i]
3894}
3895
3896proc stopblaming {} {
3897    global blameinst
3898
3899    if {[info exists blameinst]} {
3900        stop_instance $blameinst
3901        unset blameinst
3902        notbusy blaming
3903    }
3904}
3905
3906proc read_line_source {fd inst} {
3907    global blamestuff curview commfd blameinst nullid nullid2
3908
3909    while {[gets $fd line] >= 0} {
3910        lappend blamestuff($inst) $line
3911    }
3912    if {![eof $fd]} {
3913        return 1
3914    }
3915    unset commfd($inst)
3916    unset blameinst
3917    notbusy blaming
3918    fconfigure $fd -blocking 1
3919    if {[catch {close $fd} err]} {
3920        error_popup [mc "Error running git blame: %s" $err]
3921        return 0
3922    }
3923
3924    set fname {}
3925    set line [split [lindex $blamestuff($inst) 0] " "]
3926    set id [lindex $line 0]
3927    set lnum [lindex $line 1]
3928    if {[string length $id] == 40 && [string is xdigit $id] &&
3929        [string is digit -strict $lnum]} {
3930        # look for "filename" line
3931        foreach l $blamestuff($inst) {
3932            if {[string match "filename *" $l]} {
3933                set fname [string range $l 9 end]
3934                break
3935            }
3936        }
3937    }
3938    if {$fname ne {}} {
3939        # all looks good, select it
3940        if {$id eq $nullid} {
3941            # blame uses all-zeroes to mean not committed,
3942            # which would mean a change in the index
3943            set id $nullid2
3944        }
3945        if {[commitinview $id $curview]} {
3946            selectline [rowofcommit $id] 1 [list $fname $lnum] 1
3947        } else {
3948            error_popup [mc "That line comes from commit %s, \
3949                             which is not in this view" [shortids $id]]
3950        }
3951    } else {
3952        puts "oops couldn't parse git blame output"
3953    }
3954    return 0
3955}
3956
3957# delete $dir when we see eof on $f (presumably because the child has exited)
3958proc delete_at_eof {f dir} {
3959    while {[gets $f line] >= 0} {}
3960    if {[eof $f]} {
3961        if {[catch {close $f} err]} {
3962            error_popup "[mc "External diff viewer failed:"] $err"
3963        }
3964        file delete -force $dir
3965        return 0
3966    }
3967    return 1
3968}
3969
3970# Functions for adding and removing shell-type quoting
3971
3972proc shellquote {str} {
3973    if {![string match "*\['\"\\ \t]*" $str]} {
3974        return $str
3975    }
3976    if {![string match "*\['\"\\]*" $str]} {
3977        return "\"$str\""
3978    }
3979    if {![string match "*'*" $str]} {
3980        return "'$str'"
3981    }
3982    return "\"[string map {\" \\\" \\ \\\\} $str]\""
3983}
3984
3985proc shellarglist {l} {
3986    set str {}
3987    foreach a $l {
3988        if {$str ne {}} {
3989            append str " "
3990        }
3991        append str [shellquote $a]
3992    }
3993    return $str
3994}
3995
3996proc shelldequote {str} {
3997    set ret {}
3998    set used -1
3999    while {1} {
4000        incr used
4001        if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
4002            append ret [string range $str $used end]
4003            set used [string length $str]
4004            break
4005        }
4006        set first [lindex $first 0]
4007        set ch [string index $str $first]
4008        if {$first > $used} {
4009            append ret [string range $str $used [expr {$first - 1}]]
4010            set used $first
4011        }
4012        if {$ch eq " " || $ch eq "\t"} break
4013        incr used
4014        if {$ch eq "'"} {
4015            set first [string first "'" $str $used]
4016            if {$first < 0} {
4017                error "unmatched single-quote"
4018            }
4019            append ret [string range $str $used [expr {$first - 1}]]
4020            set used $first
4021            continue
4022        }
4023        if {$ch eq "\\"} {
4024            if {$used >= [string length $str]} {
4025                error "trailing backslash"
4026            }
4027            append ret [string index $str $used]
4028            continue
4029        }
4030        # here ch == "\""
4031        while {1} {
4032            if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
4033                error "unmatched double-quote"
4034            }
4035            set first [lindex $first 0]
4036            set ch [string index $str $first]
4037            if {$first > $used} {
4038                append ret [string range $str $used [expr {$first - 1}]]
4039                set used $first
4040            }
4041            if {$ch eq "\""} break
4042            incr used
4043            append ret [string index $str $used]
4044            incr used
4045        }
4046    }
4047    return [list $used $ret]
4048}
4049
4050proc shellsplit {str} {
4051    set l {}
4052    while {1} {
4053        set str [string trimleft $str]
4054        if {$str eq {}} break
4055        set dq [shelldequote $str]
4056        set n [lindex $dq 0]
4057        set word [lindex $dq 1]
4058        set str [string range $str $n end]
4059        lappend l $word
4060    }
4061    return $l
4062}
4063
4064proc set_window_title {} {
4065    global appname curview viewname vrevs
4066    set rev [mc "All files"]
4067    if {$curview ne 0} {
4068        if {$viewname($curview) eq [mc "Command line"]} {
4069            set rev [string map {"--gitk-symmetric-diff-marker" "--merge"} $vrevs($curview)]
4070        } else {
4071            set rev $viewname($curview)
4072        }
4073    }
4074    wm title . "[reponame]: $rev - $appname"
4075}
4076
4077# Code to implement multiple views
4078
4079proc newview {ishighlight} {
4080    global nextviewnum newviewname newishighlight
4081    global revtreeargs viewargscmd newviewopts curview
4082
4083    set newishighlight $ishighlight
4084    set top .gitkview
4085    if {[winfo exists $top]} {
4086        raise $top
4087        return
4088    }
4089    decode_view_opts $nextviewnum $revtreeargs
4090    set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
4091    set newviewopts($nextviewnum,perm) 0
4092    set newviewopts($nextviewnum,cmd)  $viewargscmd($curview)
4093    vieweditor $top $nextviewnum [mc "Gitk view definition"]
4094}
4095
4096set known_view_options {
4097    {perm      b    .  {}               {mc "Remember this view"}}
4098    {reflabel  l    +  {}               {mc "References (space separated list):"}}
4099    {refs      t15  .. {}               {mc "Branches & tags:"}}
4100    {allrefs   b    *. "--all"          {mc "All refs"}}
4101    {branches  b    .  "--branches"     {mc "All (local) branches"}}
4102    {tags      b    .  "--tags"         {mc "All tags"}}
4103    {remotes   b    .  "--remotes"      {mc "All remote-tracking branches"}}
4104    {commitlbl l    +  {}               {mc "Commit Info (regular expressions):"}}
4105    {author    t15  .. "--author=*"     {mc "Author:"}}
4106    {committer t15  .  "--committer=*"  {mc "Committer:"}}
4107    {loginfo   t15  .. "--grep=*"       {mc "Commit Message:"}}
4108    {allmatch  b    .. "--all-match"    {mc "Matches all Commit Info criteria"}}
4109    {igrep     b    .. "--invert-grep"  {mc "Matches no Commit Info criteria"}}
4110    {changes_l l    +  {}               {mc "Changes to Files:"}}
4111    {pickaxe_s r0   .  {}               {mc "Fixed String"}}
4112    {pickaxe_t r1   .  "--pickaxe-regex"  {mc "Regular Expression"}}
4113    {pickaxe   t15  .. "-S*"            {mc "Search string:"}}
4114    {datelabel l    +  {}               {mc "Commit Dates (\"2 weeks ago\", \"2009-03-17 15:27:38\", \"March 17, 2009 15:27:38\"):"}}
4115    {since     t15  ..  {"--since=*" "--after=*"}  {mc "Since:"}}
4116    {until     t15  .   {"--until=*" "--before=*"} {mc "Until:"}}
4117    {limit_lbl l    +  {}               {mc "Limit and/or skip a number of revisions (positive integer):"}}
4118    {limit     t10  *. "--max-count=*"  {mc "Number to show:"}}
4119    {skip      t10  .  "--skip=*"       {mc "Number to skip:"}}
4120    {misc_lbl  l    +  {}               {mc "Miscellaneous options:"}}
4121    {dorder    b    *. {"--date-order" "-d"}      {mc "Strictly sort by date"}}
4122    {lright    b    .  "--left-right"   {mc "Mark branch sides"}}
4123    {first     b    .  "--first-parent" {mc "Limit to first parent"}}
4124    {smplhst   b    .  "--simplify-by-decoration"   {mc "Simple history"}}
4125    {args      t50  *. {}               {mc "Additional arguments to git log:"}}
4126    {allpaths  path +  {}               {mc "Enter files and directories to include, one per line:"}}
4127    {cmd       t50= +  {}               {mc "Command to generate more commits to include:"}}
4128    }
4129
4130# Convert $newviewopts($n, ...) into args for git log.
4131proc encode_view_opts {n} {
4132    global known_view_options newviewopts
4133
4134    set rargs [list]
4135    foreach opt $known_view_options {
4136        set patterns [lindex $opt 3]
4137        if {$patterns eq {}} continue
4138        set pattern [lindex $patterns 0]
4139
4140        if {[lindex $opt 1] eq "b"} {
4141            set val $newviewopts($n,[lindex $opt 0])
4142            if {$val} {
4143                lappend rargs $pattern
4144            }
4145        } elseif {[regexp {^r(\d+)$} [lindex $opt 1] type value]} {
4146            regexp {^(.*_)} [lindex $opt 0] uselessvar button_id
4147            set val $newviewopts($n,$button_id)
4148            if {$val eq $value} {
4149                lappend rargs $pattern
4150            }
4151        } else {
4152            set val $newviewopts($n,[lindex $opt 0])
4153            set val [string trim $val]
4154            if {$val ne {}} {
4155                set pfix [string range $pattern 0 end-1]
4156                lappend rargs $pfix$val
4157            }
4158        }
4159    }
4160    set rargs [concat $rargs [shellsplit $newviewopts($n,refs)]]
4161    return [concat $rargs [shellsplit $newviewopts($n,args)]]
4162}
4163
4164# Fill $newviewopts($n, ...) based on args for git log.
4165proc decode_view_opts {n view_args} {
4166    global known_view_options newviewopts
4167
4168    foreach opt $known_view_options {
4169        set id [lindex $opt 0]
4170        if {[lindex $opt 1] eq "b"} {
4171            # Checkboxes
4172            set val 0
4173        } elseif {[regexp {^r(\d+)$} [lindex $opt 1]]} {
4174            # Radiobuttons
4175            regexp {^(.*_)} $id uselessvar id
4176            set val 0
4177        } else {
4178            # Text fields
4179            set val {}
4180        }
4181        set newviewopts($n,$id) $val
4182    }
4183    set oargs [list]
4184    set refargs [list]
4185    foreach arg $view_args {
4186        if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
4187            && ![info exists found(limit)]} {
4188            set newviewopts($n,limit) $cnt
4189            set found(limit) 1
4190            continue
4191        }
4192        catch { unset val }
4193        foreach opt $known_view_options {
4194            set id [lindex $opt 0]
4195            if {[info exists found($id)]} continue
4196            foreach pattern [lindex $opt 3] {
4197                if {![string match $pattern $arg]} continue
4198                if {[lindex $opt 1] eq "b"} {
4199                    # Check buttons
4200                    set val 1
4201                } elseif {[regexp {^r(\d+)$} [lindex $opt 1] match num]} {
4202                    # Radio buttons
4203                    regexp {^(.*_)} $id uselessvar id
4204                    set val $num
4205                } else {
4206                    # Text input fields
4207                    set size [string length $pattern]
4208                    set val [string range $arg [expr {$size-1}] end]
4209                }
4210                set newviewopts($n,$id) $val
4211                set found($id) 1
4212                break
4213            }
4214            if {[info exists val]} break
4215        }
4216        if {[info exists val]} continue
4217        if {[regexp {^-} $arg]} {
4218            lappend oargs $arg
4219        } else {
4220            lappend refargs $arg
4221        }
4222    }
4223    set newviewopts($n,refs) [shellarglist $refargs]
4224    set newviewopts($n,args) [shellarglist $oargs]
4225}
4226
4227proc edit_or_newview {} {
4228    global curview
4229
4230    if {$curview > 0} {
4231        editview
4232    } else {
4233        newview 0
4234    }
4235}
4236
4237proc editview {} {
4238    global curview
4239    global viewname viewperm newviewname newviewopts
4240    global viewargs viewargscmd
4241
4242    set top .gitkvedit-$curview
4243    if {[winfo exists $top]} {
4244        raise $top
4245        return
4246    }
4247    decode_view_opts $curview $viewargs($curview)
4248    set newviewname($curview)      $viewname($curview)
4249    set newviewopts($curview,perm) $viewperm($curview)
4250    set newviewopts($curview,cmd)  $viewargscmd($curview)
4251    vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
4252}
4253
4254proc vieweditor {top n title} {
4255    global newviewname newviewopts viewfiles bgcolor
4256    global known_view_options NS
4257
4258    ttk_toplevel $top
4259    wm title $top [concat $title [mc "-- criteria for selecting revisions"]]
4260    make_transient $top .
4261
4262    # View name
4263    ${NS}::frame $top.nfr
4264    ${NS}::label $top.nl -text [mc "View Name"]
4265    ${NS}::entry $top.name -width 20 -textvariable newviewname($n)
4266    pack $top.nfr -in $top -fill x -pady 5 -padx 3
4267    pack $top.nl -in $top.nfr -side left -padx {0 5}
4268    pack $top.name -in $top.nfr -side left -padx {0 25}
4269
4270    # View options
4271    set cframe $top.nfr
4272    set cexpand 0
4273    set cnt 0
4274    foreach opt $known_view_options {
4275        set id [lindex $opt 0]
4276        set type [lindex $opt 1]
4277        set flags [lindex $opt 2]
4278        set title [eval [lindex $opt 4]]
4279        set lxpad 0
4280
4281        if {$flags eq "+" || $flags eq "*"} {
4282            set cframe $top.fr$cnt
4283            incr cnt
4284            ${NS}::frame $cframe
4285            pack $cframe -in $top -fill x -pady 3 -padx 3
4286            set cexpand [expr {$flags eq "*"}]
4287        } elseif {$flags eq ".." || $flags eq "*."} {
4288            set cframe $top.fr$cnt
4289            incr cnt
4290            ${NS}::frame $cframe
4291            pack $cframe -in $top -fill x -pady 3 -padx [list 15 3]
4292            set cexpand [expr {$flags eq "*."}]
4293        } else {
4294            set lxpad 5
4295        }
4296
4297        if {$type eq "l"} {
4298            ${NS}::label $cframe.l_$id -text $title
4299            pack $cframe.l_$id -in $cframe -side left -pady [list 3 0] -anchor w
4300        } elseif {$type eq "b"} {
4301            ${NS}::checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
4302            pack $cframe.c_$id -in $cframe -side left \
4303                -padx [list $lxpad 0] -expand $cexpand -anchor w
4304        } elseif {[regexp {^r(\d+)$} $type type sz]} {
4305            regexp {^(.*_)} $id uselessvar button_id
4306            ${NS}::radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz
4307            pack $cframe.c_$id -in $cframe -side left \
4308                -padx [list $lxpad 0] -expand $cexpand -anchor w
4309        } elseif {[regexp {^t(\d+)$} $type type sz]} {
4310            ${NS}::label $cframe.l_$id -text $title
4311            ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4312                -textvariable newviewopts($n,$id)
4313            pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
4314            pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
4315        } elseif {[regexp {^t(\d+)=$} $type type sz]} {
4316            ${NS}::label $cframe.l_$id -text $title
4317            ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4318                -textvariable newviewopts($n,$id)
4319            pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
4320            pack $cframe.e_$id -in $cframe -side top -fill x
4321        } elseif {$type eq "path"} {
4322            ${NS}::label $top.l -text $title
4323            pack $top.l -in $top -side top -pady [list 3 0] -anchor w -padx 3
4324            text $top.t -width 40 -height 5 -background $bgcolor
4325            if {[info exists viewfiles($n)]} {
4326                foreach f $viewfiles($n) {
4327                    $top.t insert end $f
4328                    $top.t insert end "\n"
4329                }
4330                $top.t delete {end - 1c} end
4331                $top.t mark set insert 0.0
4332            }
4333            pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
4334        }
4335    }
4336
4337    ${NS}::frame $top.buts
4338    ${NS}::button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
4339    ${NS}::button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
4340    ${NS}::button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
4341    bind $top <Control-Return> [list newviewok $top $n]
4342    bind $top <F5> [list newviewok $top $n 1]
4343    bind $top <Escape> [list destroy $top]
4344    grid $top.buts.ok $top.buts.apply $top.buts.can
4345    grid columnconfigure $top.buts 0 -weight 1 -uniform a
4346    grid columnconfigure $top.buts 1 -weight 1 -uniform a
4347    grid columnconfigure $top.buts 2 -weight 1 -uniform a
4348    pack $top.buts -in $top -side top -fill x
4349    focus $top.t
4350}
4351
4352proc doviewmenu {m first cmd op argv} {
4353    set nmenu [$m index end]
4354    for {set i $first} {$i <= $nmenu} {incr i} {
4355        if {[$m entrycget $i -command] eq $cmd} {
4356            eval $m $op $i $argv
4357            break
4358        }
4359    }
4360}
4361
4362proc allviewmenus {n op args} {
4363    # global viewhlmenu
4364
4365    doviewmenu .bar.view 5 [list showview $n] $op $args
4366    # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
4367}
4368
4369proc newviewok {top n {apply 0}} {
4370    global nextviewnum newviewperm newviewname newishighlight
4371    global viewname viewfiles viewperm viewchanged selectedview curview
4372    global viewargs viewargscmd newviewopts viewhlmenu
4373
4374    if {[catch {
4375        set newargs [encode_view_opts $n]
4376    } err]} {
4377        error_popup "[mc "Error in commit selection arguments:"] $err" $top
4378        return
4379    }
4380    set files {}
4381    foreach f [split [$top.t get 0.0 end] "\n"] {
4382        set ft [string trim $f]
4383        if {$ft ne {}} {
4384            lappend files $ft
4385        }
4386    }
4387    if {![info exists viewfiles($n)]} {
4388        # creating a new view
4389        incr nextviewnum
4390        set viewname($n) $newviewname($n)
4391        set viewperm($n) $newviewopts($n,perm)
4392        set viewchanged($n) 1
4393        set viewfiles($n) $files
4394        set viewargs($n) $newargs
4395        set viewargscmd($n) $newviewopts($n,cmd)
4396        addviewmenu $n
4397        if {!$newishighlight} {
4398            run showview $n
4399        } else {
4400            run addvhighlight $n
4401        }
4402    } else {
4403        # editing an existing view
4404        set viewperm($n) $newviewopts($n,perm)
4405        set viewchanged($n) 1
4406        if {$newviewname($n) ne $viewname($n)} {
4407            set viewname($n) $newviewname($n)
4408            doviewmenu .bar.view 5 [list showview $n] \
4409                entryconf [list -label $viewname($n)]
4410            # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
4411                # entryconf [list -label $viewname($n) -value $viewname($n)]
4412        }
4413        if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
4414                $newviewopts($n,cmd) ne $viewargscmd($n)} {
4415            set viewfiles($n) $files
4416            set viewargs($n) $newargs
4417            set viewargscmd($n) $newviewopts($n,cmd)
4418            if {$curview == $n} {
4419                run reloadcommits
4420            }
4421        }
4422    }
4423    if {$apply} return
4424    catch {destroy $top}
4425}
4426
4427proc delview {} {
4428    global curview viewperm hlview selectedhlview viewchanged
4429
4430    if {$curview == 0} return
4431    if {[info exists hlview] && $hlview == $curview} {
4432        set selectedhlview [mc "None"]
4433        unset hlview
4434    }
4435    allviewmenus $curview delete
4436    set viewperm($curview) 0
4437    set viewchanged($curview) 1
4438    showview 0
4439}
4440
4441proc addviewmenu {n} {
4442    global viewname viewhlmenu
4443
4444    .bar.view add radiobutton -label $viewname($n) \
4445        -command [list showview $n] -variable selectedview -value $n
4446    #$viewhlmenu add radiobutton -label $viewname($n) \
4447    #   -command [list addvhighlight $n] -variable selectedhlview
4448}
4449
4450proc showview {n} {
4451    global curview cached_commitrow ordertok
4452    global displayorder parentlist rowidlist rowisopt rowfinal
4453    global colormap rowtextx nextcolor canvxmax
4454    global numcommits viewcomplete
4455    global selectedline currentid canv canvy0
4456    global treediffs
4457    global pending_select mainheadid
4458    global commitidx
4459    global selectedview
4460    global hlview selectedhlview commitinterest
4461
4462    if {$n == $curview} return
4463    set selid {}
4464    set ymax [lindex [$canv cget -scrollregion] 3]
4465    set span [$canv yview]
4466    set ytop [expr {[lindex $span 0] * $ymax}]
4467    set ybot [expr {[lindex $span 1] * $ymax}]
4468    set yscreen [expr {($ybot - $ytop) / 2}]
4469    if {$selectedline ne {}} {
4470        set selid $currentid
4471        set y [yc $selectedline]
4472        if {$ytop < $y && $y < $ybot} {
4473            set yscreen [expr {$y - $ytop}]
4474        }
4475    } elseif {[info exists pending_select]} {
4476        set selid $pending_select
4477        unset pending_select
4478    }
4479    unselectline
4480    normalline
4481    unset -nocomplain treediffs
4482    clear_display
4483    if {[info exists hlview] && $hlview == $n} {
4484        unset hlview
4485        set selectedhlview [mc "None"]
4486    }
4487    unset -nocomplain commitinterest
4488    unset -nocomplain cached_commitrow
4489    unset -nocomplain ordertok
4490
4491    set curview $n
4492    set selectedview $n
4493    .bar.view entryconf [mca "&Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
4494    .bar.view entryconf [mca "&Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
4495
4496    run refill_reflist
4497    if {![info exists viewcomplete($n)]} {
4498        getcommits $selid
4499        return
4500    }
4501
4502    set displayorder {}
4503    set parentlist {}
4504    set rowidlist {}
4505    set rowisopt {}
4506    set rowfinal {}
4507    set numcommits $commitidx($n)
4508
4509    unset -nocomplain colormap
4510    unset -nocomplain rowtextx
4511    set nextcolor 0
4512    set canvxmax [$canv cget -width]
4513    set curview $n
4514    set row 0
4515    setcanvscroll
4516    set yf 0
4517    set row {}
4518    if {$selid ne {} && [commitinview $selid $n]} {
4519        set row [rowofcommit $selid]
4520        # try to get the selected row in the same position on the screen
4521        set ymax [lindex [$canv cget -scrollregion] 3]
4522        set ytop [expr {[yc $row] - $yscreen}]
4523        if {$ytop < 0} {
4524            set ytop 0
4525        }
4526        set yf [expr {$ytop * 1.0 / $ymax}]
4527    }
4528    allcanvs yview moveto $yf
4529    drawvisible
4530    if {$row ne {}} {
4531        selectline $row 0
4532    } elseif {!$viewcomplete($n)} {
4533        reset_pending_select $selid
4534    } else {
4535        reset_pending_select {}
4536
4537        if {[commitinview $pending_select $curview]} {
4538            selectline [rowofcommit $pending_select] 1
4539        } else {
4540            set row [first_real_row]
4541            if {$row < $numcommits} {
4542                selectline $row 0
4543            }
4544        }
4545    }
4546    if {!$viewcomplete($n)} {
4547        if {$numcommits == 0} {
4548            show_status [mc "Reading commits..."]
4549        }
4550    } elseif {$numcommits == 0} {
4551        show_status [mc "No commits selected"]
4552    }
4553    set_window_title
4554}
4555
4556# Stuff relating to the highlighting facility
4557
4558proc ishighlighted {id} {
4559    global vhighlights fhighlights nhighlights rhighlights
4560
4561    if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
4562        return $nhighlights($id)
4563    }
4564    if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
4565        return $vhighlights($id)
4566    }
4567    if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
4568        return $fhighlights($id)
4569    }
4570    if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4571        return $rhighlights($id)
4572    }
4573    return 0
4574}
4575
4576proc bolden {id font} {
4577    global canv linehtag currentid boldids need_redisplay markedid
4578
4579    # need_redisplay = 1 means the display is stale and about to be redrawn
4580    if {$need_redisplay} return
4581    lappend boldids $id
4582    $canv itemconf $linehtag($id) -font $font
4583    if {[info exists currentid] && $id eq $currentid} {
4584        $canv delete secsel
4585        set t [eval $canv create rect [$canv bbox $linehtag($id)] \
4586                   -outline {{}} -tags secsel \
4587                   -fill [$canv cget -selectbackground]]
4588        $canv lower $t
4589    }
4590    if {[info exists markedid] && $id eq $markedid} {
4591        make_idmark $id
4592    }
4593}
4594
4595proc bolden_name {id font} {
4596    global canv2 linentag currentid boldnameids need_redisplay
4597
4598    if {$need_redisplay} return
4599    lappend boldnameids $id
4600    $canv2 itemconf $linentag($id) -font $font
4601    if {[info exists currentid] && $id eq $currentid} {
4602        $canv2 delete secsel
4603        set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
4604                   -outline {{}} -tags secsel \
4605                   -fill [$canv2 cget -selectbackground]]
4606        $canv2 lower $t
4607    }
4608}
4609
4610proc unbolden {} {
4611    global boldids
4612
4613    set stillbold {}
4614    foreach id $boldids {
4615        if {![ishighlighted $id]} {
4616            bolden $id mainfont
4617        } else {
4618            lappend stillbold $id
4619        }
4620    }
4621    set boldids $stillbold
4622}
4623
4624proc addvhighlight {n} {
4625    global hlview viewcomplete curview vhl_done commitidx
4626
4627    if {[info exists hlview]} {
4628        delvhighlight
4629    }
4630    set hlview $n
4631    if {$n != $curview && ![info exists viewcomplete($n)]} {
4632        start_rev_list $n
4633    }
4634    set vhl_done $commitidx($hlview)
4635    if {$vhl_done > 0} {
4636        drawvisible
4637    }
4638}
4639
4640proc delvhighlight {} {
4641    global hlview vhighlights
4642
4643    if {![info exists hlview]} return
4644    unset hlview
4645    unset -nocomplain vhighlights
4646    unbolden
4647}
4648
4649proc vhighlightmore {} {
4650    global hlview vhl_done commitidx vhighlights curview
4651
4652    set max $commitidx($hlview)
4653    set vr [visiblerows]
4654    set r0 [lindex $vr 0]
4655    set r1 [lindex $vr 1]
4656    for {set i $vhl_done} {$i < $max} {incr i} {
4657        set id [commitonrow $i $hlview]
4658        if {[commitinview $id $curview]} {
4659            set row [rowofcommit $id]
4660            if {$r0 <= $row && $row <= $r1} {
4661                if {![highlighted $row]} {
4662                    bolden $id mainfontbold
4663                }
4664                set vhighlights($id) 1
4665            }
4666        }
4667    }
4668    set vhl_done $max
4669    return 0
4670}
4671
4672proc askvhighlight {row id} {
4673    global hlview vhighlights iddrawn
4674
4675    if {[commitinview $id $hlview]} {
4676        if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
4677            bolden $id mainfontbold
4678        }
4679        set vhighlights($id) 1
4680    } else {
4681        set vhighlights($id) 0
4682    }
4683}
4684
4685proc hfiles_change {} {
4686    global highlight_files filehighlight fhighlights fh_serial
4687    global highlight_paths
4688
4689    if {[info exists filehighlight]} {
4690        # delete previous highlights
4691        catch {close $filehighlight}
4692        unset filehighlight
4693        unset -nocomplain fhighlights
4694        unbolden
4695        unhighlight_filelist
4696    }
4697    set highlight_paths {}
4698    after cancel do_file_hl $fh_serial
4699    incr fh_serial
4700    if {$highlight_files ne {}} {
4701        after 300 do_file_hl $fh_serial
4702    }
4703}
4704
4705proc gdttype_change {name ix op} {
4706    global gdttype highlight_files findstring findpattern
4707
4708    stopfinding
4709    if {$findstring ne {}} {
4710        if {$gdttype eq [mc "containing:"]} {
4711            if {$highlight_files ne {}} {
4712                set highlight_files {}
4713                hfiles_change
4714            }
4715            findcom_change
4716        } else {
4717            if {$findpattern ne {}} {
4718                set findpattern {}
4719                findcom_change
4720            }
4721            set highlight_files $findstring
4722            hfiles_change
4723        }
4724        drawvisible
4725    }
4726    # enable/disable findtype/findloc menus too
4727}
4728
4729proc find_change {name ix op} {
4730    global gdttype findstring highlight_files
4731
4732    stopfinding
4733    if {$gdttype eq [mc "containing:"]} {
4734        findcom_change
4735    } else {
4736        if {$highlight_files ne $findstring} {
4737            set highlight_files $findstring
4738            hfiles_change
4739        }
4740    }
4741    drawvisible
4742}
4743
4744proc findcom_change args {
4745    global nhighlights boldnameids
4746    global findpattern findtype findstring gdttype
4747
4748    stopfinding
4749    # delete previous highlights, if any
4750    foreach id $boldnameids {
4751        bolden_name $id mainfont
4752    }
4753    set boldnameids {}
4754    unset -nocomplain nhighlights
4755    unbolden
4756    unmarkmatches
4757    if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
4758        set findpattern {}
4759    } elseif {$findtype eq [mc "Regexp"]} {
4760        set findpattern $findstring
4761    } else {
4762        set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4763                   $findstring]
4764        set findpattern "*$e*"
4765    }
4766}
4767
4768proc makepatterns {l} {
4769    set ret {}
4770    foreach e $l {
4771        set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4772        if {[string index $ee end] eq "/"} {
4773            lappend ret "$ee*"
4774        } else {
4775            lappend ret $ee
4776            lappend ret "$ee/*"
4777        }
4778    }
4779    return $ret
4780}
4781
4782proc do_file_hl {serial} {
4783    global highlight_files filehighlight highlight_paths gdttype fhl_list
4784    global cdup findtype
4785
4786    if {$gdttype eq [mc "touching paths:"]} {
4787        # If "exact" match then convert backslashes to forward slashes.
4788        # Most useful to support Windows-flavoured file paths.
4789        if {$findtype eq [mc "Exact"]} {
4790            set highlight_files [string map {"\\" "/"} $highlight_files]
4791        }
4792        if {[catch {set paths [shellsplit $highlight_files]}]} return
4793        set highlight_paths [makepatterns $paths]
4794        highlight_filelist
4795        set relative_paths {}
4796        foreach path $paths {
4797            lappend relative_paths [file join $cdup $path]
4798        }
4799        set gdtargs [concat -- $relative_paths]
4800    } elseif {$gdttype eq [mc "adding/removing string:"]} {
4801        set gdtargs [list "-S$highlight_files"]
4802    } elseif {$gdttype eq [mc "changing lines matching:"]} {
4803        set gdtargs [list "-G$highlight_files"]
4804    } else {
4805        # must be "containing:", i.e. we're searching commit info
4806        return
4807    }
4808    set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
4809    set filehighlight [open $cmd r+]
4810    fconfigure $filehighlight -blocking 0
4811    filerun $filehighlight readfhighlight
4812    set fhl_list {}
4813    drawvisible
4814    flushhighlights
4815}
4816
4817proc flushhighlights {} {
4818    global filehighlight fhl_list
4819
4820    if {[info exists filehighlight]} {
4821        lappend fhl_list {}
4822        puts $filehighlight ""
4823        flush $filehighlight
4824    }
4825}
4826
4827proc askfilehighlight {row id} {
4828    global filehighlight fhighlights fhl_list
4829
4830    lappend fhl_list $id
4831    set fhighlights($id) -1
4832    puts $filehighlight $id
4833}
4834
4835proc readfhighlight {} {
4836    global filehighlight fhighlights curview iddrawn
4837    global fhl_list find_dirn
4838
4839    if {![info exists filehighlight]} {
4840        return 0
4841    }
4842    set nr 0
4843    while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4844        set line [string trim $line]
4845        set i [lsearch -exact $fhl_list $line]
4846        if {$i < 0} continue
4847        for {set j 0} {$j < $i} {incr j} {
4848            set id [lindex $fhl_list $j]
4849            set fhighlights($id) 0
4850        }
4851        set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4852        if {$line eq {}} continue
4853        if {![commitinview $line $curview]} continue
4854        if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4855            bolden $line mainfontbold
4856        }
4857        set fhighlights($line) 1
4858    }
4859    if {[eof $filehighlight]} {
4860        # strange...
4861        puts "oops, git diff-tree died"
4862        catch {close $filehighlight}
4863        unset filehighlight
4864        return 0
4865    }
4866    if {[info exists find_dirn]} {
4867        run findmore
4868    }
4869    return 1
4870}
4871
4872proc doesmatch {f} {
4873    global findtype findpattern
4874
4875    if {$findtype eq [mc "Regexp"]} {
4876        return [regexp $findpattern $f]
4877    } elseif {$findtype eq [mc "IgnCase"]} {
4878        return [string match -nocase $findpattern $f]
4879    } else {
4880        return [string match $findpattern $f]
4881    }
4882}
4883
4884proc askfindhighlight {row id} {
4885    global nhighlights commitinfo iddrawn
4886    global findloc
4887    global markingmatches
4888
4889    if {![info exists commitinfo($id)]} {
4890        getcommit $id
4891    }
4892    set info $commitinfo($id)
4893    set isbold 0
4894    set fldtypes [list [mc Headline] [mc Author] "" [mc Committer] "" [mc Comments]]
4895    foreach f $info ty $fldtypes {
4896        if {$ty eq ""} continue
4897        if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4898            [doesmatch $f]} {
4899            if {$ty eq [mc "Author"]} {
4900                set isbold 2
4901                break
4902            }
4903            set isbold 1
4904        }
4905    }
4906    if {$isbold && [info exists iddrawn($id)]} {
4907        if {![ishighlighted $id]} {
4908            bolden $id mainfontbold
4909            if {$isbold > 1} {
4910                bolden_name $id mainfontbold
4911            }
4912        }
4913        if {$markingmatches} {
4914            markrowmatches $row $id
4915        }
4916    }
4917    set nhighlights($id) $isbold
4918}
4919
4920proc markrowmatches {row id} {
4921    global canv canv2 linehtag linentag commitinfo findloc
4922
4923    set headline [lindex $commitinfo($id) 0]
4924    set author [lindex $commitinfo($id) 1]
4925    $canv delete match$row
4926    $canv2 delete match$row
4927    if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4928        set m [findmatches $headline]
4929        if {$m ne {}} {
4930            markmatches $canv $row $headline $linehtag($id) $m \
4931                [$canv itemcget $linehtag($id) -font] $row
4932        }
4933    }
4934    if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4935        set m [findmatches $author]
4936        if {$m ne {}} {
4937            markmatches $canv2 $row $author $linentag($id) $m \
4938                [$canv2 itemcget $linentag($id) -font] $row
4939        }
4940    }
4941}
4942
4943proc vrel_change {name ix op} {
4944    global highlight_related
4945
4946    rhighlight_none
4947    if {$highlight_related ne [mc "None"]} {
4948        run drawvisible
4949    }
4950}
4951
4952# prepare for testing whether commits are descendents or ancestors of a
4953proc rhighlight_sel {a} {
4954    global descendent desc_todo ancestor anc_todo
4955    global highlight_related
4956
4957    unset -nocomplain descendent
4958    set desc_todo [list $a]
4959    unset -nocomplain ancestor
4960    set anc_todo [list $a]
4961    if {$highlight_related ne [mc "None"]} {
4962        rhighlight_none
4963        run drawvisible
4964    }
4965}
4966
4967proc rhighlight_none {} {
4968    global rhighlights
4969
4970    unset -nocomplain rhighlights
4971    unbolden
4972}
4973
4974proc is_descendent {a} {
4975    global curview children descendent desc_todo
4976
4977    set v $curview
4978    set la [rowofcommit $a]
4979    set todo $desc_todo
4980    set leftover {}
4981    set done 0
4982    for {set i 0} {$i < [llength $todo]} {incr i} {
4983        set do [lindex $todo $i]
4984        if {[rowofcommit $do] < $la} {
4985            lappend leftover $do
4986            continue
4987        }
4988        foreach nk $children($v,$do) {
4989            if {![info exists descendent($nk)]} {
4990                set descendent($nk) 1
4991                lappend todo $nk
4992                if {$nk eq $a} {
4993                    set done 1
4994                }
4995            }
4996        }
4997        if {$done} {
4998            set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4999            return
5000        }
5001    }
5002    set descendent($a) 0
5003    set desc_todo $leftover
5004}
5005
5006proc is_ancestor {a} {
5007    global curview parents ancestor anc_todo
5008
5009    set v $curview
5010    set la [rowofcommit $a]
5011    set todo $anc_todo
5012    set leftover {}
5013    set done 0
5014    for {set i 0} {$i < [llength $todo]} {incr i} {
5015        set do [lindex $todo $i]
5016        if {![commitinview $do $v] || [rowofcommit $do] > $la} {
5017            lappend leftover $do
5018            continue
5019        }
5020        foreach np $parents($v,$do) {
5021            if {![info exists ancestor($np)]} {
5022                set ancestor($np) 1
5023                lappend todo $np
5024                if {$np eq $a} {
5025                    set done 1
5026                }
5027            }
5028        }
5029        if {$done} {
5030            set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
5031            return
5032        }
5033    }
5034    set ancestor($a) 0
5035    set anc_todo $leftover
5036}
5037
5038proc askrelhighlight {row id} {
5039    global descendent highlight_related iddrawn rhighlights
5040    global selectedline ancestor
5041
5042    if {$selectedline eq {}} return
5043    set isbold 0
5044    if {$highlight_related eq [mc "Descendant"] ||
5045        $highlight_related eq [mc "Not descendant"]} {
5046        if {![info exists descendent($id)]} {
5047            is_descendent $id
5048        }
5049        if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
5050            set isbold 1
5051        }
5052    } elseif {$highlight_related eq [mc "Ancestor"] ||
5053              $highlight_related eq [mc "Not ancestor"]} {
5054        if {![info exists ancestor($id)]} {
5055            is_ancestor $id
5056        }
5057        if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
5058            set isbold 1
5059        }
5060    }
5061    if {[info exists iddrawn($id)]} {
5062        if {$isbold && ![ishighlighted $id]} {
5063            bolden $id mainfontbold
5064        }
5065    }
5066    set rhighlights($id) $isbold
5067}
5068
5069# Graph layout functions
5070
5071proc shortids {ids} {
5072    set res {}
5073    foreach id $ids {
5074        if {[llength $id] > 1} {
5075            lappend res [shortids $id]
5076        } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
5077            lappend res [string range $id 0 7]
5078        } else {
5079            lappend res $id
5080        }
5081    }
5082    return $res
5083}
5084
5085proc ntimes {n o} {
5086    set ret {}
5087    set o [list $o]
5088    for {set mask 1} {$mask <= $n} {incr mask $mask} {
5089        if {($n & $mask) != 0} {
5090            set ret [concat $ret $o]
5091        }
5092        set o [concat $o $o]
5093    }
5094    return $ret
5095}
5096
5097proc ordertoken {id} {
5098    global ordertok curview varcid varcstart varctok curview parents children
5099    global nullid nullid2
5100
5101    if {[info exists ordertok($id)]} {
5102        return $ordertok($id)
5103    }
5104    set origid $id
5105    set todo {}
5106    while {1} {
5107        if {[info exists varcid($curview,$id)]} {
5108            set a $varcid($curview,$id)
5109            set p [lindex $varcstart($curview) $a]
5110        } else {
5111            set p [lindex $children($curview,$id) 0]
5112        }
5113        if {[info exists ordertok($p)]} {
5114            set tok $ordertok($p)
5115            break
5116        }
5117        set id [first_real_child $curview,$p]
5118        if {$id eq {}} {
5119            # it's a root
5120            set tok [lindex $varctok($curview) $varcid($curview,$p)]
5121            break
5122        }
5123        if {[llength $parents($curview,$id)] == 1} {
5124            lappend todo [list $p {}]
5125        } else {
5126            set j [lsearch -exact $parents($curview,$id) $p]
5127            if {$j < 0} {
5128                puts "oops didn't find [shortids $p] in parents of [shortids $id]"
5129            }
5130            lappend todo [list $p [strrep $j]]
5131        }
5132    }
5133    for {set i [llength $todo]} {[incr i -1] >= 0} {} {
5134        set p [lindex $todo $i 0]
5135        append tok [lindex $todo $i 1]
5136        set ordertok($p) $tok
5137    }
5138    set ordertok($origid) $tok
5139    return $tok
5140}
5141
5142# Work out where id should go in idlist so that order-token
5143# values increase from left to right
5144proc idcol {idlist id {i 0}} {
5145    set t [ordertoken $id]
5146    if {$i < 0} {
5147        set i 0
5148    }
5149    if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
5150        if {$i > [llength $idlist]} {
5151            set i [llength $idlist]
5152        }
5153        while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
5154        incr i
5155    } else {
5156        if {$t > [ordertoken [lindex $idlist $i]]} {
5157            while {[incr i] < [llength $idlist] &&
5158                   $t >= [ordertoken [lindex $idlist $i]]} {}
5159        }
5160    }
5161    return $i
5162}
5163
5164proc initlayout {} {
5165    global rowidlist rowisopt rowfinal displayorder parentlist
5166    global numcommits canvxmax canv
5167    global nextcolor
5168    global colormap rowtextx
5169
5170    set numcommits 0
5171    set displayorder {}
5172    set parentlist {}
5173    set nextcolor 0
5174    set rowidlist {}
5175    set rowisopt {}
5176    set rowfinal {}
5177    set canvxmax [$canv cget -width]
5178    unset -nocomplain colormap
5179    unset -nocomplain rowtextx
5180    setcanvscroll
5181}
5182
5183proc setcanvscroll {} {
5184    global canv canv2 canv3 numcommits linespc canvxmax canvy0
5185    global lastscrollset lastscrollrows
5186
5187    set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
5188    $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
5189    $canv2 conf -scrollregion [list 0 0 0 $ymax]
5190    $canv3 conf -scrollregion [list 0 0 0 $ymax]
5191    set lastscrollset [clock clicks -milliseconds]
5192    set lastscrollrows $numcommits
5193}
5194
5195proc visiblerows {} {
5196    global canv numcommits linespc
5197
5198    set ymax [lindex [$canv cget -scrollregion] 3]
5199    if {$ymax eq {} || $ymax == 0} return
5200    set f [$canv yview]
5201    set y0 [expr {int([lindex $f 0] * $ymax)}]
5202    set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
5203    if {$r0 < 0} {
5204        set r0 0
5205    }
5206    set y1 [expr {int([lindex $f 1] * $ymax)}]
5207    set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
5208    if {$r1 >= $numcommits} {
5209        set r1 [expr {$numcommits - 1}]
5210    }
5211    return [list $r0 $r1]
5212}
5213
5214proc layoutmore {} {
5215    global commitidx viewcomplete curview
5216    global numcommits pending_select curview
5217    global lastscrollset lastscrollrows
5218
5219    if {$lastscrollrows < 100 || $viewcomplete($curview) ||
5220        [clock clicks -milliseconds] - $lastscrollset > 500} {
5221        setcanvscroll
5222    }
5223    if {[info exists pending_select] &&
5224        [commitinview $pending_select $curview]} {
5225        update
5226        selectline [rowofcommit $pending_select] 1
5227    }
5228    drawvisible
5229}
5230
5231# With path limiting, we mightn't get the actual HEAD commit,
5232# so ask git rev-list what is the first ancestor of HEAD that
5233# touches a file in the path limit.
5234proc get_viewmainhead {view} {
5235    global viewmainheadid vfilelimit viewinstances mainheadid
5236
5237    catch {
5238        set rfd [open [concat | git rev-list -1 $mainheadid \
5239                           -- $vfilelimit($view)] r]
5240        set j [reg_instance $rfd]
5241        lappend viewinstances($view) $j
5242        fconfigure $rfd -blocking 0
5243        filerun $rfd [list getviewhead $rfd $j $view]
5244        set viewmainheadid($curview) {}
5245    }
5246}
5247
5248# git rev-list should give us just 1 line to use as viewmainheadid($view)
5249proc getviewhead {fd inst view} {
5250    global viewmainheadid commfd curview viewinstances showlocalchanges
5251
5252    set id {}
5253    if {[gets $fd line] < 0} {
5254        if {![eof $fd]} {
5255            return 1
5256        }
5257    } elseif {[string length $line] == 40 && [string is xdigit $line]} {
5258        set id $line
5259    }
5260    set viewmainheadid($view) $id
5261    close $fd
5262    unset commfd($inst)
5263    set i [lsearch -exact $viewinstances($view) $inst]
5264    if {$i >= 0} {
5265        set viewinstances($view) [lreplace $viewinstances($view) $i $i]
5266    }
5267    if {$showlocalchanges && $id ne {} && $view == $curview} {
5268        doshowlocalchanges
5269    }
5270    return 0
5271}
5272
5273proc doshowlocalchanges {} {
5274    global curview viewmainheadid
5275
5276    if {$viewmainheadid($curview) eq {}} return
5277    if {[commitinview $viewmainheadid($curview) $curview]} {
5278        dodiffindex
5279    } else {
5280        interestedin $viewmainheadid($curview) dodiffindex
5281    }
5282}
5283
5284proc dohidelocalchanges {} {
5285    global nullid nullid2 lserial curview
5286
5287    if {[commitinview $nullid $curview]} {
5288        removefakerow $nullid
5289    }
5290    if {[commitinview $nullid2 $curview]} {
5291        removefakerow $nullid2
5292    }
5293    incr lserial
5294}
5295
5296# spawn off a process to do git diff-index --cached HEAD
5297proc dodiffindex {} {
5298    global lserial showlocalchanges vfilelimit curview
5299    global hasworktree git_version
5300
5301    if {!$showlocalchanges || !$hasworktree} return
5302    incr lserial
5303    if {[package vcompare $git_version "1.7.2"] >= 0} {
5304        set cmd "|git diff-index --cached --ignore-submodules=dirty HEAD"
5305    } else {
5306        set cmd "|git diff-index --cached HEAD"
5307    }
5308    if {$vfilelimit($curview) ne {}} {
5309        set cmd [concat $cmd -- $vfilelimit($curview)]
5310    }
5311    set fd [open $cmd r]
5312    fconfigure $fd -blocking 0
5313    set i [reg_instance $fd]
5314    filerun $fd [list readdiffindex $fd $lserial $i]
5315}
5316
5317proc readdiffindex {fd serial inst} {
5318    global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
5319    global vfilelimit
5320
5321    set isdiff 1
5322    if {[gets $fd line] < 0} {
5323        if {![eof $fd]} {
5324            return 1
5325        }
5326        set isdiff 0
5327    }
5328    # we only need to see one line and we don't really care what it says...
5329    stop_instance $inst
5330
5331    if {$serial != $lserial} {
5332        return 0
5333    }
5334
5335    # now see if there are any local changes not checked in to the index
5336    set cmd "|git diff-files"
5337    if {$vfilelimit($curview) ne {}} {
5338        set cmd [concat $cmd -- $vfilelimit($curview)]
5339    }
5340    set fd [open $cmd r]
5341    fconfigure $fd -blocking 0
5342    set i [reg_instance $fd]
5343    filerun $fd [list readdifffiles $fd $serial $i]
5344
5345    if {$isdiff && ![commitinview $nullid2 $curview]} {
5346        # add the line for the changes in the index to the graph
5347        set hl [mc "Local changes checked in to index but not committed"]
5348        set commitinfo($nullid2) [list  $hl {} {} {} {} "    $hl\n"]
5349        set commitdata($nullid2) "\n    $hl\n"
5350        if {[commitinview $nullid $curview]} {
5351            removefakerow $nullid
5352        }
5353        insertfakerow $nullid2 $viewmainheadid($curview)
5354    } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
5355        if {[commitinview $nullid $curview]} {
5356            removefakerow $nullid
5357        }
5358        removefakerow $nullid2
5359    }
5360    return 0
5361}
5362
5363proc readdifffiles {fd serial inst} {
5364    global viewmainheadid nullid nullid2 curview
5365    global commitinfo commitdata lserial
5366
5367    set isdiff 1
5368    if {[gets $fd line] < 0} {
5369        if {![eof $fd]} {
5370            return 1
5371        }
5372        set isdiff 0
5373    }
5374    # we only need to see one line and we don't really care what it says...
5375    stop_instance $inst
5376
5377    if {$serial != $lserial} {
5378        return 0
5379    }
5380
5381    if {$isdiff && ![commitinview $nullid $curview]} {
5382        # add the line for the local diff to the graph
5383        set hl [mc "Local uncommitted changes, not checked in to index"]
5384        set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
5385        set commitdata($nullid) "\n    $hl\n"
5386        if {[commitinview $nullid2 $curview]} {
5387            set p $nullid2
5388        } else {
5389            set p $viewmainheadid($curview)
5390        }
5391        insertfakerow $nullid $p
5392    } elseif {!$isdiff && [commitinview $nullid $curview]} {
5393        removefakerow $nullid
5394    }
5395    return 0
5396}
5397
5398proc nextuse {id row} {
5399    global curview children
5400
5401    if {[info exists children($curview,$id)]} {
5402        foreach kid $children($curview,$id) {
5403            if {![commitinview $kid $curview]} {
5404                return -1
5405            }
5406            if {[rowofcommit $kid] > $row} {
5407                return [rowofcommit $kid]
5408            }
5409        }
5410    }
5411    if {[commitinview $id $curview]} {
5412        return [rowofcommit $id]
5413    }
5414    return -1
5415}
5416
5417proc prevuse {id row} {
5418    global curview children
5419
5420    set ret -1
5421    if {[info exists children($curview,$id)]} {
5422        foreach kid $children($curview,$id) {
5423            if {![commitinview $kid $curview]} break
5424            if {[rowofcommit $kid] < $row} {
5425                set ret [rowofcommit $kid]
5426            }
5427        }
5428    }
5429    return $ret
5430}
5431
5432proc make_idlist {row} {
5433    global displayorder parentlist uparrowlen downarrowlen mingaplen
5434    global commitidx curview children
5435
5436    set r [expr {$row - $mingaplen - $downarrowlen - 1}]
5437    if {$r < 0} {
5438        set r 0
5439    }
5440    set ra [expr {$row - $downarrowlen}]
5441    if {$ra < 0} {
5442        set ra 0
5443    }
5444    set rb [expr {$row + $uparrowlen}]
5445    if {$rb > $commitidx($curview)} {
5446        set rb $commitidx($curview)
5447    }
5448    make_disporder $r [expr {$rb + 1}]
5449    set ids {}
5450    for {} {$r < $ra} {incr r} {
5451        set nextid [lindex $displayorder [expr {$r + 1}]]
5452        foreach p [lindex $parentlist $r] {
5453            if {$p eq $nextid} continue
5454            set rn [nextuse $p $r]
5455            if {$rn >= $row &&
5456                $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
5457                lappend ids [list [ordertoken $p] $p]
5458            }
5459        }
5460    }
5461    for {} {$r < $row} {incr r} {
5462        set nextid [lindex $displayorder [expr {$r + 1}]]
5463        foreach p [lindex $parentlist $r] {
5464            if {$p eq $nextid} continue
5465            set rn [nextuse $p $r]
5466            if {$rn < 0 || $rn >= $row} {
5467                lappend ids [list [ordertoken $p] $p]
5468            }
5469        }
5470    }
5471    set id [lindex $displayorder $row]
5472    lappend ids [list [ordertoken $id] $id]
5473    while {$r < $rb} {
5474        foreach p [lindex $parentlist $r] {
5475            set firstkid [lindex $children($curview,$p) 0]
5476            if {[rowofcommit $firstkid] < $row} {
5477                lappend ids [list [ordertoken $p] $p]
5478            }
5479        }
5480        incr r
5481        set id [lindex $displayorder $r]
5482        if {$id ne {}} {
5483            set firstkid [lindex $children($curview,$id) 0]
5484            if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
5485                lappend ids [list [ordertoken $id] $id]
5486            }
5487        }
5488    }
5489    set idlist {}
5490    foreach idx [lsort -unique $ids] {
5491        lappend idlist [lindex $idx 1]
5492    }
5493    return $idlist
5494}
5495
5496proc rowsequal {a b} {
5497    while {[set i [lsearch -exact $a {}]] >= 0} {
5498        set a [lreplace $a $i $i]
5499    }
5500    while {[set i [lsearch -exact $b {}]] >= 0} {
5501        set b [lreplace $b $i $i]
5502    }
5503    return [expr {$a eq $b}]
5504}
5505
5506proc makeupline {id row rend col} {
5507    global rowidlist uparrowlen downarrowlen mingaplen
5508
5509    for {set r $rend} {1} {set r $rstart} {
5510        set rstart [prevuse $id $r]
5511        if {$rstart < 0} return
5512        if {$rstart < $row} break
5513    }
5514    if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5515        set rstart [expr {$rend - $uparrowlen - 1}]
5516    }
5517    for {set r $rstart} {[incr r] <= $row} {} {
5518        set idlist [lindex $rowidlist $r]
5519        if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5520            set col [idcol $idlist $id $col]
5521            lset rowidlist $r [linsert $idlist $col $id]
5522            changedrow $r
5523        }
5524    }
5525}
5526
5527proc layoutrows {row endrow} {
5528    global rowidlist rowisopt rowfinal displayorder
5529    global uparrowlen downarrowlen maxwidth mingaplen
5530    global children parentlist
5531    global commitidx viewcomplete curview
5532
5533    make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
5534    set idlist {}
5535    if {$row > 0} {
5536        set rm1 [expr {$row - 1}]
5537        foreach id [lindex $rowidlist $rm1] {
5538            if {$id ne {}} {
5539                lappend idlist $id
5540            }
5541        }
5542        set final [lindex $rowfinal $rm1]
5543    }
5544    for {} {$row < $endrow} {incr row} {
5545        set rm1 [expr {$row - 1}]
5546        if {$rm1 < 0 || $idlist eq {}} {
5547            set idlist [make_idlist $row]
5548            set final 1
5549        } else {
5550            set id [lindex $displayorder $rm1]
5551            set col [lsearch -exact $idlist $id]
5552            set idlist [lreplace $idlist $col $col]
5553            foreach p [lindex $parentlist $rm1] {
5554                if {[lsearch -exact $idlist $p] < 0} {
5555                    set col [idcol $idlist $p $col]
5556                    set idlist [linsert $idlist $col $p]
5557                    # if not the first child, we have to insert a line going up
5558                    if {$id ne [lindex $children($curview,$p) 0]} {
5559                        makeupline $p $rm1 $row $col
5560                    }
5561                }
5562            }
5563            set id [lindex $displayorder $row]
5564            if {$row > $downarrowlen} {
5565                set termrow [expr {$row - $downarrowlen - 1}]
5566                foreach p [lindex $parentlist $termrow] {
5567                    set i [lsearch -exact $idlist $p]
5568                    if {$i < 0} continue
5569                    set nr [nextuse $p $termrow]
5570                    if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5571                        set idlist [lreplace $idlist $i $i]
5572                    }
5573                }
5574            }
5575            set col [lsearch -exact $idlist $id]
5576            if {$col < 0} {
5577                set col [idcol $idlist $id]
5578                set idlist [linsert $idlist $col $id]
5579                if {$children($curview,$id) ne {}} {
5580                    makeupline $id $rm1 $row $col
5581                }
5582            }
5583            set r [expr {$row + $uparrowlen - 1}]
5584            if {$r < $commitidx($curview)} {
5585                set x $col
5586                foreach p [lindex $parentlist $r] {
5587                    if {[lsearch -exact $idlist $p] >= 0} continue
5588                    set fk [lindex $children($curview,$p) 0]
5589                    if {[rowofcommit $fk] < $row} {
5590                        set x [idcol $idlist $p $x]
5591                        set idlist [linsert $idlist $x $p]
5592                    }
5593                }
5594                if {[incr r] < $commitidx($curview)} {
5595                    set p [lindex $displayorder $r]
5596                    if {[lsearch -exact $idlist $p] < 0} {
5597                        set fk [lindex $children($curview,$p) 0]
5598                        if {$fk ne {} && [rowofcommit $fk] < $row} {
5599                            set x [idcol $idlist $p $x]
5600                            set idlist [linsert $idlist $x $p]
5601                        }
5602                    }
5603                }
5604            }
5605        }
5606        if {$final && !$viewcomplete($curview) &&
5607            $row + $uparrowlen + $mingaplen + $downarrowlen
5608                >= $commitidx($curview)} {
5609            set final 0
5610        }
5611        set l [llength $rowidlist]
5612        if {$row == $l} {
5613            lappend rowidlist $idlist
5614            lappend rowisopt 0
5615            lappend rowfinal $final
5616        } elseif {$row < $l} {
5617            if {![rowsequal $idlist [lindex $rowidlist $row]]} {
5618                lset rowidlist $row $idlist
5619                changedrow $row
5620            }
5621            lset rowfinal $row $final
5622        } else {
5623            set pad [ntimes [expr {$row - $l}] {}]
5624            set rowidlist [concat $rowidlist $pad]
5625            lappend rowidlist $idlist
5626            set rowfinal [concat $rowfinal $pad]
5627            lappend rowfinal $final
5628            set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5629        }
5630    }
5631    return $row
5632}
5633
5634proc changedrow {row} {
5635    global displayorder iddrawn rowisopt need_redisplay
5636
5637    set l [llength $rowisopt]
5638    if {$row < $l} {
5639        lset rowisopt $row 0
5640        if {$row + 1 < $l} {
5641            lset rowisopt [expr {$row + 1}] 0
5642            if {$row + 2 < $l} {
5643                lset rowisopt [expr {$row + 2}] 0
5644            }
5645        }
5646    }
5647    set id [lindex $displayorder $row]
5648    if {[info exists iddrawn($id)]} {
5649        set need_redisplay 1
5650    }
5651}
5652
5653proc insert_pad {row col npad} {
5654    global rowidlist
5655
5656    set pad [ntimes $npad {}]
5657    set idlist [lindex $rowidlist $row]
5658    set bef [lrange $idlist 0 [expr {$col - 1}]]
5659    set aft [lrange $idlist $col end]
5660    set i [lsearch -exact $aft {}]
5661    if {$i > 0} {
5662        set aft [lreplace $aft $i $i]
5663    }
5664    lset rowidlist $row [concat $bef $pad $aft]
5665    changedrow $row
5666}
5667
5668proc optimize_rows {row col endrow} {
5669    global rowidlist rowisopt displayorder curview children
5670
5671    if {$row < 1} {
5672        set row 1
5673    }
5674    for {} {$row < $endrow} {incr row; set col 0} {
5675        if {[lindex $rowisopt $row]} continue
5676        set haspad 0
5677        set y0 [expr {$row - 1}]
5678        set ym [expr {$row - 2}]
5679        set idlist [lindex $rowidlist $row]
5680        set previdlist [lindex $rowidlist $y0]
5681        if {$idlist eq {} || $previdlist eq {}} continue
5682        if {$ym >= 0} {
5683            set pprevidlist [lindex $rowidlist $ym]
5684            if {$pprevidlist eq {}} continue
5685        } else {
5686            set pprevidlist {}
5687        }
5688        set x0 -1
5689        set xm -1
5690        for {} {$col < [llength $idlist]} {incr col} {
5691            set id [lindex $idlist $col]
5692            if {[lindex $previdlist $col] eq $id} continue
5693            if {$id eq {}} {
5694                set haspad 1
5695                continue
5696            }
5697            set x0 [lsearch -exact $previdlist $id]
5698            if {$x0 < 0} continue
5699            set z [expr {$x0 - $col}]
5700            set isarrow 0
5701            set z0 {}
5702            if {$ym >= 0} {
5703                set xm [lsearch -exact $pprevidlist $id]
5704                if {$xm >= 0} {
5705                    set z0 [expr {$xm - $x0}]
5706                }
5707            }
5708            if {$z0 eq {}} {
5709                # if row y0 is the first child of $id then it's not an arrow
5710                if {[lindex $children($curview,$id) 0] ne
5711                    [lindex $displayorder $y0]} {
5712                    set isarrow 1
5713                }
5714            }
5715            if {!$isarrow && $id ne [lindex $displayorder $row] &&
5716                [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5717                set isarrow 1
5718            }
5719            # Looking at lines from this row to the previous row,
5720            # make them go straight up if they end in an arrow on
5721            # the previous row; otherwise make them go straight up
5722            # or at 45 degrees.
5723            if {$z < -1 || ($z < 0 && $isarrow)} {
5724                # Line currently goes left too much;
5725                # insert pads in the previous row, then optimize it
5726                set npad [expr {-1 - $z + $isarrow}]
5727                insert_pad $y0 $x0 $npad
5728                if {$y0 > 0} {
5729                    optimize_rows $y0 $x0 $row
5730                }
5731                set previdlist [lindex $rowidlist $y0]
5732                set x0 [lsearch -exact $previdlist $id]
5733                set z [expr {$x0 - $col}]
5734                if {$z0 ne {}} {
5735                    set pprevidlist [lindex $rowidlist $ym]
5736                    set xm [lsearch -exact $pprevidlist $id]
5737                    set z0 [expr {$xm - $x0}]
5738                }
5739            } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5740                # Line currently goes right too much;
5741                # insert pads in this line
5742                set npad [expr {$z - 1 + $isarrow}]
5743                insert_pad $row $col $npad
5744                set idlist [lindex $rowidlist $row]
5745                incr col $npad
5746                set z [expr {$x0 - $col}]
5747                set haspad 1
5748            }
5749            if {$z0 eq {} && !$isarrow && $ym >= 0} {
5750                # this line links to its first child on row $row-2
5751                set id [lindex $displayorder $ym]
5752                set xc [lsearch -exact $pprevidlist $id]
5753                if {$xc >= 0} {
5754                    set z0 [expr {$xc - $x0}]
5755                }
5756            }
5757            # avoid lines jigging left then immediately right
5758            if {$z0 ne {} && $z < 0 && $z0 > 0} {
5759                insert_pad $y0 $x0 1
5760                incr x0
5761                optimize_rows $y0 $x0 $row
5762                set previdlist [lindex $rowidlist $y0]
5763            }
5764        }
5765        if {!$haspad} {
5766            # Find the first column that doesn't have a line going right
5767            for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5768                set id [lindex $idlist $col]
5769                if {$id eq {}} break
5770                set x0 [lsearch -exact $previdlist $id]
5771                if {$x0 < 0} {
5772                    # check if this is the link to the first child
5773                    set kid [lindex $displayorder $y0]
5774                    if {[lindex $children($curview,$id) 0] eq $kid} {
5775                        # it is, work out offset to child
5776                        set x0 [lsearch -exact $previdlist $kid]
5777                    }
5778                }
5779                if {$x0 <= $col} break
5780            }
5781            # Insert a pad at that column as long as it has a line and
5782            # isn't the last column
5783            if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5784                set idlist [linsert $idlist $col {}]
5785                lset rowidlist $row $idlist
5786                changedrow $row
5787            }
5788        }
5789    }
5790}
5791
5792proc xc {row col} {
5793    global canvx0 linespc
5794    return [expr {$canvx0 + $col * $linespc}]
5795}
5796
5797proc yc {row} {
5798    global canvy0 linespc
5799    return [expr {$canvy0 + $row * $linespc}]
5800}
5801
5802proc linewidth {id} {
5803    global thickerline lthickness
5804
5805    set wid $lthickness
5806    if {[info exists thickerline] && $id eq $thickerline} {
5807        set wid [expr {2 * $lthickness}]
5808    }
5809    return $wid
5810}
5811
5812proc rowranges {id} {
5813    global curview children uparrowlen downarrowlen
5814    global rowidlist
5815
5816    set kids $children($curview,$id)
5817    if {$kids eq {}} {
5818        return {}
5819    }
5820    set ret {}
5821    lappend kids $id
5822    foreach child $kids {
5823        if {![commitinview $child $curview]} break
5824        set row [rowofcommit $child]
5825        if {![info exists prev]} {
5826            lappend ret [expr {$row + 1}]
5827        } else {
5828            if {$row <= $prevrow} {
5829                puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5830            }
5831            # see if the line extends the whole way from prevrow to row
5832            if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5833                [lsearch -exact [lindex $rowidlist \
5834                            [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5835                # it doesn't, see where it ends
5836                set r [expr {$prevrow + $downarrowlen}]
5837                if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5838                    while {[incr r -1] > $prevrow &&
5839                           [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5840                } else {
5841                    while {[incr r] <= $row &&
5842                           [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5843                    incr r -1
5844                }
5845                lappend ret $r
5846                # see where it starts up again
5847                set r [expr {$row - $uparrowlen}]
5848                if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5849                    while {[incr r] < $row &&
5850                           [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5851                } else {
5852                    while {[incr r -1] >= $prevrow &&
5853                           [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5854                    incr r
5855                }
5856                lappend ret $r
5857            }
5858        }
5859        if {$child eq $id} {
5860            lappend ret $row
5861        }
5862        set prev $child
5863        set prevrow $row
5864    }
5865    return $ret
5866}
5867
5868proc drawlineseg {id row endrow arrowlow} {
5869    global rowidlist displayorder iddrawn linesegs
5870    global canv colormap linespc curview maxlinelen parentlist
5871
5872    set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5873    set le [expr {$row + 1}]
5874    set arrowhigh 1
5875    while {1} {
5876        set c [lsearch -exact [lindex $rowidlist $le] $id]
5877        if {$c < 0} {
5878            incr le -1
5879            break
5880        }
5881        lappend cols $c
5882        set x [lindex $displayorder $le]
5883        if {$x eq $id} {
5884            set arrowhigh 0
5885            break
5886        }
5887        if {[info exists iddrawn($x)] || $le == $endrow} {
5888            set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5889            if {$c >= 0} {
5890                lappend cols $c
5891                set arrowhigh 0
5892            }
5893            break
5894        }
5895        incr le
5896    }
5897    if {$le <= $row} {
5898        return $row
5899    }
5900
5901    set lines {}
5902    set i 0
5903    set joinhigh 0
5904    if {[info exists linesegs($id)]} {
5905        set lines $linesegs($id)
5906        foreach li $lines {
5907            set r0 [lindex $li 0]
5908            if {$r0 > $row} {
5909                if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5910                    set joinhigh 1
5911                }
5912                break
5913            }
5914            incr i
5915        }
5916    }
5917    set joinlow 0
5918    if {$i > 0} {
5919        set li [lindex $lines [expr {$i-1}]]
5920        set r1 [lindex $li 1]
5921        if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5922            set joinlow 1
5923        }
5924    }
5925
5926    set x [lindex $cols [expr {$le - $row}]]
5927    set xp [lindex $cols [expr {$le - 1 - $row}]]
5928    set dir [expr {$xp - $x}]
5929    if {$joinhigh} {
5930        set ith [lindex $lines $i 2]
5931        set coords [$canv coords $ith]
5932        set ah [$canv itemcget $ith -arrow]
5933        set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5934        set x2 [lindex $cols [expr {$le + 1 - $row}]]
5935        if {$x2 ne {} && $x - $x2 == $dir} {
5936            set coords [lrange $coords 0 end-2]
5937        }
5938    } else {
5939        set coords [list [xc $le $x] [yc $le]]
5940    }
5941    if {$joinlow} {
5942        set itl [lindex $lines [expr {$i-1}] 2]
5943        set al [$canv itemcget $itl -arrow]
5944        set arrowlow [expr {$al eq "last" || $al eq "both"}]
5945    } elseif {$arrowlow} {
5946        if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5947            [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5948            set arrowlow 0
5949        }
5950    }
5951    set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5952    for {set y $le} {[incr y -1] > $row} {} {
5953        set x $xp
5954        set xp [lindex $cols [expr {$y - 1 - $row}]]
5955        set ndir [expr {$xp - $x}]
5956        if {$dir != $ndir || $xp < 0} {
5957            lappend coords [xc $y $x] [yc $y]
5958        }
5959        set dir $ndir
5960    }
5961    if {!$joinlow} {
5962        if {$xp < 0} {
5963            # join parent line to first child
5964            set ch [lindex $displayorder $row]
5965            set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5966            if {$xc < 0} {
5967                puts "oops: drawlineseg: child $ch not on row $row"
5968            } elseif {$xc != $x} {
5969                if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5970                    set d [expr {int(0.5 * $linespc)}]
5971                    set x1 [xc $row $x]
5972                    if {$xc < $x} {
5973                        set x2 [expr {$x1 - $d}]
5974                    } else {
5975                        set x2 [expr {$x1 + $d}]
5976                    }
5977                    set y2 [yc $row]
5978                    set y1 [expr {$y2 + $d}]
5979                    lappend coords $x1 $y1 $x2 $y2
5980                } elseif {$xc < $x - 1} {
5981                    lappend coords [xc $row [expr {$x-1}]] [yc $row]
5982                } elseif {$xc > $x + 1} {
5983                    lappend coords [xc $row [expr {$x+1}]] [yc $row]
5984                }
5985                set x $xc
5986            }
5987            lappend coords [xc $row $x] [yc $row]
5988        } else {
5989            set xn [xc $row $xp]
5990            set yn [yc $row]
5991            lappend coords $xn $yn
5992        }
5993        if {!$joinhigh} {
5994            assigncolor $id
5995            set t [$canv create line $coords -width [linewidth $id] \
5996                       -fill $colormap($id) -tags lines.$id -arrow $arrow]
5997            $canv lower $t
5998            bindline $t $id
5999            set lines [linsert $lines $i [list $row $le $t]]
6000        } else {
6001            $canv coords $ith $coords
6002            if {$arrow ne $ah} {
6003                $canv itemconf $ith -arrow $arrow
6004            }
6005            lset lines $i 0 $row
6006        }
6007    } else {
6008        set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
6009        set ndir [expr {$xo - $xp}]
6010        set clow [$canv coords $itl]
6011        if {$dir == $ndir} {
6012            set clow [lrange $clow 2 end]
6013        }
6014        set coords [concat $coords $clow]
6015        if {!$joinhigh} {
6016            lset lines [expr {$i-1}] 1 $le
6017        } else {
6018            # coalesce two pieces
6019            $canv delete $ith
6020            set b [lindex $lines [expr {$i-1}] 0]
6021            set e [lindex $lines $i 1]
6022            set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
6023        }
6024        $canv coords $itl $coords
6025        if {$arrow ne $al} {
6026            $canv itemconf $itl -arrow $arrow
6027        }
6028    }
6029
6030    set linesegs($id) $lines
6031    return $le
6032}
6033
6034proc drawparentlinks {id row} {
6035    global rowidlist canv colormap curview parentlist
6036    global idpos linespc
6037
6038    set rowids [lindex $rowidlist $row]
6039    set col [lsearch -exact $rowids $id]
6040    if {$col < 0} return
6041    set olds [lindex $parentlist $row]
6042    set row2 [expr {$row + 1}]
6043    set x [xc $row $col]
6044    set y [yc $row]
6045    set y2 [yc $row2]
6046    set d [expr {int(0.5 * $linespc)}]
6047    set ymid [expr {$y + $d}]
6048    set ids [lindex $rowidlist $row2]
6049    # rmx = right-most X coord used
6050    set rmx 0
6051    foreach p $olds {
6052        set i [lsearch -exact $ids $p]
6053        if {$i < 0} {
6054            puts "oops, parent $p of $id not in list"
6055            continue
6056        }
6057        set x2 [xc $row2 $i]
6058        if {$x2 > $rmx} {
6059            set rmx $x2
6060        }
6061        set j [lsearch -exact $rowids $p]
6062        if {$j < 0} {
6063            # drawlineseg will do this one for us
6064            continue
6065        }
6066        assigncolor $p
6067        # should handle duplicated parents here...
6068        set coords [list $x $y]
6069        if {$i != $col} {
6070            # if attaching to a vertical segment, draw a smaller
6071            # slant for visual distinctness
6072            if {$i == $j} {
6073                if {$i < $col} {
6074                    lappend coords [expr {$x2 + $d}] $y $x2 $ymid
6075                } else {
6076                    lappend coords [expr {$x2 - $d}] $y $x2 $ymid
6077                }
6078            } elseif {$i < $col && $i < $j} {
6079                # segment slants towards us already
6080                lappend coords [xc $row $j] $y
6081            } else {
6082                if {$i < $col - 1} {
6083                    lappend coords [expr {$x2 + $linespc}] $y
6084                } elseif {$i > $col + 1} {
6085                    lappend coords [expr {$x2 - $linespc}] $y
6086                }
6087                lappend coords $x2 $y2
6088            }
6089        } else {
6090            lappend coords $x2 $y2
6091        }
6092        set t [$canv create line $coords -width [linewidth $p] \
6093                   -fill $colormap($p) -tags lines.$p]
6094        $canv lower $t
6095        bindline $t $p
6096    }
6097    if {$rmx > [lindex $idpos($id) 1]} {
6098        lset idpos($id) 1 $rmx
6099        redrawtags $id
6100    }
6101}
6102
6103proc drawlines {id} {
6104    global canv
6105
6106    $canv itemconf lines.$id -width [linewidth $id]
6107}
6108
6109proc drawcmittext {id row col} {
6110    global linespc canv canv2 canv3 fgcolor curview
6111    global cmitlisted commitinfo rowidlist parentlist
6112    global rowtextx idpos idtags idheads idotherrefs
6113    global linehtag linentag linedtag selectedline
6114    global canvxmax boldids boldnameids fgcolor markedid
6115    global mainheadid nullid nullid2 circleitem circlecolors ctxbut
6116    global mainheadcirclecolor workingfilescirclecolor indexcirclecolor
6117    global circleoutlinecolor
6118
6119    # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
6120    set listed $cmitlisted($curview,$id)
6121    if {$id eq $nullid} {
6122        set ofill $workingfilescirclecolor
6123    } elseif {$id eq $nullid2} {
6124        set ofill $indexcirclecolor
6125    } elseif {$id eq $mainheadid} {
6126        set ofill $mainheadcirclecolor
6127    } else {
6128        set ofill [lindex $circlecolors $listed]
6129    }
6130    set x [xc $row $col]
6131    set y [yc $row]
6132    set orad [expr {$linespc / 3}]
6133    if {$listed <= 2} {
6134        set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
6135                   [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6136                   -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6137    } elseif {$listed == 3} {
6138        # triangle pointing left for left-side commits
6139        set t [$canv create polygon \
6140                   [expr {$x - $orad}] $y \
6141                   [expr {$x + $orad - 1}] [expr {$y - $orad}] \
6142                   [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6143                   -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6144    } else {
6145        # triangle pointing right for right-side commits
6146        set t [$canv create polygon \
6147                   [expr {$x + $orad - 1}] $y \
6148                   [expr {$x - $orad}] [expr {$y - $orad}] \
6149                   [expr {$x - $orad}] [expr {$y + $orad - 1}] \
6150                   -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6151    }
6152    set circleitem($row) $t
6153    $canv raise $t
6154    $canv bind $t <1> {selcanvline {} %x %y}
6155    set rmx [llength [lindex $rowidlist $row]]
6156    set olds [lindex $parentlist $row]
6157    if {$olds ne {}} {
6158        set nextids [lindex $rowidlist [expr {$row + 1}]]
6159        foreach p $olds {
6160            set i [lsearch -exact $nextids $p]
6161            if {$i > $rmx} {
6162                set rmx $i
6163            }
6164        }
6165    }
6166    set xt [xc $row $rmx]
6167    set rowtextx($row) $xt
6168    set idpos($id) [list $x $xt $y]
6169    if {[info exists idtags($id)] || [info exists idheads($id)]
6170        || [info exists idotherrefs($id)]} {
6171        set xt [drawtags $id $x $xt $y]
6172    }
6173    if {[lindex $commitinfo($id) 6] > 0} {
6174        set xt [drawnotesign $xt $y]
6175    }
6176    set headline [lindex $commitinfo($id) 0]
6177    set name [lindex $commitinfo($id) 1]
6178    set date [lindex $commitinfo($id) 2]
6179    set date [formatdate $date]
6180    set font mainfont
6181    set nfont mainfont
6182    set isbold [ishighlighted $id]
6183    if {$isbold > 0} {
6184        lappend boldids $id
6185        set font mainfontbold
6186        if {$isbold > 1} {
6187            lappend boldnameids $id
6188            set nfont mainfontbold
6189        }
6190    }
6191    set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
6192                           -text $headline -font $font -tags text]
6193    $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
6194    set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
6195                           -text $name -font $nfont -tags text]
6196    set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
6197                           -text $date -font mainfont -tags text]
6198    if {$selectedline == $row} {
6199        make_secsel $id
6200    }
6201    if {[info exists markedid] && $markedid eq $id} {
6202        make_idmark $id
6203    }
6204    set xr [expr {$xt + [font measure $font $headline]}]
6205    if {$xr > $canvxmax} {
6206        set canvxmax $xr
6207        setcanvscroll
6208    }
6209}
6210
6211proc drawcmitrow {row} {
6212    global displayorder rowidlist nrows_drawn
6213    global iddrawn markingmatches
6214    global commitinfo numcommits
6215    global filehighlight fhighlights findpattern nhighlights
6216    global hlview vhighlights
6217    global highlight_related rhighlights
6218
6219    if {$row >= $numcommits} return
6220
6221    set id [lindex $displayorder $row]
6222    if {[info exists hlview] && ![info exists vhighlights($id)]} {
6223        askvhighlight $row $id
6224    }
6225    if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
6226        askfilehighlight $row $id
6227    }
6228    if {$findpattern ne {} && ![info exists nhighlights($id)]} {
6229        askfindhighlight $row $id
6230    }
6231    if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
6232        askrelhighlight $row $id
6233    }
6234    if {![info exists iddrawn($id)]} {
6235        set col [lsearch -exact [lindex $rowidlist $row] $id]
6236        if {$col < 0} {
6237            puts "oops, row $row id $id not in list"
6238            return
6239        }
6240        if {![info exists commitinfo($id)]} {
6241            getcommit $id
6242        }
6243        assigncolor $id
6244        drawcmittext $id $row $col
6245        set iddrawn($id) 1
6246        incr nrows_drawn
6247    }
6248    if {$markingmatches} {
6249        markrowmatches $row $id
6250    }
6251}
6252
6253proc drawcommits {row {endrow {}}} {
6254    global numcommits iddrawn displayorder curview need_redisplay
6255    global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
6256
6257    if {$row < 0} {
6258        set row 0
6259    }
6260    if {$endrow eq {}} {
6261        set endrow $row
6262    }
6263    if {$endrow >= $numcommits} {
6264        set endrow [expr {$numcommits - 1}]
6265    }
6266
6267    set rl1 [expr {$row - $downarrowlen - 3}]
6268    if {$rl1 < 0} {
6269        set rl1 0
6270    }
6271    set ro1 [expr {$row - 3}]
6272    if {$ro1 < 0} {
6273        set ro1 0
6274    }
6275    set r2 [expr {$endrow + $uparrowlen + 3}]
6276    if {$r2 > $numcommits} {
6277        set r2 $numcommits
6278    }
6279    for {set r $rl1} {$r < $r2} {incr r} {
6280        if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
6281            if {$rl1 < $r} {
6282                layoutrows $rl1 $r
6283            }
6284            set rl1 [expr {$r + 1}]
6285        }
6286    }
6287    if {$rl1 < $r} {
6288        layoutrows $rl1 $r
6289    }
6290    optimize_rows $ro1 0 $r2
6291    if {$need_redisplay || $nrows_drawn > 2000} {
6292        clear_display
6293    }
6294
6295    # make the lines join to already-drawn rows either side
6296    set r [expr {$row - 1}]
6297    if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
6298        set r $row
6299    }
6300    set er [expr {$endrow + 1}]
6301    if {$er >= $numcommits ||
6302        ![info exists iddrawn([lindex $displayorder $er])]} {
6303        set er $endrow
6304    }
6305    for {} {$r <= $er} {incr r} {
6306        set id [lindex $displayorder $r]
6307        set wasdrawn [info exists iddrawn($id)]
6308        drawcmitrow $r
6309        if {$r == $er} break
6310        set nextid [lindex $displayorder [expr {$r + 1}]]
6311        if {$wasdrawn && [info exists iddrawn($nextid)]} continue
6312        drawparentlinks $id $r
6313
6314        set rowids [lindex $rowidlist $r]
6315        foreach lid $rowids {
6316            if {$lid eq {}} continue
6317            if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
6318            if {$lid eq $id} {
6319                # see if this is the first child of any of its parents
6320                foreach p [lindex $parentlist $r] {
6321                    if {[lsearch -exact $rowids $p] < 0} {
6322                        # make this line extend up to the child
6323                        set lineend($p) [drawlineseg $p $r $er 0]
6324                    }
6325                }
6326            } else {
6327                set lineend($lid) [drawlineseg $lid $r $er 1]
6328            }
6329        }
6330    }
6331}
6332
6333proc undolayout {row} {
6334    global uparrowlen mingaplen downarrowlen
6335    global rowidlist rowisopt rowfinal need_redisplay
6336
6337    set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
6338    if {$r < 0} {
6339        set r 0
6340    }
6341    if {[llength $rowidlist] > $r} {
6342        incr r -1
6343        set rowidlist [lrange $rowidlist 0 $r]
6344        set rowfinal [lrange $rowfinal 0 $r]
6345        set rowisopt [lrange $rowisopt 0 $r]
6346        set need_redisplay 1
6347        run drawvisible
6348    }
6349}
6350
6351proc drawvisible {} {
6352    global canv linespc curview vrowmod selectedline targetrow targetid
6353    global need_redisplay cscroll numcommits
6354
6355    set fs [$canv yview]
6356    set ymax [lindex [$canv cget -scrollregion] 3]
6357    if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
6358    set f0 [lindex $fs 0]
6359    set f1 [lindex $fs 1]
6360    set y0 [expr {int($f0 * $ymax)}]
6361    set y1 [expr {int($f1 * $ymax)}]
6362
6363    if {[info exists targetid]} {
6364        if {[commitinview $targetid $curview]} {
6365            set r [rowofcommit $targetid]
6366            if {$r != $targetrow} {
6367                # Fix up the scrollregion and change the scrolling position
6368                # now that our target row has moved.
6369                set diff [expr {($r - $targetrow) * $linespc}]
6370                set targetrow $r
6371                setcanvscroll
6372                set ymax [lindex [$canv cget -scrollregion] 3]
6373                incr y0 $diff
6374                incr y1 $diff
6375                set f0 [expr {$y0 / $ymax}]
6376                set f1 [expr {$y1 / $ymax}]
6377                allcanvs yview moveto $f0
6378                $cscroll set $f0 $f1
6379                set need_redisplay 1
6380            }
6381        } else {
6382            unset targetid
6383        }
6384    }
6385
6386    set row [expr {int(($y0 - 3) / $linespc) - 1}]
6387    set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
6388    if {$endrow >= $vrowmod($curview)} {
6389        update_arcrows $curview
6390    }
6391    if {$selectedline ne {} &&
6392        $row <= $selectedline && $selectedline <= $endrow} {
6393        set targetrow $selectedline
6394    } elseif {[info exists targetid]} {
6395        set targetrow [expr {int(($row + $endrow) / 2)}]
6396    }
6397    if {[info exists targetrow]} {
6398        if {$targetrow >= $numcommits} {
6399            set targetrow [expr {$numcommits - 1}]
6400        }
6401        set targetid [commitonrow $targetrow]
6402    }
6403    drawcommits $row $endrow
6404}
6405
6406proc clear_display {} {
6407    global iddrawn linesegs need_redisplay nrows_drawn
6408    global vhighlights fhighlights nhighlights rhighlights
6409    global linehtag linentag linedtag boldids boldnameids
6410
6411    allcanvs delete all
6412    unset -nocomplain iddrawn
6413    unset -nocomplain linesegs
6414    unset -nocomplain linehtag
6415    unset -nocomplain linentag
6416    unset -nocomplain linedtag
6417    set boldids {}
6418    set boldnameids {}
6419    unset -nocomplain vhighlights
6420    unset -nocomplain fhighlights
6421    unset -nocomplain nhighlights
6422    unset -nocomplain rhighlights
6423    set need_redisplay 0
6424    set nrows_drawn 0
6425}
6426
6427proc findcrossings {id} {
6428    global rowidlist parentlist numcommits displayorder
6429
6430    set cross {}
6431    set ccross {}
6432    foreach {s e} [rowranges $id] {
6433        if {$e >= $numcommits} {
6434            set e [expr {$numcommits - 1}]
6435        }
6436        if {$e <= $s} continue
6437        for {set row $e} {[incr row -1] >= $s} {} {
6438            set x [lsearch -exact [lindex $rowidlist $row] $id]
6439            if {$x < 0} break
6440            set olds [lindex $parentlist $row]
6441            set kid [lindex $displayorder $row]
6442            set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
6443            if {$kidx < 0} continue
6444            set nextrow [lindex $rowidlist [expr {$row + 1}]]
6445            foreach p $olds {
6446                set px [lsearch -exact $nextrow $p]
6447                if {$px < 0} continue
6448                if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
6449                    if {[lsearch -exact $ccross $p] >= 0} continue
6450                    if {$x == $px + ($kidx < $px? -1: 1)} {
6451                        lappend ccross $p
6452                    } elseif {[lsearch -exact $cross $p] < 0} {
6453                        lappend cross $p
6454                    }
6455                }
6456            }
6457        }
6458    }
6459    return [concat $ccross {{}} $cross]
6460}
6461
6462proc assigncolor {id} {
6463    global colormap colors nextcolor
6464    global parents children children curview
6465
6466    if {[info exists colormap($id)]} return
6467    set ncolors [llength $colors]
6468    if {[info exists children($curview,$id)]} {
6469        set kids $children($curview,$id)
6470    } else {
6471        set kids {}
6472    }
6473    if {[llength $kids] == 1} {
6474        set child [lindex $kids 0]
6475        if {[info exists colormap($child)]
6476            && [llength $parents($curview,$child)] == 1} {
6477            set colormap($id) $colormap($child)
6478            return
6479        }
6480    }
6481    set badcolors {}
6482    set origbad {}
6483    foreach x [findcrossings $id] {
6484        if {$x eq {}} {
6485            # delimiter between corner crossings and other crossings
6486            if {[llength $badcolors] >= $ncolors - 1} break
6487            set origbad $badcolors
6488        }
6489        if {[info exists colormap($x)]
6490            && [lsearch -exact $badcolors $colormap($x)] < 0} {
6491            lappend badcolors $colormap($x)
6492        }
6493    }
6494    if {[llength $badcolors] >= $ncolors} {
6495        set badcolors $origbad
6496    }
6497    set origbad $badcolors
6498    if {[llength $badcolors] < $ncolors - 1} {
6499        foreach child $kids {
6500            if {[info exists colormap($child)]
6501                && [lsearch -exact $badcolors $colormap($child)] < 0} {
6502                lappend badcolors $colormap($child)
6503            }
6504            foreach p $parents($curview,$child) {
6505                if {[info exists colormap($p)]
6506                    && [lsearch -exact $badcolors $colormap($p)] < 0} {
6507                    lappend badcolors $colormap($p)
6508                }
6509            }
6510        }
6511        if {[llength $badcolors] >= $ncolors} {
6512            set badcolors $origbad
6513        }
6514    }
6515    for {set i 0} {$i <= $ncolors} {incr i} {
6516        set c [lindex $colors $nextcolor]
6517        if {[incr nextcolor] >= $ncolors} {
6518            set nextcolor 0
6519        }
6520        if {[lsearch -exact $badcolors $c]} break
6521    }
6522    set colormap($id) $c
6523}
6524
6525proc bindline {t id} {
6526    global canv
6527
6528    $canv bind $t <Enter> "lineenter %x %y $id"
6529    $canv bind $t <Motion> "linemotion %x %y $id"
6530    $canv bind $t <Leave> "lineleave $id"
6531    $canv bind $t <Button-1> "lineclick %x %y $id 1"
6532}
6533
6534proc graph_pane_width {} {
6535    global use_ttk
6536
6537    if {$use_ttk} {
6538        set g [.tf.histframe.pwclist sashpos 0]
6539    } else {
6540        set g [.tf.histframe.pwclist sash coord 0]
6541    }
6542    return [lindex $g 0]
6543}
6544
6545proc totalwidth {l font extra} {
6546    set tot 0
6547    foreach str $l {
6548        set tot [expr {$tot + [font measure $font $str] + $extra}]
6549    }
6550    return $tot
6551}
6552
6553proc drawtags {id x xt y1} {
6554    global idtags idheads idotherrefs mainhead
6555    global linespc lthickness
6556    global canv rowtextx curview fgcolor bgcolor ctxbut
6557    global headbgcolor headfgcolor headoutlinecolor remotebgcolor
6558    global tagbgcolor tagfgcolor tagoutlinecolor
6559    global reflinecolor
6560
6561    set marks {}
6562    set ntags 0
6563    set nheads 0
6564    set singletag 0
6565    set maxtags 3
6566    set maxtagpct 25
6567    set maxwidth [expr {[graph_pane_width] * $maxtagpct / 100}]
6568    set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6569    set extra [expr {$delta + $lthickness + $linespc}]
6570
6571    if {[info exists idtags($id)]} {
6572        set marks $idtags($id)
6573        set ntags [llength $marks]
6574        if {$ntags > $maxtags ||
6575            [totalwidth $marks mainfont $extra] > $maxwidth} {
6576            # show just a single "n tags..." tag
6577            set singletag 1
6578            if {$ntags == 1} {
6579                set marks [list "tag..."]
6580            } else {
6581                set marks [list [format "%d tags..." $ntags]]
6582            }
6583            set ntags 1
6584        }
6585    }
6586    if {[info exists idheads($id)]} {
6587        set marks [concat $marks $idheads($id)]
6588        set nheads [llength $idheads($id)]
6589    }
6590    if {[info exists idotherrefs($id)]} {
6591        set marks [concat $marks $idotherrefs($id)]
6592    }
6593    if {$marks eq {}} {
6594        return $xt
6595    }
6596
6597    set yt [expr {$y1 - 0.5 * $linespc}]
6598    set yb [expr {$yt + $linespc - 1}]
6599    set xvals {}
6600    set wvals {}
6601    set i -1
6602    foreach tag $marks {
6603        incr i
6604        if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
6605            set wid [font measure mainfontbold $tag]
6606        } else {
6607            set wid [font measure mainfont $tag]
6608        }
6609        lappend xvals $xt
6610        lappend wvals $wid
6611        set xt [expr {$xt + $wid + $extra}]
6612    }
6613    set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
6614               -width $lthickness -fill $reflinecolor -tags tag.$id]
6615    $canv lower $t
6616    foreach tag $marks x $xvals wid $wvals {
6617        set tag_quoted [string map {% %%} $tag]
6618        set xl [expr {$x + $delta}]
6619        set xr [expr {$x + $delta + $wid + $lthickness}]
6620        set font mainfont
6621        if {[incr ntags -1] >= 0} {
6622            # draw a tag
6623            set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6624                       $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
6625                       -width 1 -outline $tagoutlinecolor -fill $tagbgcolor \
6626                       -tags tag.$id]
6627            if {$singletag} {
6628                set tagclick [list showtags $id 1]
6629            } else {
6630                set tagclick [list showtag $tag_quoted 1]
6631            }
6632            $canv bind $t <1> $tagclick
6633            set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
6634        } else {
6635            # draw a head or other ref
6636            if {[incr nheads -1] >= 0} {
6637                set col $headbgcolor
6638                if {$tag eq $mainhead} {
6639                    set font mainfontbold
6640                }
6641            } else {
6642                set col "#ddddff"
6643            }
6644            set xl [expr {$xl - $delta/2}]
6645            $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
6646                -width 1 -outline black -fill $col -tags tag.$id
6647            if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
6648                set rwid [font measure mainfont $remoteprefix]
6649                set xi [expr {$x + 1}]
6650                set yti [expr {$yt + 1}]
6651                set xri [expr {$x + $rwid}]
6652                $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6653                        -width 0 -fill $remotebgcolor -tags tag.$id
6654            }
6655        }
6656        set t [$canv create text $xl $y1 -anchor w -text $tag -fill $headfgcolor \
6657                   -font $font -tags [list tag.$id text]]
6658        if {$ntags >= 0} {
6659            $canv bind $t <1> $tagclick
6660        } elseif {$nheads >= 0} {
6661            $canv bind $t $ctxbut [list headmenu %X %Y $id $tag_quoted]
6662        }
6663    }
6664    return $xt
6665}
6666
6667proc drawnotesign {xt y} {
6668    global linespc canv fgcolor
6669
6670    set orad [expr {$linespc / 3}]
6671    set t [$canv create rectangle [expr {$xt - $orad}] [expr {$y - $orad}] \
6672               [expr {$xt + $orad - 1}] [expr {$y + $orad - 1}] \
6673               -fill yellow -outline $fgcolor -width 1 -tags circle]
6674    set xt [expr {$xt + $orad * 3}]
6675    return $xt
6676}
6677
6678proc xcoord {i level ln} {
6679    global canvx0 xspc1 xspc2
6680
6681    set x [expr {$canvx0 + $i * $xspc1($ln)}]
6682    if {$i > 0 && $i == $level} {
6683        set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6684    } elseif {$i > $level} {
6685        set x [expr {$x + $xspc2 - $xspc1($ln)}]
6686    }
6687    return $x
6688}
6689
6690proc show_status {msg} {
6691    global canv fgcolor
6692
6693    clear_display
6694    set_window_title
6695    $canv create text 3 3 -anchor nw -text $msg -font mainfont \
6696        -tags text -fill $fgcolor
6697}
6698
6699# Don't change the text pane cursor if it is currently the hand cursor,
6700# showing that we are over a sha1 ID link.
6701proc settextcursor {c} {
6702    global ctext curtextcursor
6703
6704    if {[$ctext cget -cursor] == $curtextcursor} {
6705        $ctext config -cursor $c
6706    }
6707    set curtextcursor $c
6708}
6709
6710proc nowbusy {what {name {}}} {
6711    global isbusy busyname statusw
6712
6713    if {[array names isbusy] eq {}} {
6714        . config -cursor watch
6715        settextcursor watch
6716    }
6717    set isbusy($what) 1
6718    set busyname($what) $name
6719    if {$name ne {}} {
6720        $statusw conf -text $name
6721    }
6722}
6723
6724proc notbusy {what} {
6725    global isbusy maincursor textcursor busyname statusw
6726
6727    catch {
6728        unset isbusy($what)
6729        if {$busyname($what) ne {} &&
6730            [$statusw cget -text] eq $busyname($what)} {
6731            $statusw conf -text {}
6732        }
6733    }
6734    if {[array names isbusy] eq {}} {
6735        . config -cursor $maincursor
6736        settextcursor $textcursor
6737    }
6738}
6739
6740proc findmatches {f} {
6741    global findtype findstring
6742    if {$findtype == [mc "Regexp"]} {
6743        set matches [regexp -indices -all -inline $findstring $f]
6744    } else {
6745        set fs $findstring
6746        if {$findtype == [mc "IgnCase"]} {
6747            set f [string tolower $f]
6748            set fs [string tolower $fs]
6749        }
6750        set matches {}
6751        set i 0
6752        set l [string length $fs]
6753        while {[set j [string first $fs $f $i]] >= 0} {
6754            lappend matches [list $j [expr {$j+$l-1}]]
6755            set i [expr {$j + $l}]
6756        }
6757    }
6758    return $matches
6759}
6760
6761proc dofind {{dirn 1} {wrap 1}} {
6762    global findstring findstartline findcurline selectedline numcommits
6763    global gdttype filehighlight fh_serial find_dirn findallowwrap
6764
6765    if {[info exists find_dirn]} {
6766        if {$find_dirn == $dirn} return
6767        stopfinding
6768    }
6769    focus .
6770    if {$findstring eq {} || $numcommits == 0} return
6771    if {$selectedline eq {}} {
6772        set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6773    } else {
6774        set findstartline $selectedline
6775    }
6776    set findcurline $findstartline
6777    nowbusy finding [mc "Searching"]
6778    if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6779        after cancel do_file_hl $fh_serial
6780        do_file_hl $fh_serial
6781    }
6782    set find_dirn $dirn
6783    set findallowwrap $wrap
6784    run findmore
6785}
6786
6787proc stopfinding {} {
6788    global find_dirn findcurline fprogcoord
6789
6790    if {[info exists find_dirn]} {
6791        unset find_dirn
6792        unset findcurline
6793        notbusy finding
6794        set fprogcoord 0
6795        adjustprogress
6796    }
6797    stopblaming
6798}
6799
6800proc findmore {} {
6801    global commitdata commitinfo numcommits findpattern findloc
6802    global findstartline findcurline findallowwrap
6803    global find_dirn gdttype fhighlights fprogcoord
6804    global curview varcorder vrownum varccommits vrowmod
6805
6806    if {![info exists find_dirn]} {
6807        return 0
6808    }
6809    set fldtypes [list [mc "Headline"] [mc "Author"] "" [mc "Committer"] "" [mc "Comments"]]
6810    set l $findcurline
6811    set moretodo 0
6812    if {$find_dirn > 0} {
6813        incr l
6814        if {$l >= $numcommits} {
6815            set l 0
6816        }
6817        if {$l <= $findstartline} {
6818            set lim [expr {$findstartline + 1}]
6819        } else {
6820            set lim $numcommits
6821            set moretodo $findallowwrap
6822        }
6823    } else {
6824        if {$l == 0} {
6825            set l $numcommits
6826        }
6827        incr l -1
6828        if {$l >= $findstartline} {
6829            set lim [expr {$findstartline - 1}]
6830        } else {
6831            set lim -1
6832            set moretodo $findallowwrap
6833        }
6834    }
6835    set n [expr {($lim - $l) * $find_dirn}]
6836    if {$n > 500} {
6837        set n 500
6838        set moretodo 1
6839    }
6840    if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6841        update_arcrows $curview
6842    }
6843    set found 0
6844    set domore 1
6845    set ai [bsearch $vrownum($curview) $l]
6846    set a [lindex $varcorder($curview) $ai]
6847    set arow [lindex $vrownum($curview) $ai]
6848    set ids [lindex $varccommits($curview,$a)]
6849    set arowend [expr {$arow + [llength $ids]}]
6850    if {$gdttype eq [mc "containing:"]} {
6851        for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6852            if {$l < $arow || $l >= $arowend} {
6853                incr ai $find_dirn
6854                set a [lindex $varcorder($curview) $ai]
6855                set arow [lindex $vrownum($curview) $ai]
6856                set ids [lindex $varccommits($curview,$a)]
6857                set arowend [expr {$arow + [llength $ids]}]
6858            }
6859            set id [lindex $ids [expr {$l - $arow}]]
6860            # shouldn't happen unless git log doesn't give all the commits...
6861            if {![info exists commitdata($id)] ||
6862                ![doesmatch $commitdata($id)]} {
6863                continue
6864            }
6865            if {![info exists commitinfo($id)]} {
6866                getcommit $id
6867            }
6868            set info $commitinfo($id)
6869            foreach f $info ty $fldtypes {
6870                if {$ty eq ""} continue
6871                if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6872                    [doesmatch $f]} {
6873                    set found 1
6874                    break
6875                }
6876            }
6877            if {$found} break
6878        }
6879    } else {
6880        for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6881            if {$l < $arow || $l >= $arowend} {
6882                incr ai $find_dirn
6883                set a [lindex $varcorder($curview) $ai]
6884                set arow [lindex $vrownum($curview) $ai]
6885                set ids [lindex $varccommits($curview,$a)]
6886                set arowend [expr {$arow + [llength $ids]}]
6887            }
6888            set id [lindex $ids [expr {$l - $arow}]]
6889            if {![info exists fhighlights($id)]} {
6890                # this sets fhighlights($id) to -1
6891                askfilehighlight $l $id
6892            }
6893            if {$fhighlights($id) > 0} {
6894                set found $domore
6895                break
6896            }
6897            if {$fhighlights($id) < 0} {
6898                if {$domore} {
6899                    set domore 0
6900                    set findcurline [expr {$l - $find_dirn}]
6901                }
6902            }
6903        }
6904    }
6905    if {$found || ($domore && !$moretodo)} {
6906        unset findcurline
6907        unset find_dirn
6908        notbusy finding
6909        set fprogcoord 0
6910        adjustprogress
6911        if {$found} {
6912            findselectline $l
6913        } else {
6914            bell
6915        }
6916        return 0
6917    }
6918    if {!$domore} {
6919        flushhighlights
6920    } else {
6921        set findcurline [expr {$l - $find_dirn}]
6922    }
6923    set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6924    if {$n < 0} {
6925        incr n $numcommits
6926    }
6927    set fprogcoord [expr {$n * 1.0 / $numcommits}]
6928    adjustprogress
6929    return $domore
6930}
6931
6932proc findselectline {l} {
6933    global findloc commentend ctext findcurline markingmatches gdttype
6934
6935    set markingmatches [expr {$gdttype eq [mc "containing:"]}]
6936    set findcurline $l
6937    selectline $l 1
6938    if {$markingmatches &&
6939        ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
6940        # highlight the matches in the comments
6941        set f [$ctext get 1.0 $commentend]
6942        set matches [findmatches $f]
6943        foreach match $matches {
6944            set start [lindex $match 0]
6945            set end [expr {[lindex $match 1] + 1}]
6946            $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6947        }
6948    }
6949    drawvisible
6950}
6951
6952# mark the bits of a headline or author that match a find string
6953proc markmatches {canv l str tag matches font row} {
6954    global selectedline
6955
6956    set bbox [$canv bbox $tag]
6957    set x0 [lindex $bbox 0]
6958    set y0 [lindex $bbox 1]
6959    set y1 [lindex $bbox 3]
6960    foreach match $matches {
6961        set start [lindex $match 0]
6962        set end [lindex $match 1]
6963        if {$start > $end} continue
6964        set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6965        set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6966        set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6967                   [expr {$x0+$xlen+2}] $y1 \
6968                   -outline {} -tags [list match$l matches] -fill yellow]
6969        $canv lower $t
6970        if {$row == $selectedline} {
6971            $canv raise $t secsel
6972        }
6973    }
6974}
6975
6976proc unmarkmatches {} {
6977    global markingmatches
6978
6979    allcanvs delete matches
6980    set markingmatches 0
6981    stopfinding
6982}
6983
6984proc selcanvline {w x y} {
6985    global canv canvy0 ctext linespc
6986    global rowtextx
6987    set ymax [lindex [$canv cget -scrollregion] 3]
6988    if {$ymax == {}} return
6989    set yfrac [lindex [$canv yview] 0]
6990    set y [expr {$y + $yfrac * $ymax}]
6991    set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6992    if {$l < 0} {
6993        set l 0
6994    }
6995    if {$w eq $canv} {
6996        set xmax [lindex [$canv cget -scrollregion] 2]
6997        set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6998        if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
6999    }
7000    unmarkmatches
7001    selectline $l 1
7002}
7003
7004proc commit_descriptor {p} {
7005    global commitinfo
7006    if {![info exists commitinfo($p)]} {
7007        getcommit $p
7008    }
7009    set l "..."
7010    if {[llength $commitinfo($p)] > 1} {
7011        set l [lindex $commitinfo($p) 0]
7012    }
7013    return "$p ($l)\n"
7014}
7015
7016# append some text to the ctext widget, and make any SHA1 ID
7017# that we know about be a clickable link.
7018proc appendwithlinks {text tags} {
7019    global ctext linknum curview
7020
7021    set start [$ctext index "end - 1c"]
7022    $ctext insert end $text $tags
7023    set links [regexp -indices -all -inline {(?:\m|-g)[0-9a-f]{6,40}\M} $text]
7024    foreach l $links {
7025        set s [lindex $l 0]
7026        set e [lindex $l 1]
7027        set linkid [string range $text $s $e]
7028        incr e
7029        $ctext tag delete link$linknum
7030        $ctext tag add link$linknum "$start + $s c" "$start + $e c"
7031        setlink $linkid link$linknum
7032        incr linknum
7033    }
7034}
7035
7036proc setlink {id lk} {
7037    global curview ctext pendinglinks
7038    global linkfgcolor
7039
7040    if {[string range $id 0 1] eq "-g"} {
7041      set id [string range $id 2 end]
7042    }
7043
7044    set known 0
7045    if {[string length $id] < 40} {
7046        set matches [longid $id]
7047        if {[llength $matches] > 0} {
7048            if {[llength $matches] > 1} return
7049            set known 1
7050            set id [lindex $matches 0]
7051        }
7052    } else {
7053        set known [commitinview $id $curview]
7054    }
7055    if {$known} {
7056        $ctext tag conf $lk -foreground $linkfgcolor -underline 1
7057        $ctext tag bind $lk <1> [list selbyid $id]
7058        $ctext tag bind $lk <Enter> {linkcursor %W 1}
7059        $ctext tag bind $lk <Leave> {linkcursor %W -1}
7060    } else {
7061        lappend pendinglinks($id) $lk
7062        interestedin $id {makelink %P}
7063    }
7064}
7065
7066proc appendshortlink {id {pre {}} {post {}}} {
7067    global ctext linknum
7068
7069    $ctext insert end $pre
7070    $ctext tag delete link$linknum
7071    $ctext insert end [string range $id 0 7] link$linknum
7072    $ctext insert end $post
7073    setlink $id link$linknum
7074    incr linknum
7075}
7076
7077proc makelink {id} {
7078    global pendinglinks
7079
7080    if {![info exists pendinglinks($id)]} return
7081    foreach lk $pendinglinks($id) {
7082        setlink $id $lk
7083    }
7084    unset pendinglinks($id)
7085}
7086
7087proc linkcursor {w inc} {
7088    global linkentercount curtextcursor
7089
7090    if {[incr linkentercount $inc] > 0} {
7091        $w configure -cursor hand2
7092    } else {
7093        $w configure -cursor $curtextcursor
7094        if {$linkentercount < 0} {
7095            set linkentercount 0
7096        }
7097    }
7098}
7099
7100proc viewnextline {dir} {
7101    global canv linespc
7102
7103    $canv delete hover
7104    set ymax [lindex [$canv cget -scrollregion] 3]
7105    set wnow [$canv yview]
7106    set wtop [expr {[lindex $wnow 0] * $ymax}]
7107    set newtop [expr {$wtop + $dir * $linespc}]
7108    if {$newtop < 0} {
7109        set newtop 0
7110    } elseif {$newtop > $ymax} {
7111        set newtop $ymax
7112    }
7113    allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7114}
7115
7116# add a list of tag or branch names at position pos
7117# returns the number of names inserted
7118proc appendrefs {pos ids var} {
7119    global ctext linknum curview $var maxrefs visiblerefs mainheadid
7120
7121    if {[catch {$ctext index $pos}]} {
7122        return 0
7123    }
7124    $ctext conf -state normal
7125    $ctext delete $pos "$pos lineend"
7126    set tags {}
7127    foreach id $ids {
7128        foreach tag [set $var\($id\)] {
7129            lappend tags [list $tag $id]
7130        }
7131    }
7132
7133    set sep {}
7134    set tags [lsort -index 0 -decreasing $tags]
7135    set nutags 0
7136
7137    if {[llength $tags] > $maxrefs} {
7138        # If we are displaying heads, and there are too many,
7139        # see if there are some important heads to display.
7140        # Currently that are the current head and heads listed in $visiblerefs option
7141        set itags {}
7142        if {$var eq "idheads"} {
7143            set utags {}
7144            foreach ti $tags {
7145                set hname [lindex $ti 0]
7146                set id [lindex $ti 1]
7147                if {([lsearch -exact $visiblerefs $hname] != -1 || $id eq $mainheadid) &&
7148                    [llength $itags] < $maxrefs} {
7149                    lappend itags $ti
7150                } else {
7151                    lappend utags $ti
7152                }
7153            }
7154            set tags $utags
7155        }
7156        if {$itags ne {}} {
7157            set str [mc "and many more"]
7158            set sep " "
7159        } else {
7160            set str [mc "many"]
7161        }
7162        $ctext insert $pos "$str ([llength $tags])"
7163        set nutags [llength $tags]
7164        set tags $itags
7165    }
7166
7167    foreach ti $tags {
7168        set id [lindex $ti 1]
7169        set lk link$linknum
7170        incr linknum
7171        $ctext tag delete $lk
7172        $ctext insert $pos $sep
7173        $ctext insert $pos [lindex $ti 0] $lk
7174        setlink $id $lk
7175        set sep ", "
7176    }
7177    $ctext tag add wwrap "$pos linestart" "$pos lineend"
7178    $ctext conf -state disabled
7179    return [expr {[llength $tags] + $nutags}]
7180}
7181
7182# called when we have finished computing the nearby tags
7183proc dispneartags {delay} {
7184    global selectedline currentid showneartags tagphase
7185
7186    if {$selectedline eq {} || !$showneartags} return
7187    after cancel dispnexttag
7188    if {$delay} {
7189        after 200 dispnexttag
7190        set tagphase -1
7191    } else {
7192        after idle dispnexttag
7193        set tagphase 0
7194    }
7195}
7196
7197proc dispnexttag {} {
7198    global selectedline currentid showneartags tagphase ctext
7199
7200    if {$selectedline eq {} || !$showneartags} return
7201    switch -- $tagphase {
7202        0 {
7203            set dtags [desctags $currentid]
7204            if {$dtags ne {}} {
7205                appendrefs precedes $dtags idtags
7206            }
7207        }
7208        1 {
7209            set atags [anctags $currentid]
7210            if {$atags ne {}} {
7211                appendrefs follows $atags idtags
7212            }
7213        }
7214        2 {
7215            set dheads [descheads $currentid]
7216            if {$dheads ne {}} {
7217                if {[appendrefs branch $dheads idheads] > 1
7218                    && [$ctext get "branch -3c"] eq "h"} {
7219                    # turn "Branch" into "Branches"
7220                    $ctext conf -state normal
7221                    $ctext insert "branch -2c" "es"
7222                    $ctext conf -state disabled
7223                }
7224            }
7225        }
7226    }
7227    if {[incr tagphase] <= 2} {
7228        after idle dispnexttag
7229    }
7230}
7231
7232proc make_secsel {id} {
7233    global linehtag linentag linedtag canv canv2 canv3
7234
7235    if {![info exists linehtag($id)]} return
7236    $canv delete secsel
7237    set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
7238               -tags secsel -fill [$canv cget -selectbackground]]
7239    $canv lower $t
7240    $canv2 delete secsel
7241    set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
7242               -tags secsel -fill [$canv2 cget -selectbackground]]
7243    $canv2 lower $t
7244    $canv3 delete secsel
7245    set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
7246               -tags secsel -fill [$canv3 cget -selectbackground]]
7247    $canv3 lower $t
7248}
7249
7250proc make_idmark {id} {
7251    global linehtag canv fgcolor
7252
7253    if {![info exists linehtag($id)]} return
7254    $canv delete markid
7255    set t [eval $canv create rect [$canv bbox $linehtag($id)] \
7256               -tags markid -outline $fgcolor]
7257    $canv raise $t
7258}
7259
7260proc selectline {l isnew {desired_loc {}} {switch_to_patch 0}} {
7261    global canv ctext commitinfo selectedline
7262    global canvy0 linespc parents children curview
7263    global currentid sha1entry
7264    global commentend idtags linknum
7265    global mergemax numcommits pending_select
7266    global cmitmode showneartags allcommits
7267    global targetrow targetid lastscrollrows
7268    global autoselect autosellen jump_to_here
7269    global vinlinediff
7270
7271    unset -nocomplain pending_select
7272    $canv delete hover
7273    normalline
7274    unsel_reflist
7275    stopfinding
7276    if {$l < 0 || $l >= $numcommits} return
7277    set id [commitonrow $l]
7278    set targetid $id
7279    set targetrow $l
7280    set selectedline $l
7281    set currentid $id
7282    if {$lastscrollrows < $numcommits} {
7283        setcanvscroll
7284    }
7285
7286    if {$cmitmode ne "patch" && $switch_to_patch} {
7287        set cmitmode "patch"
7288    }
7289
7290    set y [expr {$canvy0 + $l * $linespc}]
7291    set ymax [lindex [$canv cget -scrollregion] 3]
7292    set ytop [expr {$y - $linespc - 1}]
7293    set ybot [expr {$y + $linespc + 1}]
7294    set wnow [$canv yview]
7295    set wtop [expr {[lindex $wnow 0] * $ymax}]
7296    set wbot [expr {[lindex $wnow 1] * $ymax}]
7297    set wh [expr {$wbot - $wtop}]
7298    set newtop $wtop
7299    if {$ytop < $wtop} {
7300        if {$ybot < $wtop} {
7301            set newtop [expr {$y - $wh / 2.0}]
7302        } else {
7303            set newtop $ytop
7304            if {$newtop > $wtop - $linespc} {
7305                set newtop [expr {$wtop - $linespc}]
7306            }
7307        }
7308    } elseif {$ybot > $wbot} {
7309        if {$ytop > $wbot} {
7310            set newtop [expr {$y - $wh / 2.0}]
7311        } else {
7312            set newtop [expr {$ybot - $wh}]
7313            if {$newtop < $wtop + $linespc} {
7314                set newtop [expr {$wtop + $linespc}]
7315            }
7316        }
7317    }
7318    if {$newtop != $wtop} {
7319        if {$newtop < 0} {
7320            set newtop 0
7321        }
7322        allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7323        drawvisible
7324    }
7325
7326    make_secsel $id
7327
7328    if {$isnew} {
7329        addtohistory [list selbyid $id 0] savecmitpos
7330    }
7331
7332    $sha1entry delete 0 end
7333    $sha1entry insert 0 $id
7334    if {$autoselect} {
7335        $sha1entry selection range 0 $autosellen
7336    }
7337    rhighlight_sel $id
7338
7339    $ctext conf -state normal
7340    clear_ctext
7341    set linknum 0
7342    if {![info exists commitinfo($id)]} {
7343        getcommit $id
7344    }
7345    set info $commitinfo($id)
7346    set date [formatdate [lindex $info 2]]
7347    $ctext insert end "[mc "Author"]: [lindex $info 1]  $date\n"
7348    set date [formatdate [lindex $info 4]]
7349    $ctext insert end "[mc "Committer"]: [lindex $info 3]  $date\n"
7350    if {[info exists idtags($id)]} {
7351        $ctext insert end [mc "Tags:"]
7352        foreach tag $idtags($id) {
7353            $ctext insert end " $tag"
7354        }
7355        $ctext insert end "\n"
7356    }
7357
7358    set headers {}
7359    set olds $parents($curview,$id)
7360    if {[llength $olds] > 1} {
7361        set np 0
7362        foreach p $olds {
7363            if {$np >= $mergemax} {
7364                set tag mmax
7365            } else {
7366                set tag m$np
7367            }
7368            $ctext insert end "[mc "Parent"]: " $tag
7369            appendwithlinks [commit_descriptor $p] {}
7370            incr np
7371        }
7372    } else {
7373        foreach p $olds {
7374            append headers "[mc "Parent"]: [commit_descriptor $p]"
7375        }
7376    }
7377
7378    foreach c $children($curview,$id) {
7379        append headers "[mc "Child"]:  [commit_descriptor $c]"
7380    }
7381
7382    # make anything that looks like a SHA1 ID be a clickable link
7383    appendwithlinks $headers {}
7384    if {$showneartags} {
7385        if {![info exists allcommits]} {
7386            getallcommits
7387        }
7388        $ctext insert end "[mc "Branch"]: "
7389        $ctext mark set branch "end -1c"
7390        $ctext mark gravity branch left
7391        $ctext insert end "\n[mc "Follows"]: "
7392        $ctext mark set follows "end -1c"
7393        $ctext mark gravity follows left
7394        $ctext insert end "\n[mc "Precedes"]: "
7395        $ctext mark set precedes "end -1c"
7396        $ctext mark gravity precedes left
7397        $ctext insert end "\n"
7398        dispneartags 1
7399    }
7400    $ctext insert end "\n"
7401    set comment [lindex $info 5]
7402    if {[string first "\r" $comment] >= 0} {
7403        set comment [string map {"\r" "\n    "} $comment]
7404    }
7405    appendwithlinks $comment {comment}
7406
7407    $ctext tag remove found 1.0 end
7408    $ctext conf -state disabled
7409    set commentend [$ctext index "end - 1c"]
7410
7411    set jump_to_here $desired_loc
7412    init_flist [mc "Comments"]
7413    if {$cmitmode eq "tree"} {
7414        gettree $id
7415    } elseif {$vinlinediff($curview) == 1} {
7416        showinlinediff $id
7417    } elseif {[llength $olds] <= 1} {
7418        startdiff $id
7419    } else {
7420        mergediff $id
7421    }
7422}
7423
7424proc selfirstline {} {
7425    unmarkmatches
7426    selectline 0 1
7427}
7428
7429proc sellastline {} {
7430    global numcommits
7431    unmarkmatches
7432    set l [expr {$numcommits - 1}]
7433    selectline $l 1
7434}
7435
7436proc selnextline {dir} {
7437    global selectedline
7438    focus .
7439    if {$selectedline eq {}} return
7440    set l [expr {$selectedline + $dir}]
7441    unmarkmatches
7442    selectline $l 1
7443}
7444
7445proc selnextpage {dir} {
7446    global canv linespc selectedline numcommits
7447
7448    set lpp [expr {([winfo height $canv] - 2) / $linespc}]
7449    if {$lpp < 1} {
7450        set lpp 1
7451    }
7452    allcanvs yview scroll [expr {$dir * $lpp}] units
7453    drawvisible
7454    if {$selectedline eq {}} return
7455    set l [expr {$selectedline + $dir * $lpp}]
7456    if {$l < 0} {
7457        set l 0
7458    } elseif {$l >= $numcommits} {
7459        set l [expr $numcommits - 1]
7460    }
7461    unmarkmatches
7462    selectline $l 1
7463}
7464
7465proc unselectline {} {
7466    global selectedline currentid
7467
7468    set selectedline {}
7469    unset -nocomplain currentid
7470    allcanvs delete secsel
7471    rhighlight_none
7472}
7473
7474proc reselectline {} {
7475    global selectedline
7476
7477    if {$selectedline ne {}} {
7478        selectline $selectedline 0
7479    }
7480}
7481
7482proc addtohistory {cmd {saveproc {}}} {
7483    global history historyindex curview
7484
7485    unset_posvars
7486    save_position
7487    set elt [list $curview $cmd $saveproc {}]
7488    if {$historyindex > 0
7489        && [lindex $history [expr {$historyindex - 1}]] == $elt} {
7490        return
7491    }
7492
7493    if {$historyindex < [llength $history]} {
7494        set history [lreplace $history $historyindex end $elt]
7495    } else {
7496        lappend history $elt
7497    }
7498    incr historyindex
7499    if {$historyindex > 1} {
7500        .tf.bar.leftbut conf -state normal
7501    } else {
7502        .tf.bar.leftbut conf -state disabled
7503    }
7504    .tf.bar.rightbut conf -state disabled
7505}
7506
7507# save the scrolling position of the diff display pane
7508proc save_position {} {
7509    global historyindex history
7510
7511    if {$historyindex < 1} return
7512    set hi [expr {$historyindex - 1}]
7513    set fn [lindex $history $hi 2]
7514    if {$fn ne {}} {
7515        lset history $hi 3 [eval $fn]
7516    }
7517}
7518
7519proc unset_posvars {} {
7520    global last_posvars
7521
7522    if {[info exists last_posvars]} {
7523        foreach {var val} $last_posvars {
7524            global $var
7525            unset -nocomplain $var
7526        }
7527        unset last_posvars
7528    }
7529}
7530
7531proc godo {elt} {
7532    global curview last_posvars
7533
7534    set view [lindex $elt 0]
7535    set cmd [lindex $elt 1]
7536    set pv [lindex $elt 3]
7537    if {$curview != $view} {
7538        showview $view
7539    }
7540    unset_posvars
7541    foreach {var val} $pv {
7542        global $var
7543        set $var $val
7544    }
7545    set last_posvars $pv
7546    eval $cmd
7547}
7548
7549proc goback {} {
7550    global history historyindex
7551    focus .
7552
7553    if {$historyindex > 1} {
7554        save_position
7555        incr historyindex -1
7556        godo [lindex $history [expr {$historyindex - 1}]]
7557        .tf.bar.rightbut conf -state normal
7558    }
7559    if {$historyindex <= 1} {
7560        .tf.bar.leftbut conf -state disabled
7561    }
7562}
7563
7564proc goforw {} {
7565    global history historyindex
7566    focus .
7567
7568    if {$historyindex < [llength $history]} {
7569        save_position
7570        set cmd [lindex $history $historyindex]
7571        incr historyindex
7572        godo $cmd
7573        .tf.bar.leftbut conf -state normal
7574    }
7575    if {$historyindex >= [llength $history]} {
7576        .tf.bar.rightbut conf -state disabled
7577    }
7578}
7579
7580proc go_to_parent {i} {
7581    global parents curview targetid
7582    set ps $parents($curview,$targetid)
7583    if {[llength $ps] >= $i} {
7584        selbyid [lindex $ps [expr $i - 1]]
7585    }
7586}
7587
7588proc gettree {id} {
7589    global treefilelist treeidlist diffids diffmergeid treepending
7590    global nullid nullid2
7591
7592    set diffids $id
7593    unset -nocomplain diffmergeid
7594    if {![info exists treefilelist($id)]} {
7595        if {![info exists treepending]} {
7596            if {$id eq $nullid} {
7597                set cmd [list | git ls-files]
7598            } elseif {$id eq $nullid2} {
7599                set cmd [list | git ls-files --stage -t]
7600            } else {
7601                set cmd [list | git ls-tree -r $id]
7602            }
7603            if {[catch {set gtf [open $cmd r]}]} {
7604                return
7605            }
7606            set treepending $id
7607            set treefilelist($id) {}
7608            set treeidlist($id) {}
7609            fconfigure $gtf -blocking 0 -encoding binary
7610            filerun $gtf [list gettreeline $gtf $id]
7611        }
7612    } else {
7613        setfilelist $id
7614    }
7615}
7616
7617proc gettreeline {gtf id} {
7618    global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
7619
7620    set nl 0
7621    while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
7622        if {$diffids eq $nullid} {
7623            set fname $line
7624        } else {
7625            set i [string first "\t" $line]
7626            if {$i < 0} continue
7627            set fname [string range $line [expr {$i+1}] end]
7628            set line [string range $line 0 [expr {$i-1}]]
7629            if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7630            set sha1 [lindex $line 2]
7631            lappend treeidlist($id) $sha1
7632        }
7633        if {[string index $fname 0] eq "\""} {
7634            set fname [lindex $fname 0]
7635        }
7636        set fname [encoding convertfrom $fname]
7637        lappend treefilelist($id) $fname
7638    }
7639    if {![eof $gtf]} {
7640        return [expr {$nl >= 1000? 2: 1}]
7641    }
7642    close $gtf
7643    unset treepending
7644    if {$cmitmode ne "tree"} {
7645        if {![info exists diffmergeid]} {
7646            gettreediffs $diffids
7647        }
7648    } elseif {$id ne $diffids} {
7649        gettree $diffids
7650    } else {
7651        setfilelist $id
7652    }
7653    return 0
7654}
7655
7656proc showfile {f} {
7657    global treefilelist treeidlist diffids nullid nullid2
7658    global ctext_file_names ctext_file_lines
7659    global ctext commentend
7660
7661    set i [lsearch -exact $treefilelist($diffids) $f]
7662    if {$i < 0} {
7663        puts "oops, $f not in list for id $diffids"
7664        return
7665    }
7666    if {$diffids eq $nullid} {
7667        if {[catch {set bf [open $f r]} err]} {
7668            puts "oops, can't read $f: $err"
7669            return
7670        }
7671    } else {
7672        set blob [lindex $treeidlist($diffids) $i]
7673        if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7674            puts "oops, error reading blob $blob: $err"
7675            return
7676        }
7677    }
7678    fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7679    filerun $bf [list getblobline $bf $diffids]
7680    $ctext config -state normal
7681    clear_ctext $commentend
7682    lappend ctext_file_names $f
7683    lappend ctext_file_lines [lindex [split $commentend "."] 0]
7684    $ctext insert end "\n"
7685    $ctext insert end "$f\n" filesep
7686    $ctext config -state disabled
7687    $ctext yview $commentend
7688    settabs 0
7689}
7690
7691proc getblobline {bf id} {
7692    global diffids cmitmode ctext
7693
7694    if {$id ne $diffids || $cmitmode ne "tree"} {
7695        catch {close $bf}
7696        return 0
7697    }
7698    $ctext config -state normal
7699    set nl 0
7700    while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7701        $ctext insert end "$line\n"
7702    }
7703    if {[eof $bf]} {
7704        global jump_to_here ctext_file_names commentend
7705
7706        # delete last newline
7707        $ctext delete "end - 2c" "end - 1c"
7708        close $bf
7709        if {$jump_to_here ne {} &&
7710            [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7711            set lnum [expr {[lindex $jump_to_here 1] +
7712                            [lindex [split $commentend .] 0]}]
7713            mark_ctext_line $lnum
7714        }
7715        $ctext config -state disabled
7716        return 0
7717    }
7718    $ctext config -state disabled
7719    return [expr {$nl >= 1000? 2: 1}]
7720}
7721
7722proc mark_ctext_line {lnum} {
7723    global ctext markbgcolor
7724
7725    $ctext tag delete omark
7726    $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7727    $ctext tag conf omark -background $markbgcolor
7728    $ctext see $lnum.0
7729}
7730
7731proc mergediff {id} {
7732    global diffmergeid
7733    global diffids treediffs
7734    global parents curview
7735
7736    set diffmergeid $id
7737    set diffids $id
7738    set treediffs($id) {}
7739    set np [llength $parents($curview,$id)]
7740    settabs $np
7741    getblobdiffs $id
7742}
7743
7744proc startdiff {ids} {
7745    global treediffs diffids treepending diffmergeid nullid nullid2
7746
7747    settabs 1
7748    set diffids $ids
7749    unset -nocomplain diffmergeid
7750    if {![info exists treediffs($ids)] ||
7751        [lsearch -exact $ids $nullid] >= 0 ||
7752        [lsearch -exact $ids $nullid2] >= 0} {
7753        if {![info exists treepending]} {
7754            gettreediffs $ids
7755        }
7756    } else {
7757        addtocflist $ids
7758    }
7759}
7760
7761proc showinlinediff {ids} {
7762    global commitinfo commitdata ctext
7763    global treediffs
7764
7765    set info $commitinfo($ids)
7766    set diff [lindex $info 7]
7767    set difflines [split $diff "\n"]
7768
7769    initblobdiffvars
7770    set treediff {}
7771
7772    set inhdr 0
7773    foreach line $difflines {
7774        if {![string compare -length 5 "diff " $line]} {
7775            set inhdr 1
7776        } elseif {$inhdr && ![string compare -length 4 "+++ " $line]} {
7777            # offset also accounts for the b/ prefix
7778            lappend treediff [string range $line 6 end]
7779            set inhdr 0
7780        }
7781    }
7782
7783    set treediffs($ids) $treediff
7784    add_flist $treediff
7785
7786    $ctext conf -state normal
7787    foreach line $difflines {
7788        parseblobdiffline $ids $line
7789    }
7790    maybe_scroll_ctext 1
7791    $ctext conf -state disabled
7792}
7793
7794# If the filename (name) is under any of the passed filter paths
7795# then return true to include the file in the listing.
7796proc path_filter {filter name} {
7797    set worktree [gitworktree]
7798    foreach p $filter {
7799        set fq_p [file normalize $p]
7800        set fq_n [file normalize [file join $worktree $name]]
7801        if {[string match [file normalize $fq_p]* $fq_n]} {
7802            return 1
7803        }
7804    }
7805    return 0
7806}
7807
7808proc addtocflist {ids} {
7809    global treediffs
7810
7811    add_flist $treediffs($ids)
7812    getblobdiffs $ids
7813}
7814
7815proc diffcmd {ids flags} {
7816    global log_showroot nullid nullid2 git_version
7817
7818    set i [lsearch -exact $ids $nullid]
7819    set j [lsearch -exact $ids $nullid2]
7820    if {$i >= 0} {
7821        if {[llength $ids] > 1 && $j < 0} {
7822            # comparing working directory with some specific revision
7823            set cmd [concat | git diff-index $flags]
7824            if {$i == 0} {
7825                lappend cmd -R [lindex $ids 1]
7826            } else {
7827                lappend cmd [lindex $ids 0]
7828            }
7829        } else {
7830            # comparing working directory with index
7831            set cmd [concat | git diff-files $flags]
7832            if {$j == 1} {
7833                lappend cmd -R
7834            }
7835        }
7836    } elseif {$j >= 0} {
7837        if {[package vcompare $git_version "1.7.2"] >= 0} {
7838            set flags "$flags --ignore-submodules=dirty"
7839        }
7840        set cmd [concat | git diff-index --cached $flags]
7841        if {[llength $ids] > 1} {
7842            # comparing index with specific revision
7843            if {$j == 0} {
7844                lappend cmd -R [lindex $ids 1]
7845            } else {
7846                lappend cmd [lindex $ids 0]
7847            }
7848        } else {
7849            # comparing index with HEAD
7850            lappend cmd HEAD
7851        }
7852    } else {
7853        if {$log_showroot} {
7854            lappend flags --root
7855        }
7856        set cmd [concat | git diff-tree -r $flags $ids]
7857    }
7858    return $cmd
7859}
7860
7861proc gettreediffs {ids} {
7862    global treediff treepending limitdiffs vfilelimit curview
7863
7864    set cmd [diffcmd $ids {--no-commit-id}]
7865    if {$limitdiffs && $vfilelimit($curview) ne {}} {
7866            set cmd [concat $cmd -- $vfilelimit($curview)]
7867    }
7868    if {[catch {set gdtf [open $cmd r]}]} return
7869
7870    set treepending $ids
7871    set treediff {}
7872    fconfigure $gdtf -blocking 0 -encoding binary
7873    filerun $gdtf [list gettreediffline $gdtf $ids]
7874}
7875
7876proc gettreediffline {gdtf ids} {
7877    global treediff treediffs treepending diffids diffmergeid
7878    global cmitmode vfilelimit curview limitdiffs perfile_attrs
7879
7880    set nr 0
7881    set sublist {}
7882    set max 1000
7883    if {$perfile_attrs} {
7884        # cache_gitattr is slow, and even slower on win32 where we
7885        # have to invoke it for only about 30 paths at a time
7886        set max 500
7887        if {[tk windowingsystem] == "win32"} {
7888            set max 120
7889        }
7890    }
7891    while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7892        set i [string first "\t" $line]
7893        if {$i >= 0} {
7894            set file [string range $line [expr {$i+1}] end]
7895            if {[string index $file 0] eq "\""} {
7896                set file [lindex $file 0]
7897            }
7898            set file [encoding convertfrom $file]
7899            if {$file ne [lindex $treediff end]} {
7900                lappend treediff $file
7901                lappend sublist $file
7902            }
7903        }
7904    }
7905    if {$perfile_attrs} {
7906        cache_gitattr encoding $sublist
7907    }
7908    if {![eof $gdtf]} {
7909        return [expr {$nr >= $max? 2: 1}]
7910    }
7911    close $gdtf
7912    set treediffs($ids) $treediff
7913    unset treepending
7914    if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7915        gettree $diffids
7916    } elseif {$ids != $diffids} {
7917        if {![info exists diffmergeid]} {
7918            gettreediffs $diffids
7919        }
7920    } else {
7921        addtocflist $ids
7922    }
7923    return 0
7924}
7925
7926# empty string or positive integer
7927proc diffcontextvalidate {v} {
7928    return [regexp {^(|[1-9][0-9]*)$} $v]
7929}
7930
7931proc diffcontextchange {n1 n2 op} {
7932    global diffcontextstring diffcontext
7933
7934    if {[string is integer -strict $diffcontextstring]} {
7935        if {$diffcontextstring >= 0} {
7936            set diffcontext $diffcontextstring
7937            reselectline
7938        }
7939    }
7940}
7941
7942proc changeignorespace {} {
7943    reselectline
7944}
7945
7946proc changeworddiff {name ix op} {
7947    reselectline
7948}
7949
7950proc initblobdiffvars {} {
7951    global diffencoding targetline diffnparents
7952    global diffinhdr currdiffsubmod diffseehere
7953    set targetline {}
7954    set diffnparents 0
7955    set diffinhdr 0
7956    set diffencoding [get_path_encoding {}]
7957    set currdiffsubmod ""
7958    set diffseehere -1
7959}
7960
7961proc getblobdiffs {ids} {
7962    global blobdifffd diffids env
7963    global treediffs
7964    global diffcontext
7965    global ignorespace
7966    global worddiff
7967    global limitdiffs vfilelimit curview
7968    global git_version
7969
7970    set textconv {}
7971    if {[package vcompare $git_version "1.6.1"] >= 0} {
7972        set textconv "--textconv"
7973    }
7974    set submodule {}
7975    if {[package vcompare $git_version "1.6.6"] >= 0} {
7976        set submodule "--submodule"
7977    }
7978    set cmd [diffcmd $ids "-p $textconv $submodule  -C --cc --no-commit-id -U$diffcontext"]
7979    if {$ignorespace} {
7980        append cmd " -w"
7981    }
7982    if {$worddiff ne [mc "Line diff"]} {
7983        append cmd " --word-diff=porcelain"
7984    }
7985    if {$limitdiffs && $vfilelimit($curview) ne {}} {
7986        set cmd [concat $cmd -- $vfilelimit($curview)]
7987    }
7988    if {[catch {set bdf [open $cmd r]} err]} {
7989        error_popup [mc "Error getting diffs: %s" $err]
7990        return
7991    }
7992    fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
7993    set blobdifffd($ids) $bdf
7994    initblobdiffvars
7995    filerun $bdf [list getblobdiffline $bdf $diffids]
7996}
7997
7998proc savecmitpos {} {
7999    global ctext cmitmode
8000
8001    if {$cmitmode eq "tree"} {
8002        return {}
8003    }
8004    return [list target_scrollpos [$ctext index @0,0]]
8005}
8006
8007proc savectextpos {} {
8008    global ctext
8009
8010    return [list target_scrollpos [$ctext index @0,0]]
8011}
8012
8013proc maybe_scroll_ctext {ateof} {
8014    global ctext target_scrollpos
8015
8016    if {![info exists target_scrollpos]} return
8017    if {!$ateof} {
8018        set nlines [expr {[winfo height $ctext]
8019                          / [font metrics textfont -linespace]}]
8020        if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
8021    }
8022    $ctext yview $target_scrollpos
8023    unset target_scrollpos
8024}
8025
8026proc setinlist {var i val} {
8027    global $var
8028
8029    while {[llength [set $var]] < $i} {
8030        lappend $var {}
8031    }
8032    if {[llength [set $var]] == $i} {
8033        lappend $var $val
8034    } else {
8035        lset $var $i $val
8036    }
8037}
8038
8039proc makediffhdr {fname ids} {
8040    global ctext curdiffstart treediffs diffencoding
8041    global ctext_file_names jump_to_here targetline diffline
8042
8043    set fname [encoding convertfrom $fname]
8044    set diffencoding [get_path_encoding $fname]
8045    set i [lsearch -exact $treediffs($ids) $fname]
8046    if {$i >= 0} {
8047        setinlist difffilestart $i $curdiffstart
8048    }
8049    lset ctext_file_names end $fname
8050    set l [expr {(78 - [string length $fname]) / 2}]
8051    set pad [string range "----------------------------------------" 1 $l]
8052    $ctext insert $curdiffstart "$pad $fname $pad" filesep
8053    set targetline {}
8054    if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
8055        set targetline [lindex $jump_to_here 1]
8056    }
8057    set diffline 0
8058}
8059
8060proc blobdiffmaybeseehere {ateof} {
8061    global diffseehere
8062    if {$diffseehere >= 0} {
8063        mark_ctext_line [lindex [split $diffseehere .] 0]
8064    }
8065    maybe_scroll_ctext $ateof
8066}
8067
8068proc getblobdiffline {bdf ids} {
8069    global diffids blobdifffd
8070    global ctext
8071
8072    set nr 0
8073    $ctext conf -state normal
8074    while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
8075        if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
8076            catch {close $bdf}
8077            return 0
8078        }
8079        parseblobdiffline $ids $line
8080    }
8081    $ctext conf -state disabled
8082    blobdiffmaybeseehere [eof $bdf]
8083    if {[eof $bdf]} {
8084        catch {close $bdf}
8085        return 0
8086    }
8087    return [expr {$nr >= 1000? 2: 1}]
8088}
8089
8090proc parseblobdiffline {ids line} {
8091    global ctext curdiffstart
8092    global diffnexthead diffnextnote difffilestart
8093    global ctext_file_names ctext_file_lines
8094    global diffinhdr treediffs mergemax diffnparents
8095    global diffencoding jump_to_here targetline diffline currdiffsubmod
8096    global worddiff diffseehere
8097
8098    if {![string compare -length 5 "diff " $line]} {
8099        if {![regexp {^diff (--cc|--git) } $line m type]} {
8100            set line [encoding convertfrom $line]
8101            $ctext insert end "$line\n" hunksep
8102            continue
8103        }
8104        # start of a new file
8105        set diffinhdr 1
8106        $ctext insert end "\n"
8107        set curdiffstart [$ctext index "end - 1c"]
8108        lappend ctext_file_names ""
8109        lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8110        $ctext insert end "\n" filesep
8111
8112        if {$type eq "--cc"} {
8113            # start of a new file in a merge diff
8114            set fname [string range $line 10 end]
8115            if {[lsearch -exact $treediffs($ids) $fname] < 0} {
8116                lappend treediffs($ids) $fname
8117                add_flist [list $fname]
8118            }
8119
8120        } else {
8121            set line [string range $line 11 end]
8122            # If the name hasn't changed the length will be odd,
8123            # the middle char will be a space, and the two bits either
8124            # side will be a/name and b/name, or "a/name" and "b/name".
8125            # If the name has changed we'll get "rename from" and
8126            # "rename to" or "copy from" and "copy to" lines following
8127            # this, and we'll use them to get the filenames.
8128            # This complexity is necessary because spaces in the
8129            # filename(s) don't get escaped.
8130            set l [string length $line]
8131            set i [expr {$l / 2}]
8132            if {!(($l & 1) && [string index $line $i] eq " " &&
8133                  [string range $line 2 [expr {$i - 1}]] eq \
8134                      [string range $line [expr {$i + 3}] end])} {
8135                return
8136            }
8137            # unescape if quoted and chop off the a/ from the front
8138            if {[string index $line 0] eq "\""} {
8139                set fname [string range [lindex $line 0] 2 end]
8140            } else {
8141                set fname [string range $line 2 [expr {$i - 1}]]
8142            }
8143        }
8144        makediffhdr $fname $ids
8145
8146    } elseif {![string compare -length 16 "* Unmerged path " $line]} {
8147        set fname [encoding convertfrom [string range $line 16 end]]
8148        $ctext insert end "\n"
8149        set curdiffstart [$ctext index "end - 1c"]
8150        lappend ctext_file_names $fname
8151        lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8152        $ctext insert end "$line\n" filesep
8153        set i [lsearch -exact $treediffs($ids) $fname]
8154        if {$i >= 0} {
8155            setinlist difffilestart $i $curdiffstart
8156        }
8157
8158    } elseif {![string compare -length 2 "@@" $line]} {
8159        regexp {^@@+} $line ats
8160        set line [encoding convertfrom $diffencoding $line]
8161        $ctext insert end "$line\n" hunksep
8162        if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
8163            set diffline $nl
8164        }
8165        set diffnparents [expr {[string length $ats] - 1}]
8166        set diffinhdr 0
8167
8168    } elseif {![string compare -length 10 "Submodule " $line]} {
8169        # start of a new submodule
8170        if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
8171            set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
8172        } else {
8173            set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
8174        }
8175        if {$currdiffsubmod != $fname} {
8176            $ctext insert end "\n";     # Add newline after commit message
8177        }
8178        set curdiffstart [$ctext index "end - 1c"]
8179        lappend ctext_file_names ""
8180        if {$currdiffsubmod != $fname} {
8181            lappend ctext_file_lines $fname
8182            makediffhdr $fname $ids
8183            set currdiffsubmod $fname
8184            $ctext insert end "\n$line\n" filesep
8185        } else {
8186            $ctext insert end "$line\n" filesep
8187        }
8188    } elseif {![string compare -length 3 "  >" $line]} {
8189        set $currdiffsubmod ""
8190        set line [encoding convertfrom $diffencoding $line]
8191        $ctext insert end "$line\n" dresult
8192    } elseif {![string compare -length 3 "  <" $line]} {
8193        set $currdiffsubmod ""
8194        set line [encoding convertfrom $diffencoding $line]
8195        $ctext insert end "$line\n" d0
8196    } elseif {$diffinhdr} {
8197        if {![string compare -length 12 "rename from " $line]} {
8198            set fname [string range $line [expr 6 + [string first " from " $line] ] end]
8199            if {[string index $fname 0] eq "\""} {
8200                set fname [lindex $fname 0]
8201            }
8202            set fname [encoding convertfrom $fname]
8203            set i [lsearch -exact $treediffs($ids) $fname]
8204            if {$i >= 0} {
8205                setinlist difffilestart $i $curdiffstart
8206            }
8207        } elseif {![string compare -length 10 $line "rename to "] ||
8208                  ![string compare -length 8 $line "copy to "]} {
8209            set fname [string range $line [expr 4 + [string first " to " $line] ] end]
8210            if {[string index $fname 0] eq "\""} {
8211                set fname [lindex $fname 0]
8212            }
8213            makediffhdr $fname $ids
8214        } elseif {[string compare -length 3 $line "---"] == 0} {
8215            # do nothing
8216            return
8217        } elseif {[string compare -length 3 $line "+++"] == 0} {
8218            set diffinhdr 0
8219            return
8220        }
8221        $ctext insert end "$line\n" filesep
8222
8223    } else {
8224        set line [string map {\x1A ^Z} \
8225                      [encoding convertfrom $diffencoding $line]]
8226        # parse the prefix - one ' ', '-' or '+' for each parent
8227        set prefix [string range $line 0 [expr {$diffnparents - 1}]]
8228        set tag [expr {$diffnparents > 1? "m": "d"}]
8229        set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
8230        set words_pre_markup ""
8231        set words_post_markup ""
8232        if {[string trim $prefix " -+"] eq {}} {
8233            # prefix only has " ", "-" and "+" in it: normal diff line
8234            set num [string first "-" $prefix]
8235            if {$dowords} {
8236                set line [string range $line 1 end]
8237            }
8238            if {$num >= 0} {
8239                # removed line, first parent with line is $num
8240                if {$num >= $mergemax} {
8241                    set num "max"
8242                }
8243                if {$dowords && $worddiff eq [mc "Markup words"]} {
8244                    $ctext insert end "\[-$line-\]" $tag$num
8245                } else {
8246                    $ctext insert end "$line" $tag$num
8247                }
8248                if {!$dowords} {
8249                    $ctext insert end "\n" $tag$num
8250                }
8251            } else {
8252                set tags {}
8253                if {[string first "+" $prefix] >= 0} {
8254                    # added line
8255                    lappend tags ${tag}result
8256                    if {$diffnparents > 1} {
8257                        set num [string first " " $prefix]
8258                        if {$num >= 0} {
8259                            if {$num >= $mergemax} {
8260                                set num "max"
8261                            }
8262                            lappend tags m$num
8263                        }
8264                    }
8265                    set words_pre_markup "{+"
8266                    set words_post_markup "+}"
8267                }
8268                if {$targetline ne {}} {
8269                    if {$diffline == $targetline} {
8270                        set diffseehere [$ctext index "end - 1 chars"]
8271                        set targetline {}
8272                    } else {
8273                        incr diffline
8274                    }
8275                }
8276                if {$dowords && $worddiff eq [mc "Markup words"]} {
8277                    $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
8278                } else {
8279                    $ctext insert end "$line" $tags
8280                }
8281                if {!$dowords} {
8282                    $ctext insert end "\n" $tags
8283                }
8284            }
8285        } elseif {$dowords && $prefix eq "~"} {
8286            $ctext insert end "\n" {}
8287        } else {
8288            # "\ No newline at end of file",
8289            # or something else we don't recognize
8290            $ctext insert end "$line\n" hunksep
8291        }
8292    }
8293}
8294
8295proc changediffdisp {} {
8296    global ctext diffelide
8297
8298    $ctext tag conf d0 -elide [lindex $diffelide 0]
8299    $ctext tag conf dresult -elide [lindex $diffelide 1]
8300}
8301
8302proc highlightfile {cline} {
8303    global cflist cflist_top
8304
8305    if {![info exists cflist_top]} return
8306
8307    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
8308    $cflist tag add highlight $cline.0 "$cline.0 lineend"
8309    $cflist see $cline.0
8310    set cflist_top $cline
8311}
8312
8313proc highlightfile_for_scrollpos {topidx} {
8314    global cmitmode difffilestart
8315
8316    if {$cmitmode eq "tree"} return
8317    if {![info exists difffilestart]} return
8318
8319    set top [lindex [split $topidx .] 0]
8320    if {$difffilestart eq {} || $top < [lindex $difffilestart 0]} {
8321        highlightfile 0
8322    } else {
8323        highlightfile [expr {[bsearch $difffilestart $top] + 2}]
8324    }
8325}
8326
8327proc prevfile {} {
8328    global difffilestart ctext cmitmode
8329
8330    if {$cmitmode eq "tree"} return
8331    set prev 0.0
8332    set here [$ctext index @0,0]
8333    foreach loc $difffilestart {
8334        if {[$ctext compare $loc >= $here]} {
8335            $ctext yview $prev
8336            return
8337        }
8338        set prev $loc
8339    }
8340    $ctext yview $prev
8341}
8342
8343proc nextfile {} {
8344    global difffilestart ctext cmitmode
8345
8346    if {$cmitmode eq "tree"} return
8347    set here [$ctext index @0,0]
8348    foreach loc $difffilestart {
8349        if {[$ctext compare $loc > $here]} {
8350            $ctext yview $loc
8351            return
8352        }
8353    }
8354}
8355
8356proc clear_ctext {{first 1.0}} {
8357    global ctext smarktop smarkbot
8358    global ctext_file_names ctext_file_lines
8359    global pendinglinks
8360
8361    set l [lindex [split $first .] 0]
8362    if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
8363        set smarktop $l
8364    }
8365    if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
8366        set smarkbot $l
8367    }
8368    $ctext delete $first end
8369    if {$first eq "1.0"} {
8370        unset -nocomplain pendinglinks
8371    }
8372    set ctext_file_names {}
8373    set ctext_file_lines {}
8374}
8375
8376proc settabs {{firstab {}}} {
8377    global firsttabstop tabstop ctext have_tk85
8378
8379    if {$firstab ne {} && $have_tk85} {
8380        set firsttabstop $firstab
8381    }
8382    set w [font measure textfont "0"]
8383    if {$firsttabstop != 0} {
8384        $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
8385                               [expr {($firsttabstop + 2 * $tabstop) * $w}]]
8386    } elseif {$have_tk85 || $tabstop != 8} {
8387        $ctext conf -tabs [expr {$tabstop * $w}]
8388    } else {
8389        $ctext conf -tabs {}
8390    }
8391}
8392
8393proc incrsearch {name ix op} {
8394    global ctext searchstring searchdirn
8395
8396    if {[catch {$ctext index anchor}]} {
8397        # no anchor set, use start of selection, or of visible area
8398        set sel [$ctext tag ranges sel]
8399        if {$sel ne {}} {
8400            $ctext mark set anchor [lindex $sel 0]
8401        } elseif {$searchdirn eq "-forwards"} {
8402            $ctext mark set anchor @0,0
8403        } else {
8404            $ctext mark set anchor @0,[winfo height $ctext]
8405        }
8406    }
8407    if {$searchstring ne {}} {
8408        set here [$ctext search -count mlen $searchdirn -- $searchstring anchor]
8409        if {$here ne {}} {
8410            $ctext see $here
8411            set mend "$here + $mlen c"
8412            $ctext tag remove sel 1.0 end
8413            $ctext tag add sel $here $mend
8414            suppress_highlighting_file_for_current_scrollpos
8415            highlightfile_for_scrollpos $here
8416        }
8417    }
8418    rehighlight_search_results
8419}
8420
8421proc dosearch {} {
8422    global sstring ctext searchstring searchdirn
8423
8424    focus $sstring
8425    $sstring icursor end
8426    set searchdirn -forwards
8427    if {$searchstring ne {}} {
8428        set sel [$ctext tag ranges sel]
8429        if {$sel ne {}} {
8430            set start "[lindex $sel 0] + 1c"
8431        } elseif {[catch {set start [$ctext index anchor]}]} {
8432            set start "@0,0"
8433        }
8434        set match [$ctext search -count mlen -- $searchstring $start]
8435        $ctext tag remove sel 1.0 end
8436        if {$match eq {}} {
8437            bell
8438            return
8439        }
8440        $ctext see $match
8441        suppress_highlighting_file_for_current_scrollpos
8442        highlightfile_for_scrollpos $match
8443        set mend "$match + $mlen c"
8444        $ctext tag add sel $match $mend
8445        $ctext mark unset anchor
8446        rehighlight_search_results
8447    }
8448}
8449
8450proc dosearchback {} {
8451    global sstring ctext searchstring searchdirn
8452
8453    focus $sstring
8454    $sstring icursor end
8455    set searchdirn -backwards
8456    if {$searchstring ne {}} {
8457        set sel [$ctext tag ranges sel]
8458        if {$sel ne {}} {
8459            set start [lindex $sel 0]
8460        } elseif {[catch {set start [$ctext index anchor]}]} {
8461            set start @0,[winfo height $ctext]
8462        }
8463        set match [$ctext search -backwards -count ml -- $searchstring $start]
8464        $ctext tag remove sel 1.0 end
8465        if {$match eq {}} {
8466            bell
8467            return
8468        }
8469        $ctext see $match
8470        suppress_highlighting_file_for_current_scrollpos
8471        highlightfile_for_scrollpos $match
8472        set mend "$match + $ml c"
8473        $ctext tag add sel $match $mend
8474        $ctext mark unset anchor
8475        rehighlight_search_results
8476    }
8477}
8478
8479proc rehighlight_search_results {} {
8480    global ctext searchstring
8481
8482    $ctext tag remove found 1.0 end
8483    $ctext tag remove currentsearchhit 1.0 end
8484
8485    if {$searchstring ne {}} {
8486        searchmarkvisible 1
8487    }
8488}
8489
8490proc searchmark {first last} {
8491    global ctext searchstring
8492
8493    set sel [$ctext tag ranges sel]
8494
8495    set mend $first.0
8496    while {1} {
8497        set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8498        if {$match eq {}} break
8499        set mend "$match + $mlen c"
8500        if {$sel ne {} && [$ctext compare $match == [lindex $sel 0]]} {
8501            $ctext tag add currentsearchhit $match $mend
8502        } else {
8503            $ctext tag add found $match $mend
8504        }
8505    }
8506}
8507
8508proc searchmarkvisible {doall} {
8509    global ctext smarktop smarkbot
8510
8511    set topline [lindex [split [$ctext index @0,0] .] 0]
8512    set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8513    if {$doall || $botline < $smarktop || $topline > $smarkbot} {
8514        # no overlap with previous
8515        searchmark $topline $botline
8516        set smarktop $topline
8517        set smarkbot $botline
8518    } else {
8519        if {$topline < $smarktop} {
8520            searchmark $topline [expr {$smarktop-1}]
8521            set smarktop $topline
8522        }
8523        if {$botline > $smarkbot} {
8524            searchmark [expr {$smarkbot+1}] $botline
8525            set smarkbot $botline
8526        }
8527    }
8528}
8529
8530proc suppress_highlighting_file_for_current_scrollpos {} {
8531    global ctext suppress_highlighting_file_for_this_scrollpos
8532
8533    set suppress_highlighting_file_for_this_scrollpos [$ctext index @0,0]
8534}
8535
8536proc scrolltext {f0 f1} {
8537    global searchstring cmitmode ctext
8538    global suppress_highlighting_file_for_this_scrollpos
8539
8540    set topidx [$ctext index @0,0]
8541    if {![info exists suppress_highlighting_file_for_this_scrollpos]
8542        || $topidx ne $suppress_highlighting_file_for_this_scrollpos} {
8543        highlightfile_for_scrollpos $topidx
8544    }
8545
8546    unset -nocomplain suppress_highlighting_file_for_this_scrollpos
8547
8548    .bleft.bottom.sb set $f0 $f1
8549    if {$searchstring ne {}} {
8550        searchmarkvisible 0
8551    }
8552}
8553
8554proc setcoords {} {
8555    global linespc charspc canvx0 canvy0
8556    global xspc1 xspc2 lthickness
8557
8558    set linespc [font metrics mainfont -linespace]
8559    set charspc [font measure mainfont "m"]
8560    set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8561    set canvx0 [expr {int(3 + 0.5 * $linespc)}]
8562    set lthickness [expr {int($linespc / 9) + 1}]
8563    set xspc1(0) $linespc
8564    set xspc2 $linespc
8565}
8566
8567proc redisplay {} {
8568    global canv
8569    global selectedline
8570
8571    set ymax [lindex [$canv cget -scrollregion] 3]
8572    if {$ymax eq {} || $ymax == 0} return
8573    set span [$canv yview]
8574    clear_display
8575    setcanvscroll
8576    allcanvs yview moveto [lindex $span 0]
8577    drawvisible
8578    if {$selectedline ne {}} {
8579        selectline $selectedline 0
8580        allcanvs yview moveto [lindex $span 0]
8581    }
8582}
8583
8584proc parsefont {f n} {
8585    global fontattr
8586
8587    set fontattr($f,family) [lindex $n 0]
8588    set s [lindex $n 1]
8589    if {$s eq {} || $s == 0} {
8590        set s 10
8591    } elseif {$s < 0} {
8592        set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
8593    }
8594    set fontattr($f,size) $s
8595    set fontattr($f,weight) normal
8596    set fontattr($f,slant) roman
8597    foreach style [lrange $n 2 end] {
8598        switch -- $style {
8599            "normal" -
8600            "bold"   {set fontattr($f,weight) $style}
8601            "roman" -
8602            "italic" {set fontattr($f,slant) $style}
8603        }
8604    }
8605}
8606
8607proc fontflags {f {isbold 0}} {
8608    global fontattr
8609
8610    return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8611                -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8612                -slant $fontattr($f,slant)]
8613}
8614
8615proc fontname {f} {
8616    global fontattr
8617
8618    set n [list $fontattr($f,family) $fontattr($f,size)]
8619    if {$fontattr($f,weight) eq "bold"} {
8620        lappend n "bold"
8621    }
8622    if {$fontattr($f,slant) eq "italic"} {
8623        lappend n "italic"
8624    }
8625    return $n
8626}
8627
8628proc incrfont {inc} {
8629    global mainfont textfont ctext canv cflist showrefstop
8630    global stopped entries fontattr
8631
8632    unmarkmatches
8633    set s $fontattr(mainfont,size)
8634    incr s $inc
8635    if {$s < 1} {
8636        set s 1
8637    }
8638    set fontattr(mainfont,size) $s
8639    font config mainfont -size $s
8640    font config mainfontbold -size $s
8641    set mainfont [fontname mainfont]
8642    set s $fontattr(textfont,size)
8643    incr s $inc
8644    if {$s < 1} {
8645        set s 1
8646    }
8647    set fontattr(textfont,size) $s
8648    font config textfont -size $s
8649    font config textfontbold -size $s
8650    set textfont [fontname textfont]
8651    setcoords
8652    settabs
8653    redisplay
8654}
8655
8656proc clearsha1 {} {
8657    global sha1entry sha1string
8658    if {[string length $sha1string] == 40} {
8659        $sha1entry delete 0 end
8660    }
8661}
8662
8663proc sha1change {n1 n2 op} {
8664    global sha1string currentid sha1but
8665    if {$sha1string == {}
8666        || ([info exists currentid] && $sha1string == $currentid)} {
8667        set state disabled
8668    } else {
8669        set state normal
8670    }
8671    if {[$sha1but cget -state] == $state} return
8672    if {$state == "normal"} {
8673        $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
8674    } else {
8675        $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
8676    }
8677}
8678
8679proc gotocommit {} {
8680    global sha1string tagids headids curview varcid
8681
8682    if {$sha1string == {}
8683        || ([info exists currentid] && $sha1string == $currentid)} return
8684    if {[info exists tagids($sha1string)]} {
8685        set id $tagids($sha1string)
8686    } elseif {[info exists headids($sha1string)]} {
8687        set id $headids($sha1string)
8688    } else {
8689        set id [string tolower $sha1string]
8690        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
8691            set matches [longid $id]
8692            if {$matches ne {}} {
8693                if {[llength $matches] > 1} {
8694                    error_popup [mc "Short SHA1 id %s is ambiguous" $id]
8695                    return
8696                }
8697                set id [lindex $matches 0]
8698            }
8699        } else {
8700            if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8701                error_popup [mc "Revision %s is not known" $sha1string]
8702                return
8703            }
8704        }
8705    }
8706    if {[commitinview $id $curview]} {
8707        selectline [rowofcommit $id] 1
8708        return
8709    }
8710    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
8711        set msg [mc "SHA1 id %s is not known" $sha1string]
8712    } else {
8713        set msg [mc "Revision %s is not in the current view" $sha1string]
8714    }
8715    error_popup $msg
8716}
8717
8718proc lineenter {x y id} {
8719    global hoverx hovery hoverid hovertimer
8720    global commitinfo canv
8721
8722    if {![info exists commitinfo($id)] && ![getcommit $id]} return
8723    set hoverx $x
8724    set hovery $y
8725    set hoverid $id
8726    if {[info exists hovertimer]} {
8727        after cancel $hovertimer
8728    }
8729    set hovertimer [after 500 linehover]
8730    $canv delete hover
8731}
8732
8733proc linemotion {x y id} {
8734    global hoverx hovery hoverid hovertimer
8735
8736    if {[info exists hoverid] && $id == $hoverid} {
8737        set hoverx $x
8738        set hovery $y
8739        if {[info exists hovertimer]} {
8740            after cancel $hovertimer
8741        }
8742        set hovertimer [after 500 linehover]
8743    }
8744}
8745
8746proc lineleave {id} {
8747    global hoverid hovertimer canv
8748
8749    if {[info exists hoverid] && $id == $hoverid} {
8750        $canv delete hover
8751        if {[info exists hovertimer]} {
8752            after cancel $hovertimer
8753            unset hovertimer
8754        }
8755        unset hoverid
8756    }
8757}
8758
8759proc linehover {} {
8760    global hoverx hovery hoverid hovertimer
8761    global canv linespc lthickness
8762    global linehoverbgcolor linehoverfgcolor linehoveroutlinecolor
8763
8764    global commitinfo
8765
8766    set text [lindex $commitinfo($hoverid) 0]
8767    set ymax [lindex [$canv cget -scrollregion] 3]
8768    if {$ymax == {}} return
8769    set yfrac [lindex [$canv yview] 0]
8770    set x [expr {$hoverx + 2 * $linespc}]
8771    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8772    set x0 [expr {$x - 2 * $lthickness}]
8773    set y0 [expr {$y - 2 * $lthickness}]
8774    set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
8775    set y1 [expr {$y + $linespc + 2 * $lthickness}]
8776    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8777               -fill $linehoverbgcolor -outline $linehoveroutlinecolor \
8778               -width 1 -tags hover]
8779    $canv raise $t
8780    set t [$canv create text $x $y -anchor nw -text $text -tags hover \
8781               -font mainfont -fill $linehoverfgcolor]
8782    $canv raise $t
8783}
8784
8785proc clickisonarrow {id y} {
8786    global lthickness
8787
8788    set ranges [rowranges $id]
8789    set thresh [expr {2 * $lthickness + 6}]
8790    set n [expr {[llength $ranges] - 1}]
8791    for {set i 1} {$i < $n} {incr i} {
8792        set row [lindex $ranges $i]
8793        if {abs([yc $row] - $y) < $thresh} {
8794            return $i
8795        }
8796    }
8797    return {}
8798}
8799
8800proc arrowjump {id n y} {
8801    global canv
8802
8803    # 1 <-> 2, 3 <-> 4, etc...
8804    set n [expr {(($n - 1) ^ 1) + 1}]
8805    set row [lindex [rowranges $id] $n]
8806    set yt [yc $row]
8807    set ymax [lindex [$canv cget -scrollregion] 3]
8808    if {$ymax eq {} || $ymax <= 0} return
8809    set view [$canv yview]
8810    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8811    set yfrac [expr {$yt / $ymax - $yspan / 2}]
8812    if {$yfrac < 0} {
8813        set yfrac 0
8814    }
8815    allcanvs yview moveto $yfrac
8816}
8817
8818proc lineclick {x y id isnew} {
8819    global ctext commitinfo children canv thickerline curview
8820
8821    if {![info exists commitinfo($id)] && ![getcommit $id]} return
8822    unmarkmatches
8823    unselectline
8824    normalline
8825    $canv delete hover
8826    # draw this line thicker than normal
8827    set thickerline $id
8828    drawlines $id
8829    if {$isnew} {
8830        set ymax [lindex [$canv cget -scrollregion] 3]
8831        if {$ymax eq {}} return
8832        set yfrac [lindex [$canv yview] 0]
8833        set y [expr {$y + $yfrac * $ymax}]
8834    }
8835    set dirn [clickisonarrow $id $y]
8836    if {$dirn ne {}} {
8837        arrowjump $id $dirn $y
8838        return
8839    }
8840
8841    if {$isnew} {
8842        addtohistory [list lineclick $x $y $id 0] savectextpos
8843    }
8844    # fill the details pane with info about this line
8845    $ctext conf -state normal
8846    clear_ctext
8847    settabs 0
8848    $ctext insert end "[mc "Parent"]:\t"
8849    $ctext insert end $id link0
8850    setlink $id link0
8851    set info $commitinfo($id)
8852    $ctext insert end "\n\t[lindex $info 0]\n"
8853    $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8854    set date [formatdate [lindex $info 2]]
8855    $ctext insert end "\t[mc "Date"]:\t$date\n"
8856    set kids $children($curview,$id)
8857    if {$kids ne {}} {
8858        $ctext insert end "\n[mc "Children"]:"
8859        set i 0
8860        foreach child $kids {
8861            incr i
8862            if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8863            set info $commitinfo($child)
8864            $ctext insert end "\n\t"
8865            $ctext insert end $child link$i
8866            setlink $child link$i
8867            $ctext insert end "\n\t[lindex $info 0]"
8868            $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8869            set date [formatdate [lindex $info 2]]
8870            $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8871        }
8872    }
8873    maybe_scroll_ctext 1
8874    $ctext conf -state disabled
8875    init_flist {}
8876}
8877
8878proc normalline {} {
8879    global thickerline
8880    if {[info exists thickerline]} {
8881        set id $thickerline
8882        unset thickerline
8883        drawlines $id
8884    }
8885}
8886
8887proc selbyid {id {isnew 1}} {
8888    global curview
8889    if {[commitinview $id $curview]} {
8890        selectline [rowofcommit $id] $isnew
8891    }
8892}
8893
8894proc mstime {} {
8895    global startmstime
8896    if {![info exists startmstime]} {
8897        set startmstime [clock clicks -milliseconds]
8898    }
8899    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8900}
8901
8902proc rowmenu {x y id} {
8903    global rowctxmenu selectedline rowmenuid curview
8904    global nullid nullid2 fakerowmenu mainhead markedid
8905
8906    stopfinding
8907    set rowmenuid $id
8908    if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8909        set state disabled
8910    } else {
8911        set state normal
8912    }
8913    if {[info exists markedid] && $markedid ne $id} {
8914        set mstate normal
8915    } else {
8916        set mstate disabled
8917    }
8918    if {$id ne $nullid && $id ne $nullid2} {
8919        set menu $rowctxmenu
8920        if {$mainhead ne {}} {
8921            $menu entryconfigure 8 -label [mc "Reset %s branch to here" $mainhead] -state normal
8922        } else {
8923            $menu entryconfigure 8 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8924        }
8925        $menu entryconfigure 10 -state $mstate
8926        $menu entryconfigure 11 -state $mstate
8927        $menu entryconfigure 12 -state $mstate
8928    } else {
8929        set menu $fakerowmenu
8930    }
8931    $menu entryconfigure [mca "Diff this -> selected"] -state $state
8932    $menu entryconfigure [mca "Diff selected -> this"] -state $state
8933    $menu entryconfigure [mca "Make patch"] -state $state
8934    $menu entryconfigure [mca "Diff this -> marked commit"] -state $mstate
8935    $menu entryconfigure [mca "Diff marked commit -> this"] -state $mstate
8936    tk_popup $menu $x $y
8937}
8938
8939proc markhere {} {
8940    global rowmenuid markedid canv
8941
8942    set markedid $rowmenuid
8943    make_idmark $markedid
8944}
8945
8946proc gotomark {} {
8947    global markedid
8948
8949    if {[info exists markedid]} {
8950        selbyid $markedid
8951    }
8952}
8953
8954proc replace_by_kids {l r} {
8955    global curview children
8956
8957    set id [commitonrow $r]
8958    set l [lreplace $l 0 0]
8959    foreach kid $children($curview,$id) {
8960        lappend l [rowofcommit $kid]
8961    }
8962    return [lsort -integer -decreasing -unique $l]
8963}
8964
8965proc find_common_desc {} {
8966    global markedid rowmenuid curview children
8967
8968    if {![info exists markedid]} return
8969    if {![commitinview $markedid $curview] ||
8970        ![commitinview $rowmenuid $curview]} return
8971    #set t1 [clock clicks -milliseconds]
8972    set l1 [list [rowofcommit $markedid]]
8973    set l2 [list [rowofcommit $rowmenuid]]
8974    while 1 {
8975        set r1 [lindex $l1 0]
8976        set r2 [lindex $l2 0]
8977        if {$r1 eq {} || $r2 eq {}} break
8978        if {$r1 == $r2} {
8979            selectline $r1 1
8980            break
8981        }
8982        if {$r1 > $r2} {
8983            set l1 [replace_by_kids $l1 $r1]
8984        } else {
8985            set l2 [replace_by_kids $l2 $r2]
8986        }
8987    }
8988    #set t2 [clock clicks -milliseconds]
8989    #puts "took [expr {$t2-$t1}]ms"
8990}
8991
8992proc compare_commits {} {
8993    global markedid rowmenuid curview children
8994
8995    if {![info exists markedid]} return
8996    if {![commitinview $markedid $curview]} return
8997    addtohistory [list do_cmp_commits $markedid $rowmenuid]
8998    do_cmp_commits $markedid $rowmenuid
8999}
9000
9001proc getpatchid {id} {
9002    global patchids
9003
9004    if {![info exists patchids($id)]} {
9005        set cmd [diffcmd [list $id] {-p --root}]
9006        # trim off the initial "|"
9007        set cmd [lrange $cmd 1 end]
9008        if {[catch {
9009            set x [eval exec $cmd | git patch-id]
9010            set patchids($id) [lindex $x 0]
9011        }]} {
9012            set patchids($id) "error"
9013        }
9014    }
9015    return $patchids($id)
9016}
9017
9018proc do_cmp_commits {a b} {
9019    global ctext curview parents children patchids commitinfo
9020
9021    $ctext conf -state normal
9022    clear_ctext
9023    init_flist {}
9024    for {set i 0} {$i < 100} {incr i} {
9025        set skipa 0
9026        set skipb 0
9027        if {[llength $parents($curview,$a)] > 1} {
9028            appendshortlink $a [mc "Skipping merge commit "] "\n"
9029            set skipa 1
9030        } else {
9031            set patcha [getpatchid $a]
9032        }
9033        if {[llength $parents($curview,$b)] > 1} {
9034            appendshortlink $b [mc "Skipping merge commit "] "\n"
9035            set skipb 1
9036        } else {
9037            set patchb [getpatchid $b]
9038        }
9039        if {!$skipa && !$skipb} {
9040            set heada [lindex $commitinfo($a) 0]
9041            set headb [lindex $commitinfo($b) 0]
9042            if {$patcha eq "error"} {
9043                appendshortlink $a [mc "Error getting patch ID for "] \
9044                    [mc " - stopping\n"]
9045                break
9046            }
9047            if {$patchb eq "error"} {
9048                appendshortlink $b [mc "Error getting patch ID for "] \
9049                    [mc " - stopping\n"]
9050                break
9051            }
9052            if {$patcha eq $patchb} {
9053                if {$heada eq $headb} {
9054                    appendshortlink $a [mc "Commit "]
9055                    appendshortlink $b " == " "  $heada\n"
9056                } else {
9057                    appendshortlink $a [mc "Commit "] "  $heada\n"
9058                    appendshortlink $b [mc " is the same patch as\n       "] \
9059                        "  $headb\n"
9060                }
9061                set skipa 1
9062                set skipb 1
9063            } else {
9064                $ctext insert end "\n"
9065                appendshortlink $a [mc "Commit "] "  $heada\n"
9066                appendshortlink $b [mc " differs from\n       "] \
9067                    "  $headb\n"
9068                $ctext insert end [mc "Diff of commits:\n\n"]
9069                $ctext conf -state disabled
9070                update
9071                diffcommits $a $b
9072                return
9073            }
9074        }
9075        if {$skipa} {
9076            set kids [real_children $curview,$a]
9077            if {[llength $kids] != 1} {
9078                $ctext insert end "\n"
9079                appendshortlink $a [mc "Commit "] \
9080                    [mc " has %s children - stopping\n" [llength $kids]]
9081                break
9082            }
9083            set a [lindex $kids 0]
9084        }
9085        if {$skipb} {
9086            set kids [real_children $curview,$b]
9087            if {[llength $kids] != 1} {
9088                appendshortlink $b [mc "Commit "] \
9089                    [mc " has %s children - stopping\n" [llength $kids]]
9090                break
9091            }
9092            set b [lindex $kids 0]
9093        }
9094    }
9095    $ctext conf -state disabled
9096}
9097
9098proc diffcommits {a b} {
9099    global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
9100
9101    set tmpdir [gitknewtmpdir]
9102    set fna [file join $tmpdir "commit-[string range $a 0 7]"]
9103    set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
9104    if {[catch {
9105        exec git diff-tree -p --pretty $a >$fna
9106        exec git diff-tree -p --pretty $b >$fnb
9107    } err]} {
9108        error_popup [mc "Error writing commit to file: %s" $err]
9109        return
9110    }
9111    if {[catch {
9112        set fd [open "| diff -U$diffcontext $fna $fnb" r]
9113    } err]} {
9114        error_popup [mc "Error diffing commits: %s" $err]
9115        return
9116    }
9117    set diffids [list commits $a $b]
9118    set blobdifffd($diffids) $fd
9119    set diffinhdr 0
9120    set currdiffsubmod ""
9121    filerun $fd [list getblobdiffline $fd $diffids]
9122}
9123
9124proc diffvssel {dirn} {
9125    global rowmenuid selectedline
9126
9127    if {$selectedline eq {}} return
9128    if {$dirn} {
9129        set oldid [commitonrow $selectedline]
9130        set newid $rowmenuid
9131    } else {
9132        set oldid $rowmenuid
9133        set newid [commitonrow $selectedline]
9134    }
9135    addtohistory [list doseldiff $oldid $newid] savectextpos
9136    doseldiff $oldid $newid
9137}
9138
9139proc diffvsmark {dirn} {
9140    global rowmenuid markedid
9141
9142    if {![info exists markedid]} return
9143    if {$dirn} {
9144        set oldid $markedid
9145        set newid $rowmenuid
9146    } else {
9147        set oldid $rowmenuid
9148        set newid $markedid
9149    }
9150    addtohistory [list doseldiff $oldid $newid] savectextpos
9151    doseldiff $oldid $newid
9152}
9153
9154proc doseldiff {oldid newid} {
9155    global ctext
9156    global commitinfo
9157
9158    $ctext conf -state normal
9159    clear_ctext
9160    init_flist [mc "Top"]
9161    $ctext insert end "[mc "From"] "
9162    $ctext insert end $oldid link0
9163    setlink $oldid link0
9164    $ctext insert end "\n     "
9165    $ctext insert end [lindex $commitinfo($oldid) 0]
9166    $ctext insert end "\n\n[mc "To"]   "
9167    $ctext insert end $newid link1
9168    setlink $newid link1
9169    $ctext insert end "\n     "
9170    $ctext insert end [lindex $commitinfo($newid) 0]
9171    $ctext insert end "\n"
9172    $ctext conf -state disabled
9173    $ctext tag remove found 1.0 end
9174    startdiff [list $oldid $newid]
9175}
9176
9177proc mkpatch {} {
9178    global rowmenuid currentid commitinfo patchtop patchnum NS
9179
9180    if {![info exists currentid]} return
9181    set oldid $currentid
9182    set oldhead [lindex $commitinfo($oldid) 0]
9183    set newid $rowmenuid
9184    set newhead [lindex $commitinfo($newid) 0]
9185    set top .patch
9186    set patchtop $top
9187    catch {destroy $top}
9188    ttk_toplevel $top
9189    make_transient $top .
9190    ${NS}::label $top.title -text [mc "Generate patch"]
9191    grid $top.title - -pady 10
9192    ${NS}::label $top.from -text [mc "From:"]
9193    ${NS}::entry $top.fromsha1 -width 40
9194    $top.fromsha1 insert 0 $oldid
9195    $top.fromsha1 conf -state readonly
9196    grid $top.from $top.fromsha1 -sticky w
9197    ${NS}::entry $top.fromhead -width 60
9198    $top.fromhead insert 0 $oldhead
9199    $top.fromhead conf -state readonly
9200    grid x $top.fromhead -sticky w
9201    ${NS}::label $top.to -text [mc "To:"]
9202    ${NS}::entry $top.tosha1 -width 40
9203    $top.tosha1 insert 0 $newid
9204    $top.tosha1 conf -state readonly
9205    grid $top.to $top.tosha1 -sticky w
9206    ${NS}::entry $top.tohead -width 60
9207    $top.tohead insert 0 $newhead
9208    $top.tohead conf -state readonly
9209    grid x $top.tohead -sticky w
9210    ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
9211    grid $top.rev x -pady 10 -padx 5
9212    ${NS}::label $top.flab -text [mc "Output file:"]
9213    ${NS}::entry $top.fname -width 60
9214    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
9215    incr patchnum
9216    grid $top.flab $top.fname -sticky w
9217    ${NS}::frame $top.buts
9218    ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
9219    ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
9220    bind $top <Key-Return> mkpatchgo
9221    bind $top <Key-Escape> mkpatchcan
9222    grid $top.buts.gen $top.buts.can
9223    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9224    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9225    grid $top.buts - -pady 10 -sticky ew
9226    focus $top.fname
9227}
9228
9229proc mkpatchrev {} {
9230    global patchtop
9231
9232    set oldid [$patchtop.fromsha1 get]
9233    set oldhead [$patchtop.fromhead get]
9234    set newid [$patchtop.tosha1 get]
9235    set newhead [$patchtop.tohead get]
9236    foreach e [list fromsha1 fromhead tosha1 tohead] \
9237            v [list $newid $newhead $oldid $oldhead] {
9238        $patchtop.$e conf -state normal
9239        $patchtop.$e delete 0 end
9240        $patchtop.$e insert 0 $v
9241        $patchtop.$e conf -state readonly
9242    }
9243}
9244
9245proc mkpatchgo {} {
9246    global patchtop nullid nullid2
9247
9248    set oldid [$patchtop.fromsha1 get]
9249    set newid [$patchtop.tosha1 get]
9250    set fname [$patchtop.fname get]
9251    set cmd [diffcmd [list $oldid $newid] -p]
9252    # trim off the initial "|"
9253    set cmd [lrange $cmd 1 end]
9254    lappend cmd >$fname &
9255    if {[catch {eval exec $cmd} err]} {
9256        error_popup "[mc "Error creating patch:"] $err" $patchtop
9257    }
9258    catch {destroy $patchtop}
9259    unset patchtop
9260}
9261
9262proc mkpatchcan {} {
9263    global patchtop
9264
9265    catch {destroy $patchtop}
9266    unset patchtop
9267}
9268
9269proc mktag {} {
9270    global rowmenuid mktagtop commitinfo NS
9271
9272    set top .maketag
9273    set mktagtop $top
9274    catch {destroy $top}
9275    ttk_toplevel $top
9276    make_transient $top .
9277    ${NS}::label $top.title -text [mc "Create tag"]
9278    grid $top.title - -pady 10
9279    ${NS}::label $top.id -text [mc "ID:"]
9280    ${NS}::entry $top.sha1 -width 40
9281    $top.sha1 insert 0 $rowmenuid
9282    $top.sha1 conf -state readonly
9283    grid $top.id $top.sha1 -sticky w
9284    ${NS}::entry $top.head -width 60
9285    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9286    $top.head conf -state readonly
9287    grid x $top.head -sticky w
9288    ${NS}::label $top.tlab -text [mc "Tag name:"]
9289    ${NS}::entry $top.tag -width 60
9290    grid $top.tlab $top.tag -sticky w
9291    ${NS}::label $top.op -text [mc "Tag message is optional"]
9292    grid $top.op -columnspan 2 -sticky we
9293    ${NS}::label $top.mlab -text [mc "Tag message:"]
9294    ${NS}::entry $top.msg -width 60
9295    grid $top.mlab $top.msg -sticky w
9296    ${NS}::frame $top.buts
9297    ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
9298    ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
9299    bind $top <Key-Return> mktaggo
9300    bind $top <Key-Escape> mktagcan
9301    grid $top.buts.gen $top.buts.can
9302    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9303    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9304    grid $top.buts - -pady 10 -sticky ew
9305    focus $top.tag
9306}
9307
9308proc domktag {} {
9309    global mktagtop env tagids idtags
9310
9311    set id [$mktagtop.sha1 get]
9312    set tag [$mktagtop.tag get]
9313    set msg [$mktagtop.msg get]
9314    if {$tag == {}} {
9315        error_popup [mc "No tag name specified"] $mktagtop
9316        return 0
9317    }
9318    if {[info exists tagids($tag)]} {
9319        error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
9320        return 0
9321    }
9322    if {[catch {
9323        if {$msg != {}} {
9324            exec git tag -a -m $msg $tag $id
9325        } else {
9326            exec git tag $tag $id
9327        }
9328    } err]} {
9329        error_popup "[mc "Error creating tag:"] $err" $mktagtop
9330        return 0
9331    }
9332
9333    set tagids($tag) $id
9334    lappend idtags($id) $tag
9335    redrawtags $id
9336    addedtag $id
9337    dispneartags 0
9338    run refill_reflist
9339    return 1
9340}
9341
9342proc redrawtags {id} {
9343    global canv linehtag idpos currentid curview cmitlisted markedid
9344    global canvxmax iddrawn circleitem mainheadid circlecolors
9345    global mainheadcirclecolor
9346
9347    if {![commitinview $id $curview]} return
9348    if {![info exists iddrawn($id)]} return
9349    set row [rowofcommit $id]
9350    if {$id eq $mainheadid} {
9351        set ofill $mainheadcirclecolor
9352    } else {
9353        set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
9354    }
9355    $canv itemconf $circleitem($row) -fill $ofill
9356    $canv delete tag.$id
9357    set xt [eval drawtags $id $idpos($id)]
9358    $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
9359    set text [$canv itemcget $linehtag($id) -text]
9360    set font [$canv itemcget $linehtag($id) -font]
9361    set xr [expr {$xt + [font measure $font $text]}]
9362    if {$xr > $canvxmax} {
9363        set canvxmax $xr
9364        setcanvscroll
9365    }
9366    if {[info exists currentid] && $currentid == $id} {
9367        make_secsel $id
9368    }
9369    if {[info exists markedid] && $markedid eq $id} {
9370        make_idmark $id
9371    }
9372}
9373
9374proc mktagcan {} {
9375    global mktagtop
9376
9377    catch {destroy $mktagtop}
9378    unset mktagtop
9379}
9380
9381proc mktaggo {} {
9382    if {![domktag]} return
9383    mktagcan
9384}
9385
9386proc copysummary {} {
9387    global rowmenuid autosellen
9388
9389    set format "%h (\"%s\", %ad)"
9390    set cmd [list git show -s --pretty=format:$format --date=short]
9391    if {$autosellen < 40} {
9392        lappend cmd --abbrev=$autosellen
9393    }
9394    set summary [eval exec $cmd $rowmenuid]
9395
9396    clipboard clear
9397    clipboard append $summary
9398}
9399
9400proc writecommit {} {
9401    global rowmenuid wrcomtop commitinfo wrcomcmd NS
9402
9403    set top .writecommit
9404    set wrcomtop $top
9405    catch {destroy $top}
9406    ttk_toplevel $top
9407    make_transient $top .
9408    ${NS}::label $top.title -text [mc "Write commit to file"]
9409    grid $top.title - -pady 10
9410    ${NS}::label $top.id -text [mc "ID:"]
9411    ${NS}::entry $top.sha1 -width 40
9412    $top.sha1 insert 0 $rowmenuid
9413    $top.sha1 conf -state readonly
9414    grid $top.id $top.sha1 -sticky w
9415    ${NS}::entry $top.head -width 60
9416    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9417    $top.head conf -state readonly
9418    grid x $top.head -sticky w
9419    ${NS}::label $top.clab -text [mc "Command:"]
9420    ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
9421    grid $top.clab $top.cmd -sticky w -pady 10
9422    ${NS}::label $top.flab -text [mc "Output file:"]
9423    ${NS}::entry $top.fname -width 60
9424    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
9425    grid $top.flab $top.fname -sticky w
9426    ${NS}::frame $top.buts
9427    ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
9428    ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
9429    bind $top <Key-Return> wrcomgo
9430    bind $top <Key-Escape> wrcomcan
9431    grid $top.buts.gen $top.buts.can
9432    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9433    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9434    grid $top.buts - -pady 10 -sticky ew
9435    focus $top.fname
9436}
9437
9438proc wrcomgo {} {
9439    global wrcomtop
9440
9441    set id [$wrcomtop.sha1 get]
9442    set cmd "echo $id | [$wrcomtop.cmd get]"
9443    set fname [$wrcomtop.fname get]
9444    if {[catch {exec sh -c $cmd >$fname &} err]} {
9445        error_popup "[mc "Error writing commit:"] $err" $wrcomtop
9446    }
9447    catch {destroy $wrcomtop}
9448    unset wrcomtop
9449}
9450
9451proc wrcomcan {} {
9452    global wrcomtop
9453
9454    catch {destroy $wrcomtop}
9455    unset wrcomtop
9456}
9457
9458proc mkbranch {} {
9459    global NS rowmenuid
9460
9461    set top .branchdialog
9462
9463    set val(name) ""
9464    set val(id) $rowmenuid
9465    set val(command) [list mkbrgo $top]
9466
9467    set ui(title) [mc "Create branch"]
9468    set ui(accept) [mc "Create"]
9469
9470    branchdia $top val ui
9471}
9472
9473proc mvbranch {} {
9474    global NS
9475    global headmenuid headmenuhead
9476
9477    set top .branchdialog
9478
9479    set val(name) $headmenuhead
9480    set val(id) $headmenuid
9481    set val(command) [list mvbrgo $top $headmenuhead]
9482
9483    set ui(title) [mc "Rename branch %s" $headmenuhead]
9484    set ui(accept) [mc "Rename"]
9485
9486    branchdia $top val ui
9487}
9488
9489proc branchdia {top valvar uivar} {
9490    global NS commitinfo
9491    upvar $valvar val $uivar ui
9492
9493    catch {destroy $top}
9494    ttk_toplevel $top
9495    make_transient $top .
9496    ${NS}::label $top.title -text $ui(title)
9497    grid $top.title - -pady 10
9498    ${NS}::label $top.id -text [mc "ID:"]
9499    ${NS}::entry $top.sha1 -width 40
9500    $top.sha1 insert 0 $val(id)
9501    $top.sha1 conf -state readonly
9502    grid $top.id $top.sha1 -sticky w
9503    ${NS}::entry $top.head -width 60
9504    $top.head insert 0 [lindex $commitinfo($val(id)) 0]
9505    $top.head conf -state readonly
9506    grid x $top.head -sticky ew
9507    grid columnconfigure $top 1 -weight 1
9508    ${NS}::label $top.nlab -text [mc "Name:"]
9509    ${NS}::entry $top.name -width 40
9510    $top.name insert 0 $val(name)
9511    grid $top.nlab $top.name -sticky w
9512    ${NS}::frame $top.buts
9513    ${NS}::button $top.buts.go -text $ui(accept) -command $val(command)
9514    ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
9515    bind $top <Key-Return> $val(command)
9516    bind $top <Key-Escape> "catch {destroy $top}"
9517    grid $top.buts.go $top.buts.can
9518    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9519    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9520    grid $top.buts - -pady 10 -sticky ew
9521    focus $top.name
9522}
9523
9524proc mkbrgo {top} {
9525    global headids idheads
9526
9527    set name [$top.name get]
9528    set id [$top.sha1 get]
9529    set cmdargs {}
9530    set old_id {}
9531    if {$name eq {}} {
9532        error_popup [mc "Please specify a name for the new branch"] $top
9533        return
9534    }
9535    if {[info exists headids($name)]} {
9536        if {![confirm_popup [mc \
9537                "Branch '%s' already exists. Overwrite?" $name] $top]} {
9538            return
9539        }
9540        set old_id $headids($name)
9541        lappend cmdargs -f
9542    }
9543    catch {destroy $top}
9544    lappend cmdargs $name $id
9545    nowbusy newbranch
9546    update
9547    if {[catch {
9548        eval exec git branch $cmdargs
9549    } err]} {
9550        notbusy newbranch
9551        error_popup $err
9552    } else {
9553        notbusy newbranch
9554        if {$old_id ne {}} {
9555            movehead $id $name
9556            movedhead $id $name
9557            redrawtags $old_id
9558            redrawtags $id
9559        } else {
9560            set headids($name) $id
9561            lappend idheads($id) $name
9562            addedhead $id $name
9563            redrawtags $id
9564        }
9565        dispneartags 0
9566        run refill_reflist
9567    }
9568}
9569
9570proc mvbrgo {top prevname} {
9571    global headids idheads mainhead mainheadid
9572
9573    set name [$top.name get]
9574    set id [$top.sha1 get]
9575    set cmdargs {}
9576    if {$name eq $prevname} {
9577        catch {destroy $top}
9578        return
9579    }
9580    if {$name eq {}} {
9581        error_popup [mc "Please specify a new name for the branch"] $top
9582        return
9583    }
9584    catch {destroy $top}
9585    lappend cmdargs -m $prevname $name
9586    nowbusy renamebranch
9587    update
9588    if {[catch {
9589        eval exec git branch $cmdargs
9590    } err]} {
9591        notbusy renamebranch
9592        error_popup $err
9593    } else {
9594        notbusy renamebranch
9595        removehead $id $prevname
9596        removedhead $id $prevname
9597        set headids($name) $id
9598        lappend idheads($id) $name
9599        addedhead $id $name
9600        if {$prevname eq $mainhead} {
9601            set mainhead $name
9602            set mainheadid $id
9603        }
9604        redrawtags $id
9605        dispneartags 0
9606        run refill_reflist
9607    }
9608}
9609
9610proc exec_citool {tool_args {baseid {}}} {
9611    global commitinfo env
9612
9613    set save_env [array get env GIT_AUTHOR_*]
9614
9615    if {$baseid ne {}} {
9616        if {![info exists commitinfo($baseid)]} {
9617            getcommit $baseid
9618        }
9619        set author [lindex $commitinfo($baseid) 1]
9620        set date [lindex $commitinfo($baseid) 2]
9621        if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9622                    $author author name email]
9623            && $date ne {}} {
9624            set env(GIT_AUTHOR_NAME) $name
9625            set env(GIT_AUTHOR_EMAIL) $email
9626            set env(GIT_AUTHOR_DATE) $date
9627        }
9628    }
9629
9630    eval exec git citool $tool_args &
9631
9632    array unset env GIT_AUTHOR_*
9633    array set env $save_env
9634}
9635
9636proc cherrypick {} {
9637    global rowmenuid curview
9638    global mainhead mainheadid
9639    global gitdir
9640
9641    set oldhead [exec git rev-parse HEAD]
9642    set dheads [descheads $rowmenuid]
9643    if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
9644        set ok [confirm_popup [mc "Commit %s is already\
9645                included in branch %s -- really re-apply it?" \
9646                                   [string range $rowmenuid 0 7] $mainhead]]
9647        if {!$ok} return
9648    }
9649    nowbusy cherrypick [mc "Cherry-picking"]
9650    update
9651    # Unfortunately git-cherry-pick writes stuff to stderr even when
9652    # no error occurs, and exec takes that as an indication of error...
9653    if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9654        notbusy cherrypick
9655        if {[regexp -line \
9656                 {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9657                 $err msg fname]} {
9658            error_popup [mc "Cherry-pick failed because of local changes\
9659                        to file '%s'.\nPlease commit, reset or stash\
9660                        your changes and try again." $fname]
9661        } elseif {[regexp -line \
9662                       {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
9663                       $err]} {
9664            if {[confirm_popup [mc "Cherry-pick failed because of merge\
9665                        conflict.\nDo you wish to run git citool to\
9666                        resolve it?"]]} {
9667                # Force citool to read MERGE_MSG
9668                file delete [file join $gitdir "GITGUI_MSG"]
9669                exec_citool {} $rowmenuid
9670            }
9671        } else {
9672            error_popup $err
9673        }
9674        run updatecommits
9675        return
9676    }
9677    set newhead [exec git rev-parse HEAD]
9678    if {$newhead eq $oldhead} {
9679        notbusy cherrypick
9680        error_popup [mc "No changes committed"]
9681        return
9682    }
9683    addnewchild $newhead $oldhead
9684    if {[commitinview $oldhead $curview]} {
9685        # XXX this isn't right if we have a path limit...
9686        insertrow $newhead $oldhead $curview
9687        if {$mainhead ne {}} {
9688            movehead $newhead $mainhead
9689            movedhead $newhead $mainhead
9690        }
9691        set mainheadid $newhead
9692        redrawtags $oldhead
9693        redrawtags $newhead
9694        selbyid $newhead
9695    }
9696    notbusy cherrypick
9697}
9698
9699proc revert {} {
9700    global rowmenuid curview
9701    global mainhead mainheadid
9702    global gitdir
9703
9704    set oldhead [exec git rev-parse HEAD]
9705    set dheads [descheads $rowmenuid]
9706    if { $dheads eq {} || [lsearch -exact $dheads $oldhead] == -1 } {
9707       set ok [confirm_popup [mc "Commit %s is not\
9708           included in branch %s -- really revert it?" \
9709                      [string range $rowmenuid 0 7] $mainhead]]
9710       if {!$ok} return
9711    }
9712    nowbusy revert [mc "Reverting"]
9713    update
9714
9715    if [catch {exec git revert --no-edit $rowmenuid} err] {
9716        notbusy revert
9717        if [regexp {files would be overwritten by merge:(\n(( |\t)+[^\n]+\n)+)}\
9718                $err match files] {
9719            regsub {\n( |\t)+} $files "\n" files
9720            error_popup [mc "Revert failed because of local changes to\
9721                the following files:%s Please commit, reset or stash \
9722                your changes and try again." $files]
9723        } elseif [regexp {error: could not revert} $err] {
9724            if [confirm_popup [mc "Revert failed because of merge conflict.\n\
9725                Do you wish to run git citool to resolve it?"]] {
9726                # Force citool to read MERGE_MSG
9727                file delete [file join $gitdir "GITGUI_MSG"]
9728                exec_citool {} $rowmenuid
9729            }
9730        } else { error_popup $err }
9731        run updatecommits
9732        return
9733    }
9734
9735    set newhead [exec git rev-parse HEAD]
9736    if { $newhead eq $oldhead } {
9737        notbusy revert
9738        error_popup [mc "No changes committed"]
9739        return
9740    }
9741
9742    addnewchild $newhead $oldhead
9743
9744    if [commitinview $oldhead $curview] {
9745        # XXX this isn't right if we have a path limit...
9746        insertrow $newhead $oldhead $curview
9747        if {$mainhead ne {}} {
9748            movehead $newhead $mainhead
9749            movedhead $newhead $mainhead
9750        }
9751        set mainheadid $newhead
9752        redrawtags $oldhead
9753        redrawtags $newhead
9754        selbyid $newhead
9755    }
9756
9757    notbusy revert
9758}
9759
9760proc resethead {} {
9761    global mainhead rowmenuid confirm_ok resettype NS
9762
9763    set confirm_ok 0
9764    set w ".confirmreset"
9765    ttk_toplevel $w
9766    make_transient $w .
9767    wm title $w [mc "Confirm reset"]
9768    ${NS}::label $w.m -text \
9769        [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
9770    pack $w.m -side top -fill x -padx 20 -pady 20
9771    ${NS}::labelframe $w.f -text [mc "Reset type:"]
9772    set resettype mixed
9773    ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
9774        -text [mc "Soft: Leave working tree and index untouched"]
9775    grid $w.f.soft -sticky w
9776    ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
9777        -text [mc "Mixed: Leave working tree untouched, reset index"]
9778    grid $w.f.mixed -sticky w
9779    ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
9780        -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
9781    grid $w.f.hard -sticky w
9782    pack $w.f -side top -fill x -padx 4
9783    ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
9784    pack $w.ok -side left -fill x -padx 20 -pady 20
9785    ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
9786    bind $w <Key-Escape> [list destroy $w]
9787    pack $w.cancel -side right -fill x -padx 20 -pady 20
9788    bind $w <Visibility> "grab $w; focus $w"
9789    tkwait window $w
9790    if {!$confirm_ok} return
9791    if {[catch {set fd [open \
9792            [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
9793        error_popup $err
9794    } else {
9795        dohidelocalchanges
9796        filerun $fd [list readresetstat $fd]
9797        nowbusy reset [mc "Resetting"]
9798        selbyid $rowmenuid
9799    }
9800}
9801
9802proc readresetstat {fd} {
9803    global mainhead mainheadid showlocalchanges rprogcoord
9804
9805    if {[gets $fd line] >= 0} {
9806        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9807            set rprogcoord [expr {1.0 * $m / $n}]
9808            adjustprogress
9809        }
9810        return 1
9811    }
9812    set rprogcoord 0
9813    adjustprogress
9814    notbusy reset
9815    if {[catch {close $fd} err]} {
9816        error_popup $err
9817    }
9818    set oldhead $mainheadid
9819    set newhead [exec git rev-parse HEAD]
9820    if {$newhead ne $oldhead} {
9821        movehead $newhead $mainhead
9822        movedhead $newhead $mainhead
9823        set mainheadid $newhead
9824        redrawtags $oldhead
9825        redrawtags $newhead
9826    }
9827    if {$showlocalchanges} {
9828        doshowlocalchanges
9829    }
9830    return 0
9831}
9832
9833# context menu for a head
9834proc headmenu {x y id head} {
9835    global headmenuid headmenuhead headctxmenu mainhead headids
9836
9837    stopfinding
9838    set headmenuid $id
9839    set headmenuhead $head
9840    array set state {0 normal 1 normal 2 normal}
9841    if {[string match "remotes/*" $head]} {
9842        set localhead [string range $head [expr [string last / $head] + 1] end]
9843        if {[info exists headids($localhead)]} {
9844            set state(0) disabled
9845        }
9846        array set state {1 disabled 2 disabled}
9847    }
9848    if {$head eq $mainhead} {
9849        array set state {0 disabled 2 disabled}
9850    }
9851    foreach i {0 1 2} {
9852        $headctxmenu entryconfigure $i -state $state($i)
9853    }
9854    tk_popup $headctxmenu $x $y
9855}
9856
9857proc cobranch {} {
9858    global headmenuid headmenuhead headids
9859    global showlocalchanges
9860
9861    # check the tree is clean first??
9862    set newhead $headmenuhead
9863    set command [list | git checkout]
9864    if {[string match "remotes/*" $newhead]} {
9865        set remote $newhead
9866        set newhead [string range $newhead [expr [string last / $newhead] + 1] end]
9867        # The following check is redundant - the menu option should
9868        # be disabled to begin with...
9869        if {[info exists headids($newhead)]} {
9870            error_popup [mc "A local branch named %s exists already" $newhead]
9871            return
9872        }
9873        lappend command -b $newhead --track $remote
9874    } else {
9875        lappend command $newhead
9876    }
9877    lappend command 2>@1
9878    nowbusy checkout [mc "Checking out"]
9879    update
9880    dohidelocalchanges
9881    if {[catch {
9882        set fd [open $command r]
9883    } err]} {
9884        notbusy checkout
9885        error_popup $err
9886        if {$showlocalchanges} {
9887            dodiffindex
9888        }
9889    } else {
9890        filerun $fd [list readcheckoutstat $fd $newhead $headmenuid]
9891    }
9892}
9893
9894proc readcheckoutstat {fd newhead newheadid} {
9895    global mainhead mainheadid headids idheads showlocalchanges progresscoords
9896    global viewmainheadid curview
9897
9898    if {[gets $fd line] >= 0} {
9899        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9900            set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9901            adjustprogress
9902        }
9903        return 1
9904    }
9905    set progresscoords {0 0}
9906    adjustprogress
9907    notbusy checkout
9908    if {[catch {close $fd} err]} {
9909        error_popup $err
9910        return
9911    }
9912    set oldmainid $mainheadid
9913    if {! [info exists headids($newhead)]} {
9914        set headids($newhead) $newheadid
9915        lappend idheads($newheadid) $newhead
9916        addedhead $newheadid $newhead
9917    }
9918    set mainhead $newhead
9919    set mainheadid $newheadid
9920    set viewmainheadid($curview) $newheadid
9921    redrawtags $oldmainid
9922    redrawtags $newheadid
9923    selbyid $newheadid
9924    if {$showlocalchanges} {
9925        dodiffindex
9926    }
9927}
9928
9929proc rmbranch {} {
9930    global headmenuid headmenuhead mainhead
9931    global idheads
9932
9933    set head $headmenuhead
9934    set id $headmenuid
9935    # this check shouldn't be needed any more...
9936    if {$head eq $mainhead} {
9937        error_popup [mc "Cannot delete the currently checked-out branch"]
9938        return
9939    }
9940    set dheads [descheads $id]
9941    if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
9942        # the stuff on this branch isn't on any other branch
9943        if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9944                        branch.\nReally delete branch %s?" $head $head]]} return
9945    }
9946    nowbusy rmbranch
9947    update
9948    if {[catch {exec git branch -D $head} err]} {
9949        notbusy rmbranch
9950        error_popup $err
9951        return
9952    }
9953    removehead $id $head
9954    removedhead $id $head
9955    redrawtags $id
9956    notbusy rmbranch
9957    dispneartags 0
9958    run refill_reflist
9959}
9960
9961# Display a list of tags and heads
9962proc showrefs {} {
9963    global showrefstop bgcolor fgcolor selectbgcolor NS
9964    global bglist fglist reflistfilter reflist maincursor
9965
9966    set top .showrefs
9967    set showrefstop $top
9968    if {[winfo exists $top]} {
9969        raise $top
9970        refill_reflist
9971        return
9972    }
9973    ttk_toplevel $top
9974    wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
9975    make_transient $top .
9976    text $top.list -background $bgcolor -foreground $fgcolor \
9977        -selectbackground $selectbgcolor -font mainfont \
9978        -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
9979        -width 30 -height 20 -cursor $maincursor \
9980        -spacing1 1 -spacing3 1 -state disabled
9981    $top.list tag configure highlight -background $selectbgcolor
9982    if {![lsearch -exact $bglist $top.list]} {
9983        lappend bglist $top.list
9984        lappend fglist $top.list
9985    }
9986    ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
9987    ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
9988    grid $top.list $top.ysb -sticky nsew
9989    grid $top.xsb x -sticky ew
9990    ${NS}::frame $top.f
9991    ${NS}::label $top.f.l -text "[mc "Filter"]: "
9992    ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
9993    set reflistfilter "*"
9994    trace add variable reflistfilter write reflistfilter_change
9995    pack $top.f.e -side right -fill x -expand 1
9996    pack $top.f.l -side left
9997    grid $top.f - -sticky ew -pady 2
9998    ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
9999    bind $top <Key-Escape> [list destroy $top]
10000    grid $top.close -
10001    grid columnconfigure $top 0 -weight 1
10002    grid rowconfigure $top 0 -weight 1
10003    bind $top.list <1> {break}
10004    bind $top.list <B1-Motion> {break}
10005    bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
10006    set reflist {}
10007    refill_reflist
10008}
10009
10010proc sel_reflist {w x y} {
10011    global showrefstop reflist headids tagids otherrefids
10012
10013    if {![winfo exists $showrefstop]} return
10014    set l [lindex [split [$w index "@$x,$y"] "."] 0]
10015    set ref [lindex $reflist [expr {$l-1}]]
10016    set n [lindex $ref 0]
10017    switch -- [lindex $ref 1] {
10018        "H" {selbyid $headids($n)}
10019        "T" {selbyid $tagids($n)}
10020        "o" {selbyid $otherrefids($n)}
10021    }
10022    $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
10023}
10024
10025proc unsel_reflist {} {
10026    global showrefstop
10027
10028    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
10029    $showrefstop.list tag remove highlight 0.0 end
10030}
10031
10032proc reflistfilter_change {n1 n2 op} {
10033    global reflistfilter
10034
10035    after cancel refill_reflist
10036    after 200 refill_reflist
10037}
10038
10039proc refill_reflist {} {
10040    global reflist reflistfilter showrefstop headids tagids otherrefids
10041    global curview
10042
10043    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
10044    set refs {}
10045    foreach n [array names headids] {
10046        if {[string match $reflistfilter $n]} {
10047            if {[commitinview $headids($n) $curview]} {
10048                lappend refs [list $n H]
10049            } else {
10050                interestedin $headids($n) {run refill_reflist}
10051            }
10052        }
10053    }
10054    foreach n [array names tagids] {
10055        if {[string match $reflistfilter $n]} {
10056            if {[commitinview $tagids($n) $curview]} {
10057                lappend refs [list $n T]
10058            } else {
10059                interestedin $tagids($n) {run refill_reflist}
10060            }
10061        }
10062    }
10063    foreach n [array names otherrefids] {
10064        if {[string match $reflistfilter $n]} {
10065            if {[commitinview $otherrefids($n) $curview]} {
10066                lappend refs [list $n o]
10067            } else {
10068                interestedin $otherrefids($n) {run refill_reflist}
10069            }
10070        }
10071    }
10072    set refs [lsort -index 0 $refs]
10073    if {$refs eq $reflist} return
10074
10075    # Update the contents of $showrefstop.list according to the
10076    # differences between $reflist (old) and $refs (new)
10077    $showrefstop.list conf -state normal
10078    $showrefstop.list insert end "\n"
10079    set i 0
10080    set j 0
10081    while {$i < [llength $reflist] || $j < [llength $refs]} {
10082        if {$i < [llength $reflist]} {
10083            if {$j < [llength $refs]} {
10084                set cmp [string compare [lindex $reflist $i 0] \
10085                             [lindex $refs $j 0]]
10086                if {$cmp == 0} {
10087                    set cmp [string compare [lindex $reflist $i 1] \
10088                                 [lindex $refs $j 1]]
10089                }
10090            } else {
10091                set cmp -1
10092            }
10093        } else {
10094            set cmp 1
10095        }
10096        switch -- $cmp {
10097            -1 {
10098                $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
10099                incr i
10100            }
10101            0 {
10102                incr i
10103                incr j
10104            }
10105            1 {
10106                set l [expr {$j + 1}]
10107                $showrefstop.list image create $l.0 -align baseline \
10108                    -image reficon-[lindex $refs $j 1] -padx 2
10109                $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
10110                incr j
10111            }
10112        }
10113    }
10114    set reflist $refs
10115    # delete last newline
10116    $showrefstop.list delete end-2c end-1c
10117    $showrefstop.list conf -state disabled
10118}
10119
10120# Stuff for finding nearby tags
10121proc getallcommits {} {
10122    global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
10123    global idheads idtags idotherrefs allparents tagobjid
10124    global gitdir
10125
10126    if {![info exists allcommits]} {
10127        set nextarc 0
10128        set allcommits 0
10129        set seeds {}
10130        set allcwait 0
10131        set cachedarcs 0
10132        set allccache [file join $gitdir "gitk.cache"]
10133        if {![catch {
10134            set f [open $allccache r]
10135            set allcwait 1
10136            getcache $f
10137        }]} return
10138    }
10139
10140    if {$allcwait} {
10141        return
10142    }
10143    set cmd [list | git rev-list --parents]
10144    set allcupdate [expr {$seeds ne {}}]
10145    if {!$allcupdate} {
10146        set ids "--all"
10147    } else {
10148        set refs [concat [array names idheads] [array names idtags] \
10149                      [array names idotherrefs]]
10150        set ids {}
10151        set tagobjs {}
10152        foreach name [array names tagobjid] {
10153            lappend tagobjs $tagobjid($name)
10154        }
10155        foreach id [lsort -unique $refs] {
10156            if {![info exists allparents($id)] &&
10157                [lsearch -exact $tagobjs $id] < 0} {
10158                lappend ids $id
10159            }
10160        }
10161        if {$ids ne {}} {
10162            foreach id $seeds {
10163                lappend ids "^$id"
10164            }
10165        }
10166    }
10167    if {$ids ne {}} {
10168        set fd [open [concat $cmd $ids] r]
10169        fconfigure $fd -blocking 0
10170        incr allcommits
10171        nowbusy allcommits
10172        filerun $fd [list getallclines $fd]
10173    } else {
10174        dispneartags 0
10175    }
10176}
10177
10178# Since most commits have 1 parent and 1 child, we group strings of
10179# such commits into "arcs" joining branch/merge points (BMPs), which
10180# are commits that either don't have 1 parent or don't have 1 child.
10181#
10182# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
10183# arcout(id) - outgoing arcs for BMP
10184# arcids(a) - list of IDs on arc including end but not start
10185# arcstart(a) - BMP ID at start of arc
10186# arcend(a) - BMP ID at end of arc
10187# growing(a) - arc a is still growing
10188# arctags(a) - IDs out of arcids (excluding end) that have tags
10189# archeads(a) - IDs out of arcids (excluding end) that have heads
10190# The start of an arc is at the descendent end, so "incoming" means
10191# coming from descendents, and "outgoing" means going towards ancestors.
10192
10193proc getallclines {fd} {
10194    global allparents allchildren idtags idheads nextarc
10195    global arcnos arcids arctags arcout arcend arcstart archeads growing
10196    global seeds allcommits cachedarcs allcupdate
10197
10198    set nid 0
10199    while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
10200        set id [lindex $line 0]
10201        if {[info exists allparents($id)]} {
10202            # seen it already
10203            continue
10204        }
10205        set cachedarcs 0
10206        set olds [lrange $line 1 end]
10207        set allparents($id) $olds
10208        if {![info exists allchildren($id)]} {
10209            set allchildren($id) {}
10210            set arcnos($id) {}
10211            lappend seeds $id
10212        } else {
10213            set a $arcnos($id)
10214            if {[llength $olds] == 1 && [llength $a] == 1} {
10215                lappend arcids($a) $id
10216                if {[info exists idtags($id)]} {
10217                    lappend arctags($a) $id
10218                }
10219                if {[info exists idheads($id)]} {
10220                    lappend archeads($a) $id
10221                }
10222                if {[info exists allparents($olds)]} {
10223                    # seen parent already
10224                    if {![info exists arcout($olds)]} {
10225                        splitarc $olds
10226                    }
10227                    lappend arcids($a) $olds
10228                    set arcend($a) $olds
10229                    unset growing($a)
10230                }
10231                lappend allchildren($olds) $id
10232                lappend arcnos($olds) $a
10233                continue
10234            }
10235        }
10236        foreach a $arcnos($id) {
10237            lappend arcids($a) $id
10238            set arcend($a) $id
10239            unset growing($a)
10240        }
10241
10242        set ao {}
10243        foreach p $olds {
10244            lappend allchildren($p) $id
10245            set a [incr nextarc]
10246            set arcstart($a) $id
10247            set archeads($a) {}
10248            set arctags($a) {}
10249            set archeads($a) {}
10250            set arcids($a) {}
10251            lappend ao $a
10252            set growing($a) 1
10253            if {[info exists allparents($p)]} {
10254                # seen it already, may need to make a new branch
10255                if {![info exists arcout($p)]} {
10256                    splitarc $p
10257                }
10258                lappend arcids($a) $p
10259                set arcend($a) $p
10260                unset growing($a)
10261            }
10262            lappend arcnos($p) $a
10263        }
10264        set arcout($id) $ao
10265    }
10266    if {$nid > 0} {
10267        global cached_dheads cached_dtags cached_atags
10268        unset -nocomplain cached_dheads
10269        unset -nocomplain cached_dtags
10270        unset -nocomplain cached_atags
10271    }
10272    if {![eof $fd]} {
10273        return [expr {$nid >= 1000? 2: 1}]
10274    }
10275    set cacheok 1
10276    if {[catch {
10277        fconfigure $fd -blocking 1
10278        close $fd
10279    } err]} {
10280        # got an error reading the list of commits
10281        # if we were updating, try rereading the whole thing again
10282        if {$allcupdate} {
10283            incr allcommits -1
10284            dropcache $err
10285            return
10286        }
10287        error_popup "[mc "Error reading commit topology information;\
10288                branch and preceding/following tag information\
10289                will be incomplete."]\n($err)"
10290        set cacheok 0
10291    }
10292    if {[incr allcommits -1] == 0} {
10293        notbusy allcommits
10294        if {$cacheok} {
10295            run savecache
10296        }
10297    }
10298    dispneartags 0
10299    return 0
10300}
10301
10302proc recalcarc {a} {
10303    global arctags archeads arcids idtags idheads
10304
10305    set at {}
10306    set ah {}
10307    foreach id [lrange $arcids($a) 0 end-1] {
10308        if {[info exists idtags($id)]} {
10309            lappend at $id
10310        }
10311        if {[info exists idheads($id)]} {
10312            lappend ah $id
10313        }
10314    }
10315    set arctags($a) $at
10316    set archeads($a) $ah
10317}
10318
10319proc splitarc {p} {
10320    global arcnos arcids nextarc arctags archeads idtags idheads
10321    global arcstart arcend arcout allparents growing
10322
10323    set a $arcnos($p)
10324    if {[llength $a] != 1} {
10325        puts "oops splitarc called but [llength $a] arcs already"
10326        return
10327    }
10328    set a [lindex $a 0]
10329    set i [lsearch -exact $arcids($a) $p]
10330    if {$i < 0} {
10331        puts "oops splitarc $p not in arc $a"
10332        return
10333    }
10334    set na [incr nextarc]
10335    if {[info exists arcend($a)]} {
10336        set arcend($na) $arcend($a)
10337    } else {
10338        set l [lindex $allparents([lindex $arcids($a) end]) 0]
10339        set j [lsearch -exact $arcnos($l) $a]
10340        set arcnos($l) [lreplace $arcnos($l) $j $j $na]
10341    }
10342    set tail [lrange $arcids($a) [expr {$i+1}] end]
10343    set arcids($a) [lrange $arcids($a) 0 $i]
10344    set arcend($a) $p
10345    set arcstart($na) $p
10346    set arcout($p) $na
10347    set arcids($na) $tail
10348    if {[info exists growing($a)]} {
10349        set growing($na) 1
10350        unset growing($a)
10351    }
10352
10353    foreach id $tail {
10354        if {[llength $arcnos($id)] == 1} {
10355            set arcnos($id) $na
10356        } else {
10357            set j [lsearch -exact $arcnos($id) $a]
10358            set arcnos($id) [lreplace $arcnos($id) $j $j $na]
10359        }
10360    }
10361
10362    # reconstruct tags and heads lists
10363    if {$arctags($a) ne {} || $archeads($a) ne {}} {
10364        recalcarc $a
10365        recalcarc $na
10366    } else {
10367        set arctags($na) {}
10368        set archeads($na) {}
10369    }
10370}
10371
10372# Update things for a new commit added that is a child of one
10373# existing commit.  Used when cherry-picking.
10374proc addnewchild {id p} {
10375    global allparents allchildren idtags nextarc
10376    global arcnos arcids arctags arcout arcend arcstart archeads growing
10377    global seeds allcommits
10378
10379    if {![info exists allcommits] || ![info exists arcnos($p)]} return
10380    set allparents($id) [list $p]
10381    set allchildren($id) {}
10382    set arcnos($id) {}
10383    lappend seeds $id
10384    lappend allchildren($p) $id
10385    set a [incr nextarc]
10386    set arcstart($a) $id
10387    set archeads($a) {}
10388    set arctags($a) {}
10389    set arcids($a) [list $p]
10390    set arcend($a) $p
10391    if {![info exists arcout($p)]} {
10392        splitarc $p
10393    }
10394    lappend arcnos($p) $a
10395    set arcout($id) [list $a]
10396}
10397
10398# This implements a cache for the topology information.
10399# The cache saves, for each arc, the start and end of the arc,
10400# the ids on the arc, and the outgoing arcs from the end.
10401proc readcache {f} {
10402    global arcnos arcids arcout arcstart arcend arctags archeads nextarc
10403    global idtags idheads allparents cachedarcs possible_seeds seeds growing
10404    global allcwait
10405
10406    set a $nextarc
10407    set lim $cachedarcs
10408    if {$lim - $a > 500} {
10409        set lim [expr {$a + 500}]
10410    }
10411    if {[catch {
10412        if {$a == $lim} {
10413            # finish reading the cache and setting up arctags, etc.
10414            set line [gets $f]
10415            if {$line ne "1"} {error "bad final version"}
10416            close $f
10417            foreach id [array names idtags] {
10418                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10419                    [llength $allparents($id)] == 1} {
10420                    set a [lindex $arcnos($id) 0]
10421                    if {$arctags($a) eq {}} {
10422                        recalcarc $a
10423                    }
10424                }
10425            }
10426            foreach id [array names idheads] {
10427                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10428                    [llength $allparents($id)] == 1} {
10429                    set a [lindex $arcnos($id) 0]
10430                    if {$archeads($a) eq {}} {
10431                        recalcarc $a
10432                    }
10433                }
10434            }
10435            foreach id [lsort -unique $possible_seeds] {
10436                if {$arcnos($id) eq {}} {
10437                    lappend seeds $id
10438                }
10439            }
10440            set allcwait 0
10441        } else {
10442            while {[incr a] <= $lim} {
10443                set line [gets $f]
10444                if {[llength $line] != 3} {error "bad line"}
10445                set s [lindex $line 0]
10446                set arcstart($a) $s
10447                lappend arcout($s) $a
10448                if {![info exists arcnos($s)]} {
10449                    lappend possible_seeds $s
10450                    set arcnos($s) {}
10451                }
10452                set e [lindex $line 1]
10453                if {$e eq {}} {
10454                    set growing($a) 1
10455                } else {
10456                    set arcend($a) $e
10457                    if {![info exists arcout($e)]} {
10458                        set arcout($e) {}
10459                    }
10460                }
10461                set arcids($a) [lindex $line 2]
10462                foreach id $arcids($a) {
10463                    lappend allparents($s) $id
10464                    set s $id
10465                    lappend arcnos($id) $a
10466                }
10467                if {![info exists allparents($s)]} {
10468                    set allparents($s) {}
10469                }
10470                set arctags($a) {}
10471                set archeads($a) {}
10472            }
10473            set nextarc [expr {$a - 1}]
10474        }
10475    } err]} {
10476        dropcache $err
10477        return 0
10478    }
10479    if {!$allcwait} {
10480        getallcommits
10481    }
10482    return $allcwait
10483}
10484
10485proc getcache {f} {
10486    global nextarc cachedarcs possible_seeds
10487
10488    if {[catch {
10489        set line [gets $f]
10490        if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
10491        # make sure it's an integer
10492        set cachedarcs [expr {int([lindex $line 1])}]
10493        if {$cachedarcs < 0} {error "bad number of arcs"}
10494        set nextarc 0
10495        set possible_seeds {}
10496        run readcache $f
10497    } err]} {
10498        dropcache $err
10499    }
10500    return 0
10501}
10502
10503proc dropcache {err} {
10504    global allcwait nextarc cachedarcs seeds
10505
10506    #puts "dropping cache ($err)"
10507    foreach v {arcnos arcout arcids arcstart arcend growing \
10508                   arctags archeads allparents allchildren} {
10509        global $v
10510        unset -nocomplain $v
10511    }
10512    set allcwait 0
10513    set nextarc 0
10514    set cachedarcs 0
10515    set seeds {}
10516    getallcommits
10517}
10518
10519proc writecache {f} {
10520    global cachearc cachedarcs allccache
10521    global arcstart arcend arcnos arcids arcout
10522
10523    set a $cachearc
10524    set lim $cachedarcs
10525    if {$lim - $a > 1000} {
10526        set lim [expr {$a + 1000}]
10527    }
10528    if {[catch {
10529        while {[incr a] <= $lim} {
10530            if {[info exists arcend($a)]} {
10531                puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
10532            } else {
10533                puts $f [list $arcstart($a) {} $arcids($a)]
10534            }
10535        }
10536    } err]} {
10537        catch {close $f}
10538        catch {file delete $allccache}
10539        #puts "writing cache failed ($err)"
10540        return 0
10541    }
10542    set cachearc [expr {$a - 1}]
10543    if {$a > $cachedarcs} {
10544        puts $f "1"
10545        close $f
10546        return 0
10547    }
10548    return 1
10549}
10550
10551proc savecache {} {
10552    global nextarc cachedarcs cachearc allccache
10553
10554    if {$nextarc == $cachedarcs} return
10555    set cachearc 0
10556    set cachedarcs $nextarc
10557    catch {
10558        set f [open $allccache w]
10559        puts $f [list 1 $cachedarcs]
10560        run writecache $f
10561    }
10562}
10563
10564# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
10565# or 0 if neither is true.
10566proc anc_or_desc {a b} {
10567    global arcout arcstart arcend arcnos cached_isanc
10568
10569    if {$arcnos($a) eq $arcnos($b)} {
10570        # Both are on the same arc(s); either both are the same BMP,
10571        # or if one is not a BMP, the other is also not a BMP or is
10572        # the BMP at end of the arc (and it only has 1 incoming arc).
10573        # Or both can be BMPs with no incoming arcs.
10574        if {$a eq $b || $arcnos($a) eq {}} {
10575            return 0
10576        }
10577        # assert {[llength $arcnos($a)] == 1}
10578        set arc [lindex $arcnos($a) 0]
10579        set i [lsearch -exact $arcids($arc) $a]
10580        set j [lsearch -exact $arcids($arc) $b]
10581        if {$i < 0 || $i > $j} {
10582            return 1
10583        } else {
10584            return -1
10585        }
10586    }
10587
10588    if {![info exists arcout($a)]} {
10589        set arc [lindex $arcnos($a) 0]
10590        if {[info exists arcend($arc)]} {
10591            set aend $arcend($arc)
10592        } else {
10593            set aend {}
10594        }
10595        set a $arcstart($arc)
10596    } else {
10597        set aend $a
10598    }
10599    if {![info exists arcout($b)]} {
10600        set arc [lindex $arcnos($b) 0]
10601        if {[info exists arcend($arc)]} {
10602            set bend $arcend($arc)
10603        } else {
10604            set bend {}
10605        }
10606        set b $arcstart($arc)
10607    } else {
10608        set bend $b
10609    }
10610    if {$a eq $bend} {
10611        return 1
10612    }
10613    if {$b eq $aend} {
10614        return -1
10615    }
10616    if {[info exists cached_isanc($a,$bend)]} {
10617        if {$cached_isanc($a,$bend)} {
10618            return 1
10619        }
10620    }
10621    if {[info exists cached_isanc($b,$aend)]} {
10622        if {$cached_isanc($b,$aend)} {
10623            return -1
10624        }
10625        if {[info exists cached_isanc($a,$bend)]} {
10626            return 0
10627        }
10628    }
10629
10630    set todo [list $a $b]
10631    set anc($a) a
10632    set anc($b) b
10633    for {set i 0} {$i < [llength $todo]} {incr i} {
10634        set x [lindex $todo $i]
10635        if {$anc($x) eq {}} {
10636            continue
10637        }
10638        foreach arc $arcnos($x) {
10639            set xd $arcstart($arc)
10640            if {$xd eq $bend} {
10641                set cached_isanc($a,$bend) 1
10642                set cached_isanc($b,$aend) 0
10643                return 1
10644            } elseif {$xd eq $aend} {
10645                set cached_isanc($b,$aend) 1
10646                set cached_isanc($a,$bend) 0
10647                return -1
10648            }
10649            if {![info exists anc($xd)]} {
10650                set anc($xd) $anc($x)
10651                lappend todo $xd
10652            } elseif {$anc($xd) ne $anc($x)} {
10653                set anc($xd) {}
10654            }
10655        }
10656    }
10657    set cached_isanc($a,$bend) 0
10658    set cached_isanc($b,$aend) 0
10659    return 0
10660}
10661
10662# This identifies whether $desc has an ancestor that is
10663# a growing tip of the graph and which is not an ancestor of $anc
10664# and returns 0 if so and 1 if not.
10665# If we subsequently discover a tag on such a growing tip, and that
10666# turns out to be a descendent of $anc (which it could, since we
10667# don't necessarily see children before parents), then $desc
10668# isn't a good choice to display as a descendent tag of
10669# $anc (since it is the descendent of another tag which is
10670# a descendent of $anc).  Similarly, $anc isn't a good choice to
10671# display as a ancestor tag of $desc.
10672#
10673proc is_certain {desc anc} {
10674    global arcnos arcout arcstart arcend growing problems
10675
10676    set certain {}
10677    if {[llength $arcnos($anc)] == 1} {
10678        # tags on the same arc are certain
10679        if {$arcnos($desc) eq $arcnos($anc)} {
10680            return 1
10681        }
10682        if {![info exists arcout($anc)]} {
10683            # if $anc is partway along an arc, use the start of the arc instead
10684            set a [lindex $arcnos($anc) 0]
10685            set anc $arcstart($a)
10686        }
10687    }
10688    if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
10689        set x $desc
10690    } else {
10691        set a [lindex $arcnos($desc) 0]
10692        set x $arcend($a)
10693    }
10694    if {$x == $anc} {
10695        return 1
10696    }
10697    set anclist [list $x]
10698    set dl($x) 1
10699    set nnh 1
10700    set ngrowanc 0
10701    for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
10702        set x [lindex $anclist $i]
10703        if {$dl($x)} {
10704            incr nnh -1
10705        }
10706        set done($x) 1
10707        foreach a $arcout($x) {
10708            if {[info exists growing($a)]} {
10709                if {![info exists growanc($x)] && $dl($x)} {
10710                    set growanc($x) 1
10711                    incr ngrowanc
10712                }
10713            } else {
10714                set y $arcend($a)
10715                if {[info exists dl($y)]} {
10716                    if {$dl($y)} {
10717                        if {!$dl($x)} {
10718                            set dl($y) 0
10719                            if {![info exists done($y)]} {
10720                                incr nnh -1
10721                            }
10722                            if {[info exists growanc($x)]} {
10723                                incr ngrowanc -1
10724                            }
10725                            set xl [list $y]
10726                            for {set k 0} {$k < [llength $xl]} {incr k} {
10727                                set z [lindex $xl $k]
10728                                foreach c $arcout($z) {
10729                                    if {[info exists arcend($c)]} {
10730                                        set v $arcend($c)
10731                                        if {[info exists dl($v)] && $dl($v)} {
10732                                            set dl($v) 0
10733                                            if {![info exists done($v)]} {
10734                                                incr nnh -1
10735                                            }
10736                                            if {[info exists growanc($v)]} {
10737                                                incr ngrowanc -1
10738                                            }
10739                                            lappend xl $v
10740                                        }
10741                                    }
10742                                }
10743                            }
10744                        }
10745                    }
10746                } elseif {$y eq $anc || !$dl($x)} {
10747                    set dl($y) 0
10748                    lappend anclist $y
10749                } else {
10750                    set dl($y) 1
10751                    lappend anclist $y
10752                    incr nnh
10753                }
10754            }
10755        }
10756    }
10757    foreach x [array names growanc] {
10758        if {$dl($x)} {
10759            return 0
10760        }
10761        return 0
10762    }
10763    return 1
10764}
10765
10766proc validate_arctags {a} {
10767    global arctags idtags
10768
10769    set i -1
10770    set na $arctags($a)
10771    foreach id $arctags($a) {
10772        incr i
10773        if {![info exists idtags($id)]} {
10774            set na [lreplace $na $i $i]
10775            incr i -1
10776        }
10777    }
10778    set arctags($a) $na
10779}
10780
10781proc validate_archeads {a} {
10782    global archeads idheads
10783
10784    set i -1
10785    set na $archeads($a)
10786    foreach id $archeads($a) {
10787        incr i
10788        if {![info exists idheads($id)]} {
10789            set na [lreplace $na $i $i]
10790            incr i -1
10791        }
10792    }
10793    set archeads($a) $na
10794}
10795
10796# Return the list of IDs that have tags that are descendents of id,
10797# ignoring IDs that are descendents of IDs already reported.
10798proc desctags {id} {
10799    global arcnos arcstart arcids arctags idtags allparents
10800    global growing cached_dtags
10801
10802    if {![info exists allparents($id)]} {
10803        return {}
10804    }
10805    set t1 [clock clicks -milliseconds]
10806    set argid $id
10807    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10808        # part-way along an arc; check that arc first
10809        set a [lindex $arcnos($id) 0]
10810        if {$arctags($a) ne {}} {
10811            validate_arctags $a
10812            set i [lsearch -exact $arcids($a) $id]
10813            set tid {}
10814            foreach t $arctags($a) {
10815                set j [lsearch -exact $arcids($a) $t]
10816                if {$j >= $i} break
10817                set tid $t
10818            }
10819            if {$tid ne {}} {
10820                return $tid
10821            }
10822        }
10823        set id $arcstart($a)
10824        if {[info exists idtags($id)]} {
10825            return $id
10826        }
10827    }
10828    if {[info exists cached_dtags($id)]} {
10829        return $cached_dtags($id)
10830    }
10831
10832    set origid $id
10833    set todo [list $id]
10834    set queued($id) 1
10835    set nc 1
10836    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10837        set id [lindex $todo $i]
10838        set done($id) 1
10839        set ta [info exists hastaggedancestor($id)]
10840        if {!$ta} {
10841            incr nc -1
10842        }
10843        # ignore tags on starting node
10844        if {!$ta && $i > 0} {
10845            if {[info exists idtags($id)]} {
10846                set tagloc($id) $id
10847                set ta 1
10848            } elseif {[info exists cached_dtags($id)]} {
10849                set tagloc($id) $cached_dtags($id)
10850                set ta 1
10851            }
10852        }
10853        foreach a $arcnos($id) {
10854            set d $arcstart($a)
10855            if {!$ta && $arctags($a) ne {}} {
10856                validate_arctags $a
10857                if {$arctags($a) ne {}} {
10858                    lappend tagloc($id) [lindex $arctags($a) end]
10859                }
10860            }
10861            if {$ta || $arctags($a) ne {}} {
10862                set tomark [list $d]
10863                for {set j 0} {$j < [llength $tomark]} {incr j} {
10864                    set dd [lindex $tomark $j]
10865                    if {![info exists hastaggedancestor($dd)]} {
10866                        if {[info exists done($dd)]} {
10867                            foreach b $arcnos($dd) {
10868                                lappend tomark $arcstart($b)
10869                            }
10870                            if {[info exists tagloc($dd)]} {
10871                                unset tagloc($dd)
10872                            }
10873                        } elseif {[info exists queued($dd)]} {
10874                            incr nc -1
10875                        }
10876                        set hastaggedancestor($dd) 1
10877                    }
10878                }
10879            }
10880            if {![info exists queued($d)]} {
10881                lappend todo $d
10882                set queued($d) 1
10883                if {![info exists hastaggedancestor($d)]} {
10884                    incr nc
10885                }
10886            }
10887        }
10888    }
10889    set tags {}
10890    foreach id [array names tagloc] {
10891        if {![info exists hastaggedancestor($id)]} {
10892            foreach t $tagloc($id) {
10893                if {[lsearch -exact $tags $t] < 0} {
10894                    lappend tags $t
10895                }
10896            }
10897        }
10898    }
10899    set t2 [clock clicks -milliseconds]
10900    set loopix $i
10901
10902    # remove tags that are descendents of other tags
10903    for {set i 0} {$i < [llength $tags]} {incr i} {
10904        set a [lindex $tags $i]
10905        for {set j 0} {$j < $i} {incr j} {
10906            set b [lindex $tags $j]
10907            set r [anc_or_desc $a $b]
10908            if {$r == 1} {
10909                set tags [lreplace $tags $j $j]
10910                incr j -1
10911                incr i -1
10912            } elseif {$r == -1} {
10913                set tags [lreplace $tags $i $i]
10914                incr i -1
10915                break
10916            }
10917        }
10918    }
10919
10920    if {[array names growing] ne {}} {
10921        # graph isn't finished, need to check if any tag could get
10922        # eclipsed by another tag coming later.  Simply ignore any
10923        # tags that could later get eclipsed.
10924        set ctags {}
10925        foreach t $tags {
10926            if {[is_certain $t $origid]} {
10927                lappend ctags $t
10928            }
10929        }
10930        if {$tags eq $ctags} {
10931            set cached_dtags($origid) $tags
10932        } else {
10933            set tags $ctags
10934        }
10935    } else {
10936        set cached_dtags($origid) $tags
10937    }
10938    set t3 [clock clicks -milliseconds]
10939    if {0 && $t3 - $t1 >= 100} {
10940        puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10941            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10942    }
10943    return $tags
10944}
10945
10946proc anctags {id} {
10947    global arcnos arcids arcout arcend arctags idtags allparents
10948    global growing cached_atags
10949
10950    if {![info exists allparents($id)]} {
10951        return {}
10952    }
10953    set t1 [clock clicks -milliseconds]
10954    set argid $id
10955    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10956        # part-way along an arc; check that arc first
10957        set a [lindex $arcnos($id) 0]
10958        if {$arctags($a) ne {}} {
10959            validate_arctags $a
10960            set i [lsearch -exact $arcids($a) $id]
10961            foreach t $arctags($a) {
10962                set j [lsearch -exact $arcids($a) $t]
10963                if {$j > $i} {
10964                    return $t
10965                }
10966            }
10967        }
10968        if {![info exists arcend($a)]} {
10969            return {}
10970        }
10971        set id $arcend($a)
10972        if {[info exists idtags($id)]} {
10973            return $id
10974        }
10975    }
10976    if {[info exists cached_atags($id)]} {
10977        return $cached_atags($id)
10978    }
10979
10980    set origid $id
10981    set todo [list $id]
10982    set queued($id) 1
10983    set taglist {}
10984    set nc 1
10985    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10986        set id [lindex $todo $i]
10987        set done($id) 1
10988        set td [info exists hastaggeddescendent($id)]
10989        if {!$td} {
10990            incr nc -1
10991        }
10992        # ignore tags on starting node
10993        if {!$td && $i > 0} {
10994            if {[info exists idtags($id)]} {
10995                set tagloc($id) $id
10996                set td 1
10997            } elseif {[info exists cached_atags($id)]} {
10998                set tagloc($id) $cached_atags($id)
10999                set td 1
11000            }
11001        }
11002        foreach a $arcout($id) {
11003            if {!$td && $arctags($a) ne {}} {
11004                validate_arctags $a
11005                if {$arctags($a) ne {}} {
11006                    lappend tagloc($id) [lindex $arctags($a) 0]
11007                }
11008            }
11009            if {![info exists arcend($a)]} continue
11010            set d $arcend($a)
11011            if {$td || $arctags($a) ne {}} {
11012                set tomark [list $d]
11013                for {set j 0} {$j < [llength $tomark]} {incr j} {
11014                    set dd [lindex $tomark $j]
11015                    if {![info exists hastaggeddescendent($dd)]} {
11016                        if {[info exists done($dd)]} {
11017                            foreach b $arcout($dd) {
11018                                if {[info exists arcend($b)]} {
11019                                    lappend tomark $arcend($b)
11020                                }
11021                            }
11022                            if {[info exists tagloc($dd)]} {
11023                                unset tagloc($dd)
11024                            }
11025                        } elseif {[info exists queued($dd)]} {
11026                            incr nc -1
11027                        }
11028                        set hastaggeddescendent($dd) 1
11029                    }
11030                }
11031            }
11032            if {![info exists queued($d)]} {
11033                lappend todo $d
11034                set queued($d) 1
11035                if {![info exists hastaggeddescendent($d)]} {
11036                    incr nc
11037                }
11038            }
11039        }
11040    }
11041    set t2 [clock clicks -milliseconds]
11042    set loopix $i
11043    set tags {}
11044    foreach id [array names tagloc] {
11045        if {![info exists hastaggeddescendent($id)]} {
11046            foreach t $tagloc($id) {
11047                if {[lsearch -exact $tags $t] < 0} {
11048                    lappend tags $t
11049                }
11050            }
11051        }
11052    }
11053
11054    # remove tags that are ancestors of other tags
11055    for {set i 0} {$i < [llength $tags]} {incr i} {
11056        set a [lindex $tags $i]
11057        for {set j 0} {$j < $i} {incr j} {
11058            set b [lindex $tags $j]
11059            set r [anc_or_desc $a $b]
11060            if {$r == -1} {
11061                set tags [lreplace $tags $j $j]
11062                incr j -1
11063                incr i -1
11064            } elseif {$r == 1} {
11065                set tags [lreplace $tags $i $i]
11066                incr i -1
11067                break
11068            }
11069        }
11070    }
11071
11072    if {[array names growing] ne {}} {
11073        # graph isn't finished, need to check if any tag could get
11074        # eclipsed by another tag coming later.  Simply ignore any
11075        # tags that could later get eclipsed.
11076        set ctags {}
11077        foreach t $tags {
11078            if {[is_certain $origid $t]} {
11079                lappend ctags $t
11080            }
11081        }
11082        if {$tags eq $ctags} {
11083            set cached_atags($origid) $tags
11084        } else {
11085            set tags $ctags
11086        }
11087    } else {
11088        set cached_atags($origid) $tags
11089    }
11090    set t3 [clock clicks -milliseconds]
11091    if {0 && $t3 - $t1 >= 100} {
11092        puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
11093            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
11094    }
11095    return $tags
11096}
11097
11098# Return the list of IDs that have heads that are descendents of id,
11099# including id itself if it has a head.
11100proc descheads {id} {
11101    global arcnos arcstart arcids archeads idheads cached_dheads
11102    global allparents arcout
11103
11104    if {![info exists allparents($id)]} {
11105        return {}
11106    }
11107    set aret {}
11108    if {![info exists arcout($id)]} {
11109        # part-way along an arc; check it first
11110        set a [lindex $arcnos($id) 0]
11111        if {$archeads($a) ne {}} {
11112            validate_archeads $a
11113            set i [lsearch -exact $arcids($a) $id]
11114            foreach t $archeads($a) {
11115                set j [lsearch -exact $arcids($a) $t]
11116                if {$j > $i} break
11117                lappend aret $t
11118            }
11119        }
11120        set id $arcstart($a)
11121    }
11122    set origid $id
11123    set todo [list $id]
11124    set seen($id) 1
11125    set ret {}
11126    for {set i 0} {$i < [llength $todo]} {incr i} {
11127        set id [lindex $todo $i]
11128        if {[info exists cached_dheads($id)]} {
11129            set ret [concat $ret $cached_dheads($id)]
11130        } else {
11131            if {[info exists idheads($id)]} {
11132                lappend ret $id
11133            }
11134            foreach a $arcnos($id) {
11135                if {$archeads($a) ne {}} {
11136                    validate_archeads $a
11137                    if {$archeads($a) ne {}} {
11138                        set ret [concat $ret $archeads($a)]
11139                    }
11140                }
11141                set d $arcstart($a)
11142                if {![info exists seen($d)]} {
11143                    lappend todo $d
11144                    set seen($d) 1
11145                }
11146            }
11147        }
11148    }
11149    set ret [lsort -unique $ret]
11150    set cached_dheads($origid) $ret
11151    return [concat $ret $aret]
11152}
11153
11154proc addedtag {id} {
11155    global arcnos arcout cached_dtags cached_atags
11156
11157    if {![info exists arcnos($id)]} return
11158    if {![info exists arcout($id)]} {
11159        recalcarc [lindex $arcnos($id) 0]
11160    }
11161    unset -nocomplain cached_dtags
11162    unset -nocomplain cached_atags
11163}
11164
11165proc addedhead {hid head} {
11166    global arcnos arcout cached_dheads
11167
11168    if {![info exists arcnos($hid)]} return
11169    if {![info exists arcout($hid)]} {
11170        recalcarc [lindex $arcnos($hid) 0]
11171    }
11172    unset -nocomplain cached_dheads
11173}
11174
11175proc removedhead {hid head} {
11176    global cached_dheads
11177
11178    unset -nocomplain cached_dheads
11179}
11180
11181proc movedhead {hid head} {
11182    global arcnos arcout cached_dheads
11183
11184    if {![info exists arcnos($hid)]} return
11185    if {![info exists arcout($hid)]} {
11186        recalcarc [lindex $arcnos($hid) 0]
11187    }
11188    unset -nocomplain cached_dheads
11189}
11190
11191proc changedrefs {} {
11192    global cached_dheads cached_dtags cached_atags cached_tagcontent
11193    global arctags archeads arcnos arcout idheads idtags
11194
11195    foreach id [concat [array names idheads] [array names idtags]] {
11196        if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
11197            set a [lindex $arcnos($id) 0]
11198            if {![info exists donearc($a)]} {
11199                recalcarc $a
11200                set donearc($a) 1
11201            }
11202        }
11203    }
11204    unset -nocomplain cached_tagcontent
11205    unset -nocomplain cached_dtags
11206    unset -nocomplain cached_atags
11207    unset -nocomplain cached_dheads
11208}
11209
11210proc rereadrefs {} {
11211    global idtags idheads idotherrefs mainheadid
11212
11213    set refids [concat [array names idtags] \
11214                    [array names idheads] [array names idotherrefs]]
11215    foreach id $refids {
11216        if {![info exists ref($id)]} {
11217            set ref($id) [listrefs $id]
11218        }
11219    }
11220    set oldmainhead $mainheadid
11221    readrefs
11222    changedrefs
11223    set refids [lsort -unique [concat $refids [array names idtags] \
11224                        [array names idheads] [array names idotherrefs]]]
11225    foreach id $refids {
11226        set v [listrefs $id]
11227        if {![info exists ref($id)] || $ref($id) != $v} {
11228            redrawtags $id
11229        }
11230    }
11231    if {$oldmainhead ne $mainheadid} {
11232        redrawtags $oldmainhead
11233        redrawtags $mainheadid
11234    }
11235    run refill_reflist
11236}
11237
11238proc listrefs {id} {
11239    global idtags idheads idotherrefs
11240
11241    set x {}
11242    if {[info exists idtags($id)]} {
11243        set x $idtags($id)
11244    }
11245    set y {}
11246    if {[info exists idheads($id)]} {
11247        set y $idheads($id)
11248    }
11249    set z {}
11250    if {[info exists idotherrefs($id)]} {
11251        set z $idotherrefs($id)
11252    }
11253    return [list $x $y $z]
11254}
11255
11256proc add_tag_ctext {tag} {
11257    global ctext cached_tagcontent tagids
11258
11259    if {![info exists cached_tagcontent($tag)]} {
11260        catch {
11261            set cached_tagcontent($tag) [exec git cat-file -p $tag]
11262        }
11263    }
11264    $ctext insert end "[mc "Tag"]: $tag\n" bold
11265    if {[info exists cached_tagcontent($tag)]} {
11266        set text $cached_tagcontent($tag)
11267    } else {
11268        set text "[mc "Id"]:  $tagids($tag)"
11269    }
11270    appendwithlinks $text {}
11271}
11272
11273proc showtag {tag isnew} {
11274    global ctext cached_tagcontent tagids linknum tagobjid
11275
11276    if {$isnew} {
11277        addtohistory [list showtag $tag 0] savectextpos
11278    }
11279    $ctext conf -state normal
11280    clear_ctext
11281    settabs 0
11282    set linknum 0
11283    add_tag_ctext $tag
11284    maybe_scroll_ctext 1
11285    $ctext conf -state disabled
11286    init_flist {}
11287}
11288
11289proc showtags {id isnew} {
11290    global idtags ctext linknum
11291
11292    if {$isnew} {
11293        addtohistory [list showtags $id 0] savectextpos
11294    }
11295    $ctext conf -state normal
11296    clear_ctext
11297    settabs 0
11298    set linknum 0
11299    set sep {}
11300    foreach tag $idtags($id) {
11301        $ctext insert end $sep
11302        add_tag_ctext $tag
11303        set sep "\n\n"
11304    }
11305    maybe_scroll_ctext 1
11306    $ctext conf -state disabled
11307    init_flist {}
11308}
11309
11310proc doquit {} {
11311    global stopped
11312    global gitktmpdir
11313
11314    set stopped 100
11315    savestuff .
11316    destroy .
11317
11318    if {[info exists gitktmpdir]} {
11319        catch {file delete -force $gitktmpdir}
11320    }
11321}
11322
11323proc mkfontdisp {font top which} {
11324    global fontattr fontpref $font NS use_ttk
11325
11326    set fontpref($font) [set $font]
11327    ${NS}::button $top.${font}but -text $which \
11328        -command [list choosefont $font $which]
11329    ${NS}::label $top.$font -relief flat -font $font \
11330        -text $fontattr($font,family) -justify left
11331    grid x $top.${font}but $top.$font -sticky w
11332}
11333
11334proc choosefont {font which} {
11335    global fontparam fontlist fonttop fontattr
11336    global prefstop NS
11337
11338    set fontparam(which) $which
11339    set fontparam(font) $font
11340    set fontparam(family) [font actual $font -family]
11341    set fontparam(size) $fontattr($font,size)
11342    set fontparam(weight) $fontattr($font,weight)
11343    set fontparam(slant) $fontattr($font,slant)
11344    set top .gitkfont
11345    set fonttop $top
11346    if {![winfo exists $top]} {
11347        font create sample
11348        eval font config sample [font actual $font]
11349        ttk_toplevel $top
11350        make_transient $top $prefstop
11351        wm title $top [mc "Gitk font chooser"]
11352        ${NS}::label $top.l -textvariable fontparam(which)
11353        pack $top.l -side top
11354        set fontlist [lsort [font families]]
11355        ${NS}::frame $top.f
11356        listbox $top.f.fam -listvariable fontlist \
11357            -yscrollcommand [list $top.f.sb set]
11358        bind $top.f.fam <<ListboxSelect>> selfontfam
11359        ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
11360        pack $top.f.sb -side right -fill y
11361        pack $top.f.fam -side left -fill both -expand 1
11362        pack $top.f -side top -fill both -expand 1
11363        ${NS}::frame $top.g
11364        spinbox $top.g.size -from 4 -to 40 -width 4 \
11365            -textvariable fontparam(size) \
11366            -validatecommand {string is integer -strict %s}
11367        checkbutton $top.g.bold -padx 5 \
11368            -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
11369            -variable fontparam(weight) -onvalue bold -offvalue normal
11370        checkbutton $top.g.ital -padx 5 \
11371            -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
11372            -variable fontparam(slant) -onvalue italic -offvalue roman
11373        pack $top.g.size $top.g.bold $top.g.ital -side left
11374        pack $top.g -side top
11375        canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
11376            -background white
11377        $top.c create text 100 25 -anchor center -text $which -font sample \
11378            -fill black -tags text
11379        bind $top.c <Configure> [list centertext $top.c]
11380        pack $top.c -side top -fill x
11381        ${NS}::frame $top.buts
11382        ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
11383        ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
11384        bind $top <Key-Return> fontok
11385        bind $top <Key-Escape> fontcan
11386        grid $top.buts.ok $top.buts.can
11387        grid columnconfigure $top.buts 0 -weight 1 -uniform a
11388        grid columnconfigure $top.buts 1 -weight 1 -uniform a
11389        pack $top.buts -side bottom -fill x
11390        trace add variable fontparam write chg_fontparam
11391    } else {
11392        raise $top
11393        $top.c itemconf text -text $which
11394    }
11395    set i [lsearch -exact $fontlist $fontparam(family)]
11396    if {$i >= 0} {
11397        $top.f.fam selection set $i
11398        $top.f.fam see $i
11399    }
11400}
11401
11402proc centertext {w} {
11403    $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
11404}
11405
11406proc fontok {} {
11407    global fontparam fontpref prefstop
11408
11409    set f $fontparam(font)
11410    set fontpref($f) [list $fontparam(family) $fontparam(size)]
11411    if {$fontparam(weight) eq "bold"} {
11412        lappend fontpref($f) "bold"
11413    }
11414    if {$fontparam(slant) eq "italic"} {
11415        lappend fontpref($f) "italic"
11416    }
11417    set w $prefstop.notebook.fonts.$f
11418    $w conf -text $fontparam(family) -font $fontpref($f)
11419
11420    fontcan
11421}
11422
11423proc fontcan {} {
11424    global fonttop fontparam
11425
11426    if {[info exists fonttop]} {
11427        catch {destroy $fonttop}
11428        catch {font delete sample}
11429        unset fonttop
11430        unset fontparam
11431    }
11432}
11433
11434if {[package vsatisfies [package provide Tk] 8.6]} {
11435    # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
11436    # function to make use of it.
11437    proc choosefont {font which} {
11438        tk fontchooser configure -title $which -font $font \
11439            -command [list on_choosefont $font $which]
11440        tk fontchooser show
11441    }
11442    proc on_choosefont {font which newfont} {
11443        global fontparam
11444        puts stderr "$font $newfont"
11445        array set f [font actual $newfont]
11446        set fontparam(which) $which
11447        set fontparam(font) $font
11448        set fontparam(family) $f(-family)
11449        set fontparam(size) $f(-size)
11450        set fontparam(weight) $f(-weight)
11451        set fontparam(slant) $f(-slant)
11452        fontok
11453    }
11454}
11455
11456proc selfontfam {} {
11457    global fonttop fontparam
11458
11459    set i [$fonttop.f.fam curselection]
11460    if {$i ne {}} {
11461        set fontparam(family) [$fonttop.f.fam get $i]
11462    }
11463}
11464
11465proc chg_fontparam {v sub op} {
11466    global fontparam
11467
11468    font config sample -$sub $fontparam($sub)
11469}
11470
11471# Create a property sheet tab page
11472proc create_prefs_page {w} {
11473    global NS
11474    set parent [join [lrange [split $w .] 0 end-1] .]
11475    if {[winfo class $parent] eq "TNotebook"} {
11476        ${NS}::frame $w
11477    } else {
11478        ${NS}::labelframe $w
11479    }
11480}
11481
11482proc prefspage_general {notebook} {
11483    global NS maxwidth maxgraphpct showneartags showlocalchanges
11484    global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11485    global hideremotes want_ttk have_ttk maxrefs
11486
11487    set page [create_prefs_page $notebook.general]
11488
11489    ${NS}::label $page.ldisp -text [mc "Commit list display options"]
11490    grid $page.ldisp - -sticky w -pady 10
11491    ${NS}::label $page.spacer -text " "
11492    ${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
11493    spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
11494    grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w
11495                                         #xgettext:no-tcl-format
11496    ${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
11497    spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
11498    grid x $page.maxpctl $page.maxpct -sticky w
11499    ${NS}::checkbutton $page.showlocal -text [mc "Show local changes"] \
11500        -variable showlocalchanges
11501    grid x $page.showlocal -sticky w
11502    ${NS}::checkbutton $page.autoselect -text [mc "Auto-select SHA1 (length)"] \
11503        -variable autoselect
11504    spinbox $page.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
11505    grid x $page.autoselect $page.autosellen -sticky w
11506    ${NS}::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \
11507        -variable hideremotes
11508    grid x $page.hideremotes -sticky w
11509
11510    ${NS}::label $page.ddisp -text [mc "Diff display options"]
11511    grid $page.ddisp - -sticky w -pady 10
11512    ${NS}::label $page.tabstopl -text [mc "Tab spacing"]
11513    spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
11514    grid x $page.tabstopl $page.tabstop -sticky w
11515    ${NS}::checkbutton $page.ntag -text [mc "Display nearby tags/heads"] \
11516        -variable showneartags
11517    grid x $page.ntag -sticky w
11518    ${NS}::label $page.maxrefsl -text [mc "Maximum # tags/heads to show"]
11519    spinbox $page.maxrefs -from 1 -to 1000 -width 4 -textvariable maxrefs
11520    grid x $page.maxrefsl $page.maxrefs -sticky w
11521    ${NS}::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \
11522        -variable limitdiffs
11523    grid x $page.ldiff -sticky w
11524    ${NS}::checkbutton $page.lattr -text [mc "Support per-file encodings"] \
11525        -variable perfile_attrs
11526    grid x $page.lattr -sticky w
11527
11528    ${NS}::entry $page.extdifft -textvariable extdifftool
11529    ${NS}::frame $page.extdifff
11530    ${NS}::label $page.extdifff.l -text [mc "External diff tool" ]
11531    ${NS}::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff
11532    pack $page.extdifff.l $page.extdifff.b -side left
11533    pack configure $page.extdifff.l -padx 10
11534    grid x $page.extdifff $page.extdifft -sticky ew
11535
11536    ${NS}::label $page.lgen -text [mc "General options"]
11537    grid $page.lgen - -sticky w -pady 10
11538    ${NS}::checkbutton $page.want_ttk -variable want_ttk \
11539        -text [mc "Use themed widgets"]
11540    if {$have_ttk} {
11541        ${NS}::label $page.ttk_note -text [mc "(change requires restart)"]
11542    } else {
11543        ${NS}::label $page.ttk_note -text [mc "(currently unavailable)"]
11544    }
11545    grid x $page.want_ttk $page.ttk_note -sticky w
11546    return $page
11547}
11548
11549proc prefspage_colors {notebook} {
11550    global NS uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11551
11552    set page [create_prefs_page $notebook.colors]
11553
11554    ${NS}::label $page.cdisp -text [mc "Colors: press to choose"]
11555    grid $page.cdisp - -sticky w -pady 10
11556    label $page.ui -padx 40 -relief sunk -background $uicolor
11557    ${NS}::button $page.uibut -text [mc "Interface"] \
11558       -command [list choosecolor uicolor {} $page.ui [mc "interface"] setui]
11559    grid x $page.uibut $page.ui -sticky w
11560    label $page.bg -padx 40 -relief sunk -background $bgcolor
11561    ${NS}::button $page.bgbut -text [mc "Background"] \
11562        -command [list choosecolor bgcolor {} $page.bg [mc "background"] setbg]
11563    grid x $page.bgbut $page.bg -sticky w
11564    label $page.fg -padx 40 -relief sunk -background $fgcolor
11565    ${NS}::button $page.fgbut -text [mc "Foreground"] \
11566        -command [list choosecolor fgcolor {} $page.fg [mc "foreground"] setfg]
11567    grid x $page.fgbut $page.fg -sticky w
11568    label $page.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
11569    ${NS}::button $page.diffoldbut -text [mc "Diff: old lines"] \
11570        -command [list choosecolor diffcolors 0 $page.diffold [mc "diff old lines"] \
11571                      [list $ctext tag conf d0 -foreground]]
11572    grid x $page.diffoldbut $page.diffold -sticky w
11573    label $page.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
11574    ${NS}::button $page.diffnewbut -text [mc "Diff: new lines"] \
11575        -command [list choosecolor diffcolors 1 $page.diffnew [mc "diff new lines"] \
11576                      [list $ctext tag conf dresult -foreground]]
11577    grid x $page.diffnewbut $page.diffnew -sticky w
11578    label $page.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
11579    ${NS}::button $page.hunksepbut -text [mc "Diff: hunk header"] \
11580        -command [list choosecolor diffcolors 2 $page.hunksep \
11581                      [mc "diff hunk header"] \
11582                      [list $ctext tag conf hunksep -foreground]]
11583    grid x $page.hunksepbut $page.hunksep -sticky w
11584    label $page.markbgsep -padx 40 -relief sunk -background $markbgcolor
11585    ${NS}::button $page.markbgbut -text [mc "Marked line bg"] \
11586        -command [list choosecolor markbgcolor {} $page.markbgsep \
11587                      [mc "marked line background"] \
11588                      [list $ctext tag conf omark -background]]
11589    grid x $page.markbgbut $page.markbgsep -sticky w
11590    label $page.selbgsep -padx 40 -relief sunk -background $selectbgcolor
11591    ${NS}::button $page.selbgbut -text [mc "Select bg"] \
11592        -command [list choosecolor selectbgcolor {} $page.selbgsep [mc "background"] setselbg]
11593    grid x $page.selbgbut $page.selbgsep -sticky w
11594    return $page
11595}
11596
11597proc prefspage_fonts {notebook} {
11598    global NS
11599    set page [create_prefs_page $notebook.fonts]
11600    ${NS}::label $page.cfont -text [mc "Fonts: press to choose"]
11601    grid $page.cfont - -sticky w -pady 10
11602    mkfontdisp mainfont $page [mc "Main font"]
11603    mkfontdisp textfont $page [mc "Diff display font"]
11604    mkfontdisp uifont $page [mc "User interface font"]
11605    return $page
11606}
11607
11608proc doprefs {} {
11609    global maxwidth maxgraphpct use_ttk NS
11610    global oldprefs prefstop showneartags showlocalchanges
11611    global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11612    global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11613    global hideremotes want_ttk have_ttk
11614
11615    set top .gitkprefs
11616    set prefstop $top
11617    if {[winfo exists $top]} {
11618        raise $top
11619        return
11620    }
11621    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11622                   limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11623        set oldprefs($v) [set $v]
11624    }
11625    ttk_toplevel $top
11626    wm title $top [mc "Gitk preferences"]
11627    make_transient $top .
11628
11629    if {[set use_notebook [expr {$use_ttk && [info command ::ttk::notebook] ne ""}]]} {
11630        set notebook [ttk::notebook $top.notebook]
11631    } else {
11632        set notebook [${NS}::frame $top.notebook -borderwidth 0 -relief flat]
11633    }
11634
11635    lappend pages [prefspage_general $notebook] [mc "General"]
11636    lappend pages [prefspage_colors $notebook] [mc "Colors"]
11637    lappend pages [prefspage_fonts $notebook] [mc "Fonts"]
11638    set col 0
11639    foreach {page title} $pages {
11640        if {$use_notebook} {
11641            $notebook add $page -text $title
11642        } else {
11643            set btn [${NS}::button $notebook.b_[string map {. X} $page] \
11644                         -text $title -command [list raise $page]]
11645            $page configure -text $title
11646            grid $btn -row 0 -column [incr col] -sticky w
11647            grid $page -row 1 -column 0 -sticky news -columnspan 100
11648        }
11649    }
11650
11651    if {!$use_notebook} {
11652        grid columnconfigure $notebook 0 -weight 1
11653        grid rowconfigure $notebook 1 -weight 1
11654        raise [lindex $pages 0]
11655    }
11656
11657    grid $notebook -sticky news -padx 2 -pady 2
11658    grid rowconfigure $top 0 -weight 1
11659    grid columnconfigure $top 0 -weight 1
11660
11661    ${NS}::frame $top.buts
11662    ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
11663    ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
11664    bind $top <Key-Return> prefsok
11665    bind $top <Key-Escape> prefscan
11666    grid $top.buts.ok $top.buts.can
11667    grid columnconfigure $top.buts 0 -weight 1 -uniform a
11668    grid columnconfigure $top.buts 1 -weight 1 -uniform a
11669    grid $top.buts - - -pady 10 -sticky ew
11670    grid columnconfigure $top 2 -weight 1
11671    bind $top <Visibility> [list focus $top.buts.ok]
11672}
11673
11674proc choose_extdiff {} {
11675    global extdifftool
11676
11677    set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
11678    if {$prog ne {}} {
11679        set extdifftool $prog
11680    }
11681}
11682
11683proc choosecolor {v vi w x cmd} {
11684    global $v
11685
11686    set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
11687               -title [mc "Gitk: choose color for %s" $x]]
11688    if {$c eq {}} return
11689    $w conf -background $c
11690    lset $v $vi $c
11691    eval $cmd $c
11692}
11693
11694proc setselbg {c} {
11695    global bglist cflist
11696    foreach w $bglist {
11697        if {[winfo exists $w]} {
11698            $w configure -selectbackground $c
11699        }
11700    }
11701    $cflist tag configure highlight \
11702        -background [$cflist cget -selectbackground]
11703    allcanvs itemconf secsel -fill $c
11704}
11705
11706# This sets the background color and the color scheme for the whole UI.
11707# For some reason, tk_setPalette chooses a nasty dark red for selectColor
11708# if we don't specify one ourselves, which makes the checkbuttons and
11709# radiobuttons look bad.  This chooses white for selectColor if the
11710# background color is light, or black if it is dark.
11711proc setui {c} {
11712    if {[tk windowingsystem] eq "win32"} { return }
11713    set bg [winfo rgb . $c]
11714    set selc black
11715    if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
11716        set selc white
11717    }
11718    tk_setPalette background $c selectColor $selc
11719}
11720
11721proc setbg {c} {
11722    global bglist
11723
11724    foreach w $bglist {
11725        if {[winfo exists $w]} {
11726            $w conf -background $c
11727        }
11728    }
11729}
11730
11731proc setfg {c} {
11732    global fglist canv
11733
11734    foreach w $fglist {
11735        if {[winfo exists $w]} {
11736            $w conf -foreground $c
11737        }
11738    }
11739    allcanvs itemconf text -fill $c
11740    $canv itemconf circle -outline $c
11741    $canv itemconf markid -outline $c
11742}
11743
11744proc prefscan {} {
11745    global oldprefs prefstop
11746
11747    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11748                   limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11749        global $v
11750        set $v $oldprefs($v)
11751    }
11752    catch {destroy $prefstop}
11753    unset prefstop
11754    fontcan
11755}
11756
11757proc prefsok {} {
11758    global maxwidth maxgraphpct
11759    global oldprefs prefstop showneartags showlocalchanges
11760    global fontpref mainfont textfont uifont
11761    global limitdiffs treediffs perfile_attrs
11762    global hideremotes
11763
11764    catch {destroy $prefstop}
11765    unset prefstop
11766    fontcan
11767    set fontchanged 0
11768    if {$mainfont ne $fontpref(mainfont)} {
11769        set mainfont $fontpref(mainfont)
11770        parsefont mainfont $mainfont
11771        eval font configure mainfont [fontflags mainfont]
11772        eval font configure mainfontbold [fontflags mainfont 1]
11773        setcoords
11774        set fontchanged 1
11775    }
11776    if {$textfont ne $fontpref(textfont)} {
11777        set textfont $fontpref(textfont)
11778        parsefont textfont $textfont
11779        eval font configure textfont [fontflags textfont]
11780        eval font configure textfontbold [fontflags textfont 1]
11781    }
11782    if {$uifont ne $fontpref(uifont)} {
11783        set uifont $fontpref(uifont)
11784        parsefont uifont $uifont
11785        eval font configure uifont [fontflags uifont]
11786    }
11787    settabs
11788    if {$showlocalchanges != $oldprefs(showlocalchanges)} {
11789        if {$showlocalchanges} {
11790            doshowlocalchanges
11791        } else {
11792            dohidelocalchanges
11793        }
11794    }
11795    if {$limitdiffs != $oldprefs(limitdiffs) ||
11796        ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11797        # treediffs elements are limited by path;
11798        # won't have encodings cached if perfile_attrs was just turned on
11799        unset -nocomplain treediffs
11800    }
11801    if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
11802        || $maxgraphpct != $oldprefs(maxgraphpct)} {
11803        redisplay
11804    } elseif {$showneartags != $oldprefs(showneartags) ||
11805          $limitdiffs != $oldprefs(limitdiffs)} {
11806        reselectline
11807    }
11808    if {$hideremotes != $oldprefs(hideremotes)} {
11809        rereadrefs
11810    }
11811}
11812
11813proc formatdate {d} {
11814    global datetimeformat
11815    if {$d ne {}} {
11816        # If $datetimeformat includes a timezone, display in the
11817        # timezone of the argument.  Otherwise, display in local time.
11818        if {[string match {*%[zZ]*} $datetimeformat]} {
11819            if {[catch {set d [clock format [lindex $d 0] -timezone [lindex $d 1] -format $datetimeformat]}]} {
11820                # Tcl < 8.5 does not support -timezone.  Emulate it by
11821                # setting TZ (e.g. TZ=<-0430>+04:30).
11822                global env
11823                if {[info exists env(TZ)]} {
11824                    set savedTZ $env(TZ)
11825                }
11826                set zone [lindex $d 1]
11827                set sign [string map {+ - - +} [string index $zone 0]]
11828                set env(TZ) <$zone>$sign[string range $zone 1 2]:[string range $zone 3 4]
11829                set d [clock format [lindex $d 0] -format $datetimeformat]
11830                if {[info exists savedTZ]} {
11831                    set env(TZ) $savedTZ
11832                } else {
11833                    unset env(TZ)
11834                }
11835            }
11836        } else {
11837            set d [clock format [lindex $d 0] -format $datetimeformat]
11838        }
11839    }
11840    return $d
11841}
11842
11843# This list of encoding names and aliases is distilled from
11844# http://www.iana.org/assignments/character-sets.
11845# Not all of them are supported by Tcl.
11846set encoding_aliases {
11847    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11848      ISO646-US US-ASCII us IBM367 cp367 csASCII }
11849    { ISO-10646-UTF-1 csISO10646UTF1 }
11850    { ISO_646.basic:1983 ref csISO646basic1983 }
11851    { INVARIANT csINVARIANT }
11852    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11853    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11854    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11855    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11856    { NATS-DANO iso-ir-9-1 csNATSDANO }
11857    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11858    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11859    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11860    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11861    { ISO-2022-KR csISO2022KR }
11862    { EUC-KR csEUCKR }
11863    { ISO-2022-JP csISO2022JP }
11864    { ISO-2022-JP-2 csISO2022JP2 }
11865    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11866      csISO13JISC6220jp }
11867    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11868    { IT iso-ir-15 ISO646-IT csISO15Italian }
11869    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11870    { ES iso-ir-17 ISO646-ES csISO17Spanish }
11871    { greek7-old iso-ir-18 csISO18Greek7Old }
11872    { latin-greek iso-ir-19 csISO19LatinGreek }
11873    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11874    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11875    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11876    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11877    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11878    { BS_viewdata iso-ir-47 csISO47BSViewdata }
11879    { INIS iso-ir-49 csISO49INIS }
11880    { INIS-8 iso-ir-50 csISO50INIS8 }
11881    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11882    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11883    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11884    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11885    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11886    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11887      csISO60Norwegian1 }
11888    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11889    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11890    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11891    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11892    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11893    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11894    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11895    { greek7 iso-ir-88 csISO88Greek7 }
11896    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11897    { iso-ir-90 csISO90 }
11898    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11899    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11900      csISO92JISC62991984b }
11901    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11902    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11903    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11904      csISO95JIS62291984handadd }
11905    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11906    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11907    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11908    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11909      CP819 csISOLatin1 }
11910    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11911    { T.61-7bit iso-ir-102 csISO102T617bit }
11912    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11913    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
11914    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
11915    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
11916    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
11917    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
11918    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
11919    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
11920      arabic csISOLatinArabic }
11921    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
11922    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
11923    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
11924      greek greek8 csISOLatinGreek }
11925    { T.101-G2 iso-ir-128 csISO128T101G2 }
11926    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
11927      csISOLatinHebrew }
11928    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
11929    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
11930    { CSN_369103 iso-ir-139 csISO139CSN369103 }
11931    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
11932    { ISO_6937-2-add iso-ir-142 csISOTextComm }
11933    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
11934    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
11935      csISOLatinCyrillic }
11936    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
11937    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
11938    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
11939    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
11940    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
11941    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
11942    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
11943    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
11944    { ISO_10367-box iso-ir-155 csISO10367Box }
11945    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
11946    { latin-lap lap iso-ir-158 csISO158Lap }
11947    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
11948    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
11949    { us-dk csUSDK }
11950    { dk-us csDKUS }
11951    { JIS_X0201 X0201 csHalfWidthKatakana }
11952    { KSC5636 ISO646-KR csKSC5636 }
11953    { ISO-10646-UCS-2 csUnicode }
11954    { ISO-10646-UCS-4 csUCS4 }
11955    { DEC-MCS dec csDECMCS }
11956    { hp-roman8 roman8 r8 csHPRoman8 }
11957    { macintosh mac csMacintosh }
11958    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
11959      csIBM037 }
11960    { IBM038 EBCDIC-INT cp038 csIBM038 }
11961    { IBM273 CP273 csIBM273 }
11962    { IBM274 EBCDIC-BE CP274 csIBM274 }
11963    { IBM275 EBCDIC-BR cp275 csIBM275 }
11964    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
11965    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
11966    { IBM280 CP280 ebcdic-cp-it csIBM280 }
11967    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
11968    { IBM284 CP284 ebcdic-cp-es csIBM284 }
11969    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
11970    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
11971    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
11972    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
11973    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
11974    { IBM424 cp424 ebcdic-cp-he csIBM424 }
11975    { IBM437 cp437 437 csPC8CodePage437 }
11976    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
11977    { IBM775 cp775 csPC775Baltic }
11978    { IBM850 cp850 850 csPC850Multilingual }
11979    { IBM851 cp851 851 csIBM851 }
11980    { IBM852 cp852 852 csPCp852 }
11981    { IBM855 cp855 855 csIBM855 }
11982    { IBM857 cp857 857 csIBM857 }
11983    { IBM860 cp860 860 csIBM860 }
11984    { IBM861 cp861 861 cp-is csIBM861 }
11985    { IBM862 cp862 862 csPC862LatinHebrew }
11986    { IBM863 cp863 863 csIBM863 }
11987    { IBM864 cp864 csIBM864 }
11988    { IBM865 cp865 865 csIBM865 }
11989    { IBM866 cp866 866 csIBM866 }
11990    { IBM868 CP868 cp-ar csIBM868 }
11991    { IBM869 cp869 869 cp-gr csIBM869 }
11992    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
11993    { IBM871 CP871 ebcdic-cp-is csIBM871 }
11994    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
11995    { IBM891 cp891 csIBM891 }
11996    { IBM903 cp903 csIBM903 }
11997    { IBM904 cp904 904 csIBBM904 }
11998    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
11999    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
12000    { IBM1026 CP1026 csIBM1026 }
12001    { EBCDIC-AT-DE csIBMEBCDICATDE }
12002    { EBCDIC-AT-DE-A csEBCDICATDEA }
12003    { EBCDIC-CA-FR csEBCDICCAFR }
12004    { EBCDIC-DK-NO csEBCDICDKNO }
12005    { EBCDIC-DK-NO-A csEBCDICDKNOA }
12006    { EBCDIC-FI-SE csEBCDICFISE }
12007    { EBCDIC-FI-SE-A csEBCDICFISEA }
12008    { EBCDIC-FR csEBCDICFR }
12009    { EBCDIC-IT csEBCDICIT }
12010    { EBCDIC-PT csEBCDICPT }
12011    { EBCDIC-ES csEBCDICES }
12012    { EBCDIC-ES-A csEBCDICESA }
12013    { EBCDIC-ES-S csEBCDICESS }
12014    { EBCDIC-UK csEBCDICUK }
12015    { EBCDIC-US csEBCDICUS }
12016    { UNKNOWN-8BIT csUnknown8BiT }
12017    { MNEMONIC csMnemonic }
12018    { MNEM csMnem }
12019    { VISCII csVISCII }
12020    { VIQR csVIQR }
12021    { KOI8-R csKOI8R }
12022    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
12023    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
12024    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
12025    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
12026    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
12027    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
12028    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
12029    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
12030    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
12031    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
12032    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
12033    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
12034    { IBM1047 IBM-1047 }
12035    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
12036    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
12037    { UNICODE-1-1 csUnicode11 }
12038    { CESU-8 csCESU-8 }
12039    { BOCU-1 csBOCU-1 }
12040    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
12041    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
12042      l8 }
12043    { ISO-8859-15 ISO_8859-15 Latin-9 }
12044    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
12045    { GBK CP936 MS936 windows-936 }
12046    { JIS_Encoding csJISEncoding }
12047    { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
12048    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
12049      EUC-JP }
12050    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
12051    { ISO-10646-UCS-Basic csUnicodeASCII }
12052    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
12053    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
12054    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
12055    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
12056    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
12057    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
12058    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
12059    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
12060    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
12061    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
12062    { Adobe-Standard-Encoding csAdobeStandardEncoding }
12063    { Ventura-US csVenturaUS }
12064    { Ventura-International csVenturaInternational }
12065    { PC8-Danish-Norwegian csPC8DanishNorwegian }
12066    { PC8-Turkish csPC8Turkish }
12067    { IBM-Symbols csIBMSymbols }
12068    { IBM-Thai csIBMThai }
12069    { HP-Legal csHPLegal }
12070    { HP-Pi-font csHPPiFont }
12071    { HP-Math8 csHPMath8 }
12072    { Adobe-Symbol-Encoding csHPPSMath }
12073    { HP-DeskTop csHPDesktop }
12074    { Ventura-Math csVenturaMath }
12075    { Microsoft-Publishing csMicrosoftPublishing }
12076    { Windows-31J csWindows31J }
12077    { GB2312 csGB2312 }
12078    { Big5 csBig5 }
12079}
12080
12081proc tcl_encoding {enc} {
12082    global encoding_aliases tcl_encoding_cache
12083    if {[info exists tcl_encoding_cache($enc)]} {
12084        return $tcl_encoding_cache($enc)
12085    }
12086    set names [encoding names]
12087    set lcnames [string tolower $names]
12088    set enc [string tolower $enc]
12089    set i [lsearch -exact $lcnames $enc]
12090    if {$i < 0} {
12091        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
12092        if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
12093            set i [lsearch -exact $lcnames $encx]
12094        }
12095    }
12096    if {$i < 0} {
12097        foreach l $encoding_aliases {
12098            set ll [string tolower $l]
12099            if {[lsearch -exact $ll $enc] < 0} continue
12100            # look through the aliases for one that tcl knows about
12101            foreach e $ll {
12102                set i [lsearch -exact $lcnames $e]
12103                if {$i < 0} {
12104                    if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
12105                        set i [lsearch -exact $lcnames $ex]
12106                    }
12107                }
12108                if {$i >= 0} break
12109            }
12110            break
12111        }
12112    }
12113    set tclenc {}
12114    if {$i >= 0} {
12115        set tclenc [lindex $names $i]
12116    }
12117    set tcl_encoding_cache($enc) $tclenc
12118    return $tclenc
12119}
12120
12121proc gitattr {path attr default} {
12122    global path_attr_cache
12123    if {[info exists path_attr_cache($attr,$path)]} {
12124        set r $path_attr_cache($attr,$path)
12125    } else {
12126        set r "unspecified"
12127        if {![catch {set line [exec git check-attr $attr -- $path]}]} {
12128            regexp "(.*): $attr: (.*)" $line m f r
12129        }
12130        set path_attr_cache($attr,$path) $r
12131    }
12132    if {$r eq "unspecified"} {
12133        return $default
12134    }
12135    return $r
12136}
12137
12138proc cache_gitattr {attr pathlist} {
12139    global path_attr_cache
12140    set newlist {}
12141    foreach path $pathlist {
12142        if {![info exists path_attr_cache($attr,$path)]} {
12143            lappend newlist $path
12144        }
12145    }
12146    set lim 1000
12147    if {[tk windowingsystem] == "win32"} {
12148        # windows has a 32k limit on the arguments to a command...
12149        set lim 30
12150    }
12151    while {$newlist ne {}} {
12152        set head [lrange $newlist 0 [expr {$lim - 1}]]
12153        set newlist [lrange $newlist $lim end]
12154        if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
12155            foreach row [split $rlist "\n"] {
12156                if {[regexp "(.*): $attr: (.*)" $row m path value]} {
12157                    if {[string index $path 0] eq "\""} {
12158                        set path [encoding convertfrom [lindex $path 0]]
12159                    }
12160                    set path_attr_cache($attr,$path) $value
12161                }
12162            }
12163        }
12164    }
12165}
12166
12167proc get_path_encoding {path} {
12168    global gui_encoding perfile_attrs
12169    set tcl_enc $gui_encoding
12170    if {$path ne {} && $perfile_attrs} {
12171        set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
12172        if {$enc2 ne {}} {
12173            set tcl_enc $enc2
12174        }
12175    }
12176    return $tcl_enc
12177}
12178
12179## For msgcat loading, first locate the installation location.
12180if { [info exists ::env(GITK_MSGSDIR)] } {
12181    ## Msgsdir was manually set in the environment.
12182    set gitk_msgsdir $::env(GITK_MSGSDIR)
12183} else {
12184    ## Let's guess the prefix from argv0.
12185    set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
12186    set gitk_libdir [file join $gitk_prefix share gitk lib]
12187    set gitk_msgsdir [file join $gitk_libdir msgs]
12188    unset gitk_prefix
12189}
12190
12191## Internationalization (i18n) through msgcat and gettext. See
12192## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
12193package require msgcat
12194namespace import ::msgcat::mc
12195## And eventually load the actual message catalog
12196::msgcat::mcload $gitk_msgsdir
12197
12198# First check that Tcl/Tk is recent enough
12199if {[catch {package require Tk 8.4} err]} {
12200    show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
12201                         Gitk requires at least Tcl/Tk 8.4."]
12202    exit 1
12203}
12204
12205# on OSX bring the current Wish process window to front
12206if {[tk windowingsystem] eq "aqua"} {
12207    exec osascript -e [format {
12208        tell application "System Events"
12209            set frontmost of processes whose unix id is %d to true
12210        end tell
12211    } [pid] ]
12212}
12213
12214# Unset GIT_TRACE var if set
12215if { [info exists ::env(GIT_TRACE)] } {
12216    unset ::env(GIT_TRACE)
12217}
12218
12219# defaults...
12220set wrcomcmd "git diff-tree --stdin -p --pretty=email"
12221
12222set gitencoding {}
12223catch {
12224    set gitencoding [exec git config --get i18n.commitencoding]
12225}
12226catch {
12227    set gitencoding [exec git config --get i18n.logoutputencoding]
12228}
12229if {$gitencoding == ""} {
12230    set gitencoding "utf-8"
12231}
12232set tclencoding [tcl_encoding $gitencoding]
12233if {$tclencoding == {}} {
12234    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
12235}
12236
12237set gui_encoding [encoding system]
12238catch {
12239    set enc [exec git config --get gui.encoding]
12240    if {$enc ne {}} {
12241        set tclenc [tcl_encoding $enc]
12242        if {$tclenc ne {}} {
12243            set gui_encoding $tclenc
12244        } else {
12245            puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
12246        }
12247    }
12248}
12249
12250set log_showroot true
12251catch {
12252    set log_showroot [exec git config --bool --get log.showroot]
12253}
12254
12255if {[tk windowingsystem] eq "aqua"} {
12256    set mainfont {{Lucida Grande} 9}
12257    set textfont {Monaco 9}
12258    set uifont {{Lucida Grande} 9 bold}
12259} elseif {![catch {::tk::pkgconfig get fontsystem} xft] && $xft eq "xft"} {
12260    # fontconfig!
12261    set mainfont {sans 9}
12262    set textfont {monospace 9}
12263    set uifont {sans 9 bold}
12264} else {
12265    set mainfont {Helvetica 9}
12266    set textfont {Courier 9}
12267    set uifont {Helvetica 9 bold}
12268}
12269set tabstop 8
12270set findmergefiles 0
12271set maxgraphpct 50
12272set maxwidth 16
12273set revlistorder 0
12274set fastdate 0
12275set uparrowlen 5
12276set downarrowlen 5
12277set mingaplen 100
12278set cmitmode "patch"
12279set wrapcomment "none"
12280set showneartags 1
12281set hideremotes 0
12282set maxrefs 20
12283set visiblerefs {"master"}
12284set maxlinelen 200
12285set showlocalchanges 1
12286set limitdiffs 1
12287set datetimeformat "%Y-%m-%d %H:%M:%S"
12288set autoselect 1
12289set autosellen 40
12290set perfile_attrs 0
12291set want_ttk 1
12292
12293if {[tk windowingsystem] eq "aqua"} {
12294    set extdifftool "opendiff"
12295} else {
12296    set extdifftool "meld"
12297}
12298
12299set colors {"#00ff00" red blue magenta darkgrey brown orange}
12300if {[tk windowingsystem] eq "win32"} {
12301    set uicolor SystemButtonFace
12302    set uifgcolor SystemButtonText
12303    set uifgdisabledcolor SystemDisabledText
12304    set bgcolor SystemWindow
12305    set fgcolor SystemWindowText
12306    set selectbgcolor SystemHighlight
12307} else {
12308    set uicolor grey85
12309    set uifgcolor black
12310    set uifgdisabledcolor "#999"
12311    set bgcolor white
12312    set fgcolor black
12313    set selectbgcolor gray85
12314}
12315set diffcolors {red "#00a000" blue}
12316set diffcontext 3
12317set mergecolors {red blue "#00ff00" purple brown "#009090" magenta "#808000" "#009000" "#ff0080" cyan "#b07070" "#70b0f0" "#70f0b0" "#f0b070" "#ff70b0"}
12318set ignorespace 0
12319set worddiff ""
12320set markbgcolor "#e0e0ff"
12321
12322set headbgcolor "#00ff00"
12323set headfgcolor black
12324set headoutlinecolor black
12325set remotebgcolor #ffddaa
12326set tagbgcolor yellow
12327set tagfgcolor black
12328set tagoutlinecolor black
12329set reflinecolor black
12330set filesepbgcolor #aaaaaa
12331set filesepfgcolor black
12332set linehoverbgcolor #ffff80
12333set linehoverfgcolor black
12334set linehoveroutlinecolor black
12335set mainheadcirclecolor yellow
12336set workingfilescirclecolor red
12337set indexcirclecolor "#00ff00"
12338set circlecolors {white blue gray blue blue}
12339set linkfgcolor blue
12340set circleoutlinecolor $fgcolor
12341set foundbgcolor yellow
12342set currentsearchhitbgcolor orange
12343
12344# button for popping up context menus
12345if {[tk windowingsystem] eq "aqua"} {
12346    set ctxbut <Button-2>
12347} else {
12348    set ctxbut <Button-3>
12349}
12350
12351catch {
12352    # follow the XDG base directory specification by default. See
12353    # http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html
12354    if {[info exists env(XDG_CONFIG_HOME)] && $env(XDG_CONFIG_HOME) ne ""} {
12355        # XDG_CONFIG_HOME environment variable is set
12356        set config_file [file join $env(XDG_CONFIG_HOME) git gitk]
12357        set config_file_tmp [file join $env(XDG_CONFIG_HOME) git gitk-tmp]
12358    } else {
12359        # default XDG_CONFIG_HOME
12360        set config_file "~/.config/git/gitk"
12361        set config_file_tmp "~/.config/git/gitk-tmp"
12362    }
12363    if {![file exists $config_file]} {
12364        # for backward compatibility use the old config file if it exists
12365        if {[file exists "~/.gitk"]} {
12366            set config_file "~/.gitk"
12367            set config_file_tmp "~/.gitk-tmp"
12368        } elseif {![file exists [file dirname $config_file]]} {
12369            file mkdir [file dirname $config_file]
12370        }
12371    }
12372    source $config_file
12373}
12374config_check_tmp_exists 50
12375
12376set config_variables {
12377    mainfont textfont uifont tabstop findmergefiles maxgraphpct maxwidth
12378    cmitmode wrapcomment autoselect autosellen showneartags maxrefs visiblerefs
12379    hideremotes showlocalchanges datetimeformat limitdiffs uicolor want_ttk
12380    bgcolor fgcolor uifgcolor uifgdisabledcolor colors diffcolors mergecolors
12381    markbgcolor diffcontext selectbgcolor foundbgcolor currentsearchhitbgcolor
12382    extdifftool perfile_attrs headbgcolor headfgcolor headoutlinecolor
12383    remotebgcolor tagbgcolor tagfgcolor tagoutlinecolor reflinecolor
12384    filesepbgcolor filesepfgcolor linehoverbgcolor linehoverfgcolor
12385    linehoveroutlinecolor mainheadcirclecolor workingfilescirclecolor
12386    indexcirclecolor circlecolors linkfgcolor circleoutlinecolor
12387}
12388foreach var $config_variables {
12389    config_init_trace $var
12390    trace add variable $var write config_variable_change_cb
12391}
12392
12393parsefont mainfont $mainfont
12394eval font create mainfont [fontflags mainfont]
12395eval font create mainfontbold [fontflags mainfont 1]
12396
12397parsefont textfont $textfont
12398eval font create textfont [fontflags textfont]
12399eval font create textfontbold [fontflags textfont 1]
12400
12401parsefont uifont $uifont
12402eval font create uifont [fontflags uifont]
12403
12404setui $uicolor
12405
12406setoptions
12407
12408# check that we can find a .git directory somewhere...
12409if {[catch {set gitdir [exec git rev-parse --git-dir]}]} {
12410    show_error {} . [mc "Cannot find a git repository here."]
12411    exit 1
12412}
12413
12414set selecthead {}
12415set selectheadid {}
12416
12417set revtreeargs {}
12418set cmdline_files {}
12419set i 0
12420set revtreeargscmd {}
12421foreach arg $argv {
12422    switch -glob -- $arg {
12423        "" { }
12424        "--" {
12425            set cmdline_files [lrange $argv [expr {$i + 1}] end]
12426            break
12427        }
12428        "--select-commit=*" {
12429            set selecthead [string range $arg 16 end]
12430        }
12431        "--argscmd=*" {
12432            set revtreeargscmd [string range $arg 10 end]
12433        }
12434        default {
12435            lappend revtreeargs $arg
12436        }
12437    }
12438    incr i
12439}
12440
12441if {$selecthead eq "HEAD"} {
12442    set selecthead {}
12443}
12444
12445if {$i >= [llength $argv] && $revtreeargs ne {}} {
12446    # no -- on command line, but some arguments (other than --argscmd)
12447    if {[catch {
12448        set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
12449        set cmdline_files [split $f "\n"]
12450        set n [llength $cmdline_files]
12451        set revtreeargs [lrange $revtreeargs 0 end-$n]
12452        # Unfortunately git rev-parse doesn't produce an error when
12453        # something is both a revision and a filename.  To be consistent
12454        # with git log and git rev-list, check revtreeargs for filenames.
12455        foreach arg $revtreeargs {
12456            if {[file exists $arg]} {
12457                show_error {} . [mc "Ambiguous argument '%s': both revision\
12458                                 and filename" $arg]
12459                exit 1
12460            }
12461        }
12462    } err]} {
12463        # unfortunately we get both stdout and stderr in $err,
12464        # so look for "fatal:".
12465        set i [string first "fatal:" $err]
12466        if {$i > 0} {
12467            set err [string range $err [expr {$i + 6}] end]
12468        }
12469        show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
12470        exit 1
12471    }
12472}
12473
12474set nullid "0000000000000000000000000000000000000000"
12475set nullid2 "0000000000000000000000000000000000000001"
12476set nullfile "/dev/null"
12477
12478set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
12479if {![info exists have_ttk]} {
12480    set have_ttk [llength [info commands ::ttk::style]]
12481}
12482set use_ttk [expr {$have_ttk && $want_ttk}]
12483set NS [expr {$use_ttk ? "ttk" : ""}]
12484
12485if {$use_ttk} {
12486    setttkstyle
12487}
12488
12489regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
12490
12491set show_notes {}
12492if {[package vcompare $git_version "1.6.6.2"] >= 0} {
12493    set show_notes "--show-notes"
12494}
12495
12496set appname "gitk"
12497
12498set runq {}
12499set history {}
12500set historyindex 0
12501set fh_serial 0
12502set nhl_names {}
12503set highlight_paths {}
12504set findpattern {}
12505set searchdirn -forwards
12506set boldids {}
12507set boldnameids {}
12508set diffelide {0 0}
12509set markingmatches 0
12510set linkentercount 0
12511set need_redisplay 0
12512set nrows_drawn 0
12513set firsttabstop 0
12514
12515set nextviewnum 1
12516set curview 0
12517set selectedview 0
12518set selectedhlview [mc "None"]
12519set highlight_related [mc "None"]
12520set highlight_files {}
12521set viewfiles(0) {}
12522set viewperm(0) 0
12523set viewchanged(0) 0
12524set viewargs(0) {}
12525set viewargscmd(0) {}
12526
12527set selectedline {}
12528set numcommits 0
12529set loginstance 0
12530set cmdlineok 0
12531set stopped 0
12532set stuffsaved 0
12533set patchnum 0
12534set lserial 0
12535set hasworktree [hasworktree]
12536set cdup {}
12537if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} {
12538    set cdup [exec git rev-parse --show-cdup]
12539}
12540set worktree [exec git rev-parse --show-toplevel]
12541setcoords
12542makewindow
12543catch {
12544    image create photo gitlogo      -width 16 -height 16
12545
12546    image create photo gitlogominus -width  4 -height  2
12547    gitlogominus put #C00000 -to 0 0 4 2
12548    gitlogo copy gitlogominus -to  1 5
12549    gitlogo copy gitlogominus -to  6 5
12550    gitlogo copy gitlogominus -to 11 5
12551    image delete gitlogominus
12552
12553    image create photo gitlogoplus  -width  4 -height  4
12554    gitlogoplus  put #008000 -to 1 0 3 4
12555    gitlogoplus  put #008000 -to 0 1 4 3
12556    gitlogo copy gitlogoplus  -to  1 9
12557    gitlogo copy gitlogoplus  -to  6 9
12558    gitlogo copy gitlogoplus  -to 11 9
12559    image delete gitlogoplus
12560
12561    image create photo gitlogo32    -width 32 -height 32
12562    gitlogo32 copy gitlogo -zoom 2 2
12563
12564    wm iconphoto . -default gitlogo gitlogo32
12565}
12566# wait for the window to become visible
12567tkwait visibility .
12568set_window_title
12569update
12570readrefs
12571
12572if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
12573    # create a view for the files/dirs specified on the command line
12574    set curview 1
12575    set selectedview 1
12576    set nextviewnum 2
12577    set viewname(1) [mc "Command line"]
12578    set viewfiles(1) $cmdline_files
12579    set viewargs(1) $revtreeargs
12580    set viewargscmd(1) $revtreeargscmd
12581    set viewperm(1) 0
12582    set viewchanged(1) 0
12583    set vdatemode(1) 0
12584    addviewmenu 1
12585    .bar.view entryconf [mca "&Edit view..."] -state normal
12586    .bar.view entryconf [mca "&Delete view"] -state normal
12587}
12588
12589if {[info exists permviews]} {
12590    foreach v $permviews {
12591        set n $nextviewnum
12592        incr nextviewnum
12593        set viewname($n) [lindex $v 0]
12594        set viewfiles($n) [lindex $v 1]
12595        set viewargs($n) [lindex $v 2]
12596        set viewargscmd($n) [lindex $v 3]
12597        set viewperm($n) 1
12598        set viewchanged($n) 0
12599        addviewmenu $n
12600    }
12601}
12602
12603if {[tk windowingsystem] eq "win32"} {
12604    focus -force .
12605}
12606
12607getcommits {}
12608
12609# Local variables:
12610# mode: tcl
12611# indent-tabs-mode: t
12612# tab-width: 8
12613# End: