gitkon commit gitk: Remove closed file descriptors from $blobdifffd (0748f41)
   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            # Older diff read. Abort it.
8077            catch {close $bdf}
8078            if {$ids != $diffids} {
8079                array unset blobdifffd $ids
8080            }
8081            return 0
8082        }
8083        parseblobdiffline $ids $line
8084    }
8085    $ctext conf -state disabled
8086    blobdiffmaybeseehere [eof $bdf]
8087    if {[eof $bdf]} {
8088        catch {close $bdf}
8089        array unset blobdifffd $ids
8090        return 0
8091    }
8092    return [expr {$nr >= 1000? 2: 1}]
8093}
8094
8095proc parseblobdiffline {ids line} {
8096    global ctext curdiffstart
8097    global diffnexthead diffnextnote difffilestart
8098    global ctext_file_names ctext_file_lines
8099    global diffinhdr treediffs mergemax diffnparents
8100    global diffencoding jump_to_here targetline diffline currdiffsubmod
8101    global worddiff diffseehere
8102
8103    if {![string compare -length 5 "diff " $line]} {
8104        if {![regexp {^diff (--cc|--git) } $line m type]} {
8105            set line [encoding convertfrom $line]
8106            $ctext insert end "$line\n" hunksep
8107            continue
8108        }
8109        # start of a new file
8110        set diffinhdr 1
8111        $ctext insert end "\n"
8112        set curdiffstart [$ctext index "end - 1c"]
8113        lappend ctext_file_names ""
8114        lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8115        $ctext insert end "\n" filesep
8116
8117        if {$type eq "--cc"} {
8118            # start of a new file in a merge diff
8119            set fname [string range $line 10 end]
8120            if {[lsearch -exact $treediffs($ids) $fname] < 0} {
8121                lappend treediffs($ids) $fname
8122                add_flist [list $fname]
8123            }
8124
8125        } else {
8126            set line [string range $line 11 end]
8127            # If the name hasn't changed the length will be odd,
8128            # the middle char will be a space, and the two bits either
8129            # side will be a/name and b/name, or "a/name" and "b/name".
8130            # If the name has changed we'll get "rename from" and
8131            # "rename to" or "copy from" and "copy to" lines following
8132            # this, and we'll use them to get the filenames.
8133            # This complexity is necessary because spaces in the
8134            # filename(s) don't get escaped.
8135            set l [string length $line]
8136            set i [expr {$l / 2}]
8137            if {!(($l & 1) && [string index $line $i] eq " " &&
8138                  [string range $line 2 [expr {$i - 1}]] eq \
8139                      [string range $line [expr {$i + 3}] end])} {
8140                return
8141            }
8142            # unescape if quoted and chop off the a/ from the front
8143            if {[string index $line 0] eq "\""} {
8144                set fname [string range [lindex $line 0] 2 end]
8145            } else {
8146                set fname [string range $line 2 [expr {$i - 1}]]
8147            }
8148        }
8149        makediffhdr $fname $ids
8150
8151    } elseif {![string compare -length 16 "* Unmerged path " $line]} {
8152        set fname [encoding convertfrom [string range $line 16 end]]
8153        $ctext insert end "\n"
8154        set curdiffstart [$ctext index "end - 1c"]
8155        lappend ctext_file_names $fname
8156        lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8157        $ctext insert end "$line\n" filesep
8158        set i [lsearch -exact $treediffs($ids) $fname]
8159        if {$i >= 0} {
8160            setinlist difffilestart $i $curdiffstart
8161        }
8162
8163    } elseif {![string compare -length 2 "@@" $line]} {
8164        regexp {^@@+} $line ats
8165        set line [encoding convertfrom $diffencoding $line]
8166        $ctext insert end "$line\n" hunksep
8167        if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
8168            set diffline $nl
8169        }
8170        set diffnparents [expr {[string length $ats] - 1}]
8171        set diffinhdr 0
8172
8173    } elseif {![string compare -length 10 "Submodule " $line]} {
8174        # start of a new submodule
8175        if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
8176            set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
8177        } else {
8178            set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
8179        }
8180        if {$currdiffsubmod != $fname} {
8181            $ctext insert end "\n";     # Add newline after commit message
8182        }
8183        set curdiffstart [$ctext index "end - 1c"]
8184        lappend ctext_file_names ""
8185        if {$currdiffsubmod != $fname} {
8186            lappend ctext_file_lines $fname
8187            makediffhdr $fname $ids
8188            set currdiffsubmod $fname
8189            $ctext insert end "\n$line\n" filesep
8190        } else {
8191            $ctext insert end "$line\n" filesep
8192        }
8193    } elseif {![string compare -length 3 "  >" $line]} {
8194        set $currdiffsubmod ""
8195        set line [encoding convertfrom $diffencoding $line]
8196        $ctext insert end "$line\n" dresult
8197    } elseif {![string compare -length 3 "  <" $line]} {
8198        set $currdiffsubmod ""
8199        set line [encoding convertfrom $diffencoding $line]
8200        $ctext insert end "$line\n" d0
8201    } elseif {$diffinhdr} {
8202        if {![string compare -length 12 "rename from " $line]} {
8203            set fname [string range $line [expr 6 + [string first " from " $line] ] end]
8204            if {[string index $fname 0] eq "\""} {
8205                set fname [lindex $fname 0]
8206            }
8207            set fname [encoding convertfrom $fname]
8208            set i [lsearch -exact $treediffs($ids) $fname]
8209            if {$i >= 0} {
8210                setinlist difffilestart $i $curdiffstart
8211            }
8212        } elseif {![string compare -length 10 $line "rename to "] ||
8213                  ![string compare -length 8 $line "copy to "]} {
8214            set fname [string range $line [expr 4 + [string first " to " $line] ] end]
8215            if {[string index $fname 0] eq "\""} {
8216                set fname [lindex $fname 0]
8217            }
8218            makediffhdr $fname $ids
8219        } elseif {[string compare -length 3 $line "---"] == 0} {
8220            # do nothing
8221            return
8222        } elseif {[string compare -length 3 $line "+++"] == 0} {
8223            set diffinhdr 0
8224            return
8225        }
8226        $ctext insert end "$line\n" filesep
8227
8228    } else {
8229        set line [string map {\x1A ^Z} \
8230                      [encoding convertfrom $diffencoding $line]]
8231        # parse the prefix - one ' ', '-' or '+' for each parent
8232        set prefix [string range $line 0 [expr {$diffnparents - 1}]]
8233        set tag [expr {$diffnparents > 1? "m": "d"}]
8234        set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
8235        set words_pre_markup ""
8236        set words_post_markup ""
8237        if {[string trim $prefix " -+"] eq {}} {
8238            # prefix only has " ", "-" and "+" in it: normal diff line
8239            set num [string first "-" $prefix]
8240            if {$dowords} {
8241                set line [string range $line 1 end]
8242            }
8243            if {$num >= 0} {
8244                # removed line, first parent with line is $num
8245                if {$num >= $mergemax} {
8246                    set num "max"
8247                }
8248                if {$dowords && $worddiff eq [mc "Markup words"]} {
8249                    $ctext insert end "\[-$line-\]" $tag$num
8250                } else {
8251                    $ctext insert end "$line" $tag$num
8252                }
8253                if {!$dowords} {
8254                    $ctext insert end "\n" $tag$num
8255                }
8256            } else {
8257                set tags {}
8258                if {[string first "+" $prefix] >= 0} {
8259                    # added line
8260                    lappend tags ${tag}result
8261                    if {$diffnparents > 1} {
8262                        set num [string first " " $prefix]
8263                        if {$num >= 0} {
8264                            if {$num >= $mergemax} {
8265                                set num "max"
8266                            }
8267                            lappend tags m$num
8268                        }
8269                    }
8270                    set words_pre_markup "{+"
8271                    set words_post_markup "+}"
8272                }
8273                if {$targetline ne {}} {
8274                    if {$diffline == $targetline} {
8275                        set diffseehere [$ctext index "end - 1 chars"]
8276                        set targetline {}
8277                    } else {
8278                        incr diffline
8279                    }
8280                }
8281                if {$dowords && $worddiff eq [mc "Markup words"]} {
8282                    $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
8283                } else {
8284                    $ctext insert end "$line" $tags
8285                }
8286                if {!$dowords} {
8287                    $ctext insert end "\n" $tags
8288                }
8289            }
8290        } elseif {$dowords && $prefix eq "~"} {
8291            $ctext insert end "\n" {}
8292        } else {
8293            # "\ No newline at end of file",
8294            # or something else we don't recognize
8295            $ctext insert end "$line\n" hunksep
8296        }
8297    }
8298}
8299
8300proc changediffdisp {} {
8301    global ctext diffelide
8302
8303    $ctext tag conf d0 -elide [lindex $diffelide 0]
8304    $ctext tag conf dresult -elide [lindex $diffelide 1]
8305}
8306
8307proc highlightfile {cline} {
8308    global cflist cflist_top
8309
8310    if {![info exists cflist_top]} return
8311
8312    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
8313    $cflist tag add highlight $cline.0 "$cline.0 lineend"
8314    $cflist see $cline.0
8315    set cflist_top $cline
8316}
8317
8318proc highlightfile_for_scrollpos {topidx} {
8319    global cmitmode difffilestart
8320
8321    if {$cmitmode eq "tree"} return
8322    if {![info exists difffilestart]} return
8323
8324    set top [lindex [split $topidx .] 0]
8325    if {$difffilestart eq {} || $top < [lindex $difffilestart 0]} {
8326        highlightfile 0
8327    } else {
8328        highlightfile [expr {[bsearch $difffilestart $top] + 2}]
8329    }
8330}
8331
8332proc prevfile {} {
8333    global difffilestart ctext cmitmode
8334
8335    if {$cmitmode eq "tree"} return
8336    set prev 0.0
8337    set here [$ctext index @0,0]
8338    foreach loc $difffilestart {
8339        if {[$ctext compare $loc >= $here]} {
8340            $ctext yview $prev
8341            return
8342        }
8343        set prev $loc
8344    }
8345    $ctext yview $prev
8346}
8347
8348proc nextfile {} {
8349    global difffilestart ctext cmitmode
8350
8351    if {$cmitmode eq "tree"} return
8352    set here [$ctext index @0,0]
8353    foreach loc $difffilestart {
8354        if {[$ctext compare $loc > $here]} {
8355            $ctext yview $loc
8356            return
8357        }
8358    }
8359}
8360
8361proc clear_ctext {{first 1.0}} {
8362    global ctext smarktop smarkbot
8363    global ctext_file_names ctext_file_lines
8364    global pendinglinks
8365
8366    set l [lindex [split $first .] 0]
8367    if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
8368        set smarktop $l
8369    }
8370    if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
8371        set smarkbot $l
8372    }
8373    $ctext delete $first end
8374    if {$first eq "1.0"} {
8375        unset -nocomplain pendinglinks
8376    }
8377    set ctext_file_names {}
8378    set ctext_file_lines {}
8379}
8380
8381proc settabs {{firstab {}}} {
8382    global firsttabstop tabstop ctext have_tk85
8383
8384    if {$firstab ne {} && $have_tk85} {
8385        set firsttabstop $firstab
8386    }
8387    set w [font measure textfont "0"]
8388    if {$firsttabstop != 0} {
8389        $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
8390                               [expr {($firsttabstop + 2 * $tabstop) * $w}]]
8391    } elseif {$have_tk85 || $tabstop != 8} {
8392        $ctext conf -tabs [expr {$tabstop * $w}]
8393    } else {
8394        $ctext conf -tabs {}
8395    }
8396}
8397
8398proc incrsearch {name ix op} {
8399    global ctext searchstring searchdirn
8400
8401    if {[catch {$ctext index anchor}]} {
8402        # no anchor set, use start of selection, or of visible area
8403        set sel [$ctext tag ranges sel]
8404        if {$sel ne {}} {
8405            $ctext mark set anchor [lindex $sel 0]
8406        } elseif {$searchdirn eq "-forwards"} {
8407            $ctext mark set anchor @0,0
8408        } else {
8409            $ctext mark set anchor @0,[winfo height $ctext]
8410        }
8411    }
8412    if {$searchstring ne {}} {
8413        set here [$ctext search -count mlen $searchdirn -- $searchstring anchor]
8414        if {$here ne {}} {
8415            $ctext see $here
8416            set mend "$here + $mlen c"
8417            $ctext tag remove sel 1.0 end
8418            $ctext tag add sel $here $mend
8419            suppress_highlighting_file_for_current_scrollpos
8420            highlightfile_for_scrollpos $here
8421        }
8422    }
8423    rehighlight_search_results
8424}
8425
8426proc dosearch {} {
8427    global sstring ctext searchstring searchdirn
8428
8429    focus $sstring
8430    $sstring icursor end
8431    set searchdirn -forwards
8432    if {$searchstring ne {}} {
8433        set sel [$ctext tag ranges sel]
8434        if {$sel ne {}} {
8435            set start "[lindex $sel 0] + 1c"
8436        } elseif {[catch {set start [$ctext index anchor]}]} {
8437            set start "@0,0"
8438        }
8439        set match [$ctext search -count mlen -- $searchstring $start]
8440        $ctext tag remove sel 1.0 end
8441        if {$match eq {}} {
8442            bell
8443            return
8444        }
8445        $ctext see $match
8446        suppress_highlighting_file_for_current_scrollpos
8447        highlightfile_for_scrollpos $match
8448        set mend "$match + $mlen c"
8449        $ctext tag add sel $match $mend
8450        $ctext mark unset anchor
8451        rehighlight_search_results
8452    }
8453}
8454
8455proc dosearchback {} {
8456    global sstring ctext searchstring searchdirn
8457
8458    focus $sstring
8459    $sstring icursor end
8460    set searchdirn -backwards
8461    if {$searchstring ne {}} {
8462        set sel [$ctext tag ranges sel]
8463        if {$sel ne {}} {
8464            set start [lindex $sel 0]
8465        } elseif {[catch {set start [$ctext index anchor]}]} {
8466            set start @0,[winfo height $ctext]
8467        }
8468        set match [$ctext search -backwards -count ml -- $searchstring $start]
8469        $ctext tag remove sel 1.0 end
8470        if {$match eq {}} {
8471            bell
8472            return
8473        }
8474        $ctext see $match
8475        suppress_highlighting_file_for_current_scrollpos
8476        highlightfile_for_scrollpos $match
8477        set mend "$match + $ml c"
8478        $ctext tag add sel $match $mend
8479        $ctext mark unset anchor
8480        rehighlight_search_results
8481    }
8482}
8483
8484proc rehighlight_search_results {} {
8485    global ctext searchstring
8486
8487    $ctext tag remove found 1.0 end
8488    $ctext tag remove currentsearchhit 1.0 end
8489
8490    if {$searchstring ne {}} {
8491        searchmarkvisible 1
8492    }
8493}
8494
8495proc searchmark {first last} {
8496    global ctext searchstring
8497
8498    set sel [$ctext tag ranges sel]
8499
8500    set mend $first.0
8501    while {1} {
8502        set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8503        if {$match eq {}} break
8504        set mend "$match + $mlen c"
8505        if {$sel ne {} && [$ctext compare $match == [lindex $sel 0]]} {
8506            $ctext tag add currentsearchhit $match $mend
8507        } else {
8508            $ctext tag add found $match $mend
8509        }
8510    }
8511}
8512
8513proc searchmarkvisible {doall} {
8514    global ctext smarktop smarkbot
8515
8516    set topline [lindex [split [$ctext index @0,0] .] 0]
8517    set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8518    if {$doall || $botline < $smarktop || $topline > $smarkbot} {
8519        # no overlap with previous
8520        searchmark $topline $botline
8521        set smarktop $topline
8522        set smarkbot $botline
8523    } else {
8524        if {$topline < $smarktop} {
8525            searchmark $topline [expr {$smarktop-1}]
8526            set smarktop $topline
8527        }
8528        if {$botline > $smarkbot} {
8529            searchmark [expr {$smarkbot+1}] $botline
8530            set smarkbot $botline
8531        }
8532    }
8533}
8534
8535proc suppress_highlighting_file_for_current_scrollpos {} {
8536    global ctext suppress_highlighting_file_for_this_scrollpos
8537
8538    set suppress_highlighting_file_for_this_scrollpos [$ctext index @0,0]
8539}
8540
8541proc scrolltext {f0 f1} {
8542    global searchstring cmitmode ctext
8543    global suppress_highlighting_file_for_this_scrollpos
8544
8545    set topidx [$ctext index @0,0]
8546    if {![info exists suppress_highlighting_file_for_this_scrollpos]
8547        || $topidx ne $suppress_highlighting_file_for_this_scrollpos} {
8548        highlightfile_for_scrollpos $topidx
8549    }
8550
8551    unset -nocomplain suppress_highlighting_file_for_this_scrollpos
8552
8553    .bleft.bottom.sb set $f0 $f1
8554    if {$searchstring ne {}} {
8555        searchmarkvisible 0
8556    }
8557}
8558
8559proc setcoords {} {
8560    global linespc charspc canvx0 canvy0
8561    global xspc1 xspc2 lthickness
8562
8563    set linespc [font metrics mainfont -linespace]
8564    set charspc [font measure mainfont "m"]
8565    set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8566    set canvx0 [expr {int(3 + 0.5 * $linespc)}]
8567    set lthickness [expr {int($linespc / 9) + 1}]
8568    set xspc1(0) $linespc
8569    set xspc2 $linespc
8570}
8571
8572proc redisplay {} {
8573    global canv
8574    global selectedline
8575
8576    set ymax [lindex [$canv cget -scrollregion] 3]
8577    if {$ymax eq {} || $ymax == 0} return
8578    set span [$canv yview]
8579    clear_display
8580    setcanvscroll
8581    allcanvs yview moveto [lindex $span 0]
8582    drawvisible
8583    if {$selectedline ne {}} {
8584        selectline $selectedline 0
8585        allcanvs yview moveto [lindex $span 0]
8586    }
8587}
8588
8589proc parsefont {f n} {
8590    global fontattr
8591
8592    set fontattr($f,family) [lindex $n 0]
8593    set s [lindex $n 1]
8594    if {$s eq {} || $s == 0} {
8595        set s 10
8596    } elseif {$s < 0} {
8597        set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
8598    }
8599    set fontattr($f,size) $s
8600    set fontattr($f,weight) normal
8601    set fontattr($f,slant) roman
8602    foreach style [lrange $n 2 end] {
8603        switch -- $style {
8604            "normal" -
8605            "bold"   {set fontattr($f,weight) $style}
8606            "roman" -
8607            "italic" {set fontattr($f,slant) $style}
8608        }
8609    }
8610}
8611
8612proc fontflags {f {isbold 0}} {
8613    global fontattr
8614
8615    return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8616                -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8617                -slant $fontattr($f,slant)]
8618}
8619
8620proc fontname {f} {
8621    global fontattr
8622
8623    set n [list $fontattr($f,family) $fontattr($f,size)]
8624    if {$fontattr($f,weight) eq "bold"} {
8625        lappend n "bold"
8626    }
8627    if {$fontattr($f,slant) eq "italic"} {
8628        lappend n "italic"
8629    }
8630    return $n
8631}
8632
8633proc incrfont {inc} {
8634    global mainfont textfont ctext canv cflist showrefstop
8635    global stopped entries fontattr
8636
8637    unmarkmatches
8638    set s $fontattr(mainfont,size)
8639    incr s $inc
8640    if {$s < 1} {
8641        set s 1
8642    }
8643    set fontattr(mainfont,size) $s
8644    font config mainfont -size $s
8645    font config mainfontbold -size $s
8646    set mainfont [fontname mainfont]
8647    set s $fontattr(textfont,size)
8648    incr s $inc
8649    if {$s < 1} {
8650        set s 1
8651    }
8652    set fontattr(textfont,size) $s
8653    font config textfont -size $s
8654    font config textfontbold -size $s
8655    set textfont [fontname textfont]
8656    setcoords
8657    settabs
8658    redisplay
8659}
8660
8661proc clearsha1 {} {
8662    global sha1entry sha1string
8663    if {[string length $sha1string] == 40} {
8664        $sha1entry delete 0 end
8665    }
8666}
8667
8668proc sha1change {n1 n2 op} {
8669    global sha1string currentid sha1but
8670    if {$sha1string == {}
8671        || ([info exists currentid] && $sha1string == $currentid)} {
8672        set state disabled
8673    } else {
8674        set state normal
8675    }
8676    if {[$sha1but cget -state] == $state} return
8677    if {$state == "normal"} {
8678        $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
8679    } else {
8680        $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
8681    }
8682}
8683
8684proc gotocommit {} {
8685    global sha1string tagids headids curview varcid
8686
8687    if {$sha1string == {}
8688        || ([info exists currentid] && $sha1string == $currentid)} return
8689    if {[info exists tagids($sha1string)]} {
8690        set id $tagids($sha1string)
8691    } elseif {[info exists headids($sha1string)]} {
8692        set id $headids($sha1string)
8693    } else {
8694        set id [string tolower $sha1string]
8695        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
8696            set matches [longid $id]
8697            if {$matches ne {}} {
8698                if {[llength $matches] > 1} {
8699                    error_popup [mc "Short SHA1 id %s is ambiguous" $id]
8700                    return
8701                }
8702                set id [lindex $matches 0]
8703            }
8704        } else {
8705            if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8706                error_popup [mc "Revision %s is not known" $sha1string]
8707                return
8708            }
8709        }
8710    }
8711    if {[commitinview $id $curview]} {
8712        selectline [rowofcommit $id] 1
8713        return
8714    }
8715    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
8716        set msg [mc "SHA1 id %s is not known" $sha1string]
8717    } else {
8718        set msg [mc "Revision %s is not in the current view" $sha1string]
8719    }
8720    error_popup $msg
8721}
8722
8723proc lineenter {x y id} {
8724    global hoverx hovery hoverid hovertimer
8725    global commitinfo canv
8726
8727    if {![info exists commitinfo($id)] && ![getcommit $id]} return
8728    set hoverx $x
8729    set hovery $y
8730    set hoverid $id
8731    if {[info exists hovertimer]} {
8732        after cancel $hovertimer
8733    }
8734    set hovertimer [after 500 linehover]
8735    $canv delete hover
8736}
8737
8738proc linemotion {x y id} {
8739    global hoverx hovery hoverid hovertimer
8740
8741    if {[info exists hoverid] && $id == $hoverid} {
8742        set hoverx $x
8743        set hovery $y
8744        if {[info exists hovertimer]} {
8745            after cancel $hovertimer
8746        }
8747        set hovertimer [after 500 linehover]
8748    }
8749}
8750
8751proc lineleave {id} {
8752    global hoverid hovertimer canv
8753
8754    if {[info exists hoverid] && $id == $hoverid} {
8755        $canv delete hover
8756        if {[info exists hovertimer]} {
8757            after cancel $hovertimer
8758            unset hovertimer
8759        }
8760        unset hoverid
8761    }
8762}
8763
8764proc linehover {} {
8765    global hoverx hovery hoverid hovertimer
8766    global canv linespc lthickness
8767    global linehoverbgcolor linehoverfgcolor linehoveroutlinecolor
8768
8769    global commitinfo
8770
8771    set text [lindex $commitinfo($hoverid) 0]
8772    set ymax [lindex [$canv cget -scrollregion] 3]
8773    if {$ymax == {}} return
8774    set yfrac [lindex [$canv yview] 0]
8775    set x [expr {$hoverx + 2 * $linespc}]
8776    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8777    set x0 [expr {$x - 2 * $lthickness}]
8778    set y0 [expr {$y - 2 * $lthickness}]
8779    set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
8780    set y1 [expr {$y + $linespc + 2 * $lthickness}]
8781    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8782               -fill $linehoverbgcolor -outline $linehoveroutlinecolor \
8783               -width 1 -tags hover]
8784    $canv raise $t
8785    set t [$canv create text $x $y -anchor nw -text $text -tags hover \
8786               -font mainfont -fill $linehoverfgcolor]
8787    $canv raise $t
8788}
8789
8790proc clickisonarrow {id y} {
8791    global lthickness
8792
8793    set ranges [rowranges $id]
8794    set thresh [expr {2 * $lthickness + 6}]
8795    set n [expr {[llength $ranges] - 1}]
8796    for {set i 1} {$i < $n} {incr i} {
8797        set row [lindex $ranges $i]
8798        if {abs([yc $row] - $y) < $thresh} {
8799            return $i
8800        }
8801    }
8802    return {}
8803}
8804
8805proc arrowjump {id n y} {
8806    global canv
8807
8808    # 1 <-> 2, 3 <-> 4, etc...
8809    set n [expr {(($n - 1) ^ 1) + 1}]
8810    set row [lindex [rowranges $id] $n]
8811    set yt [yc $row]
8812    set ymax [lindex [$canv cget -scrollregion] 3]
8813    if {$ymax eq {} || $ymax <= 0} return
8814    set view [$canv yview]
8815    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8816    set yfrac [expr {$yt / $ymax - $yspan / 2}]
8817    if {$yfrac < 0} {
8818        set yfrac 0
8819    }
8820    allcanvs yview moveto $yfrac
8821}
8822
8823proc lineclick {x y id isnew} {
8824    global ctext commitinfo children canv thickerline curview
8825
8826    if {![info exists commitinfo($id)] && ![getcommit $id]} return
8827    unmarkmatches
8828    unselectline
8829    normalline
8830    $canv delete hover
8831    # draw this line thicker than normal
8832    set thickerline $id
8833    drawlines $id
8834    if {$isnew} {
8835        set ymax [lindex [$canv cget -scrollregion] 3]
8836        if {$ymax eq {}} return
8837        set yfrac [lindex [$canv yview] 0]
8838        set y [expr {$y + $yfrac * $ymax}]
8839    }
8840    set dirn [clickisonarrow $id $y]
8841    if {$dirn ne {}} {
8842        arrowjump $id $dirn $y
8843        return
8844    }
8845
8846    if {$isnew} {
8847        addtohistory [list lineclick $x $y $id 0] savectextpos
8848    }
8849    # fill the details pane with info about this line
8850    $ctext conf -state normal
8851    clear_ctext
8852    settabs 0
8853    $ctext insert end "[mc "Parent"]:\t"
8854    $ctext insert end $id link0
8855    setlink $id link0
8856    set info $commitinfo($id)
8857    $ctext insert end "\n\t[lindex $info 0]\n"
8858    $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8859    set date [formatdate [lindex $info 2]]
8860    $ctext insert end "\t[mc "Date"]:\t$date\n"
8861    set kids $children($curview,$id)
8862    if {$kids ne {}} {
8863        $ctext insert end "\n[mc "Children"]:"
8864        set i 0
8865        foreach child $kids {
8866            incr i
8867            if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8868            set info $commitinfo($child)
8869            $ctext insert end "\n\t"
8870            $ctext insert end $child link$i
8871            setlink $child link$i
8872            $ctext insert end "\n\t[lindex $info 0]"
8873            $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8874            set date [formatdate [lindex $info 2]]
8875            $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8876        }
8877    }
8878    maybe_scroll_ctext 1
8879    $ctext conf -state disabled
8880    init_flist {}
8881}
8882
8883proc normalline {} {
8884    global thickerline
8885    if {[info exists thickerline]} {
8886        set id $thickerline
8887        unset thickerline
8888        drawlines $id
8889    }
8890}
8891
8892proc selbyid {id {isnew 1}} {
8893    global curview
8894    if {[commitinview $id $curview]} {
8895        selectline [rowofcommit $id] $isnew
8896    }
8897}
8898
8899proc mstime {} {
8900    global startmstime
8901    if {![info exists startmstime]} {
8902        set startmstime [clock clicks -milliseconds]
8903    }
8904    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8905}
8906
8907proc rowmenu {x y id} {
8908    global rowctxmenu selectedline rowmenuid curview
8909    global nullid nullid2 fakerowmenu mainhead markedid
8910
8911    stopfinding
8912    set rowmenuid $id
8913    if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8914        set state disabled
8915    } else {
8916        set state normal
8917    }
8918    if {[info exists markedid] && $markedid ne $id} {
8919        set mstate normal
8920    } else {
8921        set mstate disabled
8922    }
8923    if {$id ne $nullid && $id ne $nullid2} {
8924        set menu $rowctxmenu
8925        if {$mainhead ne {}} {
8926            $menu entryconfigure 8 -label [mc "Reset %s branch to here" $mainhead] -state normal
8927        } else {
8928            $menu entryconfigure 8 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8929        }
8930        $menu entryconfigure 10 -state $mstate
8931        $menu entryconfigure 11 -state $mstate
8932        $menu entryconfigure 12 -state $mstate
8933    } else {
8934        set menu $fakerowmenu
8935    }
8936    $menu entryconfigure [mca "Diff this -> selected"] -state $state
8937    $menu entryconfigure [mca "Diff selected -> this"] -state $state
8938    $menu entryconfigure [mca "Make patch"] -state $state
8939    $menu entryconfigure [mca "Diff this -> marked commit"] -state $mstate
8940    $menu entryconfigure [mca "Diff marked commit -> this"] -state $mstate
8941    tk_popup $menu $x $y
8942}
8943
8944proc markhere {} {
8945    global rowmenuid markedid canv
8946
8947    set markedid $rowmenuid
8948    make_idmark $markedid
8949}
8950
8951proc gotomark {} {
8952    global markedid
8953
8954    if {[info exists markedid]} {
8955        selbyid $markedid
8956    }
8957}
8958
8959proc replace_by_kids {l r} {
8960    global curview children
8961
8962    set id [commitonrow $r]
8963    set l [lreplace $l 0 0]
8964    foreach kid $children($curview,$id) {
8965        lappend l [rowofcommit $kid]
8966    }
8967    return [lsort -integer -decreasing -unique $l]
8968}
8969
8970proc find_common_desc {} {
8971    global markedid rowmenuid curview children
8972
8973    if {![info exists markedid]} return
8974    if {![commitinview $markedid $curview] ||
8975        ![commitinview $rowmenuid $curview]} return
8976    #set t1 [clock clicks -milliseconds]
8977    set l1 [list [rowofcommit $markedid]]
8978    set l2 [list [rowofcommit $rowmenuid]]
8979    while 1 {
8980        set r1 [lindex $l1 0]
8981        set r2 [lindex $l2 0]
8982        if {$r1 eq {} || $r2 eq {}} break
8983        if {$r1 == $r2} {
8984            selectline $r1 1
8985            break
8986        }
8987        if {$r1 > $r2} {
8988            set l1 [replace_by_kids $l1 $r1]
8989        } else {
8990            set l2 [replace_by_kids $l2 $r2]
8991        }
8992    }
8993    #set t2 [clock clicks -milliseconds]
8994    #puts "took [expr {$t2-$t1}]ms"
8995}
8996
8997proc compare_commits {} {
8998    global markedid rowmenuid curview children
8999
9000    if {![info exists markedid]} return
9001    if {![commitinview $markedid $curview]} return
9002    addtohistory [list do_cmp_commits $markedid $rowmenuid]
9003    do_cmp_commits $markedid $rowmenuid
9004}
9005
9006proc getpatchid {id} {
9007    global patchids
9008
9009    if {![info exists patchids($id)]} {
9010        set cmd [diffcmd [list $id] {-p --root}]
9011        # trim off the initial "|"
9012        set cmd [lrange $cmd 1 end]
9013        if {[catch {
9014            set x [eval exec $cmd | git patch-id]
9015            set patchids($id) [lindex $x 0]
9016        }]} {
9017            set patchids($id) "error"
9018        }
9019    }
9020    return $patchids($id)
9021}
9022
9023proc do_cmp_commits {a b} {
9024    global ctext curview parents children patchids commitinfo
9025
9026    $ctext conf -state normal
9027    clear_ctext
9028    init_flist {}
9029    for {set i 0} {$i < 100} {incr i} {
9030        set skipa 0
9031        set skipb 0
9032        if {[llength $parents($curview,$a)] > 1} {
9033            appendshortlink $a [mc "Skipping merge commit "] "\n"
9034            set skipa 1
9035        } else {
9036            set patcha [getpatchid $a]
9037        }
9038        if {[llength $parents($curview,$b)] > 1} {
9039            appendshortlink $b [mc "Skipping merge commit "] "\n"
9040            set skipb 1
9041        } else {
9042            set patchb [getpatchid $b]
9043        }
9044        if {!$skipa && !$skipb} {
9045            set heada [lindex $commitinfo($a) 0]
9046            set headb [lindex $commitinfo($b) 0]
9047            if {$patcha eq "error"} {
9048                appendshortlink $a [mc "Error getting patch ID for "] \
9049                    [mc " - stopping\n"]
9050                break
9051            }
9052            if {$patchb eq "error"} {
9053                appendshortlink $b [mc "Error getting patch ID for "] \
9054                    [mc " - stopping\n"]
9055                break
9056            }
9057            if {$patcha eq $patchb} {
9058                if {$heada eq $headb} {
9059                    appendshortlink $a [mc "Commit "]
9060                    appendshortlink $b " == " "  $heada\n"
9061                } else {
9062                    appendshortlink $a [mc "Commit "] "  $heada\n"
9063                    appendshortlink $b [mc " is the same patch as\n       "] \
9064                        "  $headb\n"
9065                }
9066                set skipa 1
9067                set skipb 1
9068            } else {
9069                $ctext insert end "\n"
9070                appendshortlink $a [mc "Commit "] "  $heada\n"
9071                appendshortlink $b [mc " differs from\n       "] \
9072                    "  $headb\n"
9073                $ctext insert end [mc "Diff of commits:\n\n"]
9074                $ctext conf -state disabled
9075                update
9076                diffcommits $a $b
9077                return
9078            }
9079        }
9080        if {$skipa} {
9081            set kids [real_children $curview,$a]
9082            if {[llength $kids] != 1} {
9083                $ctext insert end "\n"
9084                appendshortlink $a [mc "Commit "] \
9085                    [mc " has %s children - stopping\n" [llength $kids]]
9086                break
9087            }
9088            set a [lindex $kids 0]
9089        }
9090        if {$skipb} {
9091            set kids [real_children $curview,$b]
9092            if {[llength $kids] != 1} {
9093                appendshortlink $b [mc "Commit "] \
9094                    [mc " has %s children - stopping\n" [llength $kids]]
9095                break
9096            }
9097            set b [lindex $kids 0]
9098        }
9099    }
9100    $ctext conf -state disabled
9101}
9102
9103proc diffcommits {a b} {
9104    global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
9105
9106    set tmpdir [gitknewtmpdir]
9107    set fna [file join $tmpdir "commit-[string range $a 0 7]"]
9108    set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
9109    if {[catch {
9110        exec git diff-tree -p --pretty $a >$fna
9111        exec git diff-tree -p --pretty $b >$fnb
9112    } err]} {
9113        error_popup [mc "Error writing commit to file: %s" $err]
9114        return
9115    }
9116    if {[catch {
9117        set fd [open "| diff -U$diffcontext $fna $fnb" r]
9118    } err]} {
9119        error_popup [mc "Error diffing commits: %s" $err]
9120        return
9121    }
9122    set diffids [list commits $a $b]
9123    set blobdifffd($diffids) $fd
9124    set diffinhdr 0
9125    set currdiffsubmod ""
9126    filerun $fd [list getblobdiffline $fd $diffids]
9127}
9128
9129proc diffvssel {dirn} {
9130    global rowmenuid selectedline
9131
9132    if {$selectedline eq {}} return
9133    if {$dirn} {
9134        set oldid [commitonrow $selectedline]
9135        set newid $rowmenuid
9136    } else {
9137        set oldid $rowmenuid
9138        set newid [commitonrow $selectedline]
9139    }
9140    addtohistory [list doseldiff $oldid $newid] savectextpos
9141    doseldiff $oldid $newid
9142}
9143
9144proc diffvsmark {dirn} {
9145    global rowmenuid markedid
9146
9147    if {![info exists markedid]} return
9148    if {$dirn} {
9149        set oldid $markedid
9150        set newid $rowmenuid
9151    } else {
9152        set oldid $rowmenuid
9153        set newid $markedid
9154    }
9155    addtohistory [list doseldiff $oldid $newid] savectextpos
9156    doseldiff $oldid $newid
9157}
9158
9159proc doseldiff {oldid newid} {
9160    global ctext
9161    global commitinfo
9162
9163    $ctext conf -state normal
9164    clear_ctext
9165    init_flist [mc "Top"]
9166    $ctext insert end "[mc "From"] "
9167    $ctext insert end $oldid link0
9168    setlink $oldid link0
9169    $ctext insert end "\n     "
9170    $ctext insert end [lindex $commitinfo($oldid) 0]
9171    $ctext insert end "\n\n[mc "To"]   "
9172    $ctext insert end $newid link1
9173    setlink $newid link1
9174    $ctext insert end "\n     "
9175    $ctext insert end [lindex $commitinfo($newid) 0]
9176    $ctext insert end "\n"
9177    $ctext conf -state disabled
9178    $ctext tag remove found 1.0 end
9179    startdiff [list $oldid $newid]
9180}
9181
9182proc mkpatch {} {
9183    global rowmenuid currentid commitinfo patchtop patchnum NS
9184
9185    if {![info exists currentid]} return
9186    set oldid $currentid
9187    set oldhead [lindex $commitinfo($oldid) 0]
9188    set newid $rowmenuid
9189    set newhead [lindex $commitinfo($newid) 0]
9190    set top .patch
9191    set patchtop $top
9192    catch {destroy $top}
9193    ttk_toplevel $top
9194    make_transient $top .
9195    ${NS}::label $top.title -text [mc "Generate patch"]
9196    grid $top.title - -pady 10
9197    ${NS}::label $top.from -text [mc "From:"]
9198    ${NS}::entry $top.fromsha1 -width 40
9199    $top.fromsha1 insert 0 $oldid
9200    $top.fromsha1 conf -state readonly
9201    grid $top.from $top.fromsha1 -sticky w
9202    ${NS}::entry $top.fromhead -width 60
9203    $top.fromhead insert 0 $oldhead
9204    $top.fromhead conf -state readonly
9205    grid x $top.fromhead -sticky w
9206    ${NS}::label $top.to -text [mc "To:"]
9207    ${NS}::entry $top.tosha1 -width 40
9208    $top.tosha1 insert 0 $newid
9209    $top.tosha1 conf -state readonly
9210    grid $top.to $top.tosha1 -sticky w
9211    ${NS}::entry $top.tohead -width 60
9212    $top.tohead insert 0 $newhead
9213    $top.tohead conf -state readonly
9214    grid x $top.tohead -sticky w
9215    ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
9216    grid $top.rev x -pady 10 -padx 5
9217    ${NS}::label $top.flab -text [mc "Output file:"]
9218    ${NS}::entry $top.fname -width 60
9219    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
9220    incr patchnum
9221    grid $top.flab $top.fname -sticky w
9222    ${NS}::frame $top.buts
9223    ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
9224    ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
9225    bind $top <Key-Return> mkpatchgo
9226    bind $top <Key-Escape> mkpatchcan
9227    grid $top.buts.gen $top.buts.can
9228    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9229    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9230    grid $top.buts - -pady 10 -sticky ew
9231    focus $top.fname
9232}
9233
9234proc mkpatchrev {} {
9235    global patchtop
9236
9237    set oldid [$patchtop.fromsha1 get]
9238    set oldhead [$patchtop.fromhead get]
9239    set newid [$patchtop.tosha1 get]
9240    set newhead [$patchtop.tohead get]
9241    foreach e [list fromsha1 fromhead tosha1 tohead] \
9242            v [list $newid $newhead $oldid $oldhead] {
9243        $patchtop.$e conf -state normal
9244        $patchtop.$e delete 0 end
9245        $patchtop.$e insert 0 $v
9246        $patchtop.$e conf -state readonly
9247    }
9248}
9249
9250proc mkpatchgo {} {
9251    global patchtop nullid nullid2
9252
9253    set oldid [$patchtop.fromsha1 get]
9254    set newid [$patchtop.tosha1 get]
9255    set fname [$patchtop.fname get]
9256    set cmd [diffcmd [list $oldid $newid] -p]
9257    # trim off the initial "|"
9258    set cmd [lrange $cmd 1 end]
9259    lappend cmd >$fname &
9260    if {[catch {eval exec $cmd} err]} {
9261        error_popup "[mc "Error creating patch:"] $err" $patchtop
9262    }
9263    catch {destroy $patchtop}
9264    unset patchtop
9265}
9266
9267proc mkpatchcan {} {
9268    global patchtop
9269
9270    catch {destroy $patchtop}
9271    unset patchtop
9272}
9273
9274proc mktag {} {
9275    global rowmenuid mktagtop commitinfo NS
9276
9277    set top .maketag
9278    set mktagtop $top
9279    catch {destroy $top}
9280    ttk_toplevel $top
9281    make_transient $top .
9282    ${NS}::label $top.title -text [mc "Create tag"]
9283    grid $top.title - -pady 10
9284    ${NS}::label $top.id -text [mc "ID:"]
9285    ${NS}::entry $top.sha1 -width 40
9286    $top.sha1 insert 0 $rowmenuid
9287    $top.sha1 conf -state readonly
9288    grid $top.id $top.sha1 -sticky w
9289    ${NS}::entry $top.head -width 60
9290    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9291    $top.head conf -state readonly
9292    grid x $top.head -sticky w
9293    ${NS}::label $top.tlab -text [mc "Tag name:"]
9294    ${NS}::entry $top.tag -width 60
9295    grid $top.tlab $top.tag -sticky w
9296    ${NS}::label $top.op -text [mc "Tag message is optional"]
9297    grid $top.op -columnspan 2 -sticky we
9298    ${NS}::label $top.mlab -text [mc "Tag message:"]
9299    ${NS}::entry $top.msg -width 60
9300    grid $top.mlab $top.msg -sticky w
9301    ${NS}::frame $top.buts
9302    ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
9303    ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
9304    bind $top <Key-Return> mktaggo
9305    bind $top <Key-Escape> mktagcan
9306    grid $top.buts.gen $top.buts.can
9307    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9308    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9309    grid $top.buts - -pady 10 -sticky ew
9310    focus $top.tag
9311}
9312
9313proc domktag {} {
9314    global mktagtop env tagids idtags
9315
9316    set id [$mktagtop.sha1 get]
9317    set tag [$mktagtop.tag get]
9318    set msg [$mktagtop.msg get]
9319    if {$tag == {}} {
9320        error_popup [mc "No tag name specified"] $mktagtop
9321        return 0
9322    }
9323    if {[info exists tagids($tag)]} {
9324        error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
9325        return 0
9326    }
9327    if {[catch {
9328        if {$msg != {}} {
9329            exec git tag -a -m $msg $tag $id
9330        } else {
9331            exec git tag $tag $id
9332        }
9333    } err]} {
9334        error_popup "[mc "Error creating tag:"] $err" $mktagtop
9335        return 0
9336    }
9337
9338    set tagids($tag) $id
9339    lappend idtags($id) $tag
9340    redrawtags $id
9341    addedtag $id
9342    dispneartags 0
9343    run refill_reflist
9344    return 1
9345}
9346
9347proc redrawtags {id} {
9348    global canv linehtag idpos currentid curview cmitlisted markedid
9349    global canvxmax iddrawn circleitem mainheadid circlecolors
9350    global mainheadcirclecolor
9351
9352    if {![commitinview $id $curview]} return
9353    if {![info exists iddrawn($id)]} return
9354    set row [rowofcommit $id]
9355    if {$id eq $mainheadid} {
9356        set ofill $mainheadcirclecolor
9357    } else {
9358        set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
9359    }
9360    $canv itemconf $circleitem($row) -fill $ofill
9361    $canv delete tag.$id
9362    set xt [eval drawtags $id $idpos($id)]
9363    $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
9364    set text [$canv itemcget $linehtag($id) -text]
9365    set font [$canv itemcget $linehtag($id) -font]
9366    set xr [expr {$xt + [font measure $font $text]}]
9367    if {$xr > $canvxmax} {
9368        set canvxmax $xr
9369        setcanvscroll
9370    }
9371    if {[info exists currentid] && $currentid == $id} {
9372        make_secsel $id
9373    }
9374    if {[info exists markedid] && $markedid eq $id} {
9375        make_idmark $id
9376    }
9377}
9378
9379proc mktagcan {} {
9380    global mktagtop
9381
9382    catch {destroy $mktagtop}
9383    unset mktagtop
9384}
9385
9386proc mktaggo {} {
9387    if {![domktag]} return
9388    mktagcan
9389}
9390
9391proc copysummary {} {
9392    global rowmenuid autosellen
9393
9394    set format "%h (\"%s\", %ad)"
9395    set cmd [list git show -s --pretty=format:$format --date=short]
9396    if {$autosellen < 40} {
9397        lappend cmd --abbrev=$autosellen
9398    }
9399    set summary [eval exec $cmd $rowmenuid]
9400
9401    clipboard clear
9402    clipboard append $summary
9403}
9404
9405proc writecommit {} {
9406    global rowmenuid wrcomtop commitinfo wrcomcmd NS
9407
9408    set top .writecommit
9409    set wrcomtop $top
9410    catch {destroy $top}
9411    ttk_toplevel $top
9412    make_transient $top .
9413    ${NS}::label $top.title -text [mc "Write commit to file"]
9414    grid $top.title - -pady 10
9415    ${NS}::label $top.id -text [mc "ID:"]
9416    ${NS}::entry $top.sha1 -width 40
9417    $top.sha1 insert 0 $rowmenuid
9418    $top.sha1 conf -state readonly
9419    grid $top.id $top.sha1 -sticky w
9420    ${NS}::entry $top.head -width 60
9421    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9422    $top.head conf -state readonly
9423    grid x $top.head -sticky w
9424    ${NS}::label $top.clab -text [mc "Command:"]
9425    ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
9426    grid $top.clab $top.cmd -sticky w -pady 10
9427    ${NS}::label $top.flab -text [mc "Output file:"]
9428    ${NS}::entry $top.fname -width 60
9429    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
9430    grid $top.flab $top.fname -sticky w
9431    ${NS}::frame $top.buts
9432    ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
9433    ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
9434    bind $top <Key-Return> wrcomgo
9435    bind $top <Key-Escape> wrcomcan
9436    grid $top.buts.gen $top.buts.can
9437    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9438    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9439    grid $top.buts - -pady 10 -sticky ew
9440    focus $top.fname
9441}
9442
9443proc wrcomgo {} {
9444    global wrcomtop
9445
9446    set id [$wrcomtop.sha1 get]
9447    set cmd "echo $id | [$wrcomtop.cmd get]"
9448    set fname [$wrcomtop.fname get]
9449    if {[catch {exec sh -c $cmd >$fname &} err]} {
9450        error_popup "[mc "Error writing commit:"] $err" $wrcomtop
9451    }
9452    catch {destroy $wrcomtop}
9453    unset wrcomtop
9454}
9455
9456proc wrcomcan {} {
9457    global wrcomtop
9458
9459    catch {destroy $wrcomtop}
9460    unset wrcomtop
9461}
9462
9463proc mkbranch {} {
9464    global NS rowmenuid
9465
9466    set top .branchdialog
9467
9468    set val(name) ""
9469    set val(id) $rowmenuid
9470    set val(command) [list mkbrgo $top]
9471
9472    set ui(title) [mc "Create branch"]
9473    set ui(accept) [mc "Create"]
9474
9475    branchdia $top val ui
9476}
9477
9478proc mvbranch {} {
9479    global NS
9480    global headmenuid headmenuhead
9481
9482    set top .branchdialog
9483
9484    set val(name) $headmenuhead
9485    set val(id) $headmenuid
9486    set val(command) [list mvbrgo $top $headmenuhead]
9487
9488    set ui(title) [mc "Rename branch %s" $headmenuhead]
9489    set ui(accept) [mc "Rename"]
9490
9491    branchdia $top val ui
9492}
9493
9494proc branchdia {top valvar uivar} {
9495    global NS commitinfo
9496    upvar $valvar val $uivar ui
9497
9498    catch {destroy $top}
9499    ttk_toplevel $top
9500    make_transient $top .
9501    ${NS}::label $top.title -text $ui(title)
9502    grid $top.title - -pady 10
9503    ${NS}::label $top.id -text [mc "ID:"]
9504    ${NS}::entry $top.sha1 -width 40
9505    $top.sha1 insert 0 $val(id)
9506    $top.sha1 conf -state readonly
9507    grid $top.id $top.sha1 -sticky w
9508    ${NS}::entry $top.head -width 60
9509    $top.head insert 0 [lindex $commitinfo($val(id)) 0]
9510    $top.head conf -state readonly
9511    grid x $top.head -sticky ew
9512    grid columnconfigure $top 1 -weight 1
9513    ${NS}::label $top.nlab -text [mc "Name:"]
9514    ${NS}::entry $top.name -width 40
9515    $top.name insert 0 $val(name)
9516    grid $top.nlab $top.name -sticky w
9517    ${NS}::frame $top.buts
9518    ${NS}::button $top.buts.go -text $ui(accept) -command $val(command)
9519    ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
9520    bind $top <Key-Return> $val(command)
9521    bind $top <Key-Escape> "catch {destroy $top}"
9522    grid $top.buts.go $top.buts.can
9523    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9524    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9525    grid $top.buts - -pady 10 -sticky ew
9526    focus $top.name
9527}
9528
9529proc mkbrgo {top} {
9530    global headids idheads
9531
9532    set name [$top.name get]
9533    set id [$top.sha1 get]
9534    set cmdargs {}
9535    set old_id {}
9536    if {$name eq {}} {
9537        error_popup [mc "Please specify a name for the new branch"] $top
9538        return
9539    }
9540    if {[info exists headids($name)]} {
9541        if {![confirm_popup [mc \
9542                "Branch '%s' already exists. Overwrite?" $name] $top]} {
9543            return
9544        }
9545        set old_id $headids($name)
9546        lappend cmdargs -f
9547    }
9548    catch {destroy $top}
9549    lappend cmdargs $name $id
9550    nowbusy newbranch
9551    update
9552    if {[catch {
9553        eval exec git branch $cmdargs
9554    } err]} {
9555        notbusy newbranch
9556        error_popup $err
9557    } else {
9558        notbusy newbranch
9559        if {$old_id ne {}} {
9560            movehead $id $name
9561            movedhead $id $name
9562            redrawtags $old_id
9563            redrawtags $id
9564        } else {
9565            set headids($name) $id
9566            lappend idheads($id) $name
9567            addedhead $id $name
9568            redrawtags $id
9569        }
9570        dispneartags 0
9571        run refill_reflist
9572    }
9573}
9574
9575proc mvbrgo {top prevname} {
9576    global headids idheads mainhead mainheadid
9577
9578    set name [$top.name get]
9579    set id [$top.sha1 get]
9580    set cmdargs {}
9581    if {$name eq $prevname} {
9582        catch {destroy $top}
9583        return
9584    }
9585    if {$name eq {}} {
9586        error_popup [mc "Please specify a new name for the branch"] $top
9587        return
9588    }
9589    catch {destroy $top}
9590    lappend cmdargs -m $prevname $name
9591    nowbusy renamebranch
9592    update
9593    if {[catch {
9594        eval exec git branch $cmdargs
9595    } err]} {
9596        notbusy renamebranch
9597        error_popup $err
9598    } else {
9599        notbusy renamebranch
9600        removehead $id $prevname
9601        removedhead $id $prevname
9602        set headids($name) $id
9603        lappend idheads($id) $name
9604        addedhead $id $name
9605        if {$prevname eq $mainhead} {
9606            set mainhead $name
9607            set mainheadid $id
9608        }
9609        redrawtags $id
9610        dispneartags 0
9611        run refill_reflist
9612    }
9613}
9614
9615proc exec_citool {tool_args {baseid {}}} {
9616    global commitinfo env
9617
9618    set save_env [array get env GIT_AUTHOR_*]
9619
9620    if {$baseid ne {}} {
9621        if {![info exists commitinfo($baseid)]} {
9622            getcommit $baseid
9623        }
9624        set author [lindex $commitinfo($baseid) 1]
9625        set date [lindex $commitinfo($baseid) 2]
9626        if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9627                    $author author name email]
9628            && $date ne {}} {
9629            set env(GIT_AUTHOR_NAME) $name
9630            set env(GIT_AUTHOR_EMAIL) $email
9631            set env(GIT_AUTHOR_DATE) $date
9632        }
9633    }
9634
9635    eval exec git citool $tool_args &
9636
9637    array unset env GIT_AUTHOR_*
9638    array set env $save_env
9639}
9640
9641proc cherrypick {} {
9642    global rowmenuid curview
9643    global mainhead mainheadid
9644    global gitdir
9645
9646    set oldhead [exec git rev-parse HEAD]
9647    set dheads [descheads $rowmenuid]
9648    if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
9649        set ok [confirm_popup [mc "Commit %s is already\
9650                included in branch %s -- really re-apply it?" \
9651                                   [string range $rowmenuid 0 7] $mainhead]]
9652        if {!$ok} return
9653    }
9654    nowbusy cherrypick [mc "Cherry-picking"]
9655    update
9656    # Unfortunately git-cherry-pick writes stuff to stderr even when
9657    # no error occurs, and exec takes that as an indication of error...
9658    if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9659        notbusy cherrypick
9660        if {[regexp -line \
9661                 {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9662                 $err msg fname]} {
9663            error_popup [mc "Cherry-pick failed because of local changes\
9664                        to file '%s'.\nPlease commit, reset or stash\
9665                        your changes and try again." $fname]
9666        } elseif {[regexp -line \
9667                       {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
9668                       $err]} {
9669            if {[confirm_popup [mc "Cherry-pick failed because of merge\
9670                        conflict.\nDo you wish to run git citool to\
9671                        resolve it?"]]} {
9672                # Force citool to read MERGE_MSG
9673                file delete [file join $gitdir "GITGUI_MSG"]
9674                exec_citool {} $rowmenuid
9675            }
9676        } else {
9677            error_popup $err
9678        }
9679        run updatecommits
9680        return
9681    }
9682    set newhead [exec git rev-parse HEAD]
9683    if {$newhead eq $oldhead} {
9684        notbusy cherrypick
9685        error_popup [mc "No changes committed"]
9686        return
9687    }
9688    addnewchild $newhead $oldhead
9689    if {[commitinview $oldhead $curview]} {
9690        # XXX this isn't right if we have a path limit...
9691        insertrow $newhead $oldhead $curview
9692        if {$mainhead ne {}} {
9693            movehead $newhead $mainhead
9694            movedhead $newhead $mainhead
9695        }
9696        set mainheadid $newhead
9697        redrawtags $oldhead
9698        redrawtags $newhead
9699        selbyid $newhead
9700    }
9701    notbusy cherrypick
9702}
9703
9704proc revert {} {
9705    global rowmenuid curview
9706    global mainhead mainheadid
9707    global gitdir
9708
9709    set oldhead [exec git rev-parse HEAD]
9710    set dheads [descheads $rowmenuid]
9711    if { $dheads eq {} || [lsearch -exact $dheads $oldhead] == -1 } {
9712       set ok [confirm_popup [mc "Commit %s is not\
9713           included in branch %s -- really revert it?" \
9714                      [string range $rowmenuid 0 7] $mainhead]]
9715       if {!$ok} return
9716    }
9717    nowbusy revert [mc "Reverting"]
9718    update
9719
9720    if [catch {exec git revert --no-edit $rowmenuid} err] {
9721        notbusy revert
9722        if [regexp {files would be overwritten by merge:(\n(( |\t)+[^\n]+\n)+)}\
9723                $err match files] {
9724            regsub {\n( |\t)+} $files "\n" files
9725            error_popup [mc "Revert failed because of local changes to\
9726                the following files:%s Please commit, reset or stash \
9727                your changes and try again." $files]
9728        } elseif [regexp {error: could not revert} $err] {
9729            if [confirm_popup [mc "Revert failed because of merge conflict.\n\
9730                Do you wish to run git citool to resolve it?"]] {
9731                # Force citool to read MERGE_MSG
9732                file delete [file join $gitdir "GITGUI_MSG"]
9733                exec_citool {} $rowmenuid
9734            }
9735        } else { error_popup $err }
9736        run updatecommits
9737        return
9738    }
9739
9740    set newhead [exec git rev-parse HEAD]
9741    if { $newhead eq $oldhead } {
9742        notbusy revert
9743        error_popup [mc "No changes committed"]
9744        return
9745    }
9746
9747    addnewchild $newhead $oldhead
9748
9749    if [commitinview $oldhead $curview] {
9750        # XXX this isn't right if we have a path limit...
9751        insertrow $newhead $oldhead $curview
9752        if {$mainhead ne {}} {
9753            movehead $newhead $mainhead
9754            movedhead $newhead $mainhead
9755        }
9756        set mainheadid $newhead
9757        redrawtags $oldhead
9758        redrawtags $newhead
9759        selbyid $newhead
9760    }
9761
9762    notbusy revert
9763}
9764
9765proc resethead {} {
9766    global mainhead rowmenuid confirm_ok resettype NS
9767
9768    set confirm_ok 0
9769    set w ".confirmreset"
9770    ttk_toplevel $w
9771    make_transient $w .
9772    wm title $w [mc "Confirm reset"]
9773    ${NS}::label $w.m -text \
9774        [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
9775    pack $w.m -side top -fill x -padx 20 -pady 20
9776    ${NS}::labelframe $w.f -text [mc "Reset type:"]
9777    set resettype mixed
9778    ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
9779        -text [mc "Soft: Leave working tree and index untouched"]
9780    grid $w.f.soft -sticky w
9781    ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
9782        -text [mc "Mixed: Leave working tree untouched, reset index"]
9783    grid $w.f.mixed -sticky w
9784    ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
9785        -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
9786    grid $w.f.hard -sticky w
9787    pack $w.f -side top -fill x -padx 4
9788    ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
9789    pack $w.ok -side left -fill x -padx 20 -pady 20
9790    ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
9791    bind $w <Key-Escape> [list destroy $w]
9792    pack $w.cancel -side right -fill x -padx 20 -pady 20
9793    bind $w <Visibility> "grab $w; focus $w"
9794    tkwait window $w
9795    if {!$confirm_ok} return
9796    if {[catch {set fd [open \
9797            [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
9798        error_popup $err
9799    } else {
9800        dohidelocalchanges
9801        filerun $fd [list readresetstat $fd]
9802        nowbusy reset [mc "Resetting"]
9803        selbyid $rowmenuid
9804    }
9805}
9806
9807proc readresetstat {fd} {
9808    global mainhead mainheadid showlocalchanges rprogcoord
9809
9810    if {[gets $fd line] >= 0} {
9811        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9812            set rprogcoord [expr {1.0 * $m / $n}]
9813            adjustprogress
9814        }
9815        return 1
9816    }
9817    set rprogcoord 0
9818    adjustprogress
9819    notbusy reset
9820    if {[catch {close $fd} err]} {
9821        error_popup $err
9822    }
9823    set oldhead $mainheadid
9824    set newhead [exec git rev-parse HEAD]
9825    if {$newhead ne $oldhead} {
9826        movehead $newhead $mainhead
9827        movedhead $newhead $mainhead
9828        set mainheadid $newhead
9829        redrawtags $oldhead
9830        redrawtags $newhead
9831    }
9832    if {$showlocalchanges} {
9833        doshowlocalchanges
9834    }
9835    return 0
9836}
9837
9838# context menu for a head
9839proc headmenu {x y id head} {
9840    global headmenuid headmenuhead headctxmenu mainhead headids
9841
9842    stopfinding
9843    set headmenuid $id
9844    set headmenuhead $head
9845    array set state {0 normal 1 normal 2 normal}
9846    if {[string match "remotes/*" $head]} {
9847        set localhead [string range $head [expr [string last / $head] + 1] end]
9848        if {[info exists headids($localhead)]} {
9849            set state(0) disabled
9850        }
9851        array set state {1 disabled 2 disabled}
9852    }
9853    if {$head eq $mainhead} {
9854        array set state {0 disabled 2 disabled}
9855    }
9856    foreach i {0 1 2} {
9857        $headctxmenu entryconfigure $i -state $state($i)
9858    }
9859    tk_popup $headctxmenu $x $y
9860}
9861
9862proc cobranch {} {
9863    global headmenuid headmenuhead headids
9864    global showlocalchanges
9865
9866    # check the tree is clean first??
9867    set newhead $headmenuhead
9868    set command [list | git checkout]
9869    if {[string match "remotes/*" $newhead]} {
9870        set remote $newhead
9871        set newhead [string range $newhead [expr [string last / $newhead] + 1] end]
9872        # The following check is redundant - the menu option should
9873        # be disabled to begin with...
9874        if {[info exists headids($newhead)]} {
9875            error_popup [mc "A local branch named %s exists already" $newhead]
9876            return
9877        }
9878        lappend command -b $newhead --track $remote
9879    } else {
9880        lappend command $newhead
9881    }
9882    lappend command 2>@1
9883    nowbusy checkout [mc "Checking out"]
9884    update
9885    dohidelocalchanges
9886    if {[catch {
9887        set fd [open $command r]
9888    } err]} {
9889        notbusy checkout
9890        error_popup $err
9891        if {$showlocalchanges} {
9892            dodiffindex
9893        }
9894    } else {
9895        filerun $fd [list readcheckoutstat $fd $newhead $headmenuid]
9896    }
9897}
9898
9899proc readcheckoutstat {fd newhead newheadid} {
9900    global mainhead mainheadid headids idheads showlocalchanges progresscoords
9901    global viewmainheadid curview
9902
9903    if {[gets $fd line] >= 0} {
9904        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9905            set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9906            adjustprogress
9907        }
9908        return 1
9909    }
9910    set progresscoords {0 0}
9911    adjustprogress
9912    notbusy checkout
9913    if {[catch {close $fd} err]} {
9914        error_popup $err
9915        return
9916    }
9917    set oldmainid $mainheadid
9918    if {! [info exists headids($newhead)]} {
9919        set headids($newhead) $newheadid
9920        lappend idheads($newheadid) $newhead
9921        addedhead $newheadid $newhead
9922    }
9923    set mainhead $newhead
9924    set mainheadid $newheadid
9925    set viewmainheadid($curview) $newheadid
9926    redrawtags $oldmainid
9927    redrawtags $newheadid
9928    selbyid $newheadid
9929    if {$showlocalchanges} {
9930        dodiffindex
9931    }
9932}
9933
9934proc rmbranch {} {
9935    global headmenuid headmenuhead mainhead
9936    global idheads
9937
9938    set head $headmenuhead
9939    set id $headmenuid
9940    # this check shouldn't be needed any more...
9941    if {$head eq $mainhead} {
9942        error_popup [mc "Cannot delete the currently checked-out branch"]
9943        return
9944    }
9945    set dheads [descheads $id]
9946    if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
9947        # the stuff on this branch isn't on any other branch
9948        if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9949                        branch.\nReally delete branch %s?" $head $head]]} return
9950    }
9951    nowbusy rmbranch
9952    update
9953    if {[catch {exec git branch -D $head} err]} {
9954        notbusy rmbranch
9955        error_popup $err
9956        return
9957    }
9958    removehead $id $head
9959    removedhead $id $head
9960    redrawtags $id
9961    notbusy rmbranch
9962    dispneartags 0
9963    run refill_reflist
9964}
9965
9966# Display a list of tags and heads
9967proc showrefs {} {
9968    global showrefstop bgcolor fgcolor selectbgcolor NS
9969    global bglist fglist reflistfilter reflist maincursor
9970
9971    set top .showrefs
9972    set showrefstop $top
9973    if {[winfo exists $top]} {
9974        raise $top
9975        refill_reflist
9976        return
9977    }
9978    ttk_toplevel $top
9979    wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
9980    make_transient $top .
9981    text $top.list -background $bgcolor -foreground $fgcolor \
9982        -selectbackground $selectbgcolor -font mainfont \
9983        -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
9984        -width 30 -height 20 -cursor $maincursor \
9985        -spacing1 1 -spacing3 1 -state disabled
9986    $top.list tag configure highlight -background $selectbgcolor
9987    if {![lsearch -exact $bglist $top.list]} {
9988        lappend bglist $top.list
9989        lappend fglist $top.list
9990    }
9991    ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
9992    ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
9993    grid $top.list $top.ysb -sticky nsew
9994    grid $top.xsb x -sticky ew
9995    ${NS}::frame $top.f
9996    ${NS}::label $top.f.l -text "[mc "Filter"]: "
9997    ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
9998    set reflistfilter "*"
9999    trace add variable reflistfilter write reflistfilter_change
10000    pack $top.f.e -side right -fill x -expand 1
10001    pack $top.f.l -side left
10002    grid $top.f - -sticky ew -pady 2
10003    ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
10004    bind $top <Key-Escape> [list destroy $top]
10005    grid $top.close -
10006    grid columnconfigure $top 0 -weight 1
10007    grid rowconfigure $top 0 -weight 1
10008    bind $top.list <1> {break}
10009    bind $top.list <B1-Motion> {break}
10010    bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
10011    set reflist {}
10012    refill_reflist
10013}
10014
10015proc sel_reflist {w x y} {
10016    global showrefstop reflist headids tagids otherrefids
10017
10018    if {![winfo exists $showrefstop]} return
10019    set l [lindex [split [$w index "@$x,$y"] "."] 0]
10020    set ref [lindex $reflist [expr {$l-1}]]
10021    set n [lindex $ref 0]
10022    switch -- [lindex $ref 1] {
10023        "H" {selbyid $headids($n)}
10024        "T" {selbyid $tagids($n)}
10025        "o" {selbyid $otherrefids($n)}
10026    }
10027    $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
10028}
10029
10030proc unsel_reflist {} {
10031    global showrefstop
10032
10033    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
10034    $showrefstop.list tag remove highlight 0.0 end
10035}
10036
10037proc reflistfilter_change {n1 n2 op} {
10038    global reflistfilter
10039
10040    after cancel refill_reflist
10041    after 200 refill_reflist
10042}
10043
10044proc refill_reflist {} {
10045    global reflist reflistfilter showrefstop headids tagids otherrefids
10046    global curview
10047
10048    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
10049    set refs {}
10050    foreach n [array names headids] {
10051        if {[string match $reflistfilter $n]} {
10052            if {[commitinview $headids($n) $curview]} {
10053                lappend refs [list $n H]
10054            } else {
10055                interestedin $headids($n) {run refill_reflist}
10056            }
10057        }
10058    }
10059    foreach n [array names tagids] {
10060        if {[string match $reflistfilter $n]} {
10061            if {[commitinview $tagids($n) $curview]} {
10062                lappend refs [list $n T]
10063            } else {
10064                interestedin $tagids($n) {run refill_reflist}
10065            }
10066        }
10067    }
10068    foreach n [array names otherrefids] {
10069        if {[string match $reflistfilter $n]} {
10070            if {[commitinview $otherrefids($n) $curview]} {
10071                lappend refs [list $n o]
10072            } else {
10073                interestedin $otherrefids($n) {run refill_reflist}
10074            }
10075        }
10076    }
10077    set refs [lsort -index 0 $refs]
10078    if {$refs eq $reflist} return
10079
10080    # Update the contents of $showrefstop.list according to the
10081    # differences between $reflist (old) and $refs (new)
10082    $showrefstop.list conf -state normal
10083    $showrefstop.list insert end "\n"
10084    set i 0
10085    set j 0
10086    while {$i < [llength $reflist] || $j < [llength $refs]} {
10087        if {$i < [llength $reflist]} {
10088            if {$j < [llength $refs]} {
10089                set cmp [string compare [lindex $reflist $i 0] \
10090                             [lindex $refs $j 0]]
10091                if {$cmp == 0} {
10092                    set cmp [string compare [lindex $reflist $i 1] \
10093                                 [lindex $refs $j 1]]
10094                }
10095            } else {
10096                set cmp -1
10097            }
10098        } else {
10099            set cmp 1
10100        }
10101        switch -- $cmp {
10102            -1 {
10103                $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
10104                incr i
10105            }
10106            0 {
10107                incr i
10108                incr j
10109            }
10110            1 {
10111                set l [expr {$j + 1}]
10112                $showrefstop.list image create $l.0 -align baseline \
10113                    -image reficon-[lindex $refs $j 1] -padx 2
10114                $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
10115                incr j
10116            }
10117        }
10118    }
10119    set reflist $refs
10120    # delete last newline
10121    $showrefstop.list delete end-2c end-1c
10122    $showrefstop.list conf -state disabled
10123}
10124
10125# Stuff for finding nearby tags
10126proc getallcommits {} {
10127    global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
10128    global idheads idtags idotherrefs allparents tagobjid
10129    global gitdir
10130
10131    if {![info exists allcommits]} {
10132        set nextarc 0
10133        set allcommits 0
10134        set seeds {}
10135        set allcwait 0
10136        set cachedarcs 0
10137        set allccache [file join $gitdir "gitk.cache"]
10138        if {![catch {
10139            set f [open $allccache r]
10140            set allcwait 1
10141            getcache $f
10142        }]} return
10143    }
10144
10145    if {$allcwait} {
10146        return
10147    }
10148    set cmd [list | git rev-list --parents]
10149    set allcupdate [expr {$seeds ne {}}]
10150    if {!$allcupdate} {
10151        set ids "--all"
10152    } else {
10153        set refs [concat [array names idheads] [array names idtags] \
10154                      [array names idotherrefs]]
10155        set ids {}
10156        set tagobjs {}
10157        foreach name [array names tagobjid] {
10158            lappend tagobjs $tagobjid($name)
10159        }
10160        foreach id [lsort -unique $refs] {
10161            if {![info exists allparents($id)] &&
10162                [lsearch -exact $tagobjs $id] < 0} {
10163                lappend ids $id
10164            }
10165        }
10166        if {$ids ne {}} {
10167            foreach id $seeds {
10168                lappend ids "^$id"
10169            }
10170        }
10171    }
10172    if {$ids ne {}} {
10173        set fd [open [concat $cmd $ids] r]
10174        fconfigure $fd -blocking 0
10175        incr allcommits
10176        nowbusy allcommits
10177        filerun $fd [list getallclines $fd]
10178    } else {
10179        dispneartags 0
10180    }
10181}
10182
10183# Since most commits have 1 parent and 1 child, we group strings of
10184# such commits into "arcs" joining branch/merge points (BMPs), which
10185# are commits that either don't have 1 parent or don't have 1 child.
10186#
10187# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
10188# arcout(id) - outgoing arcs for BMP
10189# arcids(a) - list of IDs on arc including end but not start
10190# arcstart(a) - BMP ID at start of arc
10191# arcend(a) - BMP ID at end of arc
10192# growing(a) - arc a is still growing
10193# arctags(a) - IDs out of arcids (excluding end) that have tags
10194# archeads(a) - IDs out of arcids (excluding end) that have heads
10195# The start of an arc is at the descendent end, so "incoming" means
10196# coming from descendents, and "outgoing" means going towards ancestors.
10197
10198proc getallclines {fd} {
10199    global allparents allchildren idtags idheads nextarc
10200    global arcnos arcids arctags arcout arcend arcstart archeads growing
10201    global seeds allcommits cachedarcs allcupdate
10202
10203    set nid 0
10204    while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
10205        set id [lindex $line 0]
10206        if {[info exists allparents($id)]} {
10207            # seen it already
10208            continue
10209        }
10210        set cachedarcs 0
10211        set olds [lrange $line 1 end]
10212        set allparents($id) $olds
10213        if {![info exists allchildren($id)]} {
10214            set allchildren($id) {}
10215            set arcnos($id) {}
10216            lappend seeds $id
10217        } else {
10218            set a $arcnos($id)
10219            if {[llength $olds] == 1 && [llength $a] == 1} {
10220                lappend arcids($a) $id
10221                if {[info exists idtags($id)]} {
10222                    lappend arctags($a) $id
10223                }
10224                if {[info exists idheads($id)]} {
10225                    lappend archeads($a) $id
10226                }
10227                if {[info exists allparents($olds)]} {
10228                    # seen parent already
10229                    if {![info exists arcout($olds)]} {
10230                        splitarc $olds
10231                    }
10232                    lappend arcids($a) $olds
10233                    set arcend($a) $olds
10234                    unset growing($a)
10235                }
10236                lappend allchildren($olds) $id
10237                lappend arcnos($olds) $a
10238                continue
10239            }
10240        }
10241        foreach a $arcnos($id) {
10242            lappend arcids($a) $id
10243            set arcend($a) $id
10244            unset growing($a)
10245        }
10246
10247        set ao {}
10248        foreach p $olds {
10249            lappend allchildren($p) $id
10250            set a [incr nextarc]
10251            set arcstart($a) $id
10252            set archeads($a) {}
10253            set arctags($a) {}
10254            set archeads($a) {}
10255            set arcids($a) {}
10256            lappend ao $a
10257            set growing($a) 1
10258            if {[info exists allparents($p)]} {
10259                # seen it already, may need to make a new branch
10260                if {![info exists arcout($p)]} {
10261                    splitarc $p
10262                }
10263                lappend arcids($a) $p
10264                set arcend($a) $p
10265                unset growing($a)
10266            }
10267            lappend arcnos($p) $a
10268        }
10269        set arcout($id) $ao
10270    }
10271    if {$nid > 0} {
10272        global cached_dheads cached_dtags cached_atags
10273        unset -nocomplain cached_dheads
10274        unset -nocomplain cached_dtags
10275        unset -nocomplain cached_atags
10276    }
10277    if {![eof $fd]} {
10278        return [expr {$nid >= 1000? 2: 1}]
10279    }
10280    set cacheok 1
10281    if {[catch {
10282        fconfigure $fd -blocking 1
10283        close $fd
10284    } err]} {
10285        # got an error reading the list of commits
10286        # if we were updating, try rereading the whole thing again
10287        if {$allcupdate} {
10288            incr allcommits -1
10289            dropcache $err
10290            return
10291        }
10292        error_popup "[mc "Error reading commit topology information;\
10293                branch and preceding/following tag information\
10294                will be incomplete."]\n($err)"
10295        set cacheok 0
10296    }
10297    if {[incr allcommits -1] == 0} {
10298        notbusy allcommits
10299        if {$cacheok} {
10300            run savecache
10301        }
10302    }
10303    dispneartags 0
10304    return 0
10305}
10306
10307proc recalcarc {a} {
10308    global arctags archeads arcids idtags idheads
10309
10310    set at {}
10311    set ah {}
10312    foreach id [lrange $arcids($a) 0 end-1] {
10313        if {[info exists idtags($id)]} {
10314            lappend at $id
10315        }
10316        if {[info exists idheads($id)]} {
10317            lappend ah $id
10318        }
10319    }
10320    set arctags($a) $at
10321    set archeads($a) $ah
10322}
10323
10324proc splitarc {p} {
10325    global arcnos arcids nextarc arctags archeads idtags idheads
10326    global arcstart arcend arcout allparents growing
10327
10328    set a $arcnos($p)
10329    if {[llength $a] != 1} {
10330        puts "oops splitarc called but [llength $a] arcs already"
10331        return
10332    }
10333    set a [lindex $a 0]
10334    set i [lsearch -exact $arcids($a) $p]
10335    if {$i < 0} {
10336        puts "oops splitarc $p not in arc $a"
10337        return
10338    }
10339    set na [incr nextarc]
10340    if {[info exists arcend($a)]} {
10341        set arcend($na) $arcend($a)
10342    } else {
10343        set l [lindex $allparents([lindex $arcids($a) end]) 0]
10344        set j [lsearch -exact $arcnos($l) $a]
10345        set arcnos($l) [lreplace $arcnos($l) $j $j $na]
10346    }
10347    set tail [lrange $arcids($a) [expr {$i+1}] end]
10348    set arcids($a) [lrange $arcids($a) 0 $i]
10349    set arcend($a) $p
10350    set arcstart($na) $p
10351    set arcout($p) $na
10352    set arcids($na) $tail
10353    if {[info exists growing($a)]} {
10354        set growing($na) 1
10355        unset growing($a)
10356    }
10357
10358    foreach id $tail {
10359        if {[llength $arcnos($id)] == 1} {
10360            set arcnos($id) $na
10361        } else {
10362            set j [lsearch -exact $arcnos($id) $a]
10363            set arcnos($id) [lreplace $arcnos($id) $j $j $na]
10364        }
10365    }
10366
10367    # reconstruct tags and heads lists
10368    if {$arctags($a) ne {} || $archeads($a) ne {}} {
10369        recalcarc $a
10370        recalcarc $na
10371    } else {
10372        set arctags($na) {}
10373        set archeads($na) {}
10374    }
10375}
10376
10377# Update things for a new commit added that is a child of one
10378# existing commit.  Used when cherry-picking.
10379proc addnewchild {id p} {
10380    global allparents allchildren idtags nextarc
10381    global arcnos arcids arctags arcout arcend arcstart archeads growing
10382    global seeds allcommits
10383
10384    if {![info exists allcommits] || ![info exists arcnos($p)]} return
10385    set allparents($id) [list $p]
10386    set allchildren($id) {}
10387    set arcnos($id) {}
10388    lappend seeds $id
10389    lappend allchildren($p) $id
10390    set a [incr nextarc]
10391    set arcstart($a) $id
10392    set archeads($a) {}
10393    set arctags($a) {}
10394    set arcids($a) [list $p]
10395    set arcend($a) $p
10396    if {![info exists arcout($p)]} {
10397        splitarc $p
10398    }
10399    lappend arcnos($p) $a
10400    set arcout($id) [list $a]
10401}
10402
10403# This implements a cache for the topology information.
10404# The cache saves, for each arc, the start and end of the arc,
10405# the ids on the arc, and the outgoing arcs from the end.
10406proc readcache {f} {
10407    global arcnos arcids arcout arcstart arcend arctags archeads nextarc
10408    global idtags idheads allparents cachedarcs possible_seeds seeds growing
10409    global allcwait
10410
10411    set a $nextarc
10412    set lim $cachedarcs
10413    if {$lim - $a > 500} {
10414        set lim [expr {$a + 500}]
10415    }
10416    if {[catch {
10417        if {$a == $lim} {
10418            # finish reading the cache and setting up arctags, etc.
10419            set line [gets $f]
10420            if {$line ne "1"} {error "bad final version"}
10421            close $f
10422            foreach id [array names idtags] {
10423                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10424                    [llength $allparents($id)] == 1} {
10425                    set a [lindex $arcnos($id) 0]
10426                    if {$arctags($a) eq {}} {
10427                        recalcarc $a
10428                    }
10429                }
10430            }
10431            foreach id [array names idheads] {
10432                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10433                    [llength $allparents($id)] == 1} {
10434                    set a [lindex $arcnos($id) 0]
10435                    if {$archeads($a) eq {}} {
10436                        recalcarc $a
10437                    }
10438                }
10439            }
10440            foreach id [lsort -unique $possible_seeds] {
10441                if {$arcnos($id) eq {}} {
10442                    lappend seeds $id
10443                }
10444            }
10445            set allcwait 0
10446        } else {
10447            while {[incr a] <= $lim} {
10448                set line [gets $f]
10449                if {[llength $line] != 3} {error "bad line"}
10450                set s [lindex $line 0]
10451                set arcstart($a) $s
10452                lappend arcout($s) $a
10453                if {![info exists arcnos($s)]} {
10454                    lappend possible_seeds $s
10455                    set arcnos($s) {}
10456                }
10457                set e [lindex $line 1]
10458                if {$e eq {}} {
10459                    set growing($a) 1
10460                } else {
10461                    set arcend($a) $e
10462                    if {![info exists arcout($e)]} {
10463                        set arcout($e) {}
10464                    }
10465                }
10466                set arcids($a) [lindex $line 2]
10467                foreach id $arcids($a) {
10468                    lappend allparents($s) $id
10469                    set s $id
10470                    lappend arcnos($id) $a
10471                }
10472                if {![info exists allparents($s)]} {
10473                    set allparents($s) {}
10474                }
10475                set arctags($a) {}
10476                set archeads($a) {}
10477            }
10478            set nextarc [expr {$a - 1}]
10479        }
10480    } err]} {
10481        dropcache $err
10482        return 0
10483    }
10484    if {!$allcwait} {
10485        getallcommits
10486    }
10487    return $allcwait
10488}
10489
10490proc getcache {f} {
10491    global nextarc cachedarcs possible_seeds
10492
10493    if {[catch {
10494        set line [gets $f]
10495        if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
10496        # make sure it's an integer
10497        set cachedarcs [expr {int([lindex $line 1])}]
10498        if {$cachedarcs < 0} {error "bad number of arcs"}
10499        set nextarc 0
10500        set possible_seeds {}
10501        run readcache $f
10502    } err]} {
10503        dropcache $err
10504    }
10505    return 0
10506}
10507
10508proc dropcache {err} {
10509    global allcwait nextarc cachedarcs seeds
10510
10511    #puts "dropping cache ($err)"
10512    foreach v {arcnos arcout arcids arcstart arcend growing \
10513                   arctags archeads allparents allchildren} {
10514        global $v
10515        unset -nocomplain $v
10516    }
10517    set allcwait 0
10518    set nextarc 0
10519    set cachedarcs 0
10520    set seeds {}
10521    getallcommits
10522}
10523
10524proc writecache {f} {
10525    global cachearc cachedarcs allccache
10526    global arcstart arcend arcnos arcids arcout
10527
10528    set a $cachearc
10529    set lim $cachedarcs
10530    if {$lim - $a > 1000} {
10531        set lim [expr {$a + 1000}]
10532    }
10533    if {[catch {
10534        while {[incr a] <= $lim} {
10535            if {[info exists arcend($a)]} {
10536                puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
10537            } else {
10538                puts $f [list $arcstart($a) {} $arcids($a)]
10539            }
10540        }
10541    } err]} {
10542        catch {close $f}
10543        catch {file delete $allccache}
10544        #puts "writing cache failed ($err)"
10545        return 0
10546    }
10547    set cachearc [expr {$a - 1}]
10548    if {$a > $cachedarcs} {
10549        puts $f "1"
10550        close $f
10551        return 0
10552    }
10553    return 1
10554}
10555
10556proc savecache {} {
10557    global nextarc cachedarcs cachearc allccache
10558
10559    if {$nextarc == $cachedarcs} return
10560    set cachearc 0
10561    set cachedarcs $nextarc
10562    catch {
10563        set f [open $allccache w]
10564        puts $f [list 1 $cachedarcs]
10565        run writecache $f
10566    }
10567}
10568
10569# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
10570# or 0 if neither is true.
10571proc anc_or_desc {a b} {
10572    global arcout arcstart arcend arcnos cached_isanc
10573
10574    if {$arcnos($a) eq $arcnos($b)} {
10575        # Both are on the same arc(s); either both are the same BMP,
10576        # or if one is not a BMP, the other is also not a BMP or is
10577        # the BMP at end of the arc (and it only has 1 incoming arc).
10578        # Or both can be BMPs with no incoming arcs.
10579        if {$a eq $b || $arcnos($a) eq {}} {
10580            return 0
10581        }
10582        # assert {[llength $arcnos($a)] == 1}
10583        set arc [lindex $arcnos($a) 0]
10584        set i [lsearch -exact $arcids($arc) $a]
10585        set j [lsearch -exact $arcids($arc) $b]
10586        if {$i < 0 || $i > $j} {
10587            return 1
10588        } else {
10589            return -1
10590        }
10591    }
10592
10593    if {![info exists arcout($a)]} {
10594        set arc [lindex $arcnos($a) 0]
10595        if {[info exists arcend($arc)]} {
10596            set aend $arcend($arc)
10597        } else {
10598            set aend {}
10599        }
10600        set a $arcstart($arc)
10601    } else {
10602        set aend $a
10603    }
10604    if {![info exists arcout($b)]} {
10605        set arc [lindex $arcnos($b) 0]
10606        if {[info exists arcend($arc)]} {
10607            set bend $arcend($arc)
10608        } else {
10609            set bend {}
10610        }
10611        set b $arcstart($arc)
10612    } else {
10613        set bend $b
10614    }
10615    if {$a eq $bend} {
10616        return 1
10617    }
10618    if {$b eq $aend} {
10619        return -1
10620    }
10621    if {[info exists cached_isanc($a,$bend)]} {
10622        if {$cached_isanc($a,$bend)} {
10623            return 1
10624        }
10625    }
10626    if {[info exists cached_isanc($b,$aend)]} {
10627        if {$cached_isanc($b,$aend)} {
10628            return -1
10629        }
10630        if {[info exists cached_isanc($a,$bend)]} {
10631            return 0
10632        }
10633    }
10634
10635    set todo [list $a $b]
10636    set anc($a) a
10637    set anc($b) b
10638    for {set i 0} {$i < [llength $todo]} {incr i} {
10639        set x [lindex $todo $i]
10640        if {$anc($x) eq {}} {
10641            continue
10642        }
10643        foreach arc $arcnos($x) {
10644            set xd $arcstart($arc)
10645            if {$xd eq $bend} {
10646                set cached_isanc($a,$bend) 1
10647                set cached_isanc($b,$aend) 0
10648                return 1
10649            } elseif {$xd eq $aend} {
10650                set cached_isanc($b,$aend) 1
10651                set cached_isanc($a,$bend) 0
10652                return -1
10653            }
10654            if {![info exists anc($xd)]} {
10655                set anc($xd) $anc($x)
10656                lappend todo $xd
10657            } elseif {$anc($xd) ne $anc($x)} {
10658                set anc($xd) {}
10659            }
10660        }
10661    }
10662    set cached_isanc($a,$bend) 0
10663    set cached_isanc($b,$aend) 0
10664    return 0
10665}
10666
10667# This identifies whether $desc has an ancestor that is
10668# a growing tip of the graph and which is not an ancestor of $anc
10669# and returns 0 if so and 1 if not.
10670# If we subsequently discover a tag on such a growing tip, and that
10671# turns out to be a descendent of $anc (which it could, since we
10672# don't necessarily see children before parents), then $desc
10673# isn't a good choice to display as a descendent tag of
10674# $anc (since it is the descendent of another tag which is
10675# a descendent of $anc).  Similarly, $anc isn't a good choice to
10676# display as a ancestor tag of $desc.
10677#
10678proc is_certain {desc anc} {
10679    global arcnos arcout arcstart arcend growing problems
10680
10681    set certain {}
10682    if {[llength $arcnos($anc)] == 1} {
10683        # tags on the same arc are certain
10684        if {$arcnos($desc) eq $arcnos($anc)} {
10685            return 1
10686        }
10687        if {![info exists arcout($anc)]} {
10688            # if $anc is partway along an arc, use the start of the arc instead
10689            set a [lindex $arcnos($anc) 0]
10690            set anc $arcstart($a)
10691        }
10692    }
10693    if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
10694        set x $desc
10695    } else {
10696        set a [lindex $arcnos($desc) 0]
10697        set x $arcend($a)
10698    }
10699    if {$x == $anc} {
10700        return 1
10701    }
10702    set anclist [list $x]
10703    set dl($x) 1
10704    set nnh 1
10705    set ngrowanc 0
10706    for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
10707        set x [lindex $anclist $i]
10708        if {$dl($x)} {
10709            incr nnh -1
10710        }
10711        set done($x) 1
10712        foreach a $arcout($x) {
10713            if {[info exists growing($a)]} {
10714                if {![info exists growanc($x)] && $dl($x)} {
10715                    set growanc($x) 1
10716                    incr ngrowanc
10717                }
10718            } else {
10719                set y $arcend($a)
10720                if {[info exists dl($y)]} {
10721                    if {$dl($y)} {
10722                        if {!$dl($x)} {
10723                            set dl($y) 0
10724                            if {![info exists done($y)]} {
10725                                incr nnh -1
10726                            }
10727                            if {[info exists growanc($x)]} {
10728                                incr ngrowanc -1
10729                            }
10730                            set xl [list $y]
10731                            for {set k 0} {$k < [llength $xl]} {incr k} {
10732                                set z [lindex $xl $k]
10733                                foreach c $arcout($z) {
10734                                    if {[info exists arcend($c)]} {
10735                                        set v $arcend($c)
10736                                        if {[info exists dl($v)] && $dl($v)} {
10737                                            set dl($v) 0
10738                                            if {![info exists done($v)]} {
10739                                                incr nnh -1
10740                                            }
10741                                            if {[info exists growanc($v)]} {
10742                                                incr ngrowanc -1
10743                                            }
10744                                            lappend xl $v
10745                                        }
10746                                    }
10747                                }
10748                            }
10749                        }
10750                    }
10751                } elseif {$y eq $anc || !$dl($x)} {
10752                    set dl($y) 0
10753                    lappend anclist $y
10754                } else {
10755                    set dl($y) 1
10756                    lappend anclist $y
10757                    incr nnh
10758                }
10759            }
10760        }
10761    }
10762    foreach x [array names growanc] {
10763        if {$dl($x)} {
10764            return 0
10765        }
10766        return 0
10767    }
10768    return 1
10769}
10770
10771proc validate_arctags {a} {
10772    global arctags idtags
10773
10774    set i -1
10775    set na $arctags($a)
10776    foreach id $arctags($a) {
10777        incr i
10778        if {![info exists idtags($id)]} {
10779            set na [lreplace $na $i $i]
10780            incr i -1
10781        }
10782    }
10783    set arctags($a) $na
10784}
10785
10786proc validate_archeads {a} {
10787    global archeads idheads
10788
10789    set i -1
10790    set na $archeads($a)
10791    foreach id $archeads($a) {
10792        incr i
10793        if {![info exists idheads($id)]} {
10794            set na [lreplace $na $i $i]
10795            incr i -1
10796        }
10797    }
10798    set archeads($a) $na
10799}
10800
10801# Return the list of IDs that have tags that are descendents of id,
10802# ignoring IDs that are descendents of IDs already reported.
10803proc desctags {id} {
10804    global arcnos arcstart arcids arctags idtags allparents
10805    global growing cached_dtags
10806
10807    if {![info exists allparents($id)]} {
10808        return {}
10809    }
10810    set t1 [clock clicks -milliseconds]
10811    set argid $id
10812    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10813        # part-way along an arc; check that arc first
10814        set a [lindex $arcnos($id) 0]
10815        if {$arctags($a) ne {}} {
10816            validate_arctags $a
10817            set i [lsearch -exact $arcids($a) $id]
10818            set tid {}
10819            foreach t $arctags($a) {
10820                set j [lsearch -exact $arcids($a) $t]
10821                if {$j >= $i} break
10822                set tid $t
10823            }
10824            if {$tid ne {}} {
10825                return $tid
10826            }
10827        }
10828        set id $arcstart($a)
10829        if {[info exists idtags($id)]} {
10830            return $id
10831        }
10832    }
10833    if {[info exists cached_dtags($id)]} {
10834        return $cached_dtags($id)
10835    }
10836
10837    set origid $id
10838    set todo [list $id]
10839    set queued($id) 1
10840    set nc 1
10841    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10842        set id [lindex $todo $i]
10843        set done($id) 1
10844        set ta [info exists hastaggedancestor($id)]
10845        if {!$ta} {
10846            incr nc -1
10847        }
10848        # ignore tags on starting node
10849        if {!$ta && $i > 0} {
10850            if {[info exists idtags($id)]} {
10851                set tagloc($id) $id
10852                set ta 1
10853            } elseif {[info exists cached_dtags($id)]} {
10854                set tagloc($id) $cached_dtags($id)
10855                set ta 1
10856            }
10857        }
10858        foreach a $arcnos($id) {
10859            set d $arcstart($a)
10860            if {!$ta && $arctags($a) ne {}} {
10861                validate_arctags $a
10862                if {$arctags($a) ne {}} {
10863                    lappend tagloc($id) [lindex $arctags($a) end]
10864                }
10865            }
10866            if {$ta || $arctags($a) ne {}} {
10867                set tomark [list $d]
10868                for {set j 0} {$j < [llength $tomark]} {incr j} {
10869                    set dd [lindex $tomark $j]
10870                    if {![info exists hastaggedancestor($dd)]} {
10871                        if {[info exists done($dd)]} {
10872                            foreach b $arcnos($dd) {
10873                                lappend tomark $arcstart($b)
10874                            }
10875                            if {[info exists tagloc($dd)]} {
10876                                unset tagloc($dd)
10877                            }
10878                        } elseif {[info exists queued($dd)]} {
10879                            incr nc -1
10880                        }
10881                        set hastaggedancestor($dd) 1
10882                    }
10883                }
10884            }
10885            if {![info exists queued($d)]} {
10886                lappend todo $d
10887                set queued($d) 1
10888                if {![info exists hastaggedancestor($d)]} {
10889                    incr nc
10890                }
10891            }
10892        }
10893    }
10894    set tags {}
10895    foreach id [array names tagloc] {
10896        if {![info exists hastaggedancestor($id)]} {
10897            foreach t $tagloc($id) {
10898                if {[lsearch -exact $tags $t] < 0} {
10899                    lappend tags $t
10900                }
10901            }
10902        }
10903    }
10904    set t2 [clock clicks -milliseconds]
10905    set loopix $i
10906
10907    # remove tags that are descendents of other tags
10908    for {set i 0} {$i < [llength $tags]} {incr i} {
10909        set a [lindex $tags $i]
10910        for {set j 0} {$j < $i} {incr j} {
10911            set b [lindex $tags $j]
10912            set r [anc_or_desc $a $b]
10913            if {$r == 1} {
10914                set tags [lreplace $tags $j $j]
10915                incr j -1
10916                incr i -1
10917            } elseif {$r == -1} {
10918                set tags [lreplace $tags $i $i]
10919                incr i -1
10920                break
10921            }
10922        }
10923    }
10924
10925    if {[array names growing] ne {}} {
10926        # graph isn't finished, need to check if any tag could get
10927        # eclipsed by another tag coming later.  Simply ignore any
10928        # tags that could later get eclipsed.
10929        set ctags {}
10930        foreach t $tags {
10931            if {[is_certain $t $origid]} {
10932                lappend ctags $t
10933            }
10934        }
10935        if {$tags eq $ctags} {
10936            set cached_dtags($origid) $tags
10937        } else {
10938            set tags $ctags
10939        }
10940    } else {
10941        set cached_dtags($origid) $tags
10942    }
10943    set t3 [clock clicks -milliseconds]
10944    if {0 && $t3 - $t1 >= 100} {
10945        puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10946            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10947    }
10948    return $tags
10949}
10950
10951proc anctags {id} {
10952    global arcnos arcids arcout arcend arctags idtags allparents
10953    global growing cached_atags
10954
10955    if {![info exists allparents($id)]} {
10956        return {}
10957    }
10958    set t1 [clock clicks -milliseconds]
10959    set argid $id
10960    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10961        # part-way along an arc; check that arc first
10962        set a [lindex $arcnos($id) 0]
10963        if {$arctags($a) ne {}} {
10964            validate_arctags $a
10965            set i [lsearch -exact $arcids($a) $id]
10966            foreach t $arctags($a) {
10967                set j [lsearch -exact $arcids($a) $t]
10968                if {$j > $i} {
10969                    return $t
10970                }
10971            }
10972        }
10973        if {![info exists arcend($a)]} {
10974            return {}
10975        }
10976        set id $arcend($a)
10977        if {[info exists idtags($id)]} {
10978            return $id
10979        }
10980    }
10981    if {[info exists cached_atags($id)]} {
10982        return $cached_atags($id)
10983    }
10984
10985    set origid $id
10986    set todo [list $id]
10987    set queued($id) 1
10988    set taglist {}
10989    set nc 1
10990    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10991        set id [lindex $todo $i]
10992        set done($id) 1
10993        set td [info exists hastaggeddescendent($id)]
10994        if {!$td} {
10995            incr nc -1
10996        }
10997        # ignore tags on starting node
10998        if {!$td && $i > 0} {
10999            if {[info exists idtags($id)]} {
11000                set tagloc($id) $id
11001                set td 1
11002            } elseif {[info exists cached_atags($id)]} {
11003                set tagloc($id) $cached_atags($id)
11004                set td 1
11005            }
11006        }
11007        foreach a $arcout($id) {
11008            if {!$td && $arctags($a) ne {}} {
11009                validate_arctags $a
11010                if {$arctags($a) ne {}} {
11011                    lappend tagloc($id) [lindex $arctags($a) 0]
11012                }
11013            }
11014            if {![info exists arcend($a)]} continue
11015            set d $arcend($a)
11016            if {$td || $arctags($a) ne {}} {
11017                set tomark [list $d]
11018                for {set j 0} {$j < [llength $tomark]} {incr j} {
11019                    set dd [lindex $tomark $j]
11020                    if {![info exists hastaggeddescendent($dd)]} {
11021                        if {[info exists done($dd)]} {
11022                            foreach b $arcout($dd) {
11023                                if {[info exists arcend($b)]} {
11024                                    lappend tomark $arcend($b)
11025                                }
11026                            }
11027                            if {[info exists tagloc($dd)]} {
11028                                unset tagloc($dd)
11029                            }
11030                        } elseif {[info exists queued($dd)]} {
11031                            incr nc -1
11032                        }
11033                        set hastaggeddescendent($dd) 1
11034                    }
11035                }
11036            }
11037            if {![info exists queued($d)]} {
11038                lappend todo $d
11039                set queued($d) 1
11040                if {![info exists hastaggeddescendent($d)]} {
11041                    incr nc
11042                }
11043            }
11044        }
11045    }
11046    set t2 [clock clicks -milliseconds]
11047    set loopix $i
11048    set tags {}
11049    foreach id [array names tagloc] {
11050        if {![info exists hastaggeddescendent($id)]} {
11051            foreach t $tagloc($id) {
11052                if {[lsearch -exact $tags $t] < 0} {
11053                    lappend tags $t
11054                }
11055            }
11056        }
11057    }
11058
11059    # remove tags that are ancestors of other tags
11060    for {set i 0} {$i < [llength $tags]} {incr i} {
11061        set a [lindex $tags $i]
11062        for {set j 0} {$j < $i} {incr j} {
11063            set b [lindex $tags $j]
11064            set r [anc_or_desc $a $b]
11065            if {$r == -1} {
11066                set tags [lreplace $tags $j $j]
11067                incr j -1
11068                incr i -1
11069            } elseif {$r == 1} {
11070                set tags [lreplace $tags $i $i]
11071                incr i -1
11072                break
11073            }
11074        }
11075    }
11076
11077    if {[array names growing] ne {}} {
11078        # graph isn't finished, need to check if any tag could get
11079        # eclipsed by another tag coming later.  Simply ignore any
11080        # tags that could later get eclipsed.
11081        set ctags {}
11082        foreach t $tags {
11083            if {[is_certain $origid $t]} {
11084                lappend ctags $t
11085            }
11086        }
11087        if {$tags eq $ctags} {
11088            set cached_atags($origid) $tags
11089        } else {
11090            set tags $ctags
11091        }
11092    } else {
11093        set cached_atags($origid) $tags
11094    }
11095    set t3 [clock clicks -milliseconds]
11096    if {0 && $t3 - $t1 >= 100} {
11097        puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
11098            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
11099    }
11100    return $tags
11101}
11102
11103# Return the list of IDs that have heads that are descendents of id,
11104# including id itself if it has a head.
11105proc descheads {id} {
11106    global arcnos arcstart arcids archeads idheads cached_dheads
11107    global allparents arcout
11108
11109    if {![info exists allparents($id)]} {
11110        return {}
11111    }
11112    set aret {}
11113    if {![info exists arcout($id)]} {
11114        # part-way along an arc; check it first
11115        set a [lindex $arcnos($id) 0]
11116        if {$archeads($a) ne {}} {
11117            validate_archeads $a
11118            set i [lsearch -exact $arcids($a) $id]
11119            foreach t $archeads($a) {
11120                set j [lsearch -exact $arcids($a) $t]
11121                if {$j > $i} break
11122                lappend aret $t
11123            }
11124        }
11125        set id $arcstart($a)
11126    }
11127    set origid $id
11128    set todo [list $id]
11129    set seen($id) 1
11130    set ret {}
11131    for {set i 0} {$i < [llength $todo]} {incr i} {
11132        set id [lindex $todo $i]
11133        if {[info exists cached_dheads($id)]} {
11134            set ret [concat $ret $cached_dheads($id)]
11135        } else {
11136            if {[info exists idheads($id)]} {
11137                lappend ret $id
11138            }
11139            foreach a $arcnos($id) {
11140                if {$archeads($a) ne {}} {
11141                    validate_archeads $a
11142                    if {$archeads($a) ne {}} {
11143                        set ret [concat $ret $archeads($a)]
11144                    }
11145                }
11146                set d $arcstart($a)
11147                if {![info exists seen($d)]} {
11148                    lappend todo $d
11149                    set seen($d) 1
11150                }
11151            }
11152        }
11153    }
11154    set ret [lsort -unique $ret]
11155    set cached_dheads($origid) $ret
11156    return [concat $ret $aret]
11157}
11158
11159proc addedtag {id} {
11160    global arcnos arcout cached_dtags cached_atags
11161
11162    if {![info exists arcnos($id)]} return
11163    if {![info exists arcout($id)]} {
11164        recalcarc [lindex $arcnos($id) 0]
11165    }
11166    unset -nocomplain cached_dtags
11167    unset -nocomplain cached_atags
11168}
11169
11170proc addedhead {hid head} {
11171    global arcnos arcout cached_dheads
11172
11173    if {![info exists arcnos($hid)]} return
11174    if {![info exists arcout($hid)]} {
11175        recalcarc [lindex $arcnos($hid) 0]
11176    }
11177    unset -nocomplain cached_dheads
11178}
11179
11180proc removedhead {hid head} {
11181    global cached_dheads
11182
11183    unset -nocomplain cached_dheads
11184}
11185
11186proc movedhead {hid head} {
11187    global arcnos arcout cached_dheads
11188
11189    if {![info exists arcnos($hid)]} return
11190    if {![info exists arcout($hid)]} {
11191        recalcarc [lindex $arcnos($hid) 0]
11192    }
11193    unset -nocomplain cached_dheads
11194}
11195
11196proc changedrefs {} {
11197    global cached_dheads cached_dtags cached_atags cached_tagcontent
11198    global arctags archeads arcnos arcout idheads idtags
11199
11200    foreach id [concat [array names idheads] [array names idtags]] {
11201        if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
11202            set a [lindex $arcnos($id) 0]
11203            if {![info exists donearc($a)]} {
11204                recalcarc $a
11205                set donearc($a) 1
11206            }
11207        }
11208    }
11209    unset -nocomplain cached_tagcontent
11210    unset -nocomplain cached_dtags
11211    unset -nocomplain cached_atags
11212    unset -nocomplain cached_dheads
11213}
11214
11215proc rereadrefs {} {
11216    global idtags idheads idotherrefs mainheadid
11217
11218    set refids [concat [array names idtags] \
11219                    [array names idheads] [array names idotherrefs]]
11220    foreach id $refids {
11221        if {![info exists ref($id)]} {
11222            set ref($id) [listrefs $id]
11223        }
11224    }
11225    set oldmainhead $mainheadid
11226    readrefs
11227    changedrefs
11228    set refids [lsort -unique [concat $refids [array names idtags] \
11229                        [array names idheads] [array names idotherrefs]]]
11230    foreach id $refids {
11231        set v [listrefs $id]
11232        if {![info exists ref($id)] || $ref($id) != $v} {
11233            redrawtags $id
11234        }
11235    }
11236    if {$oldmainhead ne $mainheadid} {
11237        redrawtags $oldmainhead
11238        redrawtags $mainheadid
11239    }
11240    run refill_reflist
11241}
11242
11243proc listrefs {id} {
11244    global idtags idheads idotherrefs
11245
11246    set x {}
11247    if {[info exists idtags($id)]} {
11248        set x $idtags($id)
11249    }
11250    set y {}
11251    if {[info exists idheads($id)]} {
11252        set y $idheads($id)
11253    }
11254    set z {}
11255    if {[info exists idotherrefs($id)]} {
11256        set z $idotherrefs($id)
11257    }
11258    return [list $x $y $z]
11259}
11260
11261proc add_tag_ctext {tag} {
11262    global ctext cached_tagcontent tagids
11263
11264    if {![info exists cached_tagcontent($tag)]} {
11265        catch {
11266            set cached_tagcontent($tag) [exec git cat-file -p $tag]
11267        }
11268    }
11269    $ctext insert end "[mc "Tag"]: $tag\n" bold
11270    if {[info exists cached_tagcontent($tag)]} {
11271        set text $cached_tagcontent($tag)
11272    } else {
11273        set text "[mc "Id"]:  $tagids($tag)"
11274    }
11275    appendwithlinks $text {}
11276}
11277
11278proc showtag {tag isnew} {
11279    global ctext cached_tagcontent tagids linknum tagobjid
11280
11281    if {$isnew} {
11282        addtohistory [list showtag $tag 0] savectextpos
11283    }
11284    $ctext conf -state normal
11285    clear_ctext
11286    settabs 0
11287    set linknum 0
11288    add_tag_ctext $tag
11289    maybe_scroll_ctext 1
11290    $ctext conf -state disabled
11291    init_flist {}
11292}
11293
11294proc showtags {id isnew} {
11295    global idtags ctext linknum
11296
11297    if {$isnew} {
11298        addtohistory [list showtags $id 0] savectextpos
11299    }
11300    $ctext conf -state normal
11301    clear_ctext
11302    settabs 0
11303    set linknum 0
11304    set sep {}
11305    foreach tag $idtags($id) {
11306        $ctext insert end $sep
11307        add_tag_ctext $tag
11308        set sep "\n\n"
11309    }
11310    maybe_scroll_ctext 1
11311    $ctext conf -state disabled
11312    init_flist {}
11313}
11314
11315proc doquit {} {
11316    global stopped
11317    global gitktmpdir
11318
11319    set stopped 100
11320    savestuff .
11321    destroy .
11322
11323    if {[info exists gitktmpdir]} {
11324        catch {file delete -force $gitktmpdir}
11325    }
11326}
11327
11328proc mkfontdisp {font top which} {
11329    global fontattr fontpref $font NS use_ttk
11330
11331    set fontpref($font) [set $font]
11332    ${NS}::button $top.${font}but -text $which \
11333        -command [list choosefont $font $which]
11334    ${NS}::label $top.$font -relief flat -font $font \
11335        -text $fontattr($font,family) -justify left
11336    grid x $top.${font}but $top.$font -sticky w
11337}
11338
11339proc choosefont {font which} {
11340    global fontparam fontlist fonttop fontattr
11341    global prefstop NS
11342
11343    set fontparam(which) $which
11344    set fontparam(font) $font
11345    set fontparam(family) [font actual $font -family]
11346    set fontparam(size) $fontattr($font,size)
11347    set fontparam(weight) $fontattr($font,weight)
11348    set fontparam(slant) $fontattr($font,slant)
11349    set top .gitkfont
11350    set fonttop $top
11351    if {![winfo exists $top]} {
11352        font create sample
11353        eval font config sample [font actual $font]
11354        ttk_toplevel $top
11355        make_transient $top $prefstop
11356        wm title $top [mc "Gitk font chooser"]
11357        ${NS}::label $top.l -textvariable fontparam(which)
11358        pack $top.l -side top
11359        set fontlist [lsort [font families]]
11360        ${NS}::frame $top.f
11361        listbox $top.f.fam -listvariable fontlist \
11362            -yscrollcommand [list $top.f.sb set]
11363        bind $top.f.fam <<ListboxSelect>> selfontfam
11364        ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
11365        pack $top.f.sb -side right -fill y
11366        pack $top.f.fam -side left -fill both -expand 1
11367        pack $top.f -side top -fill both -expand 1
11368        ${NS}::frame $top.g
11369        spinbox $top.g.size -from 4 -to 40 -width 4 \
11370            -textvariable fontparam(size) \
11371            -validatecommand {string is integer -strict %s}
11372        checkbutton $top.g.bold -padx 5 \
11373            -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
11374            -variable fontparam(weight) -onvalue bold -offvalue normal
11375        checkbutton $top.g.ital -padx 5 \
11376            -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
11377            -variable fontparam(slant) -onvalue italic -offvalue roman
11378        pack $top.g.size $top.g.bold $top.g.ital -side left
11379        pack $top.g -side top
11380        canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
11381            -background white
11382        $top.c create text 100 25 -anchor center -text $which -font sample \
11383            -fill black -tags text
11384        bind $top.c <Configure> [list centertext $top.c]
11385        pack $top.c -side top -fill x
11386        ${NS}::frame $top.buts
11387        ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
11388        ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
11389        bind $top <Key-Return> fontok
11390        bind $top <Key-Escape> fontcan
11391        grid $top.buts.ok $top.buts.can
11392        grid columnconfigure $top.buts 0 -weight 1 -uniform a
11393        grid columnconfigure $top.buts 1 -weight 1 -uniform a
11394        pack $top.buts -side bottom -fill x
11395        trace add variable fontparam write chg_fontparam
11396    } else {
11397        raise $top
11398        $top.c itemconf text -text $which
11399    }
11400    set i [lsearch -exact $fontlist $fontparam(family)]
11401    if {$i >= 0} {
11402        $top.f.fam selection set $i
11403        $top.f.fam see $i
11404    }
11405}
11406
11407proc centertext {w} {
11408    $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
11409}
11410
11411proc fontok {} {
11412    global fontparam fontpref prefstop
11413
11414    set f $fontparam(font)
11415    set fontpref($f) [list $fontparam(family) $fontparam(size)]
11416    if {$fontparam(weight) eq "bold"} {
11417        lappend fontpref($f) "bold"
11418    }
11419    if {$fontparam(slant) eq "italic"} {
11420        lappend fontpref($f) "italic"
11421    }
11422    set w $prefstop.notebook.fonts.$f
11423    $w conf -text $fontparam(family) -font $fontpref($f)
11424
11425    fontcan
11426}
11427
11428proc fontcan {} {
11429    global fonttop fontparam
11430
11431    if {[info exists fonttop]} {
11432        catch {destroy $fonttop}
11433        catch {font delete sample}
11434        unset fonttop
11435        unset fontparam
11436    }
11437}
11438
11439if {[package vsatisfies [package provide Tk] 8.6]} {
11440    # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
11441    # function to make use of it.
11442    proc choosefont {font which} {
11443        tk fontchooser configure -title $which -font $font \
11444            -command [list on_choosefont $font $which]
11445        tk fontchooser show
11446    }
11447    proc on_choosefont {font which newfont} {
11448        global fontparam
11449        puts stderr "$font $newfont"
11450        array set f [font actual $newfont]
11451        set fontparam(which) $which
11452        set fontparam(font) $font
11453        set fontparam(family) $f(-family)
11454        set fontparam(size) $f(-size)
11455        set fontparam(weight) $f(-weight)
11456        set fontparam(slant) $f(-slant)
11457        fontok
11458    }
11459}
11460
11461proc selfontfam {} {
11462    global fonttop fontparam
11463
11464    set i [$fonttop.f.fam curselection]
11465    if {$i ne {}} {
11466        set fontparam(family) [$fonttop.f.fam get $i]
11467    }
11468}
11469
11470proc chg_fontparam {v sub op} {
11471    global fontparam
11472
11473    font config sample -$sub $fontparam($sub)
11474}
11475
11476# Create a property sheet tab page
11477proc create_prefs_page {w} {
11478    global NS
11479    set parent [join [lrange [split $w .] 0 end-1] .]
11480    if {[winfo class $parent] eq "TNotebook"} {
11481        ${NS}::frame $w
11482    } else {
11483        ${NS}::labelframe $w
11484    }
11485}
11486
11487proc prefspage_general {notebook} {
11488    global NS maxwidth maxgraphpct showneartags showlocalchanges
11489    global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11490    global hideremotes want_ttk have_ttk maxrefs
11491
11492    set page [create_prefs_page $notebook.general]
11493
11494    ${NS}::label $page.ldisp -text [mc "Commit list display options"]
11495    grid $page.ldisp - -sticky w -pady 10
11496    ${NS}::label $page.spacer -text " "
11497    ${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
11498    spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
11499    grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w
11500                                         #xgettext:no-tcl-format
11501    ${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
11502    spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
11503    grid x $page.maxpctl $page.maxpct -sticky w
11504    ${NS}::checkbutton $page.showlocal -text [mc "Show local changes"] \
11505        -variable showlocalchanges
11506    grid x $page.showlocal -sticky w
11507    ${NS}::checkbutton $page.autoselect -text [mc "Auto-select SHA1 (length)"] \
11508        -variable autoselect
11509    spinbox $page.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
11510    grid x $page.autoselect $page.autosellen -sticky w
11511    ${NS}::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \
11512        -variable hideremotes
11513    grid x $page.hideremotes -sticky w
11514
11515    ${NS}::label $page.ddisp -text [mc "Diff display options"]
11516    grid $page.ddisp - -sticky w -pady 10
11517    ${NS}::label $page.tabstopl -text [mc "Tab spacing"]
11518    spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
11519    grid x $page.tabstopl $page.tabstop -sticky w
11520    ${NS}::checkbutton $page.ntag -text [mc "Display nearby tags/heads"] \
11521        -variable showneartags
11522    grid x $page.ntag -sticky w
11523    ${NS}::label $page.maxrefsl -text [mc "Maximum # tags/heads to show"]
11524    spinbox $page.maxrefs -from 1 -to 1000 -width 4 -textvariable maxrefs
11525    grid x $page.maxrefsl $page.maxrefs -sticky w
11526    ${NS}::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \
11527        -variable limitdiffs
11528    grid x $page.ldiff -sticky w
11529    ${NS}::checkbutton $page.lattr -text [mc "Support per-file encodings"] \
11530        -variable perfile_attrs
11531    grid x $page.lattr -sticky w
11532
11533    ${NS}::entry $page.extdifft -textvariable extdifftool
11534    ${NS}::frame $page.extdifff
11535    ${NS}::label $page.extdifff.l -text [mc "External diff tool" ]
11536    ${NS}::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff
11537    pack $page.extdifff.l $page.extdifff.b -side left
11538    pack configure $page.extdifff.l -padx 10
11539    grid x $page.extdifff $page.extdifft -sticky ew
11540
11541    ${NS}::label $page.lgen -text [mc "General options"]
11542    grid $page.lgen - -sticky w -pady 10
11543    ${NS}::checkbutton $page.want_ttk -variable want_ttk \
11544        -text [mc "Use themed widgets"]
11545    if {$have_ttk} {
11546        ${NS}::label $page.ttk_note -text [mc "(change requires restart)"]
11547    } else {
11548        ${NS}::label $page.ttk_note -text [mc "(currently unavailable)"]
11549    }
11550    grid x $page.want_ttk $page.ttk_note -sticky w
11551    return $page
11552}
11553
11554proc prefspage_colors {notebook} {
11555    global NS uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11556
11557    set page [create_prefs_page $notebook.colors]
11558
11559    ${NS}::label $page.cdisp -text [mc "Colors: press to choose"]
11560    grid $page.cdisp - -sticky w -pady 10
11561    label $page.ui -padx 40 -relief sunk -background $uicolor
11562    ${NS}::button $page.uibut -text [mc "Interface"] \
11563       -command [list choosecolor uicolor {} $page.ui [mc "interface"] setui]
11564    grid x $page.uibut $page.ui -sticky w
11565    label $page.bg -padx 40 -relief sunk -background $bgcolor
11566    ${NS}::button $page.bgbut -text [mc "Background"] \
11567        -command [list choosecolor bgcolor {} $page.bg [mc "background"] setbg]
11568    grid x $page.bgbut $page.bg -sticky w
11569    label $page.fg -padx 40 -relief sunk -background $fgcolor
11570    ${NS}::button $page.fgbut -text [mc "Foreground"] \
11571        -command [list choosecolor fgcolor {} $page.fg [mc "foreground"] setfg]
11572    grid x $page.fgbut $page.fg -sticky w
11573    label $page.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
11574    ${NS}::button $page.diffoldbut -text [mc "Diff: old lines"] \
11575        -command [list choosecolor diffcolors 0 $page.diffold [mc "diff old lines"] \
11576                      [list $ctext tag conf d0 -foreground]]
11577    grid x $page.diffoldbut $page.diffold -sticky w
11578    label $page.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
11579    ${NS}::button $page.diffnewbut -text [mc "Diff: new lines"] \
11580        -command [list choosecolor diffcolors 1 $page.diffnew [mc "diff new lines"] \
11581                      [list $ctext tag conf dresult -foreground]]
11582    grid x $page.diffnewbut $page.diffnew -sticky w
11583    label $page.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
11584    ${NS}::button $page.hunksepbut -text [mc "Diff: hunk header"] \
11585        -command [list choosecolor diffcolors 2 $page.hunksep \
11586                      [mc "diff hunk header"] \
11587                      [list $ctext tag conf hunksep -foreground]]
11588    grid x $page.hunksepbut $page.hunksep -sticky w
11589    label $page.markbgsep -padx 40 -relief sunk -background $markbgcolor
11590    ${NS}::button $page.markbgbut -text [mc "Marked line bg"] \
11591        -command [list choosecolor markbgcolor {} $page.markbgsep \
11592                      [mc "marked line background"] \
11593                      [list $ctext tag conf omark -background]]
11594    grid x $page.markbgbut $page.markbgsep -sticky w
11595    label $page.selbgsep -padx 40 -relief sunk -background $selectbgcolor
11596    ${NS}::button $page.selbgbut -text [mc "Select bg"] \
11597        -command [list choosecolor selectbgcolor {} $page.selbgsep [mc "background"] setselbg]
11598    grid x $page.selbgbut $page.selbgsep -sticky w
11599    return $page
11600}
11601
11602proc prefspage_fonts {notebook} {
11603    global NS
11604    set page [create_prefs_page $notebook.fonts]
11605    ${NS}::label $page.cfont -text [mc "Fonts: press to choose"]
11606    grid $page.cfont - -sticky w -pady 10
11607    mkfontdisp mainfont $page [mc "Main font"]
11608    mkfontdisp textfont $page [mc "Diff display font"]
11609    mkfontdisp uifont $page [mc "User interface font"]
11610    return $page
11611}
11612
11613proc doprefs {} {
11614    global maxwidth maxgraphpct use_ttk NS
11615    global oldprefs prefstop showneartags showlocalchanges
11616    global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11617    global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11618    global hideremotes want_ttk have_ttk
11619
11620    set top .gitkprefs
11621    set prefstop $top
11622    if {[winfo exists $top]} {
11623        raise $top
11624        return
11625    }
11626    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11627                   limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11628        set oldprefs($v) [set $v]
11629    }
11630    ttk_toplevel $top
11631    wm title $top [mc "Gitk preferences"]
11632    make_transient $top .
11633
11634    if {[set use_notebook [expr {$use_ttk && [info command ::ttk::notebook] ne ""}]]} {
11635        set notebook [ttk::notebook $top.notebook]
11636    } else {
11637        set notebook [${NS}::frame $top.notebook -borderwidth 0 -relief flat]
11638    }
11639
11640    lappend pages [prefspage_general $notebook] [mc "General"]
11641    lappend pages [prefspage_colors $notebook] [mc "Colors"]
11642    lappend pages [prefspage_fonts $notebook] [mc "Fonts"]
11643    set col 0
11644    foreach {page title} $pages {
11645        if {$use_notebook} {
11646            $notebook add $page -text $title
11647        } else {
11648            set btn [${NS}::button $notebook.b_[string map {. X} $page] \
11649                         -text $title -command [list raise $page]]
11650            $page configure -text $title
11651            grid $btn -row 0 -column [incr col] -sticky w
11652            grid $page -row 1 -column 0 -sticky news -columnspan 100
11653        }
11654    }
11655
11656    if {!$use_notebook} {
11657        grid columnconfigure $notebook 0 -weight 1
11658        grid rowconfigure $notebook 1 -weight 1
11659        raise [lindex $pages 0]
11660    }
11661
11662    grid $notebook -sticky news -padx 2 -pady 2
11663    grid rowconfigure $top 0 -weight 1
11664    grid columnconfigure $top 0 -weight 1
11665
11666    ${NS}::frame $top.buts
11667    ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
11668    ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
11669    bind $top <Key-Return> prefsok
11670    bind $top <Key-Escape> prefscan
11671    grid $top.buts.ok $top.buts.can
11672    grid columnconfigure $top.buts 0 -weight 1 -uniform a
11673    grid columnconfigure $top.buts 1 -weight 1 -uniform a
11674    grid $top.buts - - -pady 10 -sticky ew
11675    grid columnconfigure $top 2 -weight 1
11676    bind $top <Visibility> [list focus $top.buts.ok]
11677}
11678
11679proc choose_extdiff {} {
11680    global extdifftool
11681
11682    set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
11683    if {$prog ne {}} {
11684        set extdifftool $prog
11685    }
11686}
11687
11688proc choosecolor {v vi w x cmd} {
11689    global $v
11690
11691    set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
11692               -title [mc "Gitk: choose color for %s" $x]]
11693    if {$c eq {}} return
11694    $w conf -background $c
11695    lset $v $vi $c
11696    eval $cmd $c
11697}
11698
11699proc setselbg {c} {
11700    global bglist cflist
11701    foreach w $bglist {
11702        if {[winfo exists $w]} {
11703            $w configure -selectbackground $c
11704        }
11705    }
11706    $cflist tag configure highlight \
11707        -background [$cflist cget -selectbackground]
11708    allcanvs itemconf secsel -fill $c
11709}
11710
11711# This sets the background color and the color scheme for the whole UI.
11712# For some reason, tk_setPalette chooses a nasty dark red for selectColor
11713# if we don't specify one ourselves, which makes the checkbuttons and
11714# radiobuttons look bad.  This chooses white for selectColor if the
11715# background color is light, or black if it is dark.
11716proc setui {c} {
11717    if {[tk windowingsystem] eq "win32"} { return }
11718    set bg [winfo rgb . $c]
11719    set selc black
11720    if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
11721        set selc white
11722    }
11723    tk_setPalette background $c selectColor $selc
11724}
11725
11726proc setbg {c} {
11727    global bglist
11728
11729    foreach w $bglist {
11730        if {[winfo exists $w]} {
11731            $w conf -background $c
11732        }
11733    }
11734}
11735
11736proc setfg {c} {
11737    global fglist canv
11738
11739    foreach w $fglist {
11740        if {[winfo exists $w]} {
11741            $w conf -foreground $c
11742        }
11743    }
11744    allcanvs itemconf text -fill $c
11745    $canv itemconf circle -outline $c
11746    $canv itemconf markid -outline $c
11747}
11748
11749proc prefscan {} {
11750    global oldprefs prefstop
11751
11752    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11753                   limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11754        global $v
11755        set $v $oldprefs($v)
11756    }
11757    catch {destroy $prefstop}
11758    unset prefstop
11759    fontcan
11760}
11761
11762proc prefsok {} {
11763    global maxwidth maxgraphpct
11764    global oldprefs prefstop showneartags showlocalchanges
11765    global fontpref mainfont textfont uifont
11766    global limitdiffs treediffs perfile_attrs
11767    global hideremotes
11768
11769    catch {destroy $prefstop}
11770    unset prefstop
11771    fontcan
11772    set fontchanged 0
11773    if {$mainfont ne $fontpref(mainfont)} {
11774        set mainfont $fontpref(mainfont)
11775        parsefont mainfont $mainfont
11776        eval font configure mainfont [fontflags mainfont]
11777        eval font configure mainfontbold [fontflags mainfont 1]
11778        setcoords
11779        set fontchanged 1
11780    }
11781    if {$textfont ne $fontpref(textfont)} {
11782        set textfont $fontpref(textfont)
11783        parsefont textfont $textfont
11784        eval font configure textfont [fontflags textfont]
11785        eval font configure textfontbold [fontflags textfont 1]
11786    }
11787    if {$uifont ne $fontpref(uifont)} {
11788        set uifont $fontpref(uifont)
11789        parsefont uifont $uifont
11790        eval font configure uifont [fontflags uifont]
11791    }
11792    settabs
11793    if {$showlocalchanges != $oldprefs(showlocalchanges)} {
11794        if {$showlocalchanges} {
11795            doshowlocalchanges
11796        } else {
11797            dohidelocalchanges
11798        }
11799    }
11800    if {$limitdiffs != $oldprefs(limitdiffs) ||
11801        ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11802        # treediffs elements are limited by path;
11803        # won't have encodings cached if perfile_attrs was just turned on
11804        unset -nocomplain treediffs
11805    }
11806    if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
11807        || $maxgraphpct != $oldprefs(maxgraphpct)} {
11808        redisplay
11809    } elseif {$showneartags != $oldprefs(showneartags) ||
11810          $limitdiffs != $oldprefs(limitdiffs)} {
11811        reselectline
11812    }
11813    if {$hideremotes != $oldprefs(hideremotes)} {
11814        rereadrefs
11815    }
11816}
11817
11818proc formatdate {d} {
11819    global datetimeformat
11820    if {$d ne {}} {
11821        # If $datetimeformat includes a timezone, display in the
11822        # timezone of the argument.  Otherwise, display in local time.
11823        if {[string match {*%[zZ]*} $datetimeformat]} {
11824            if {[catch {set d [clock format [lindex $d 0] -timezone [lindex $d 1] -format $datetimeformat]}]} {
11825                # Tcl < 8.5 does not support -timezone.  Emulate it by
11826                # setting TZ (e.g. TZ=<-0430>+04:30).
11827                global env
11828                if {[info exists env(TZ)]} {
11829                    set savedTZ $env(TZ)
11830                }
11831                set zone [lindex $d 1]
11832                set sign [string map {+ - - +} [string index $zone 0]]
11833                set env(TZ) <$zone>$sign[string range $zone 1 2]:[string range $zone 3 4]
11834                set d [clock format [lindex $d 0] -format $datetimeformat]
11835                if {[info exists savedTZ]} {
11836                    set env(TZ) $savedTZ
11837                } else {
11838                    unset env(TZ)
11839                }
11840            }
11841        } else {
11842            set d [clock format [lindex $d 0] -format $datetimeformat]
11843        }
11844    }
11845    return $d
11846}
11847
11848# This list of encoding names and aliases is distilled from
11849# http://www.iana.org/assignments/character-sets.
11850# Not all of them are supported by Tcl.
11851set encoding_aliases {
11852    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11853      ISO646-US US-ASCII us IBM367 cp367 csASCII }
11854    { ISO-10646-UTF-1 csISO10646UTF1 }
11855    { ISO_646.basic:1983 ref csISO646basic1983 }
11856    { INVARIANT csINVARIANT }
11857    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11858    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11859    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11860    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11861    { NATS-DANO iso-ir-9-1 csNATSDANO }
11862    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11863    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11864    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11865    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11866    { ISO-2022-KR csISO2022KR }
11867    { EUC-KR csEUCKR }
11868    { ISO-2022-JP csISO2022JP }
11869    { ISO-2022-JP-2 csISO2022JP2 }
11870    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11871      csISO13JISC6220jp }
11872    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11873    { IT iso-ir-15 ISO646-IT csISO15Italian }
11874    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11875    { ES iso-ir-17 ISO646-ES csISO17Spanish }
11876    { greek7-old iso-ir-18 csISO18Greek7Old }
11877    { latin-greek iso-ir-19 csISO19LatinGreek }
11878    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11879    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11880    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11881    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11882    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11883    { BS_viewdata iso-ir-47 csISO47BSViewdata }
11884    { INIS iso-ir-49 csISO49INIS }
11885    { INIS-8 iso-ir-50 csISO50INIS8 }
11886    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11887    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11888    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11889    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11890    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11891    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11892      csISO60Norwegian1 }
11893    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11894    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11895    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11896    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11897    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11898    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11899    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11900    { greek7 iso-ir-88 csISO88Greek7 }
11901    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11902    { iso-ir-90 csISO90 }
11903    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11904    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11905      csISO92JISC62991984b }
11906    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11907    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11908    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11909      csISO95JIS62291984handadd }
11910    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11911    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11912    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11913    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11914      CP819 csISOLatin1 }
11915    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11916    { T.61-7bit iso-ir-102 csISO102T617bit }
11917    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11918    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
11919    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
11920    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
11921    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
11922    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
11923    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
11924    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
11925      arabic csISOLatinArabic }
11926    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
11927    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
11928    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
11929      greek greek8 csISOLatinGreek }
11930    { T.101-G2 iso-ir-128 csISO128T101G2 }
11931    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
11932      csISOLatinHebrew }
11933    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
11934    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
11935    { CSN_369103 iso-ir-139 csISO139CSN369103 }
11936    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
11937    { ISO_6937-2-add iso-ir-142 csISOTextComm }
11938    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
11939    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
11940      csISOLatinCyrillic }
11941    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
11942    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
11943    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
11944    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
11945    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
11946    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
11947    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
11948    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
11949    { ISO_10367-box iso-ir-155 csISO10367Box }
11950    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
11951    { latin-lap lap iso-ir-158 csISO158Lap }
11952    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
11953    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
11954    { us-dk csUSDK }
11955    { dk-us csDKUS }
11956    { JIS_X0201 X0201 csHalfWidthKatakana }
11957    { KSC5636 ISO646-KR csKSC5636 }
11958    { ISO-10646-UCS-2 csUnicode }
11959    { ISO-10646-UCS-4 csUCS4 }
11960    { DEC-MCS dec csDECMCS }
11961    { hp-roman8 roman8 r8 csHPRoman8 }
11962    { macintosh mac csMacintosh }
11963    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
11964      csIBM037 }
11965    { IBM038 EBCDIC-INT cp038 csIBM038 }
11966    { IBM273 CP273 csIBM273 }
11967    { IBM274 EBCDIC-BE CP274 csIBM274 }
11968    { IBM275 EBCDIC-BR cp275 csIBM275 }
11969    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
11970    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
11971    { IBM280 CP280 ebcdic-cp-it csIBM280 }
11972    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
11973    { IBM284 CP284 ebcdic-cp-es csIBM284 }
11974    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
11975    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
11976    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
11977    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
11978    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
11979    { IBM424 cp424 ebcdic-cp-he csIBM424 }
11980    { IBM437 cp437 437 csPC8CodePage437 }
11981    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
11982    { IBM775 cp775 csPC775Baltic }
11983    { IBM850 cp850 850 csPC850Multilingual }
11984    { IBM851 cp851 851 csIBM851 }
11985    { IBM852 cp852 852 csPCp852 }
11986    { IBM855 cp855 855 csIBM855 }
11987    { IBM857 cp857 857 csIBM857 }
11988    { IBM860 cp860 860 csIBM860 }
11989    { IBM861 cp861 861 cp-is csIBM861 }
11990    { IBM862 cp862 862 csPC862LatinHebrew }
11991    { IBM863 cp863 863 csIBM863 }
11992    { IBM864 cp864 csIBM864 }
11993    { IBM865 cp865 865 csIBM865 }
11994    { IBM866 cp866 866 csIBM866 }
11995    { IBM868 CP868 cp-ar csIBM868 }
11996    { IBM869 cp869 869 cp-gr csIBM869 }
11997    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
11998    { IBM871 CP871 ebcdic-cp-is csIBM871 }
11999    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
12000    { IBM891 cp891 csIBM891 }
12001    { IBM903 cp903 csIBM903 }
12002    { IBM904 cp904 904 csIBBM904 }
12003    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
12004    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
12005    { IBM1026 CP1026 csIBM1026 }
12006    { EBCDIC-AT-DE csIBMEBCDICATDE }
12007    { EBCDIC-AT-DE-A csEBCDICATDEA }
12008    { EBCDIC-CA-FR csEBCDICCAFR }
12009    { EBCDIC-DK-NO csEBCDICDKNO }
12010    { EBCDIC-DK-NO-A csEBCDICDKNOA }
12011    { EBCDIC-FI-SE csEBCDICFISE }
12012    { EBCDIC-FI-SE-A csEBCDICFISEA }
12013    { EBCDIC-FR csEBCDICFR }
12014    { EBCDIC-IT csEBCDICIT }
12015    { EBCDIC-PT csEBCDICPT }
12016    { EBCDIC-ES csEBCDICES }
12017    { EBCDIC-ES-A csEBCDICESA }
12018    { EBCDIC-ES-S csEBCDICESS }
12019    { EBCDIC-UK csEBCDICUK }
12020    { EBCDIC-US csEBCDICUS }
12021    { UNKNOWN-8BIT csUnknown8BiT }
12022    { MNEMONIC csMnemonic }
12023    { MNEM csMnem }
12024    { VISCII csVISCII }
12025    { VIQR csVIQR }
12026    { KOI8-R csKOI8R }
12027    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
12028    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
12029    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
12030    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
12031    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
12032    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
12033    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
12034    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
12035    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
12036    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
12037    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
12038    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
12039    { IBM1047 IBM-1047 }
12040    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
12041    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
12042    { UNICODE-1-1 csUnicode11 }
12043    { CESU-8 csCESU-8 }
12044    { BOCU-1 csBOCU-1 }
12045    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
12046    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
12047      l8 }
12048    { ISO-8859-15 ISO_8859-15 Latin-9 }
12049    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
12050    { GBK CP936 MS936 windows-936 }
12051    { JIS_Encoding csJISEncoding }
12052    { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
12053    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
12054      EUC-JP }
12055    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
12056    { ISO-10646-UCS-Basic csUnicodeASCII }
12057    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
12058    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
12059    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
12060    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
12061    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
12062    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
12063    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
12064    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
12065    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
12066    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
12067    { Adobe-Standard-Encoding csAdobeStandardEncoding }
12068    { Ventura-US csVenturaUS }
12069    { Ventura-International csVenturaInternational }
12070    { PC8-Danish-Norwegian csPC8DanishNorwegian }
12071    { PC8-Turkish csPC8Turkish }
12072    { IBM-Symbols csIBMSymbols }
12073    { IBM-Thai csIBMThai }
12074    { HP-Legal csHPLegal }
12075    { HP-Pi-font csHPPiFont }
12076    { HP-Math8 csHPMath8 }
12077    { Adobe-Symbol-Encoding csHPPSMath }
12078    { HP-DeskTop csHPDesktop }
12079    { Ventura-Math csVenturaMath }
12080    { Microsoft-Publishing csMicrosoftPublishing }
12081    { Windows-31J csWindows31J }
12082    { GB2312 csGB2312 }
12083    { Big5 csBig5 }
12084}
12085
12086proc tcl_encoding {enc} {
12087    global encoding_aliases tcl_encoding_cache
12088    if {[info exists tcl_encoding_cache($enc)]} {
12089        return $tcl_encoding_cache($enc)
12090    }
12091    set names [encoding names]
12092    set lcnames [string tolower $names]
12093    set enc [string tolower $enc]
12094    set i [lsearch -exact $lcnames $enc]
12095    if {$i < 0} {
12096        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
12097        if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
12098            set i [lsearch -exact $lcnames $encx]
12099        }
12100    }
12101    if {$i < 0} {
12102        foreach l $encoding_aliases {
12103            set ll [string tolower $l]
12104            if {[lsearch -exact $ll $enc] < 0} continue
12105            # look through the aliases for one that tcl knows about
12106            foreach e $ll {
12107                set i [lsearch -exact $lcnames $e]
12108                if {$i < 0} {
12109                    if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
12110                        set i [lsearch -exact $lcnames $ex]
12111                    }
12112                }
12113                if {$i >= 0} break
12114            }
12115            break
12116        }
12117    }
12118    set tclenc {}
12119    if {$i >= 0} {
12120        set tclenc [lindex $names $i]
12121    }
12122    set tcl_encoding_cache($enc) $tclenc
12123    return $tclenc
12124}
12125
12126proc gitattr {path attr default} {
12127    global path_attr_cache
12128    if {[info exists path_attr_cache($attr,$path)]} {
12129        set r $path_attr_cache($attr,$path)
12130    } else {
12131        set r "unspecified"
12132        if {![catch {set line [exec git check-attr $attr -- $path]}]} {
12133            regexp "(.*): $attr: (.*)" $line m f r
12134        }
12135        set path_attr_cache($attr,$path) $r
12136    }
12137    if {$r eq "unspecified"} {
12138        return $default
12139    }
12140    return $r
12141}
12142
12143proc cache_gitattr {attr pathlist} {
12144    global path_attr_cache
12145    set newlist {}
12146    foreach path $pathlist {
12147        if {![info exists path_attr_cache($attr,$path)]} {
12148            lappend newlist $path
12149        }
12150    }
12151    set lim 1000
12152    if {[tk windowingsystem] == "win32"} {
12153        # windows has a 32k limit on the arguments to a command...
12154        set lim 30
12155    }
12156    while {$newlist ne {}} {
12157        set head [lrange $newlist 0 [expr {$lim - 1}]]
12158        set newlist [lrange $newlist $lim end]
12159        if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
12160            foreach row [split $rlist "\n"] {
12161                if {[regexp "(.*): $attr: (.*)" $row m path value]} {
12162                    if {[string index $path 0] eq "\""} {
12163                        set path [encoding convertfrom [lindex $path 0]]
12164                    }
12165                    set path_attr_cache($attr,$path) $value
12166                }
12167            }
12168        }
12169    }
12170}
12171
12172proc get_path_encoding {path} {
12173    global gui_encoding perfile_attrs
12174    set tcl_enc $gui_encoding
12175    if {$path ne {} && $perfile_attrs} {
12176        set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
12177        if {$enc2 ne {}} {
12178            set tcl_enc $enc2
12179        }
12180    }
12181    return $tcl_enc
12182}
12183
12184## For msgcat loading, first locate the installation location.
12185if { [info exists ::env(GITK_MSGSDIR)] } {
12186    ## Msgsdir was manually set in the environment.
12187    set gitk_msgsdir $::env(GITK_MSGSDIR)
12188} else {
12189    ## Let's guess the prefix from argv0.
12190    set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
12191    set gitk_libdir [file join $gitk_prefix share gitk lib]
12192    set gitk_msgsdir [file join $gitk_libdir msgs]
12193    unset gitk_prefix
12194}
12195
12196## Internationalization (i18n) through msgcat and gettext. See
12197## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
12198package require msgcat
12199namespace import ::msgcat::mc
12200## And eventually load the actual message catalog
12201::msgcat::mcload $gitk_msgsdir
12202
12203# First check that Tcl/Tk is recent enough
12204if {[catch {package require Tk 8.4} err]} {
12205    show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
12206                         Gitk requires at least Tcl/Tk 8.4."]
12207    exit 1
12208}
12209
12210# on OSX bring the current Wish process window to front
12211if {[tk windowingsystem] eq "aqua"} {
12212    exec osascript -e [format {
12213        tell application "System Events"
12214            set frontmost of processes whose unix id is %d to true
12215        end tell
12216    } [pid] ]
12217}
12218
12219# Unset GIT_TRACE var if set
12220if { [info exists ::env(GIT_TRACE)] } {
12221    unset ::env(GIT_TRACE)
12222}
12223
12224# defaults...
12225set wrcomcmd "git diff-tree --stdin -p --pretty=email"
12226
12227set gitencoding {}
12228catch {
12229    set gitencoding [exec git config --get i18n.commitencoding]
12230}
12231catch {
12232    set gitencoding [exec git config --get i18n.logoutputencoding]
12233}
12234if {$gitencoding == ""} {
12235    set gitencoding "utf-8"
12236}
12237set tclencoding [tcl_encoding $gitencoding]
12238if {$tclencoding == {}} {
12239    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
12240}
12241
12242set gui_encoding [encoding system]
12243catch {
12244    set enc [exec git config --get gui.encoding]
12245    if {$enc ne {}} {
12246        set tclenc [tcl_encoding $enc]
12247        if {$tclenc ne {}} {
12248            set gui_encoding $tclenc
12249        } else {
12250            puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
12251        }
12252    }
12253}
12254
12255set log_showroot true
12256catch {
12257    set log_showroot [exec git config --bool --get log.showroot]
12258}
12259
12260if {[tk windowingsystem] eq "aqua"} {
12261    set mainfont {{Lucida Grande} 9}
12262    set textfont {Monaco 9}
12263    set uifont {{Lucida Grande} 9 bold}
12264} elseif {![catch {::tk::pkgconfig get fontsystem} xft] && $xft eq "xft"} {
12265    # fontconfig!
12266    set mainfont {sans 9}
12267    set textfont {monospace 9}
12268    set uifont {sans 9 bold}
12269} else {
12270    set mainfont {Helvetica 9}
12271    set textfont {Courier 9}
12272    set uifont {Helvetica 9 bold}
12273}
12274set tabstop 8
12275set findmergefiles 0
12276set maxgraphpct 50
12277set maxwidth 16
12278set revlistorder 0
12279set fastdate 0
12280set uparrowlen 5
12281set downarrowlen 5
12282set mingaplen 100
12283set cmitmode "patch"
12284set wrapcomment "none"
12285set showneartags 1
12286set hideremotes 0
12287set maxrefs 20
12288set visiblerefs {"master"}
12289set maxlinelen 200
12290set showlocalchanges 1
12291set limitdiffs 1
12292set datetimeformat "%Y-%m-%d %H:%M:%S"
12293set autoselect 1
12294set autosellen 40
12295set perfile_attrs 0
12296set want_ttk 1
12297
12298if {[tk windowingsystem] eq "aqua"} {
12299    set extdifftool "opendiff"
12300} else {
12301    set extdifftool "meld"
12302}
12303
12304set colors {"#00ff00" red blue magenta darkgrey brown orange}
12305if {[tk windowingsystem] eq "win32"} {
12306    set uicolor SystemButtonFace
12307    set uifgcolor SystemButtonText
12308    set uifgdisabledcolor SystemDisabledText
12309    set bgcolor SystemWindow
12310    set fgcolor SystemWindowText
12311    set selectbgcolor SystemHighlight
12312} else {
12313    set uicolor grey85
12314    set uifgcolor black
12315    set uifgdisabledcolor "#999"
12316    set bgcolor white
12317    set fgcolor black
12318    set selectbgcolor gray85
12319}
12320set diffcolors {red "#00a000" blue}
12321set diffcontext 3
12322set mergecolors {red blue "#00ff00" purple brown "#009090" magenta "#808000" "#009000" "#ff0080" cyan "#b07070" "#70b0f0" "#70f0b0" "#f0b070" "#ff70b0"}
12323set ignorespace 0
12324set worddiff ""
12325set markbgcolor "#e0e0ff"
12326
12327set headbgcolor "#00ff00"
12328set headfgcolor black
12329set headoutlinecolor black
12330set remotebgcolor #ffddaa
12331set tagbgcolor yellow
12332set tagfgcolor black
12333set tagoutlinecolor black
12334set reflinecolor black
12335set filesepbgcolor #aaaaaa
12336set filesepfgcolor black
12337set linehoverbgcolor #ffff80
12338set linehoverfgcolor black
12339set linehoveroutlinecolor black
12340set mainheadcirclecolor yellow
12341set workingfilescirclecolor red
12342set indexcirclecolor "#00ff00"
12343set circlecolors {white blue gray blue blue}
12344set linkfgcolor blue
12345set circleoutlinecolor $fgcolor
12346set foundbgcolor yellow
12347set currentsearchhitbgcolor orange
12348
12349# button for popping up context menus
12350if {[tk windowingsystem] eq "aqua"} {
12351    set ctxbut <Button-2>
12352} else {
12353    set ctxbut <Button-3>
12354}
12355
12356catch {
12357    # follow the XDG base directory specification by default. See
12358    # http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html
12359    if {[info exists env(XDG_CONFIG_HOME)] && $env(XDG_CONFIG_HOME) ne ""} {
12360        # XDG_CONFIG_HOME environment variable is set
12361        set config_file [file join $env(XDG_CONFIG_HOME) git gitk]
12362        set config_file_tmp [file join $env(XDG_CONFIG_HOME) git gitk-tmp]
12363    } else {
12364        # default XDG_CONFIG_HOME
12365        set config_file "~/.config/git/gitk"
12366        set config_file_tmp "~/.config/git/gitk-tmp"
12367    }
12368    if {![file exists $config_file]} {
12369        # for backward compatibility use the old config file if it exists
12370        if {[file exists "~/.gitk"]} {
12371            set config_file "~/.gitk"
12372            set config_file_tmp "~/.gitk-tmp"
12373        } elseif {![file exists [file dirname $config_file]]} {
12374            file mkdir [file dirname $config_file]
12375        }
12376    }
12377    source $config_file
12378}
12379config_check_tmp_exists 50
12380
12381set config_variables {
12382    mainfont textfont uifont tabstop findmergefiles maxgraphpct maxwidth
12383    cmitmode wrapcomment autoselect autosellen showneartags maxrefs visiblerefs
12384    hideremotes showlocalchanges datetimeformat limitdiffs uicolor want_ttk
12385    bgcolor fgcolor uifgcolor uifgdisabledcolor colors diffcolors mergecolors
12386    markbgcolor diffcontext selectbgcolor foundbgcolor currentsearchhitbgcolor
12387    extdifftool perfile_attrs headbgcolor headfgcolor headoutlinecolor
12388    remotebgcolor tagbgcolor tagfgcolor tagoutlinecolor reflinecolor
12389    filesepbgcolor filesepfgcolor linehoverbgcolor linehoverfgcolor
12390    linehoveroutlinecolor mainheadcirclecolor workingfilescirclecolor
12391    indexcirclecolor circlecolors linkfgcolor circleoutlinecolor
12392}
12393foreach var $config_variables {
12394    config_init_trace $var
12395    trace add variable $var write config_variable_change_cb
12396}
12397
12398parsefont mainfont $mainfont
12399eval font create mainfont [fontflags mainfont]
12400eval font create mainfontbold [fontflags mainfont 1]
12401
12402parsefont textfont $textfont
12403eval font create textfont [fontflags textfont]
12404eval font create textfontbold [fontflags textfont 1]
12405
12406parsefont uifont $uifont
12407eval font create uifont [fontflags uifont]
12408
12409setui $uicolor
12410
12411setoptions
12412
12413# check that we can find a .git directory somewhere...
12414if {[catch {set gitdir [exec git rev-parse --git-dir]}]} {
12415    show_error {} . [mc "Cannot find a git repository here."]
12416    exit 1
12417}
12418
12419set selecthead {}
12420set selectheadid {}
12421
12422set revtreeargs {}
12423set cmdline_files {}
12424set i 0
12425set revtreeargscmd {}
12426foreach arg $argv {
12427    switch -glob -- $arg {
12428        "" { }
12429        "--" {
12430            set cmdline_files [lrange $argv [expr {$i + 1}] end]
12431            break
12432        }
12433        "--select-commit=*" {
12434            set selecthead [string range $arg 16 end]
12435        }
12436        "--argscmd=*" {
12437            set revtreeargscmd [string range $arg 10 end]
12438        }
12439        default {
12440            lappend revtreeargs $arg
12441        }
12442    }
12443    incr i
12444}
12445
12446if {$selecthead eq "HEAD"} {
12447    set selecthead {}
12448}
12449
12450if {$i >= [llength $argv] && $revtreeargs ne {}} {
12451    # no -- on command line, but some arguments (other than --argscmd)
12452    if {[catch {
12453        set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
12454        set cmdline_files [split $f "\n"]
12455        set n [llength $cmdline_files]
12456        set revtreeargs [lrange $revtreeargs 0 end-$n]
12457        # Unfortunately git rev-parse doesn't produce an error when
12458        # something is both a revision and a filename.  To be consistent
12459        # with git log and git rev-list, check revtreeargs for filenames.
12460        foreach arg $revtreeargs {
12461            if {[file exists $arg]} {
12462                show_error {} . [mc "Ambiguous argument '%s': both revision\
12463                                 and filename" $arg]
12464                exit 1
12465            }
12466        }
12467    } err]} {
12468        # unfortunately we get both stdout and stderr in $err,
12469        # so look for "fatal:".
12470        set i [string first "fatal:" $err]
12471        if {$i > 0} {
12472            set err [string range $err [expr {$i + 6}] end]
12473        }
12474        show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
12475        exit 1
12476    }
12477}
12478
12479set nullid "0000000000000000000000000000000000000000"
12480set nullid2 "0000000000000000000000000000000000000001"
12481set nullfile "/dev/null"
12482
12483set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
12484if {![info exists have_ttk]} {
12485    set have_ttk [llength [info commands ::ttk::style]]
12486}
12487set use_ttk [expr {$have_ttk && $want_ttk}]
12488set NS [expr {$use_ttk ? "ttk" : ""}]
12489
12490if {$use_ttk} {
12491    setttkstyle
12492}
12493
12494regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
12495
12496set show_notes {}
12497if {[package vcompare $git_version "1.6.6.2"] >= 0} {
12498    set show_notes "--show-notes"
12499}
12500
12501set appname "gitk"
12502
12503set runq {}
12504set history {}
12505set historyindex 0
12506set fh_serial 0
12507set nhl_names {}
12508set highlight_paths {}
12509set findpattern {}
12510set searchdirn -forwards
12511set boldids {}
12512set boldnameids {}
12513set diffelide {0 0}
12514set markingmatches 0
12515set linkentercount 0
12516set need_redisplay 0
12517set nrows_drawn 0
12518set firsttabstop 0
12519
12520set nextviewnum 1
12521set curview 0
12522set selectedview 0
12523set selectedhlview [mc "None"]
12524set highlight_related [mc "None"]
12525set highlight_files {}
12526set viewfiles(0) {}
12527set viewperm(0) 0
12528set viewchanged(0) 0
12529set viewargs(0) {}
12530set viewargscmd(0) {}
12531
12532set selectedline {}
12533set numcommits 0
12534set loginstance 0
12535set cmdlineok 0
12536set stopped 0
12537set stuffsaved 0
12538set patchnum 0
12539set lserial 0
12540set hasworktree [hasworktree]
12541set cdup {}
12542if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} {
12543    set cdup [exec git rev-parse --show-cdup]
12544}
12545set worktree [exec git rev-parse --show-toplevel]
12546setcoords
12547makewindow
12548catch {
12549    image create photo gitlogo      -width 16 -height 16
12550
12551    image create photo gitlogominus -width  4 -height  2
12552    gitlogominus put #C00000 -to 0 0 4 2
12553    gitlogo copy gitlogominus -to  1 5
12554    gitlogo copy gitlogominus -to  6 5
12555    gitlogo copy gitlogominus -to 11 5
12556    image delete gitlogominus
12557
12558    image create photo gitlogoplus  -width  4 -height  4
12559    gitlogoplus  put #008000 -to 1 0 3 4
12560    gitlogoplus  put #008000 -to 0 1 4 3
12561    gitlogo copy gitlogoplus  -to  1 9
12562    gitlogo copy gitlogoplus  -to  6 9
12563    gitlogo copy gitlogoplus  -to 11 9
12564    image delete gitlogoplus
12565
12566    image create photo gitlogo32    -width 32 -height 32
12567    gitlogo32 copy gitlogo -zoom 2 2
12568
12569    wm iconphoto . -default gitlogo gitlogo32
12570}
12571# wait for the window to become visible
12572tkwait visibility .
12573set_window_title
12574update
12575readrefs
12576
12577if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
12578    # create a view for the files/dirs specified on the command line
12579    set curview 1
12580    set selectedview 1
12581    set nextviewnum 2
12582    set viewname(1) [mc "Command line"]
12583    set viewfiles(1) $cmdline_files
12584    set viewargs(1) $revtreeargs
12585    set viewargscmd(1) $revtreeargscmd
12586    set viewperm(1) 0
12587    set viewchanged(1) 0
12588    set vdatemode(1) 0
12589    addviewmenu 1
12590    .bar.view entryconf [mca "&Edit view..."] -state normal
12591    .bar.view entryconf [mca "&Delete view"] -state normal
12592}
12593
12594if {[info exists permviews]} {
12595    foreach v $permviews {
12596        set n $nextviewnum
12597        incr nextviewnum
12598        set viewname($n) [lindex $v 0]
12599        set viewfiles($n) [lindex $v 1]
12600        set viewargs($n) [lindex $v 2]
12601        set viewargscmd($n) [lindex $v 3]
12602        set viewperm($n) 1
12603        set viewchanged($n) 0
12604        addviewmenu $n
12605    }
12606}
12607
12608if {[tk windowingsystem] eq "win32"} {
12609    focus -force .
12610}
12611
12612getcommits {}
12613
12614# Local variables:
12615# mode: tcl
12616# indent-tabs-mode: t
12617# tab-width: 8
12618# End: