gitk-git / gitkon commit t7503: verify proper hook execution (f78f6c7)
   1#!/bin/sh
   2# Tcl ignores the next line -*- tcl -*- \
   3exec wish "$0" -- "$@"
   4
   5# Copyright © 2005-2016 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 commitinfo
 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 commitinfo
 613    unset -nocomplain commitinterest
 614    unset -nocomplain cached_commitrow
 615    unset -nocomplain targetid
 616    setcanvscroll
 617    getcommits $selid
 618    return 0
 619}
 620
 621# This makes a string representation of a positive integer which
 622# sorts as a string in numerical order
 623proc strrep {n} {
 624    if {$n < 16} {
 625        return [format "%x" $n]
 626    } elseif {$n < 256} {
 627        return [format "x%.2x" $n]
 628    } elseif {$n < 65536} {
 629        return [format "y%.4x" $n]
 630    }
 631    return [format "z%.8x" $n]
 632}
 633
 634# Procedures used in reordering commits from git log (without
 635# --topo-order) into the order for display.
 636
 637proc varcinit {view} {
 638    global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
 639    global vtokmod varcmod vrowmod varcix vlastins
 640
 641    set varcstart($view) {{}}
 642    set vupptr($view) {0}
 643    set vdownptr($view) {0}
 644    set vleftptr($view) {0}
 645    set vbackptr($view) {0}
 646    set varctok($view) {{}}
 647    set varcrow($view) {{}}
 648    set vtokmod($view) {}
 649    set varcmod($view) 0
 650    set vrowmod($view) 0
 651    set varcix($view) {{}}
 652    set vlastins($view) {0}
 653}
 654
 655proc resetvarcs {view} {
 656    global varcid varccommits parents children vseedcount ordertok
 657    global vshortids
 658
 659    foreach vid [array names varcid $view,*] {
 660        unset varcid($vid)
 661        unset children($vid)
 662        unset parents($vid)
 663    }
 664    foreach vid [array names vshortids $view,*] {
 665        unset vshortids($vid)
 666    }
 667    # some commits might have children but haven't been seen yet
 668    foreach vid [array names children $view,*] {
 669        unset children($vid)
 670    }
 671    foreach va [array names varccommits $view,*] {
 672        unset varccommits($va)
 673    }
 674    foreach vd [array names vseedcount $view,*] {
 675        unset vseedcount($vd)
 676    }
 677    unset -nocomplain ordertok
 678}
 679
 680# returns a list of the commits with no children
 681proc seeds {v} {
 682    global vdownptr vleftptr varcstart
 683
 684    set ret {}
 685    set a [lindex $vdownptr($v) 0]
 686    while {$a != 0} {
 687        lappend ret [lindex $varcstart($v) $a]
 688        set a [lindex $vleftptr($v) $a]
 689    }
 690    return $ret
 691}
 692
 693proc newvarc {view id} {
 694    global varcid varctok parents children vdatemode
 695    global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
 696    global commitdata commitinfo vseedcount varccommits vlastins
 697
 698    set a [llength $varctok($view)]
 699    set vid $view,$id
 700    if {[llength $children($vid)] == 0 || $vdatemode($view)} {
 701        if {![info exists commitinfo($id)]} {
 702            parsecommit $id $commitdata($id) 1
 703        }
 704        set cdate [lindex [lindex $commitinfo($id) 4] 0]
 705        if {![string is integer -strict $cdate]} {
 706            set cdate 0
 707        }
 708        if {![info exists vseedcount($view,$cdate)]} {
 709            set vseedcount($view,$cdate) -1
 710        }
 711        set c [incr vseedcount($view,$cdate)]
 712        set cdate [expr {$cdate ^ 0xffffffff}]
 713        set tok "s[strrep $cdate][strrep $c]"
 714    } else {
 715        set tok {}
 716    }
 717    set ka 0
 718    if {[llength $children($vid)] > 0} {
 719        set kid [lindex $children($vid) end]
 720        set k $varcid($view,$kid)
 721        if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
 722            set ki $kid
 723            set ka $k
 724            set tok [lindex $varctok($view) $k]
 725        }
 726    }
 727    if {$ka != 0} {
 728        set i [lsearch -exact $parents($view,$ki) $id]
 729        set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
 730        append tok [strrep $j]
 731    }
 732    set c [lindex $vlastins($view) $ka]
 733    if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
 734        set c $ka
 735        set b [lindex $vdownptr($view) $ka]
 736    } else {
 737        set b [lindex $vleftptr($view) $c]
 738    }
 739    while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
 740        set c $b
 741        set b [lindex $vleftptr($view) $c]
 742    }
 743    if {$c == $ka} {
 744        lset vdownptr($view) $ka $a
 745        lappend vbackptr($view) 0
 746    } else {
 747        lset vleftptr($view) $c $a
 748        lappend vbackptr($view) $c
 749    }
 750    lset vlastins($view) $ka $a
 751    lappend vupptr($view) $ka
 752    lappend vleftptr($view) $b
 753    if {$b != 0} {
 754        lset vbackptr($view) $b $a
 755    }
 756    lappend varctok($view) $tok
 757    lappend varcstart($view) $id
 758    lappend vdownptr($view) 0
 759    lappend varcrow($view) {}
 760    lappend varcix($view) {}
 761    set varccommits($view,$a) {}
 762    lappend vlastins($view) 0
 763    return $a
 764}
 765
 766proc splitvarc {p v} {
 767    global varcid varcstart varccommits varctok vtokmod
 768    global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
 769
 770    set oa $varcid($v,$p)
 771    set otok [lindex $varctok($v) $oa]
 772    set ac $varccommits($v,$oa)
 773    set i [lsearch -exact $varccommits($v,$oa) $p]
 774    if {$i <= 0} return
 775    set na [llength $varctok($v)]
 776    # "%" sorts before "0"...
 777    set tok "$otok%[strrep $i]"
 778    lappend varctok($v) $tok
 779    lappend varcrow($v) {}
 780    lappend varcix($v) {}
 781    set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
 782    set varccommits($v,$na) [lrange $ac $i end]
 783    lappend varcstart($v) $p
 784    foreach id $varccommits($v,$na) {
 785        set varcid($v,$id) $na
 786    }
 787    lappend vdownptr($v) [lindex $vdownptr($v) $oa]
 788    lappend vlastins($v) [lindex $vlastins($v) $oa]
 789    lset vdownptr($v) $oa $na
 790    lset vlastins($v) $oa 0
 791    lappend vupptr($v) $oa
 792    lappend vleftptr($v) 0
 793    lappend vbackptr($v) 0
 794    for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
 795        lset vupptr($v) $b $na
 796    }
 797    if {[string compare $otok $vtokmod($v)] <= 0} {
 798        modify_arc $v $oa
 799    }
 800}
 801
 802proc renumbervarc {a v} {
 803    global parents children varctok varcstart varccommits
 804    global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
 805
 806    set t1 [clock clicks -milliseconds]
 807    set todo {}
 808    set isrelated($a) 1
 809    set kidchanged($a) 1
 810    set ntot 0
 811    while {$a != 0} {
 812        if {[info exists isrelated($a)]} {
 813            lappend todo $a
 814            set id [lindex $varccommits($v,$a) end]
 815            foreach p $parents($v,$id) {
 816                if {[info exists varcid($v,$p)]} {
 817                    set isrelated($varcid($v,$p)) 1
 818                }
 819            }
 820        }
 821        incr ntot
 822        set b [lindex $vdownptr($v) $a]
 823        if {$b == 0} {
 824            while {$a != 0} {
 825                set b [lindex $vleftptr($v) $a]
 826                if {$b != 0} break
 827                set a [lindex $vupptr($v) $a]
 828            }
 829        }
 830        set a $b
 831    }
 832    foreach a $todo {
 833        if {![info exists kidchanged($a)]} continue
 834        set id [lindex $varcstart($v) $a]
 835        if {[llength $children($v,$id)] > 1} {
 836            set children($v,$id) [lsort -command [list vtokcmp $v] \
 837                                      $children($v,$id)]
 838        }
 839        set oldtok [lindex $varctok($v) $a]
 840        if {!$vdatemode($v)} {
 841            set tok {}
 842        } else {
 843            set tok $oldtok
 844        }
 845        set ka 0
 846        set kid [last_real_child $v,$id]
 847        if {$kid ne {}} {
 848            set k $varcid($v,$kid)
 849            if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
 850                set ki $kid
 851                set ka $k
 852                set tok [lindex $varctok($v) $k]
 853            }
 854        }
 855        if {$ka != 0} {
 856            set i [lsearch -exact $parents($v,$ki) $id]
 857            set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
 858            append tok [strrep $j]
 859        }
 860        if {$tok eq $oldtok} {
 861            continue
 862        }
 863        set id [lindex $varccommits($v,$a) end]
 864        foreach p $parents($v,$id) {
 865            if {[info exists varcid($v,$p)]} {
 866                set kidchanged($varcid($v,$p)) 1
 867            } else {
 868                set sortkids($p) 1
 869            }
 870        }
 871        lset varctok($v) $a $tok
 872        set b [lindex $vupptr($v) $a]
 873        if {$b != $ka} {
 874            if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
 875                modify_arc $v $ka
 876            }
 877            if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
 878                modify_arc $v $b
 879            }
 880            set c [lindex $vbackptr($v) $a]
 881            set d [lindex $vleftptr($v) $a]
 882            if {$c == 0} {
 883                lset vdownptr($v) $b $d
 884            } else {
 885                lset vleftptr($v) $c $d
 886            }
 887            if {$d != 0} {
 888                lset vbackptr($v) $d $c
 889            }
 890            if {[lindex $vlastins($v) $b] == $a} {
 891                lset vlastins($v) $b $c
 892            }
 893            lset vupptr($v) $a $ka
 894            set c [lindex $vlastins($v) $ka]
 895            if {$c == 0 || \
 896                    [string compare $tok [lindex $varctok($v) $c]] < 0} {
 897                set c $ka
 898                set b [lindex $vdownptr($v) $ka]
 899            } else {
 900                set b [lindex $vleftptr($v) $c]
 901            }
 902            while {$b != 0 && \
 903                      [string compare $tok [lindex $varctok($v) $b]] >= 0} {
 904                set c $b
 905                set b [lindex $vleftptr($v) $c]
 906            }
 907            if {$c == $ka} {
 908                lset vdownptr($v) $ka $a
 909                lset vbackptr($v) $a 0
 910            } else {
 911                lset vleftptr($v) $c $a
 912                lset vbackptr($v) $a $c
 913            }
 914            lset vleftptr($v) $a $b
 915            if {$b != 0} {
 916                lset vbackptr($v) $b $a
 917            }
 918            lset vlastins($v) $ka $a
 919        }
 920    }
 921    foreach id [array names sortkids] {
 922        if {[llength $children($v,$id)] > 1} {
 923            set children($v,$id) [lsort -command [list vtokcmp $v] \
 924                                      $children($v,$id)]
 925        }
 926    }
 927    set t2 [clock clicks -milliseconds]
 928    #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
 929}
 930
 931# Fix up the graph after we have found out that in view $v,
 932# $p (a commit that we have already seen) is actually the parent
 933# of the last commit in arc $a.
 934proc fix_reversal {p a v} {
 935    global varcid varcstart varctok vupptr
 936
 937    set pa $varcid($v,$p)
 938    if {$p ne [lindex $varcstart($v) $pa]} {
 939        splitvarc $p $v
 940        set pa $varcid($v,$p)
 941    }
 942    # seeds always need to be renumbered
 943    if {[lindex $vupptr($v) $pa] == 0 ||
 944        [string compare [lindex $varctok($v) $a] \
 945             [lindex $varctok($v) $pa]] > 0} {
 946        renumbervarc $pa $v
 947    }
 948}
 949
 950proc insertrow {id p v} {
 951    global cmitlisted children parents varcid varctok vtokmod
 952    global varccommits ordertok commitidx numcommits curview
 953    global targetid targetrow vshortids
 954
 955    readcommit $id
 956    set vid $v,$id
 957    set cmitlisted($vid) 1
 958    set children($vid) {}
 959    set parents($vid) [list $p]
 960    set a [newvarc $v $id]
 961    set varcid($vid) $a
 962    lappend vshortids($v,[string range $id 0 3]) $id
 963    if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
 964        modify_arc $v $a
 965    }
 966    lappend varccommits($v,$a) $id
 967    set vp $v,$p
 968    if {[llength [lappend children($vp) $id]] > 1} {
 969        set children($vp) [lsort -command [list vtokcmp $v] $children($vp)]
 970        unset -nocomplain ordertok
 971    }
 972    fix_reversal $p $a $v
 973    incr commitidx($v)
 974    if {$v == $curview} {
 975        set numcommits $commitidx($v)
 976        setcanvscroll
 977        if {[info exists targetid]} {
 978            if {![comes_before $targetid $p]} {
 979                incr targetrow
 980            }
 981        }
 982    }
 983}
 984
 985proc insertfakerow {id p} {
 986    global varcid varccommits parents children cmitlisted
 987    global commitidx varctok vtokmod targetid targetrow curview numcommits
 988
 989    set v $curview
 990    set a $varcid($v,$p)
 991    set i [lsearch -exact $varccommits($v,$a) $p]
 992    if {$i < 0} {
 993        puts "oops: insertfakerow can't find [shortids $p] on arc $a"
 994        return
 995    }
 996    set children($v,$id) {}
 997    set parents($v,$id) [list $p]
 998    set varcid($v,$id) $a
 999    lappend children($v,$p) $id
1000    set cmitlisted($v,$id) 1
1001    set numcommits [incr commitidx($v)]
1002    # note we deliberately don't update varcstart($v) even if $i == 0
1003    set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
1004    modify_arc $v $a $i
1005    if {[info exists targetid]} {
1006        if {![comes_before $targetid $p]} {
1007            incr targetrow
1008        }
1009    }
1010    setcanvscroll
1011    drawvisible
1012}
1013
1014proc removefakerow {id} {
1015    global varcid varccommits parents children commitidx
1016    global varctok vtokmod cmitlisted currentid selectedline
1017    global targetid curview numcommits
1018
1019    set v $curview
1020    if {[llength $parents($v,$id)] != 1} {
1021        puts "oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
1022        return
1023    }
1024    set p [lindex $parents($v,$id) 0]
1025    set a $varcid($v,$id)
1026    set i [lsearch -exact $varccommits($v,$a) $id]
1027    if {$i < 0} {
1028        puts "oops: removefakerow can't find [shortids $id] on arc $a"
1029        return
1030    }
1031    unset varcid($v,$id)
1032    set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
1033    unset parents($v,$id)
1034    unset children($v,$id)
1035    unset cmitlisted($v,$id)
1036    set numcommits [incr commitidx($v) -1]
1037    set j [lsearch -exact $children($v,$p) $id]
1038    if {$j >= 0} {
1039        set children($v,$p) [lreplace $children($v,$p) $j $j]
1040    }
1041    modify_arc $v $a $i
1042    if {[info exist currentid] && $id eq $currentid} {
1043        unset currentid
1044        set selectedline {}
1045    }
1046    if {[info exists targetid] && $targetid eq $id} {
1047        set targetid $p
1048    }
1049    setcanvscroll
1050    drawvisible
1051}
1052
1053proc real_children {vp} {
1054    global children nullid nullid2
1055
1056    set kids {}
1057    foreach id $children($vp) {
1058        if {$id ne $nullid && $id ne $nullid2} {
1059            lappend kids $id
1060        }
1061    }
1062    return $kids
1063}
1064
1065proc first_real_child {vp} {
1066    global children nullid nullid2
1067
1068    foreach id $children($vp) {
1069        if {$id ne $nullid && $id ne $nullid2} {
1070            return $id
1071        }
1072    }
1073    return {}
1074}
1075
1076proc last_real_child {vp} {
1077    global children nullid nullid2
1078
1079    set kids $children($vp)
1080    for {set i [llength $kids]} {[incr i -1] >= 0} {} {
1081        set id [lindex $kids $i]
1082        if {$id ne $nullid && $id ne $nullid2} {
1083            return $id
1084        }
1085    }
1086    return {}
1087}
1088
1089proc vtokcmp {v a b} {
1090    global varctok varcid
1091
1092    return [string compare [lindex $varctok($v) $varcid($v,$a)] \
1093                [lindex $varctok($v) $varcid($v,$b)]]
1094}
1095
1096# This assumes that if lim is not given, the caller has checked that
1097# arc a's token is less than $vtokmod($v)
1098proc modify_arc {v a {lim {}}} {
1099    global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
1100
1101    if {$lim ne {}} {
1102        set c [string compare [lindex $varctok($v) $a] $vtokmod($v)]
1103        if {$c > 0} return
1104        if {$c == 0} {
1105            set r [lindex $varcrow($v) $a]
1106            if {$r ne {} && $vrowmod($v) <= $r + $lim} return
1107        }
1108    }
1109    set vtokmod($v) [lindex $varctok($v) $a]
1110    set varcmod($v) $a
1111    if {$v == $curview} {
1112        while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
1113            set a [lindex $vupptr($v) $a]
1114            set lim {}
1115        }
1116        set r 0
1117        if {$a != 0} {
1118            if {$lim eq {}} {
1119                set lim [llength $varccommits($v,$a)]
1120            }
1121            set r [expr {[lindex $varcrow($v) $a] + $lim}]
1122        }
1123        set vrowmod($v) $r
1124        undolayout $r
1125    }
1126}
1127
1128proc update_arcrows {v} {
1129    global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
1130    global varcid vrownum varcorder varcix varccommits
1131    global vupptr vdownptr vleftptr varctok
1132    global displayorder parentlist curview cached_commitrow
1133
1134    if {$vrowmod($v) == $commitidx($v)} return
1135    if {$v == $curview} {
1136        if {[llength $displayorder] > $vrowmod($v)} {
1137            set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
1138            set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
1139        }
1140        unset -nocomplain cached_commitrow
1141    }
1142    set narctot [expr {[llength $varctok($v)] - 1}]
1143    set a $varcmod($v)
1144    while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
1145        # go up the tree until we find something that has a row number,
1146        # or we get to a seed
1147        set a [lindex $vupptr($v) $a]
1148    }
1149    if {$a == 0} {
1150        set a [lindex $vdownptr($v) 0]
1151        if {$a == 0} return
1152        set vrownum($v) {0}
1153        set varcorder($v) [list $a]
1154        lset varcix($v) $a 0
1155        lset varcrow($v) $a 0
1156        set arcn 0
1157        set row 0
1158    } else {
1159        set arcn [lindex $varcix($v) $a]
1160        if {[llength $vrownum($v)] > $arcn + 1} {
1161            set vrownum($v) [lrange $vrownum($v) 0 $arcn]
1162            set varcorder($v) [lrange $varcorder($v) 0 $arcn]
1163        }
1164        set row [lindex $varcrow($v) $a]
1165    }
1166    while {1} {
1167        set p $a
1168        incr row [llength $varccommits($v,$a)]
1169        # go down if possible
1170        set b [lindex $vdownptr($v) $a]
1171        if {$b == 0} {
1172            # if not, go left, or go up until we can go left
1173            while {$a != 0} {
1174                set b [lindex $vleftptr($v) $a]
1175                if {$b != 0} break
1176                set a [lindex $vupptr($v) $a]
1177            }
1178            if {$a == 0} break
1179        }
1180        set a $b
1181        incr arcn
1182        lappend vrownum($v) $row
1183        lappend varcorder($v) $a
1184        lset varcix($v) $a $arcn
1185        lset varcrow($v) $a $row
1186    }
1187    set vtokmod($v) [lindex $varctok($v) $p]
1188    set varcmod($v) $p
1189    set vrowmod($v) $row
1190    if {[info exists currentid]} {
1191        set selectedline [rowofcommit $currentid]
1192    }
1193}
1194
1195# Test whether view $v contains commit $id
1196proc commitinview {id v} {
1197    global varcid
1198
1199    return [info exists varcid($v,$id)]
1200}
1201
1202# Return the row number for commit $id in the current view
1203proc rowofcommit {id} {
1204    global varcid varccommits varcrow curview cached_commitrow
1205    global varctok vtokmod
1206
1207    set v $curview
1208    if {![info exists varcid($v,$id)]} {
1209        puts "oops rowofcommit no arc for [shortids $id]"
1210        return {}
1211    }
1212    set a $varcid($v,$id)
1213    if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
1214        update_arcrows $v
1215    }
1216    if {[info exists cached_commitrow($id)]} {
1217        return $cached_commitrow($id)
1218    }
1219    set i [lsearch -exact $varccommits($v,$a) $id]
1220    if {$i < 0} {
1221        puts "oops didn't find commit [shortids $id] in arc $a"
1222        return {}
1223    }
1224    incr i [lindex $varcrow($v) $a]
1225    set cached_commitrow($id) $i
1226    return $i
1227}
1228
1229# Returns 1 if a is on an earlier row than b, otherwise 0
1230proc comes_before {a b} {
1231    global varcid varctok curview
1232
1233    set v $curview
1234    if {$a eq $b || ![info exists varcid($v,$a)] || \
1235            ![info exists varcid($v,$b)]} {
1236        return 0
1237    }
1238    if {$varcid($v,$a) != $varcid($v,$b)} {
1239        return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
1240                           [lindex $varctok($v) $varcid($v,$b)]] < 0}]
1241    }
1242    return [expr {[rowofcommit $a] < [rowofcommit $b]}]
1243}
1244
1245proc bsearch {l elt} {
1246    if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
1247        return 0
1248    }
1249    set lo 0
1250    set hi [llength $l]
1251    while {$hi - $lo > 1} {
1252        set mid [expr {int(($lo + $hi) / 2)}]
1253        set t [lindex $l $mid]
1254        if {$elt < $t} {
1255            set hi $mid
1256        } elseif {$elt > $t} {
1257            set lo $mid
1258        } else {
1259            return $mid
1260        }
1261    }
1262    return $lo
1263}
1264
1265# Make sure rows $start..$end-1 are valid in displayorder and parentlist
1266proc make_disporder {start end} {
1267    global vrownum curview commitidx displayorder parentlist
1268    global varccommits varcorder parents vrowmod varcrow
1269    global d_valid_start d_valid_end
1270
1271    if {$end > $vrowmod($curview)} {
1272        update_arcrows $curview
1273    }
1274    set ai [bsearch $vrownum($curview) $start]
1275    set start [lindex $vrownum($curview) $ai]
1276    set narc [llength $vrownum($curview)]
1277    for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
1278        set a [lindex $varcorder($curview) $ai]
1279        set l [llength $displayorder]
1280        set al [llength $varccommits($curview,$a)]
1281        if {$l < $r + $al} {
1282            if {$l < $r} {
1283                set pad [ntimes [expr {$r - $l}] {}]
1284                set displayorder [concat $displayorder $pad]
1285                set parentlist [concat $parentlist $pad]
1286            } elseif {$l > $r} {
1287                set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
1288                set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
1289            }
1290            foreach id $varccommits($curview,$a) {
1291                lappend displayorder $id
1292                lappend parentlist $parents($curview,$id)
1293            }
1294        } elseif {[lindex $displayorder [expr {$r + $al - 1}]] eq {}} {
1295            set i $r
1296            foreach id $varccommits($curview,$a) {
1297                lset displayorder $i $id
1298                lset parentlist $i $parents($curview,$id)
1299                incr i
1300            }
1301        }
1302        incr r $al
1303    }
1304}
1305
1306proc commitonrow {row} {
1307    global displayorder
1308
1309    set id [lindex $displayorder $row]
1310    if {$id eq {}} {
1311        make_disporder $row [expr {$row + 1}]
1312        set id [lindex $displayorder $row]
1313    }
1314    return $id
1315}
1316
1317proc closevarcs {v} {
1318    global varctok varccommits varcid parents children
1319    global cmitlisted commitidx vtokmod curview numcommits
1320
1321    set missing_parents 0
1322    set scripts {}
1323    set narcs [llength $varctok($v)]
1324    for {set a 1} {$a < $narcs} {incr a} {
1325        set id [lindex $varccommits($v,$a) end]
1326        foreach p $parents($v,$id) {
1327            if {[info exists varcid($v,$p)]} continue
1328            # add p as a new commit
1329            incr missing_parents
1330            set cmitlisted($v,$p) 0
1331            set parents($v,$p) {}
1332            if {[llength $children($v,$p)] == 1 &&
1333                [llength $parents($v,$id)] == 1} {
1334                set b $a
1335            } else {
1336                set b [newvarc $v $p]
1337            }
1338            set varcid($v,$p) $b
1339            if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
1340                modify_arc $v $b
1341            }
1342            lappend varccommits($v,$b) $p
1343            incr commitidx($v)
1344            if {$v == $curview} {
1345                set numcommits $commitidx($v)
1346            }
1347            set scripts [check_interest $p $scripts]
1348        }
1349    }
1350    if {$missing_parents > 0} {
1351        foreach s $scripts {
1352            eval $s
1353        }
1354    }
1355}
1356
1357# Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1358# Assumes we already have an arc for $rwid.
1359proc rewrite_commit {v id rwid} {
1360    global children parents varcid varctok vtokmod varccommits
1361
1362    foreach ch $children($v,$id) {
1363        # make $rwid be $ch's parent in place of $id
1364        set i [lsearch -exact $parents($v,$ch) $id]
1365        if {$i < 0} {
1366            puts "oops rewrite_commit didn't find $id in parent list for $ch"
1367        }
1368        set parents($v,$ch) [lreplace $parents($v,$ch) $i $i $rwid]
1369        # add $ch to $rwid's children and sort the list if necessary
1370        if {[llength [lappend children($v,$rwid) $ch]] > 1} {
1371            set children($v,$rwid) [lsort -command [list vtokcmp $v] \
1372                                        $children($v,$rwid)]
1373        }
1374        # fix the graph after joining $id to $rwid
1375        set a $varcid($v,$ch)
1376        fix_reversal $rwid $a $v
1377        # parentlist is wrong for the last element of arc $a
1378        # even if displayorder is right, hence the 3rd arg here
1379        modify_arc $v $a [expr {[llength $varccommits($v,$a)] - 1}]
1380    }
1381}
1382
1383# Mechanism for registering a command to be executed when we come
1384# across a particular commit.  To handle the case when only the
1385# prefix of the commit is known, the commitinterest array is now
1386# indexed by the first 4 characters of the ID.  Each element is a
1387# list of id, cmd pairs.
1388proc interestedin {id cmd} {
1389    global commitinterest
1390
1391    lappend commitinterest([string range $id 0 3]) $id $cmd
1392}
1393
1394proc check_interest {id scripts} {
1395    global commitinterest
1396
1397    set prefix [string range $id 0 3]
1398    if {[info exists commitinterest($prefix)]} {
1399        set newlist {}
1400        foreach {i script} $commitinterest($prefix) {
1401            if {[string match "$i*" $id]} {
1402                lappend scripts [string map [list "%I" $id "%P" $i] $script]
1403            } else {
1404                lappend newlist $i $script
1405            }
1406        }
1407        if {$newlist ne {}} {
1408            set commitinterest($prefix) $newlist
1409        } else {
1410            unset commitinterest($prefix)
1411        }
1412    }
1413    return $scripts
1414}
1415
1416proc getcommitlines {fd inst view updating}  {
1417    global cmitlisted leftover
1418    global commitidx commitdata vdatemode
1419    global parents children curview hlview
1420    global idpending ordertok
1421    global varccommits varcid varctok vtokmod vfilelimit vshortids
1422
1423    set stuff [read $fd 500000]
1424    # git log doesn't terminate the last commit with a null...
1425    if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
1426        set stuff "\0"
1427    }
1428    if {$stuff == {}} {
1429        if {![eof $fd]} {
1430            return 1
1431        }
1432        global commfd viewcomplete viewactive viewname
1433        global viewinstances
1434        unset commfd($inst)
1435        set i [lsearch -exact $viewinstances($view) $inst]
1436        if {$i >= 0} {
1437            set viewinstances($view) [lreplace $viewinstances($view) $i $i]
1438        }
1439        # set it blocking so we wait for the process to terminate
1440        fconfigure $fd -blocking 1
1441        if {[catch {close $fd} err]} {
1442            set fv {}
1443            if {$view != $curview} {
1444                set fv " for the \"$viewname($view)\" view"
1445            }
1446            if {[string range $err 0 4] == "usage"} {
1447                set err "Gitk: error reading commits$fv:\
1448                        bad arguments to git log."
1449                if {$viewname($view) eq [mc "Command line"]} {
1450                    append err \
1451                        "  (Note: arguments to gitk are passed to git log\
1452                         to allow selection of commits to be displayed.)"
1453                }
1454            } else {
1455                set err "Error reading commits$fv: $err"
1456            }
1457            error_popup $err
1458        }
1459        if {[incr viewactive($view) -1] <= 0} {
1460            set viewcomplete($view) 1
1461            # Check if we have seen any ids listed as parents that haven't
1462            # appeared in the list
1463            closevarcs $view
1464            notbusy $view
1465        }
1466        if {$view == $curview} {
1467            run chewcommits
1468        }
1469        return 0
1470    }
1471    set start 0
1472    set gotsome 0
1473    set scripts {}
1474    while 1 {
1475        set i [string first "\0" $stuff $start]
1476        if {$i < 0} {
1477            append leftover($inst) [string range $stuff $start end]
1478            break
1479        }
1480        if {$start == 0} {
1481            set cmit $leftover($inst)
1482            append cmit [string range $stuff 0 [expr {$i - 1}]]
1483            set leftover($inst) {}
1484        } else {
1485            set cmit [string range $stuff $start [expr {$i - 1}]]
1486        }
1487        set start [expr {$i + 1}]
1488        set j [string first "\n" $cmit]
1489        set ok 0
1490        set listed 1
1491        if {$j >= 0 && [string match "commit *" $cmit]} {
1492            set ids [string range $cmit 7 [expr {$j - 1}]]
1493            if {[string match {[-^<>]*} $ids]} {
1494                switch -- [string index $ids 0] {
1495                    "-" {set listed 0}
1496                    "^" {set listed 2}
1497                    "<" {set listed 3}
1498                    ">" {set listed 4}
1499                }
1500                set ids [string range $ids 1 end]
1501            }
1502            set ok 1
1503            foreach id $ids {
1504                if {[string length $id] != 40} {
1505                    set ok 0
1506                    break
1507                }
1508            }
1509        }
1510        if {!$ok} {
1511            set shortcmit $cmit
1512            if {[string length $shortcmit] > 80} {
1513                set shortcmit "[string range $shortcmit 0 80]..."
1514            }
1515            error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
1516            exit 1
1517        }
1518        set id [lindex $ids 0]
1519        set vid $view,$id
1520
1521        lappend vshortids($view,[string range $id 0 3]) $id
1522
1523        if {!$listed && $updating && ![info exists varcid($vid)] &&
1524            $vfilelimit($view) ne {}} {
1525            # git log doesn't rewrite parents for unlisted commits
1526            # when doing path limiting, so work around that here
1527            # by working out the rewritten parent with git rev-list
1528            # and if we already know about it, using the rewritten
1529            # parent as a substitute parent for $id's children.
1530            if {![catch {
1531                set rwid [exec git rev-list --first-parent --max-count=1 \
1532                              $id -- $vfilelimit($view)]
1533            }]} {
1534                if {$rwid ne {} && [info exists varcid($view,$rwid)]} {
1535                    # use $rwid in place of $id
1536                    rewrite_commit $view $id $rwid
1537                    continue
1538                }
1539            }
1540        }
1541
1542        set a 0
1543        if {[info exists varcid($vid)]} {
1544            if {$cmitlisted($vid) || !$listed} continue
1545            set a $varcid($vid)
1546        }
1547        if {$listed} {
1548            set olds [lrange $ids 1 end]
1549        } else {
1550            set olds {}
1551        }
1552        set commitdata($id) [string range $cmit [expr {$j + 1}] end]
1553        set cmitlisted($vid) $listed
1554        set parents($vid) $olds
1555        if {![info exists children($vid)]} {
1556            set children($vid) {}
1557        } elseif {$a == 0 && [llength $children($vid)] == 1} {
1558            set k [lindex $children($vid) 0]
1559            if {[llength $parents($view,$k)] == 1 &&
1560                (!$vdatemode($view) ||
1561                 $varcid($view,$k) == [llength $varctok($view)] - 1)} {
1562                set a $varcid($view,$k)
1563            }
1564        }
1565        if {$a == 0} {
1566            # new arc
1567            set a [newvarc $view $id]
1568        }
1569        if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
1570            modify_arc $view $a
1571        }
1572        if {![info exists varcid($vid)]} {
1573            set varcid($vid) $a
1574            lappend varccommits($view,$a) $id
1575            incr commitidx($view)
1576        }
1577
1578        set i 0
1579        foreach p $olds {
1580            if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
1581                set vp $view,$p
1582                if {[llength [lappend children($vp) $id]] > 1 &&
1583                    [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
1584                    set children($vp) [lsort -command [list vtokcmp $view] \
1585                                           $children($vp)]
1586                    unset -nocomplain ordertok
1587                }
1588                if {[info exists varcid($view,$p)]} {
1589                    fix_reversal $p $a $view
1590                }
1591            }
1592            incr i
1593        }
1594
1595        set scripts [check_interest $id $scripts]
1596        set gotsome 1
1597    }
1598    if {$gotsome} {
1599        global numcommits hlview
1600
1601        if {$view == $curview} {
1602            set numcommits $commitidx($view)
1603            run chewcommits
1604        }
1605        if {[info exists hlview] && $view == $hlview} {
1606            # we never actually get here...
1607            run vhighlightmore
1608        }
1609        foreach s $scripts {
1610            eval $s
1611        }
1612    }
1613    return 2
1614}
1615
1616proc chewcommits {} {
1617    global curview hlview viewcomplete
1618    global pending_select
1619
1620    layoutmore
1621    if {$viewcomplete($curview)} {
1622        global commitidx varctok
1623        global numcommits startmsecs
1624
1625        if {[info exists pending_select]} {
1626            update
1627            reset_pending_select {}
1628
1629            if {[commitinview $pending_select $curview]} {
1630                selectline [rowofcommit $pending_select] 1
1631            } else {
1632                set row [first_real_row]
1633                selectline $row 1
1634            }
1635        }
1636        if {$commitidx($curview) > 0} {
1637            #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1638            #puts "overall $ms ms for $numcommits commits"
1639            #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1640        } else {
1641            show_status [mc "No commits selected"]
1642        }
1643        notbusy layout
1644    }
1645    return 0
1646}
1647
1648proc do_readcommit {id} {
1649    global tclencoding
1650
1651    # Invoke git-log to handle automatic encoding conversion
1652    set fd [open [concat | git log --no-color --pretty=raw -1 $id] r]
1653    # Read the results using i18n.logoutputencoding
1654    fconfigure $fd -translation lf -eofchar {}
1655    if {$tclencoding != {}} {
1656        fconfigure $fd -encoding $tclencoding
1657    }
1658    set contents [read $fd]
1659    close $fd
1660    # Remove the heading line
1661    regsub {^commit [0-9a-f]+\n} $contents {} contents
1662
1663    return $contents
1664}
1665
1666proc readcommit {id} {
1667    if {[catch {set contents [do_readcommit $id]}]} return
1668    parsecommit $id $contents 1
1669}
1670
1671proc parsecommit {id contents listed} {
1672    global commitinfo
1673
1674    set inhdr 1
1675    set comment {}
1676    set headline {}
1677    set auname {}
1678    set audate {}
1679    set comname {}
1680    set comdate {}
1681    set hdrend [string first "\n\n" $contents]
1682    if {$hdrend < 0} {
1683        # should never happen...
1684        set hdrend [string length $contents]
1685    }
1686    set header [string range $contents 0 [expr {$hdrend - 1}]]
1687    set comment [string range $contents [expr {$hdrend + 2}] end]
1688    foreach line [split $header "\n"] {
1689        set line [split $line " "]
1690        set tag [lindex $line 0]
1691        if {$tag == "author"} {
1692            set audate [lrange $line end-1 end]
1693            set auname [join [lrange $line 1 end-2] " "]
1694        } elseif {$tag == "committer"} {
1695            set comdate [lrange $line end-1 end]
1696            set comname [join [lrange $line 1 end-2] " "]
1697        }
1698    }
1699    set headline {}
1700    # take the first non-blank line of the comment as the headline
1701    set headline [string trimleft $comment]
1702    set i [string first "\n" $headline]
1703    if {$i >= 0} {
1704        set headline [string range $headline 0 $i]
1705    }
1706    set headline [string trimright $headline]
1707    set i [string first "\r" $headline]
1708    if {$i >= 0} {
1709        set headline [string trimright [string range $headline 0 $i]]
1710    }
1711    if {!$listed} {
1712        # git log indents the comment by 4 spaces;
1713        # if we got this via git cat-file, add the indentation
1714        set newcomment {}
1715        foreach line [split $comment "\n"] {
1716            append newcomment "    "
1717            append newcomment $line
1718            append newcomment "\n"
1719        }
1720        set comment $newcomment
1721    }
1722    set hasnote [string first "\nNotes:\n" $contents]
1723    set diff ""
1724    # If there is diff output shown in the git-log stream, split it
1725    # out.  But get rid of the empty line that always precedes the
1726    # diff.
1727    set i [string first "\n\ndiff" $comment]
1728    if {$i >= 0} {
1729        set diff [string range $comment $i+1 end]
1730        set comment [string range $comment 0 $i-1]
1731    }
1732    set commitinfo($id) [list $headline $auname $audate \
1733                             $comname $comdate $comment $hasnote $diff]
1734}
1735
1736proc getcommit {id} {
1737    global commitdata commitinfo
1738
1739    if {[info exists commitdata($id)]} {
1740        parsecommit $id $commitdata($id) 1
1741    } else {
1742        readcommit $id
1743        if {![info exists commitinfo($id)]} {
1744            set commitinfo($id) [list [mc "No commit information available"]]
1745        }
1746    }
1747    return 1
1748}
1749
1750# Expand an abbreviated commit ID to a list of full 40-char IDs that match
1751# and are present in the current view.
1752# This is fairly slow...
1753proc longid {prefix} {
1754    global varcid curview vshortids
1755
1756    set ids {}
1757    if {[string length $prefix] >= 4} {
1758        set vshortid $curview,[string range $prefix 0 3]
1759        if {[info exists vshortids($vshortid)]} {
1760            foreach id $vshortids($vshortid) {
1761                if {[string match "$prefix*" $id]} {
1762                    if {[lsearch -exact $ids $id] < 0} {
1763                        lappend ids $id
1764                        if {[llength $ids] >= 2} break
1765                    }
1766                }
1767            }
1768        }
1769    } else {
1770        foreach match [array names varcid "$curview,$prefix*"] {
1771            lappend ids [lindex [split $match ","] 1]
1772            if {[llength $ids] >= 2} break
1773        }
1774    }
1775    return $ids
1776}
1777
1778proc readrefs {} {
1779    global tagids idtags headids idheads tagobjid
1780    global otherrefids idotherrefs mainhead mainheadid
1781    global selecthead selectheadid
1782    global hideremotes
1783
1784    foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
1785        unset -nocomplain $v
1786    }
1787    set refd [open [list | git show-ref -d] r]
1788    while {[gets $refd line] >= 0} {
1789        if {[string index $line 40] ne " "} continue
1790        set id [string range $line 0 39]
1791        set ref [string range $line 41 end]
1792        if {![string match "refs/*" $ref]} continue
1793        set name [string range $ref 5 end]
1794        if {[string match "remotes/*" $name]} {
1795            if {![string match "*/HEAD" $name] && !$hideremotes} {
1796                set headids($name) $id
1797                lappend idheads($id) $name
1798            }
1799        } elseif {[string match "heads/*" $name]} {
1800            set name [string range $name 6 end]
1801            set headids($name) $id
1802            lappend idheads($id) $name
1803        } elseif {[string match "tags/*" $name]} {
1804            # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1805            # which is what we want since the former is the commit ID
1806            set name [string range $name 5 end]
1807            if {[string match "*^{}" $name]} {
1808                set name [string range $name 0 end-3]
1809            } else {
1810                set tagobjid($name) $id
1811            }
1812            set tagids($name) $id
1813            lappend idtags($id) $name
1814        } else {
1815            set otherrefids($name) $id
1816            lappend idotherrefs($id) $name
1817        }
1818    }
1819    catch {close $refd}
1820    set mainhead {}
1821    set mainheadid {}
1822    catch {
1823        set mainheadid [exec git rev-parse HEAD]
1824        set thehead [exec git symbolic-ref HEAD]
1825        if {[string match "refs/heads/*" $thehead]} {
1826            set mainhead [string range $thehead 11 end]
1827        }
1828    }
1829    set selectheadid {}
1830    if {$selecthead ne {}} {
1831        catch {
1832            set selectheadid [exec git rev-parse --verify $selecthead]
1833        }
1834    }
1835}
1836
1837# skip over fake commits
1838proc first_real_row {} {
1839    global nullid nullid2 numcommits
1840
1841    for {set row 0} {$row < $numcommits} {incr row} {
1842        set id [commitonrow $row]
1843        if {$id ne $nullid && $id ne $nullid2} {
1844            break
1845        }
1846    }
1847    return $row
1848}
1849
1850# update things for a head moved to a child of its previous location
1851proc movehead {id name} {
1852    global headids idheads
1853
1854    removehead $headids($name) $name
1855    set headids($name) $id
1856    lappend idheads($id) $name
1857}
1858
1859# update things when a head has been removed
1860proc removehead {id name} {
1861    global headids idheads
1862
1863    if {$idheads($id) eq $name} {
1864        unset idheads($id)
1865    } else {
1866        set i [lsearch -exact $idheads($id) $name]
1867        if {$i >= 0} {
1868            set idheads($id) [lreplace $idheads($id) $i $i]
1869        }
1870    }
1871    unset headids($name)
1872}
1873
1874proc ttk_toplevel {w args} {
1875    global use_ttk
1876    eval [linsert $args 0 ::toplevel $w]
1877    if {$use_ttk} {
1878        place [ttk::frame $w._toplevel_background] -x 0 -y 0 -relwidth 1 -relheight 1
1879    }
1880    return $w
1881}
1882
1883proc make_transient {window origin} {
1884    global have_tk85
1885
1886    # In MacOS Tk 8.4 transient appears to work by setting
1887    # overrideredirect, which is utterly useless, since the
1888    # windows get no border, and are not even kept above
1889    # the parent.
1890    if {!$have_tk85 && [tk windowingsystem] eq {aqua}} return
1891
1892    wm transient $window $origin
1893
1894    # Windows fails to place transient windows normally, so
1895    # schedule a callback to center them on the parent.
1896    if {[tk windowingsystem] eq {win32}} {
1897        after idle [list tk::PlaceWindow $window widget $origin]
1898    }
1899}
1900
1901proc show_error {w top msg} {
1902    global NS
1903    if {![info exists NS]} {set NS ""}
1904    if {[wm state $top] eq "withdrawn"} { wm deiconify $top }
1905    message $w.m -text $msg -justify center -aspect 400
1906    pack $w.m -side top -fill x -padx 20 -pady 20
1907    ${NS}::button $w.ok -default active -text [mc OK] -command "destroy $top"
1908    pack $w.ok -side bottom -fill x
1909    bind $top <Visibility> "grab $top; focus $top"
1910    bind $top <Key-Return> "destroy $top"
1911    bind $top <Key-space>  "destroy $top"
1912    bind $top <Key-Escape> "destroy $top"
1913    tkwait window $top
1914}
1915
1916proc error_popup {msg {owner .}} {
1917    if {[tk windowingsystem] eq "win32"} {
1918        tk_messageBox -icon error -type ok -title [wm title .] \
1919            -parent $owner -message $msg
1920    } else {
1921        set w .error
1922        ttk_toplevel $w
1923        make_transient $w $owner
1924        show_error $w $w $msg
1925    }
1926}
1927
1928proc confirm_popup {msg {owner .}} {
1929    global confirm_ok NS
1930    set confirm_ok 0
1931    set w .confirm
1932    ttk_toplevel $w
1933    make_transient $w $owner
1934    message $w.m -text $msg -justify center -aspect 400
1935    pack $w.m -side top -fill x -padx 20 -pady 20
1936    ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
1937    pack $w.ok -side left -fill x
1938    ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
1939    pack $w.cancel -side right -fill x
1940    bind $w <Visibility> "grab $w; focus $w"
1941    bind $w <Key-Return> "set confirm_ok 1; destroy $w"
1942    bind $w <Key-space>  "set confirm_ok 1; destroy $w"
1943    bind $w <Key-Escape> "destroy $w"
1944    tk::PlaceWindow $w widget $owner
1945    tkwait window $w
1946    return $confirm_ok
1947}
1948
1949proc setoptions {} {
1950    global use_ttk
1951
1952    if {[tk windowingsystem] ne "win32"} {
1953        option add *Panedwindow.showHandle 1 startupFile
1954        option add *Panedwindow.sashRelief raised startupFile
1955        if {[tk windowingsystem] ne "aqua"} {
1956            option add *Menu.font uifont startupFile
1957        }
1958    } else {
1959        option add *Menu.TearOff 0 startupFile
1960    }
1961    option add *Button.font uifont startupFile
1962    option add *Checkbutton.font uifont startupFile
1963    option add *Radiobutton.font uifont startupFile
1964    option add *Menubutton.font uifont startupFile
1965    option add *Label.font uifont startupFile
1966    option add *Message.font uifont startupFile
1967    option add *Entry.font textfont startupFile
1968    option add *Text.font textfont startupFile
1969    option add *Labelframe.font uifont startupFile
1970    option add *Spinbox.font textfont startupFile
1971    option add *Listbox.font mainfont startupFile
1972}
1973
1974proc setttkstyle {} {
1975    eval font configure TkDefaultFont [fontflags mainfont]
1976    eval font configure TkTextFont [fontflags textfont]
1977    eval font configure TkHeadingFont [fontflags mainfont]
1978    eval font configure TkCaptionFont [fontflags mainfont] -weight bold
1979    eval font configure TkTooltipFont [fontflags uifont]
1980    eval font configure TkFixedFont   [fontflags textfont]
1981    eval font configure TkIconFont    [fontflags uifont]
1982    eval font configure TkMenuFont    [fontflags uifont]
1983    eval font configure TkSmallCaptionFont [fontflags uifont]
1984}
1985
1986# Make a menu and submenus.
1987# m is the window name for the menu, items is the list of menu items to add.
1988# Each item is a list {mc label type description options...}
1989# mc is ignored; it's so we can put mc there to alert xgettext
1990# label is the string that appears in the menu
1991# type is cascade, command or radiobutton (should add checkbutton)
1992# description depends on type; it's the sublist for cascade, the
1993# command to invoke for command, or {variable value} for radiobutton
1994proc makemenu {m items} {
1995    menu $m
1996    if {[tk windowingsystem] eq {aqua}} {
1997        set Meta1 Cmd
1998    } else {
1999        set Meta1 Ctrl
2000    }
2001    foreach i $items {
2002        set name [mc [lindex $i 1]]
2003        set type [lindex $i 2]
2004        set thing [lindex $i 3]
2005        set params [list $type]
2006        if {$name ne {}} {
2007            set u [string first "&" [string map {&& x} $name]]
2008            lappend params -label [string map {&& & & {}} $name]
2009            if {$u >= 0} {
2010                lappend params -underline $u
2011            }
2012        }
2013        switch -- $type {
2014            "cascade" {
2015                set submenu [string tolower [string map {& ""} [lindex $i 1]]]
2016                lappend params -menu $m.$submenu
2017            }
2018            "command" {
2019                lappend params -command $thing
2020            }
2021            "radiobutton" {
2022                lappend params -variable [lindex $thing 0] \
2023                    -value [lindex $thing 1]
2024            }
2025        }
2026        set tail [lrange $i 4 end]
2027        regsub -all {\yMeta1\y} $tail $Meta1 tail
2028        eval $m add $params $tail
2029        if {$type eq "cascade"} {
2030            makemenu $m.$submenu $thing
2031        }
2032    }
2033}
2034
2035# translate string and remove ampersands
2036proc mca {str} {
2037    return [string map {&& & & {}} [mc $str]]
2038}
2039
2040proc cleardropsel {w} {
2041    $w selection clear
2042}
2043proc makedroplist {w varname args} {
2044    global use_ttk
2045    if {$use_ttk} {
2046        set width 0
2047        foreach label $args {
2048            set cx [string length $label]
2049            if {$cx > $width} {set width $cx}
2050        }
2051        set gm [ttk::combobox $w -width $width -state readonly\
2052                    -textvariable $varname -values $args \
2053                    -exportselection false]
2054        bind $gm <<ComboboxSelected>> [list $gm selection clear]
2055    } else {
2056        set gm [eval [linsert $args 0 tk_optionMenu $w $varname]]
2057    }
2058    return $gm
2059}
2060
2061proc makewindow {} {
2062    global canv canv2 canv3 linespc charspc ctext cflist cscroll
2063    global tabstop
2064    global findtype findtypemenu findloc findstring fstring geometry
2065    global entries sha1entry sha1string sha1but
2066    global diffcontextstring diffcontext
2067    global ignorespace
2068    global maincursor textcursor curtextcursor
2069    global rowctxmenu fakerowmenu mergemax wrapcomment
2070    global highlight_files gdttype
2071    global searchstring sstring
2072    global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
2073    global uifgcolor uifgdisabledcolor
2074    global filesepbgcolor filesepfgcolor
2075    global mergecolors foundbgcolor currentsearchhitbgcolor
2076    global headctxmenu progresscanv progressitem progresscoords statusw
2077    global fprogitem fprogcoord lastprogupdate progupdatepending
2078    global rprogitem rprogcoord rownumsel numcommits
2079    global have_tk85 use_ttk NS
2080    global git_version
2081    global worddiff
2082
2083    # The "mc" arguments here are purely so that xgettext
2084    # sees the following string as needing to be translated
2085    set file {
2086        mc "&File" cascade {
2087            {mc "&Update" command updatecommits -accelerator F5}
2088            {mc "&Reload" command reloadcommits -accelerator Shift-F5}
2089            {mc "Reread re&ferences" command rereadrefs}
2090            {mc "&List references" command showrefs -accelerator F2}
2091            {xx "" separator}
2092            {mc "Start git &gui" command {exec git gui &}}
2093            {xx "" separator}
2094            {mc "&Quit" command doquit -accelerator Meta1-Q}
2095        }}
2096    set edit {
2097        mc "&Edit" cascade {
2098            {mc "&Preferences" command doprefs}
2099        }}
2100    set view {
2101        mc "&View" cascade {
2102            {mc "&New view..." command {newview 0} -accelerator Shift-F4}
2103            {mc "&Edit view..." command editview -state disabled -accelerator F4}
2104            {mc "&Delete view" command delview -state disabled}
2105            {xx "" separator}
2106            {mc "&All files" radiobutton {selectedview 0} -command {showview 0}}
2107        }}
2108    if {[tk windowingsystem] ne "aqua"} {
2109        set help {
2110        mc "&Help" cascade {
2111            {mc "&About gitk" command about}
2112            {mc "&Key bindings" command keys}
2113        }}
2114        set bar [list $file $edit $view $help]
2115    } else {
2116        proc ::tk::mac::ShowPreferences {} {doprefs}
2117        proc ::tk::mac::Quit {} {doquit}
2118        lset file end [lreplace [lindex $file end] end-1 end]
2119        set apple {
2120        xx "&Apple" cascade {
2121            {mc "&About gitk" command about}
2122            {xx "" separator}
2123        }}
2124        set help {
2125        mc "&Help" cascade {
2126            {mc "&Key bindings" command keys}
2127        }}
2128        set bar [list $apple $file $view $help]
2129    }
2130    makemenu .bar $bar
2131    . configure -menu .bar
2132
2133    if {$use_ttk} {
2134        # cover the non-themed toplevel with a themed frame.
2135        place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1
2136    }
2137
2138    # the gui has upper and lower half, parts of a paned window.
2139    ${NS}::panedwindow .ctop -orient vertical
2140
2141    # possibly use assumed geometry
2142    if {![info exists geometry(pwsash0)]} {
2143        set geometry(topheight) [expr {15 * $linespc}]
2144        set geometry(topwidth) [expr {80 * $charspc}]
2145        set geometry(botheight) [expr {15 * $linespc}]
2146        set geometry(botwidth) [expr {50 * $charspc}]
2147        set geometry(pwsash0) [list [expr {40 * $charspc}] 2]
2148        set geometry(pwsash1) [list [expr {60 * $charspc}] 2]
2149    }
2150
2151    # the upper half will have a paned window, a scroll bar to the right, and some stuff below
2152    ${NS}::frame .tf -height $geometry(topheight) -width $geometry(topwidth)
2153    ${NS}::frame .tf.histframe
2154    ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal
2155    if {!$use_ttk} {
2156        .tf.histframe.pwclist configure -sashpad 0 -handlesize 4
2157    }
2158
2159    # create three canvases
2160    set cscroll .tf.histframe.csb
2161    set canv .tf.histframe.pwclist.canv
2162    canvas $canv \
2163        -selectbackground $selectbgcolor \
2164        -background $bgcolor -bd 0 \
2165        -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
2166    .tf.histframe.pwclist add $canv
2167    set canv2 .tf.histframe.pwclist.canv2
2168    canvas $canv2 \
2169        -selectbackground $selectbgcolor \
2170        -background $bgcolor -bd 0 -yscrollincr $linespc
2171    .tf.histframe.pwclist add $canv2
2172    set canv3 .tf.histframe.pwclist.canv3
2173    canvas $canv3 \
2174        -selectbackground $selectbgcolor \
2175        -background $bgcolor -bd 0 -yscrollincr $linespc
2176    .tf.histframe.pwclist add $canv3
2177    if {$use_ttk} {
2178        bind .tf.histframe.pwclist <Map> {
2179            bind %W <Map> {}
2180            .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0]
2181            .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0]
2182        }
2183    } else {
2184        eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
2185        eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
2186    }
2187
2188    # a scroll bar to rule them
2189    ${NS}::scrollbar $cscroll -command {allcanvs yview}
2190    if {!$use_ttk} {$cscroll configure -highlightthickness 0}
2191    pack $cscroll -side right -fill y
2192    bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
2193    lappend bglist $canv $canv2 $canv3
2194    pack .tf.histframe.pwclist -fill both -expand 1 -side left
2195
2196    # we have two button bars at bottom of top frame. Bar 1
2197    ${NS}::frame .tf.bar
2198    ${NS}::frame .tf.lbar -height 15
2199
2200    set sha1entry .tf.bar.sha1
2201    set entries $sha1entry
2202    set sha1but .tf.bar.sha1label
2203    button $sha1but -text "[mc "SHA1 ID:"] " -state disabled -relief flat \
2204        -command gotocommit -width 8
2205    $sha1but conf -disabledforeground [$sha1but cget -foreground]
2206    pack .tf.bar.sha1label -side left
2207    ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string
2208    trace add variable sha1string write sha1change
2209    pack $sha1entry -side left -pady 2
2210
2211    set bm_left_data {
2212        #define left_width 16
2213        #define left_height 16
2214        static unsigned char left_bits[] = {
2215        0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
2216        0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
2217        0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
2218    }
2219    set bm_right_data {
2220        #define right_width 16
2221        #define right_height 16
2222        static unsigned char right_bits[] = {
2223        0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
2224        0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
2225        0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
2226    }
2227    image create bitmap bm-left -data $bm_left_data -foreground $uifgcolor
2228    image create bitmap bm-left-gray -data $bm_left_data -foreground $uifgdisabledcolor
2229    image create bitmap bm-right -data $bm_right_data -foreground $uifgcolor
2230    image create bitmap bm-right-gray -data $bm_right_data -foreground $uifgdisabledcolor
2231
2232    ${NS}::button .tf.bar.leftbut -command goback -state disabled -width 26
2233    if {$use_ttk} {
2234        .tf.bar.leftbut configure -image [list bm-left disabled bm-left-gray]
2235    } else {
2236        .tf.bar.leftbut configure -image bm-left
2237    }
2238    pack .tf.bar.leftbut -side left -fill y
2239    ${NS}::button .tf.bar.rightbut -command goforw -state disabled -width 26
2240    if {$use_ttk} {
2241        .tf.bar.rightbut configure -image [list bm-right disabled bm-right-gray]
2242    } else {
2243        .tf.bar.rightbut configure -image bm-right
2244    }
2245    pack .tf.bar.rightbut -side left -fill y
2246
2247    ${NS}::label .tf.bar.rowlabel -text [mc "Row"]
2248    set rownumsel {}
2249    ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \
2250        -relief sunken -anchor e
2251    ${NS}::label .tf.bar.rowlabel2 -text "/"
2252    ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \
2253        -relief sunken -anchor e
2254    pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
2255        -side left
2256    if {!$use_ttk} {
2257        foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont}
2258    }
2259    global selectedline
2260    trace add variable selectedline write selectedline_change
2261
2262    # Status label and progress bar
2263    set statusw .tf.bar.status
2264    ${NS}::label $statusw -width 15 -relief sunken
2265    pack $statusw -side left -padx 5
2266    if {$use_ttk} {
2267        set progresscanv [ttk::progressbar .tf.bar.progress]
2268    } else {
2269        set h [expr {[font metrics uifont -linespace] + 2}]
2270        set progresscanv .tf.bar.progress
2271        canvas $progresscanv -relief sunken -height $h -borderwidth 2
2272        set progressitem [$progresscanv create rect -1 0 0 $h -fill "#00ff00"]
2273        set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
2274        set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
2275    }
2276    pack $progresscanv -side right -expand 1 -fill x -padx {0 2}
2277    set progresscoords {0 0}
2278    set fprogcoord 0
2279    set rprogcoord 0
2280    bind $progresscanv <Configure> adjustprogress
2281    set lastprogupdate [clock clicks -milliseconds]
2282    set progupdatepending 0
2283
2284    # build up the bottom bar of upper window
2285    ${NS}::label .tf.lbar.flabel -text "[mc "Find"] "
2286
2287    set bm_down_data {
2288        #define down_width 16
2289        #define down_height 16
2290        static unsigned char down_bits[] = {
2291        0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2292        0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2293        0x87, 0xe1, 0x8e, 0x71, 0x9c, 0x39, 0xb8, 0x1d,
2294        0xf0, 0x0f, 0xe0, 0x07, 0xc0, 0x03, 0x80, 0x01};
2295    }
2296    image create bitmap bm-down -data $bm_down_data -foreground $uifgcolor
2297    ${NS}::button .tf.lbar.fnext -width 26 -command {dofind 1 1}
2298    .tf.lbar.fnext configure -image bm-down
2299
2300    set bm_up_data {
2301        #define up_width 16
2302        #define up_height 16
2303        static unsigned char up_bits[] = {
2304        0x80, 0x01, 0xc0, 0x03, 0xe0, 0x07, 0xf0, 0x0f,
2305        0xb8, 0x1d, 0x9c, 0x39, 0x8e, 0x71, 0x87, 0xe1,
2306        0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2307        0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01};
2308    }
2309    image create bitmap bm-up -data $bm_up_data -foreground $uifgcolor
2310    ${NS}::button .tf.lbar.fprev -width 26 -command {dofind -1 1}
2311    .tf.lbar.fprev configure -image bm-up
2312
2313    ${NS}::label .tf.lbar.flab2 -text " [mc "commit"] "
2314
2315    pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
2316        -side left -fill y
2317    set gdttype [mc "containing:"]
2318    set gm [makedroplist .tf.lbar.gdttype gdttype \
2319                [mc "containing:"] \
2320                [mc "touching paths:"] \
2321                [mc "adding/removing string:"] \
2322                [mc "changing lines matching:"]]
2323    trace add variable gdttype write gdttype_change
2324    pack .tf.lbar.gdttype -side left -fill y
2325
2326    set findstring {}
2327    set fstring .tf.lbar.findstring
2328    lappend entries $fstring
2329    ${NS}::entry $fstring -width 30 -textvariable findstring
2330    trace add variable findstring write find_change
2331    set findtype [mc "Exact"]
2332    set findtypemenu [makedroplist .tf.lbar.findtype \
2333                          findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
2334    trace add variable findtype write findcom_change
2335    set findloc [mc "All fields"]
2336    makedroplist .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
2337        [mc "Comments"] [mc "Author"] [mc "Committer"]
2338    trace add variable findloc write find_change
2339    pack .tf.lbar.findloc -side right
2340    pack .tf.lbar.findtype -side right
2341    pack $fstring -side left -expand 1 -fill x
2342
2343    # Finish putting the upper half of the viewer together
2344    pack .tf.lbar -in .tf -side bottom -fill x
2345    pack .tf.bar -in .tf -side bottom -fill x
2346    pack .tf.histframe -fill both -side top -expand 1
2347    .ctop add .tf
2348    if {!$use_ttk} {
2349        .ctop paneconfigure .tf -height $geometry(topheight)
2350        .ctop paneconfigure .tf -width $geometry(topwidth)
2351    }
2352
2353    # now build up the bottom
2354    ${NS}::panedwindow .pwbottom -orient horizontal
2355
2356    # lower left, a text box over search bar, scroll bar to the right
2357    # if we know window height, then that will set the lower text height, otherwise
2358    # we set lower text height which will drive window height
2359    if {[info exists geometry(main)]} {
2360        ${NS}::frame .bleft -width $geometry(botwidth)
2361    } else {
2362        ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
2363    }
2364    ${NS}::frame .bleft.top
2365    ${NS}::frame .bleft.mid
2366    ${NS}::frame .bleft.bottom
2367
2368    # gap between sub-widgets
2369    set wgap [font measure uifont "i"]
2370
2371    ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch
2372    pack .bleft.top.search -side left -padx 5
2373    set sstring .bleft.top.sstring
2374    set searchstring ""
2375    ${NS}::entry $sstring -width 20 -textvariable searchstring
2376    lappend entries $sstring
2377    trace add variable searchstring write incrsearch
2378    pack $sstring -side left -expand 1 -fill x
2379    ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \
2380        -command changediffdisp -variable diffelide -value {0 0}
2381    ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \
2382        -command changediffdisp -variable diffelide -value {0 1}
2383    ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \
2384        -command changediffdisp -variable diffelide -value {1 0}
2385
2386    ${NS}::label .bleft.mid.labeldiffcontext -text "      [mc "Lines of context"]: "
2387    pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left -ipadx $wgap
2388    spinbox .bleft.mid.diffcontext -width 5 \
2389        -from 0 -increment 1 -to 10000000 \
2390        -validate all -validatecommand "diffcontextvalidate %P" \
2391        -textvariable diffcontextstring
2392    .bleft.mid.diffcontext set $diffcontext
2393    trace add variable diffcontextstring write diffcontextchange
2394    lappend entries .bleft.mid.diffcontext
2395    pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left -ipadx $wgap
2396    ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
2397        -command changeignorespace -variable ignorespace
2398    pack .bleft.mid.ignspace -side left -padx 5
2399
2400    set worddiff [mc "Line diff"]
2401    if {[package vcompare $git_version "1.7.2"] >= 0} {
2402        makedroplist .bleft.mid.worddiff worddiff [mc "Line diff"] \
2403            [mc "Markup words"] [mc "Color words"]
2404        trace add variable worddiff write changeworddiff
2405        pack .bleft.mid.worddiff -side left -padx 5
2406    }
2407
2408    set ctext .bleft.bottom.ctext
2409    text $ctext -background $bgcolor -foreground $fgcolor \
2410        -state disabled -undo 0 -font textfont \
2411        -yscrollcommand scrolltext -wrap none \
2412        -xscrollcommand ".bleft.bottom.sbhorizontal set"
2413    if {$have_tk85} {
2414        $ctext conf -tabstyle wordprocessor
2415    }
2416    ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview"
2417    ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h
2418    pack .bleft.top -side top -fill x
2419    pack .bleft.mid -side top -fill x
2420    grid $ctext .bleft.bottom.sb -sticky nsew
2421    grid .bleft.bottom.sbhorizontal -sticky ew
2422    grid columnconfigure .bleft.bottom 0 -weight 1
2423    grid rowconfigure .bleft.bottom 0 -weight 1
2424    grid rowconfigure .bleft.bottom 1 -weight 0
2425    pack .bleft.bottom -side top -fill both -expand 1
2426    lappend bglist $ctext
2427    lappend fglist $ctext
2428
2429    $ctext tag conf comment -wrap $wrapcomment
2430    $ctext tag conf filesep -font textfontbold -fore $filesepfgcolor -back $filesepbgcolor
2431    $ctext tag conf hunksep -fore [lindex $diffcolors 2]
2432    $ctext tag conf d0 -fore [lindex $diffcolors 0]
2433    $ctext tag conf dresult -fore [lindex $diffcolors 1]
2434    $ctext tag conf m0 -fore [lindex $mergecolors 0]
2435    $ctext tag conf m1 -fore [lindex $mergecolors 1]
2436    $ctext tag conf m2 -fore [lindex $mergecolors 2]
2437    $ctext tag conf m3 -fore [lindex $mergecolors 3]
2438    $ctext tag conf m4 -fore [lindex $mergecolors 4]
2439    $ctext tag conf m5 -fore [lindex $mergecolors 5]
2440    $ctext tag conf m6 -fore [lindex $mergecolors 6]
2441    $ctext tag conf m7 -fore [lindex $mergecolors 7]
2442    $ctext tag conf m8 -fore [lindex $mergecolors 8]
2443    $ctext tag conf m9 -fore [lindex $mergecolors 9]
2444    $ctext tag conf m10 -fore [lindex $mergecolors 10]
2445    $ctext tag conf m11 -fore [lindex $mergecolors 11]
2446    $ctext tag conf m12 -fore [lindex $mergecolors 12]
2447    $ctext tag conf m13 -fore [lindex $mergecolors 13]
2448    $ctext tag conf m14 -fore [lindex $mergecolors 14]
2449    $ctext tag conf m15 -fore [lindex $mergecolors 15]
2450    $ctext tag conf mmax -fore darkgrey
2451    set mergemax 16
2452    $ctext tag conf mresult -font textfontbold
2453    $ctext tag conf msep -font textfontbold
2454    $ctext tag conf found -back $foundbgcolor
2455    $ctext tag conf currentsearchhit -back $currentsearchhitbgcolor
2456    $ctext tag conf wwrap -wrap word -lmargin2 1c
2457    $ctext tag conf bold -font textfontbold
2458
2459    .pwbottom add .bleft
2460    if {!$use_ttk} {
2461        .pwbottom paneconfigure .bleft -width $geometry(botwidth)
2462    }
2463
2464    # lower right
2465    ${NS}::frame .bright
2466    ${NS}::frame .bright.mode
2467    ${NS}::radiobutton .bright.mode.patch -text [mc "Patch"] \
2468        -command reselectline -variable cmitmode -value "patch"
2469    ${NS}::radiobutton .bright.mode.tree -text [mc "Tree"] \
2470        -command reselectline -variable cmitmode -value "tree"
2471    grid .bright.mode.patch .bright.mode.tree -sticky ew
2472    pack .bright.mode -side top -fill x
2473    set cflist .bright.cfiles
2474    set indent [font measure mainfont "nn"]
2475    text $cflist \
2476        -selectbackground $selectbgcolor \
2477        -background $bgcolor -foreground $fgcolor \
2478        -font mainfont \
2479        -tabs [list $indent [expr {2 * $indent}]] \
2480        -yscrollcommand ".bright.sb set" \
2481        -cursor [. cget -cursor] \
2482        -spacing1 1 -spacing3 1
2483    lappend bglist $cflist
2484    lappend fglist $cflist
2485    ${NS}::scrollbar .bright.sb -command "$cflist yview"
2486    pack .bright.sb -side right -fill y
2487    pack $cflist -side left -fill both -expand 1
2488    $cflist tag configure highlight \
2489        -background [$cflist cget -selectbackground]
2490    $cflist tag configure bold -font mainfontbold
2491
2492    .pwbottom add .bright
2493    .ctop add .pwbottom
2494
2495    # restore window width & height if known
2496    if {[info exists geometry(main)]} {
2497        if {[scan $geometry(main) "%dx%d" w h] >= 2} {
2498            if {$w > [winfo screenwidth .]} {
2499                set w [winfo screenwidth .]
2500            }
2501            if {$h > [winfo screenheight .]} {
2502                set h [winfo screenheight .]
2503            }
2504            wm geometry . "${w}x$h"
2505        }
2506    }
2507
2508    if {[info exists geometry(state)] && $geometry(state) eq "zoomed"} {
2509        wm state . $geometry(state)
2510    }
2511
2512    if {[tk windowingsystem] eq {aqua}} {
2513        set M1B M1
2514        set ::BM "3"
2515    } else {
2516        set M1B Control
2517        set ::BM "2"
2518    }
2519
2520    if {$use_ttk} {
2521        bind .ctop <Map> {
2522            bind %W <Map> {}
2523            %W sashpos 0 $::geometry(topheight)
2524        }
2525        bind .pwbottom <Map> {
2526            bind %W <Map> {}
2527            %W sashpos 0 $::geometry(botwidth)
2528        }
2529    }
2530
2531    bind .pwbottom <Configure> {resizecdetpanes %W %w}
2532    pack .ctop -fill both -expand 1
2533    bindall <1> {selcanvline %W %x %y}
2534    #bindall <B1-Motion> {selcanvline %W %x %y}
2535    if {[tk windowingsystem] == "win32"} {
2536        bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
2537        bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
2538    } else {
2539        bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
2540        bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
2541        bind $ctext <Button> {
2542            if {"%b" eq 6} {
2543                $ctext xview scroll -5 units
2544            } elseif {"%b" eq 7} {
2545                $ctext xview scroll 5 units
2546            }
2547        }
2548        if {[tk windowingsystem] eq "aqua"} {
2549            bindall <MouseWheel> {
2550                set delta [expr {- (%D)}]
2551                allcanvs yview scroll $delta units
2552            }
2553            bindall <Shift-MouseWheel> {
2554                set delta [expr {- (%D)}]
2555                $canv xview scroll $delta units
2556            }
2557        }
2558    }
2559    bindall <$::BM> "canvscan mark %W %x %y"
2560    bindall <B$::BM-Motion> "canvscan dragto %W %x %y"
2561    bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2562    bind . <$M1B-Key-w> doquit
2563    bindkey <Home> selfirstline
2564    bindkey <End> sellastline
2565    bind . <Key-Up> "selnextline -1"
2566    bind . <Key-Down> "selnextline 1"
2567    bind . <Shift-Key-Up> "dofind -1 0"
2568    bind . <Shift-Key-Down> "dofind 1 0"
2569    bindkey <Key-Right> "goforw"
2570    bindkey <Key-Left> "goback"
2571    bind . <Key-Prior> "selnextpage -1"
2572    bind . <Key-Next> "selnextpage 1"
2573    bind . <$M1B-Home> "allcanvs yview moveto 0.0"
2574    bind . <$M1B-End> "allcanvs yview moveto 1.0"
2575    bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
2576    bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
2577    bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2578    bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
2579    bindkey <Key-Delete> "$ctext yview scroll -1 pages"
2580    bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
2581    bindkey <Key-space> "$ctext yview scroll 1 pages"
2582    bindkey p "selnextline -1"
2583    bindkey n "selnextline 1"
2584    bindkey z "goback"
2585    bindkey x "goforw"
2586    bindkey k "selnextline -1"
2587    bindkey j "selnextline 1"
2588    bindkey h "goback"
2589    bindkey l "goforw"
2590    bindkey b prevfile
2591    bindkey d "$ctext yview scroll 18 units"
2592    bindkey u "$ctext yview scroll -18 units"
2593    bindkey g {$sha1entry delete 0 end; focus $sha1entry}
2594    bindkey / {focus $fstring}
2595    bindkey <Key-KP_Divide> {focus $fstring}
2596    bindkey <Key-Return> {dofind 1 1}
2597    bindkey ? {dofind -1 1}
2598    bindkey f nextfile
2599    bind . <F5> updatecommits
2600    bindmodfunctionkey Shift 5 reloadcommits
2601    bind . <F2> showrefs
2602    bindmodfunctionkey Shift 4 {newview 0}
2603    bind . <F4> edit_or_newview
2604    bind . <$M1B-q> doquit
2605    bind . <$M1B-f> {dofind 1 1}
2606    bind . <$M1B-g> {dofind 1 0}
2607    bind . <$M1B-r> dosearchback
2608    bind . <$M1B-s> dosearch
2609    bind . <$M1B-equal> {incrfont 1}
2610    bind . <$M1B-plus> {incrfont 1}
2611    bind . <$M1B-KP_Add> {incrfont 1}
2612    bind . <$M1B-minus> {incrfont -1}
2613    bind . <$M1B-KP_Subtract> {incrfont -1}
2614    wm protocol . WM_DELETE_WINDOW doquit
2615    bind . <Destroy> {stop_backends}
2616    bind . <Button-1> "click %W"
2617    bind $fstring <Key-Return> {dofind 1 1}
2618    bind $sha1entry <Key-Return> {gotocommit; break}
2619    bind $sha1entry <<PasteSelection>> clearsha1
2620    bind $sha1entry <<Paste>> clearsha1
2621    bind $cflist <1> {sel_flist %W %x %y; break}
2622    bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
2623    bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
2624    global ctxbut
2625    bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
2626    bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
2627    bind $ctext <Button-1> {focus %W}
2628    bind $ctext <<Selection>> rehighlight_search_results
2629    for {set i 1} {$i < 10} {incr i} {
2630        bind . <$M1B-Key-$i> [list go_to_parent $i]
2631    }
2632
2633    set maincursor [. cget -cursor]
2634    set textcursor [$ctext cget -cursor]
2635    set curtextcursor $textcursor
2636
2637    set rowctxmenu .rowctxmenu
2638    makemenu $rowctxmenu {
2639        {mc "Diff this -> selected" command {diffvssel 0}}
2640        {mc "Diff selected -> this" command {diffvssel 1}}
2641        {mc "Make patch" command mkpatch}
2642        {mc "Create tag" command mktag}
2643        {mc "Copy commit summary" command copysummary}
2644        {mc "Write commit to file" command writecommit}
2645        {mc "Create new branch" command mkbranch}
2646        {mc "Cherry-pick this commit" command cherrypick}
2647        {mc "Reset HEAD branch to here" command resethead}
2648        {mc "Mark this commit" command markhere}
2649        {mc "Return to mark" command gotomark}
2650        {mc "Find descendant of this and mark" command find_common_desc}
2651        {mc "Compare with marked commit" command compare_commits}
2652        {mc "Diff this -> marked commit" command {diffvsmark 0}}
2653        {mc "Diff marked commit -> this" command {diffvsmark 1}}
2654        {mc "Revert this commit" command revert}
2655    }
2656    $rowctxmenu configure -tearoff 0
2657
2658    set fakerowmenu .fakerowmenu
2659    makemenu $fakerowmenu {
2660        {mc "Diff this -> selected" command {diffvssel 0}}
2661        {mc "Diff selected -> this" command {diffvssel 1}}
2662        {mc "Make patch" command mkpatch}
2663        {mc "Diff this -> marked commit" command {diffvsmark 0}}
2664        {mc "Diff marked commit -> this" command {diffvsmark 1}}
2665    }
2666    $fakerowmenu configure -tearoff 0
2667
2668    set headctxmenu .headctxmenu
2669    makemenu $headctxmenu {
2670        {mc "Check out this branch" command cobranch}
2671        {mc "Rename this branch" command mvbranch}
2672        {mc "Remove this branch" command rmbranch}
2673        {mc "Copy branch name" command {clipboard clear; clipboard append $headmenuhead}}
2674    }
2675    $headctxmenu configure -tearoff 0
2676
2677    global flist_menu
2678    set flist_menu .flistctxmenu
2679    makemenu $flist_menu {
2680        {mc "Highlight this too" command {flist_hl 0}}
2681        {mc "Highlight this only" command {flist_hl 1}}
2682        {mc "External diff" command {external_diff}}
2683        {mc "Blame parent commit" command {external_blame 1}}
2684        {mc "Copy path" command {clipboard clear; clipboard append $flist_menu_file}}
2685    }
2686    $flist_menu configure -tearoff 0
2687
2688    global diff_menu
2689    set diff_menu .diffctxmenu
2690    makemenu $diff_menu {
2691        {mc "Show origin of this line" command show_line_source}
2692        {mc "Run git gui blame on this line" command {external_blame_diff}}
2693    }
2694    $diff_menu configure -tearoff 0
2695}
2696
2697# Windows sends all mouse wheel events to the current focused window, not
2698# the one where the mouse hovers, so bind those events here and redirect
2699# to the correct window
2700proc windows_mousewheel_redirector {W X Y D} {
2701    global canv canv2 canv3
2702    set w [winfo containing -displayof $W $X $Y]
2703    if {$w ne ""} {
2704        set u [expr {$D < 0 ? 5 : -5}]
2705        if {$w == $canv || $w == $canv2 || $w == $canv3} {
2706            allcanvs yview scroll $u units
2707        } else {
2708            catch {
2709                $w yview scroll $u units
2710            }
2711        }
2712    }
2713}
2714
2715# Update row number label when selectedline changes
2716proc selectedline_change {n1 n2 op} {
2717    global selectedline rownumsel
2718
2719    if {$selectedline eq {}} {
2720        set rownumsel {}
2721    } else {
2722        set rownumsel [expr {$selectedline + 1}]
2723    }
2724}
2725
2726# mouse-2 makes all windows scan vertically, but only the one
2727# the cursor is in scans horizontally
2728proc canvscan {op w x y} {
2729    global canv canv2 canv3
2730    foreach c [list $canv $canv2 $canv3] {
2731        if {$c == $w} {
2732            $c scan $op $x $y
2733        } else {
2734            $c scan $op 0 $y
2735        }
2736    }
2737}
2738
2739proc scrollcanv {cscroll f0 f1} {
2740    $cscroll set $f0 $f1
2741    drawvisible
2742    flushhighlights
2743}
2744
2745# when we make a key binding for the toplevel, make sure
2746# it doesn't get triggered when that key is pressed in the
2747# find string entry widget.
2748proc bindkey {ev script} {
2749    global entries
2750    bind . $ev $script
2751    set escript [bind Entry $ev]
2752    if {$escript == {}} {
2753        set escript [bind Entry <Key>]
2754    }
2755    foreach e $entries {
2756        bind $e $ev "$escript; break"
2757    }
2758}
2759
2760proc bindmodfunctionkey {mod n script} {
2761    bind . <$mod-F$n> $script
2762    catch { bind . <$mod-XF86_Switch_VT_$n> $script }
2763}
2764
2765# set the focus back to the toplevel for any click outside
2766# the entry widgets
2767proc click {w} {
2768    global ctext entries
2769    foreach e [concat $entries $ctext] {
2770        if {$w == $e} return
2771    }
2772    focus .
2773}
2774
2775# Adjust the progress bar for a change in requested extent or canvas size
2776proc adjustprogress {} {
2777    global progresscanv progressitem progresscoords
2778    global fprogitem fprogcoord lastprogupdate progupdatepending
2779    global rprogitem rprogcoord use_ttk
2780
2781    if {$use_ttk} {
2782        $progresscanv configure -value [expr {int($fprogcoord * 100)}]
2783        return
2784    }
2785
2786    set w [expr {[winfo width $progresscanv] - 4}]
2787    set x0 [expr {$w * [lindex $progresscoords 0]}]
2788    set x1 [expr {$w * [lindex $progresscoords 1]}]
2789    set h [winfo height $progresscanv]
2790    $progresscanv coords $progressitem $x0 0 $x1 $h
2791    $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2792    $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2793    set now [clock clicks -milliseconds]
2794    if {$now >= $lastprogupdate + 100} {
2795        set progupdatepending 0
2796        update
2797    } elseif {!$progupdatepending} {
2798        set progupdatepending 1
2799        after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2800    }
2801}
2802
2803proc doprogupdate {} {
2804    global lastprogupdate progupdatepending
2805
2806    if {$progupdatepending} {
2807        set progupdatepending 0
2808        set lastprogupdate [clock clicks -milliseconds]
2809        update
2810    }
2811}
2812
2813proc config_check_tmp_exists {tries_left} {
2814    global config_file_tmp
2815
2816    if {[file exists $config_file_tmp]} {
2817        incr tries_left -1
2818        if {$tries_left > 0} {
2819            after 100 [list config_check_tmp_exists $tries_left]
2820        } else {
2821            error_popup "There appears to be a stale $config_file_tmp\
2822 file, which will prevent gitk from saving its configuration on exit.\
2823 Please remove it if it is not being used by any existing gitk process."
2824        }
2825    }
2826}
2827
2828proc config_init_trace {name} {
2829    global config_variable_changed config_variable_original
2830
2831    upvar #0 $name var
2832    set config_variable_changed($name) 0
2833    set config_variable_original($name) $var
2834}
2835
2836proc config_variable_change_cb {name name2 op} {
2837    global config_variable_changed config_variable_original
2838
2839    upvar #0 $name var
2840    if {$op eq "write" &&
2841        (![info exists config_variable_original($name)] ||
2842         $config_variable_original($name) ne $var)} {
2843        set config_variable_changed($name) 1
2844    }
2845}
2846
2847proc savestuff {w} {
2848    global stuffsaved
2849    global config_file config_file_tmp
2850    global config_variables config_variable_changed
2851    global viewchanged
2852
2853    upvar #0 viewname current_viewname
2854    upvar #0 viewfiles current_viewfiles
2855    upvar #0 viewargs current_viewargs
2856    upvar #0 viewargscmd current_viewargscmd
2857    upvar #0 viewperm current_viewperm
2858    upvar #0 nextviewnum current_nextviewnum
2859    upvar #0 use_ttk current_use_ttk
2860
2861    if {$stuffsaved} return
2862    if {![winfo viewable .]} return
2863    set remove_tmp 0
2864    if {[catch {
2865        set try_count 0
2866        while {[catch {set f [open $config_file_tmp {WRONLY CREAT EXCL}]}]} {
2867            if {[incr try_count] > 50} {
2868                error "Unable to write config file: $config_file_tmp exists"
2869            }
2870            after 100
2871        }
2872        set remove_tmp 1
2873        if {$::tcl_platform(platform) eq {windows}} {
2874            file attributes $config_file_tmp -hidden true
2875        }
2876        if {[file exists $config_file]} {
2877            source $config_file
2878        }
2879        foreach var_name $config_variables {
2880            upvar #0 $var_name var
2881            upvar 0 $var_name old_var
2882            if {!$config_variable_changed($var_name) && [info exists old_var]} {
2883                puts $f [list set $var_name $old_var]
2884            } else {
2885                puts $f [list set $var_name $var]
2886            }
2887        }
2888
2889        puts $f "set geometry(main) [wm geometry .]"
2890        puts $f "set geometry(state) [wm state .]"
2891        puts $f "set geometry(topwidth) [winfo width .tf]"
2892        puts $f "set geometry(topheight) [winfo height .tf]"
2893        if {$current_use_ttk} {
2894            puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
2895            puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
2896        } else {
2897            puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2898            puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2899        }
2900        puts $f "set geometry(botwidth) [winfo width .bleft]"
2901        puts $f "set geometry(botheight) [winfo height .bleft]"
2902
2903        array set view_save {}
2904        array set views {}
2905        if {![info exists permviews]} { set permviews {} }
2906        foreach view $permviews {
2907            set view_save([lindex $view 0]) 1
2908            set views([lindex $view 0]) $view
2909        }
2910        puts -nonewline $f "set permviews {"
2911        for {set v 1} {$v < $current_nextviewnum} {incr v} {
2912            if {$viewchanged($v)} {
2913                if {$current_viewperm($v)} {
2914                    set views($current_viewname($v)) [list $current_viewname($v) $current_viewfiles($v) $current_viewargs($v) $current_viewargscmd($v)]
2915                } else {
2916                    set view_save($current_viewname($v)) 0
2917                }
2918            }
2919        }
2920        # write old and updated view to their places and append remaining to the end
2921        foreach view $permviews {
2922            set view_name [lindex $view 0]
2923            if {$view_save($view_name)} {
2924                puts $f "{$views($view_name)}"
2925            }
2926            unset views($view_name)
2927        }
2928        foreach view_name [array names views] {
2929            puts $f "{$views($view_name)}"
2930        }
2931        puts $f "}"
2932        close $f
2933        file rename -force $config_file_tmp $config_file
2934        set remove_tmp 0
2935    } err]} {
2936        puts "Error saving config: $err"
2937    }
2938    if {$remove_tmp} {
2939        file delete -force $config_file_tmp
2940    }
2941    set stuffsaved 1
2942}
2943
2944proc resizeclistpanes {win w} {
2945    global oldwidth use_ttk
2946    if {[info exists oldwidth($win)]} {
2947        if {$use_ttk} {
2948            set s0 [$win sashpos 0]
2949            set s1 [$win sashpos 1]
2950        } else {
2951            set s0 [$win sash coord 0]
2952            set s1 [$win sash coord 1]
2953        }
2954        if {$w < 60} {
2955            set sash0 [expr {int($w/2 - 2)}]
2956            set sash1 [expr {int($w*5/6 - 2)}]
2957        } else {
2958            set factor [expr {1.0 * $w / $oldwidth($win)}]
2959            set sash0 [expr {int($factor * [lindex $s0 0])}]
2960            set sash1 [expr {int($factor * [lindex $s1 0])}]
2961            if {$sash0 < 30} {
2962                set sash0 30
2963            }
2964            if {$sash1 < $sash0 + 20} {
2965                set sash1 [expr {$sash0 + 20}]
2966            }
2967            if {$sash1 > $w - 10} {
2968                set sash1 [expr {$w - 10}]
2969                if {$sash0 > $sash1 - 20} {
2970                    set sash0 [expr {$sash1 - 20}]
2971                }
2972            }
2973        }
2974        if {$use_ttk} {
2975            $win sashpos 0 $sash0
2976            $win sashpos 1 $sash1
2977        } else {
2978            $win sash place 0 $sash0 [lindex $s0 1]
2979            $win sash place 1 $sash1 [lindex $s1 1]
2980        }
2981    }
2982    set oldwidth($win) $w
2983}
2984
2985proc resizecdetpanes {win w} {
2986    global oldwidth use_ttk
2987    if {[info exists oldwidth($win)]} {
2988        if {$use_ttk} {
2989            set s0 [$win sashpos 0]
2990        } else {
2991            set s0 [$win sash coord 0]
2992        }
2993        if {$w < 60} {
2994            set sash0 [expr {int($w*3/4 - 2)}]
2995        } else {
2996            set factor [expr {1.0 * $w / $oldwidth($win)}]
2997            set sash0 [expr {int($factor * [lindex $s0 0])}]
2998            if {$sash0 < 45} {
2999                set sash0 45
3000            }
3001            if {$sash0 > $w - 15} {
3002                set sash0 [expr {$w - 15}]
3003            }
3004        }
3005        if {$use_ttk} {
3006            $win sashpos 0 $sash0
3007        } else {
3008            $win sash place 0 $sash0 [lindex $s0 1]
3009        }
3010    }
3011    set oldwidth($win) $w
3012}
3013
3014proc allcanvs args {
3015    global canv canv2 canv3
3016    eval $canv $args
3017    eval $canv2 $args
3018    eval $canv3 $args
3019}
3020
3021proc bindall {event action} {
3022    global canv canv2 canv3
3023    bind $canv $event $action
3024    bind $canv2 $event $action
3025    bind $canv3 $event $action
3026}
3027
3028proc about {} {
3029    global bgcolor NS
3030    set w .about
3031    if {[winfo exists $w]} {
3032        raise $w
3033        return
3034    }
3035    ttk_toplevel $w
3036    wm title $w [mc "About gitk"]
3037    make_transient $w .
3038    message $w.m -text [mc "
3039Gitk - a commit viewer for git
3040
3041Copyright \u00a9 2005-2016 Paul Mackerras
3042
3043Use and redistribute under the terms of the GNU General Public License"] \
3044            -justify center -aspect 400 -border 2 -bg $bgcolor -relief groove
3045    pack $w.m -side top -fill x -padx 2 -pady 2
3046    ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
3047    pack $w.ok -side bottom
3048    bind $w <Visibility> "focus $w.ok"
3049    bind $w <Key-Escape> "destroy $w"
3050    bind $w <Key-Return> "destroy $w"
3051    tk::PlaceWindow $w widget .
3052}
3053
3054proc keys {} {
3055    global bgcolor NS
3056    set w .keys
3057    if {[winfo exists $w]} {
3058        raise $w
3059        return
3060    }
3061    if {[tk windowingsystem] eq {aqua}} {
3062        set M1T Cmd
3063    } else {
3064        set M1T Ctrl
3065    }
3066    ttk_toplevel $w
3067    wm title $w [mc "Gitk key bindings"]
3068    make_transient $w .
3069    message $w.m -text "
3070[mc "Gitk key bindings:"]
3071
3072[mc "<%s-Q>             Quit" $M1T]
3073[mc "<%s-W>             Close window" $M1T]
3074[mc "<Home>             Move to first commit"]
3075[mc "<End>              Move to last commit"]
3076[mc "<Up>, p, k Move up one commit"]
3077[mc "<Down>, n, j       Move down one commit"]
3078[mc "<Left>, z, h       Go back in history list"]
3079[mc "<Right>, x, l      Go forward in history list"]
3080[mc "<%s-n>     Go to n-th parent of current commit in history list" $M1T]
3081[mc "<PageUp>   Move up one page in commit list"]
3082[mc "<PageDown> Move down one page in commit list"]
3083[mc "<%s-Home>  Scroll to top of commit list" $M1T]
3084[mc "<%s-End>   Scroll to bottom of commit list" $M1T]
3085[mc "<%s-Up>    Scroll commit list up one line" $M1T]
3086[mc "<%s-Down>  Scroll commit list down one line" $M1T]
3087[mc "<%s-PageUp>        Scroll commit list up one page" $M1T]
3088[mc "<%s-PageDown>      Scroll commit list down one page" $M1T]
3089[mc "<Shift-Up> Find backwards (upwards, later commits)"]
3090[mc "<Shift-Down>       Find forwards (downwards, earlier commits)"]
3091[mc "<Delete>, b        Scroll diff view up one page"]
3092[mc "<Backspace>        Scroll diff view up one page"]
3093[mc "<Space>            Scroll diff view down one page"]
3094[mc "u          Scroll diff view up 18 lines"]
3095[mc "d          Scroll diff view down 18 lines"]
3096[mc "<%s-F>             Find" $M1T]
3097[mc "<%s-G>             Move to next find hit" $M1T]
3098[mc "<Return>   Move to next find hit"]
3099[mc "g          Go to commit"]
3100[mc "/          Focus the search box"]
3101[mc "?          Move to previous find hit"]
3102[mc "f          Scroll diff view to next file"]
3103[mc "<%s-S>             Search for next hit in diff view" $M1T]
3104[mc "<%s-R>             Search for previous hit in diff view" $M1T]
3105[mc "<%s-KP+>   Increase font size" $M1T]
3106[mc "<%s-plus>  Increase font size" $M1T]
3107[mc "<%s-KP->   Decrease font size" $M1T]
3108[mc "<%s-minus> Decrease font size" $M1T]
3109[mc "<F5>               Update"]
3110" \
3111            -justify left -bg $bgcolor -border 2 -relief groove
3112    pack $w.m -side top -fill both -padx 2 -pady 2
3113    ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
3114    bind $w <Key-Escape> [list destroy $w]
3115    pack $w.ok -side bottom
3116    bind $w <Visibility> "focus $w.ok"
3117    bind $w <Key-Escape> "destroy $w"
3118    bind $w <Key-Return> "destroy $w"
3119}
3120
3121# Procedures for manipulating the file list window at the
3122# bottom right of the overall window.
3123
3124proc treeview {w l openlevs} {
3125    global treecontents treediropen treeheight treeparent treeindex
3126
3127    set ix 0
3128    set treeindex() 0
3129    set lev 0
3130    set prefix {}
3131    set prefixend -1
3132    set prefendstack {}
3133    set htstack {}
3134    set ht 0
3135    set treecontents() {}
3136    $w conf -state normal
3137    foreach f $l {
3138        while {[string range $f 0 $prefixend] ne $prefix} {
3139            if {$lev <= $openlevs} {
3140                $w mark set e:$treeindex($prefix) "end -1c"
3141                $w mark gravity e:$treeindex($prefix) left
3142            }
3143            set treeheight($prefix) $ht
3144            incr ht [lindex $htstack end]
3145            set htstack [lreplace $htstack end end]
3146            set prefixend [lindex $prefendstack end]
3147            set prefendstack [lreplace $prefendstack end end]
3148            set prefix [string range $prefix 0 $prefixend]
3149            incr lev -1
3150        }
3151        set tail [string range $f [expr {$prefixend+1}] end]
3152        while {[set slash [string first "/" $tail]] >= 0} {
3153            lappend htstack $ht
3154            set ht 0
3155            lappend prefendstack $prefixend
3156            incr prefixend [expr {$slash + 1}]
3157            set d [string range $tail 0 $slash]
3158            lappend treecontents($prefix) $d
3159            set oldprefix $prefix
3160            append prefix $d
3161            set treecontents($prefix) {}
3162            set treeindex($prefix) [incr ix]
3163            set treeparent($prefix) $oldprefix
3164            set tail [string range $tail [expr {$slash+1}] end]
3165            if {$lev <= $openlevs} {
3166                set ht 1
3167                set treediropen($prefix) [expr {$lev < $openlevs}]
3168                set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
3169                $w mark set d:$ix "end -1c"
3170                $w mark gravity d:$ix left
3171                set str "\n"
3172                for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3173                $w insert end $str
3174                $w image create end -align center -image $bm -padx 1 \
3175                    -name a:$ix
3176                $w insert end $d [highlight_tag $prefix]
3177                $w mark set s:$ix "end -1c"
3178                $w mark gravity s:$ix left
3179            }
3180            incr lev
3181        }
3182        if {$tail ne {}} {
3183            if {$lev <= $openlevs} {
3184                incr ht
3185                set str "\n"
3186                for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3187                $w insert end $str
3188                $w insert end $tail [highlight_tag $f]
3189            }
3190            lappend treecontents($prefix) $tail
3191        }
3192    }
3193    while {$htstack ne {}} {
3194        set treeheight($prefix) $ht
3195        incr ht [lindex $htstack end]
3196        set htstack [lreplace $htstack end end]
3197        set prefixend [lindex $prefendstack end]
3198        set prefendstack [lreplace $prefendstack end end]
3199        set prefix [string range $prefix 0 $prefixend]
3200    }
3201    $w conf -state disabled
3202}
3203
3204proc linetoelt {l} {
3205    global treeheight treecontents
3206
3207    set y 2
3208    set prefix {}
3209    while {1} {
3210        foreach e $treecontents($prefix) {
3211            if {$y == $l} {
3212                return "$prefix$e"
3213            }
3214            set n 1
3215            if {[string index $e end] eq "/"} {
3216                set n $treeheight($prefix$e)
3217                if {$y + $n > $l} {
3218                    append prefix $e
3219                    incr y
3220                    break
3221                }
3222            }
3223            incr y $n
3224        }
3225    }
3226}
3227
3228proc highlight_tree {y prefix} {
3229    global treeheight treecontents cflist
3230
3231    foreach e $treecontents($prefix) {
3232        set path $prefix$e
3233        if {[highlight_tag $path] ne {}} {
3234            $cflist tag add bold $y.0 "$y.0 lineend"
3235        }
3236        incr y
3237        if {[string index $e end] eq "/" && $treeheight($path) > 1} {
3238            set y [highlight_tree $y $path]
3239        }
3240    }
3241    return $y
3242}
3243
3244proc treeclosedir {w dir} {
3245    global treediropen treeheight treeparent treeindex
3246
3247    set ix $treeindex($dir)
3248    $w conf -state normal
3249    $w delete s:$ix e:$ix
3250    set treediropen($dir) 0
3251    $w image configure a:$ix -image tri-rt
3252    $w conf -state disabled
3253    set n [expr {1 - $treeheight($dir)}]
3254    while {$dir ne {}} {
3255        incr treeheight($dir) $n
3256        set dir $treeparent($dir)
3257    }
3258}
3259
3260proc treeopendir {w dir} {
3261    global treediropen treeheight treeparent treecontents treeindex
3262
3263    set ix $treeindex($dir)
3264    $w conf -state normal
3265    $w image configure a:$ix -image tri-dn
3266    $w mark set e:$ix s:$ix
3267    $w mark gravity e:$ix right
3268    set lev 0
3269    set str "\n"
3270    set n [llength $treecontents($dir)]
3271    for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
3272        incr lev
3273        append str "\t"
3274        incr treeheight($x) $n
3275    }
3276    foreach e $treecontents($dir) {
3277        set de $dir$e
3278        if {[string index $e end] eq "/"} {
3279            set iy $treeindex($de)
3280            $w mark set d:$iy e:$ix
3281            $w mark gravity d:$iy left
3282            $w insert e:$ix $str
3283            set treediropen($de) 0
3284            $w image create e:$ix -align center -image tri-rt -padx 1 \
3285                -name a:$iy
3286            $w insert e:$ix $e [highlight_tag $de]
3287            $w mark set s:$iy e:$ix
3288            $w mark gravity s:$iy left
3289            set treeheight($de) 1
3290        } else {
3291            $w insert e:$ix $str
3292            $w insert e:$ix $e [highlight_tag $de]
3293        }
3294    }
3295    $w mark gravity e:$ix right
3296    $w conf -state disabled
3297    set treediropen($dir) 1
3298    set top [lindex [split [$w index @0,0] .] 0]
3299    set ht [$w cget -height]
3300    set l [lindex [split [$w index s:$ix] .] 0]
3301    if {$l < $top} {
3302        $w yview $l.0
3303    } elseif {$l + $n + 1 > $top + $ht} {
3304        set top [expr {$l + $n + 2 - $ht}]
3305        if {$l < $top} {
3306            set top $l
3307        }
3308        $w yview $top.0
3309    }
3310}
3311
3312proc treeclick {w x y} {
3313    global treediropen cmitmode ctext cflist cflist_top
3314
3315    if {$cmitmode ne "tree"} return
3316    if {![info exists cflist_top]} return
3317    set l [lindex [split [$w index "@$x,$y"] "."] 0]
3318    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3319    $cflist tag add highlight $l.0 "$l.0 lineend"
3320    set cflist_top $l
3321    if {$l == 1} {
3322        $ctext yview 1.0
3323        return
3324    }
3325    set e [linetoelt $l]
3326    if {[string index $e end] ne "/"} {
3327        showfile $e
3328    } elseif {$treediropen($e)} {
3329        treeclosedir $w $e
3330    } else {
3331        treeopendir $w $e
3332    }
3333}
3334
3335proc setfilelist {id} {
3336    global treefilelist cflist jump_to_here
3337
3338    treeview $cflist $treefilelist($id) 0
3339    if {$jump_to_here ne {}} {
3340        set f [lindex $jump_to_here 0]
3341        if {[lsearch -exact $treefilelist($id) $f] >= 0} {
3342            showfile $f
3343        }
3344    }
3345}
3346
3347image create bitmap tri-rt -background black -foreground blue -data {
3348    #define tri-rt_width 13
3349    #define tri-rt_height 13
3350    static unsigned char tri-rt_bits[] = {
3351       0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
3352       0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
3353       0x00, 0x00};
3354} -maskdata {
3355    #define tri-rt-mask_width 13
3356    #define tri-rt-mask_height 13
3357    static unsigned char tri-rt-mask_bits[] = {
3358       0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
3359       0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
3360       0x08, 0x00};
3361}
3362image create bitmap tri-dn -background black -foreground blue -data {
3363    #define tri-dn_width 13
3364    #define tri-dn_height 13
3365    static unsigned char tri-dn_bits[] = {
3366       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
3367       0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3368       0x00, 0x00};
3369} -maskdata {
3370    #define tri-dn-mask_width 13
3371    #define tri-dn-mask_height 13
3372    static unsigned char tri-dn-mask_bits[] = {
3373       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
3374       0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
3375       0x00, 0x00};
3376}
3377
3378image create bitmap reficon-T -background black -foreground yellow -data {
3379    #define tagicon_width 13
3380    #define tagicon_height 9
3381    static unsigned char tagicon_bits[] = {
3382       0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
3383       0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
3384} -maskdata {
3385    #define tagicon-mask_width 13
3386    #define tagicon-mask_height 9
3387    static unsigned char tagicon-mask_bits[] = {
3388       0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
3389       0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
3390}
3391set rectdata {
3392    #define headicon_width 13
3393    #define headicon_height 9
3394    static unsigned char headicon_bits[] = {
3395       0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3396       0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3397}
3398set rectmask {
3399    #define headicon-mask_width 13
3400    #define headicon-mask_height 9
3401    static unsigned char headicon-mask_bits[] = {
3402       0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3403       0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3404}
3405image create bitmap reficon-H -background black -foreground "#00ff00" \
3406    -data $rectdata -maskdata $rectmask
3407image create bitmap reficon-o -background black -foreground "#ddddff" \
3408    -data $rectdata -maskdata $rectmask
3409
3410proc init_flist {first} {
3411    global cflist cflist_top difffilestart
3412
3413    $cflist conf -state normal
3414    $cflist delete 0.0 end
3415    if {$first ne {}} {
3416        $cflist insert end $first
3417        set cflist_top 1
3418        $cflist tag add highlight 1.0 "1.0 lineend"
3419    } else {
3420        unset -nocomplain cflist_top
3421    }
3422    $cflist conf -state disabled
3423    set difffilestart {}
3424}
3425
3426proc highlight_tag {f} {
3427    global highlight_paths
3428
3429    foreach p $highlight_paths {
3430        if {[string match $p $f]} {
3431            return "bold"
3432        }
3433    }
3434    return {}
3435}
3436
3437proc highlight_filelist {} {
3438    global cmitmode cflist
3439
3440    $cflist conf -state normal
3441    if {$cmitmode ne "tree"} {
3442        set end [lindex [split [$cflist index end] .] 0]
3443        for {set l 2} {$l < $end} {incr l} {
3444            set line [$cflist get $l.0 "$l.0 lineend"]
3445            if {[highlight_tag $line] ne {}} {
3446                $cflist tag add bold $l.0 "$l.0 lineend"
3447            }
3448        }
3449    } else {
3450        highlight_tree 2 {}
3451    }
3452    $cflist conf -state disabled
3453}
3454
3455proc unhighlight_filelist {} {
3456    global cflist
3457
3458    $cflist conf -state normal
3459    $cflist tag remove bold 1.0 end
3460    $cflist conf -state disabled
3461}
3462
3463proc add_flist {fl} {
3464    global cflist
3465
3466    $cflist conf -state normal
3467    foreach f $fl {
3468        $cflist insert end "\n"
3469        $cflist insert end $f [highlight_tag $f]
3470    }
3471    $cflist conf -state disabled
3472}
3473
3474proc sel_flist {w x y} {
3475    global ctext difffilestart cflist cflist_top cmitmode
3476
3477    if {$cmitmode eq "tree"} return
3478    if {![info exists cflist_top]} return
3479    set l [lindex [split [$w index "@$x,$y"] "."] 0]
3480    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3481    $cflist tag add highlight $l.0 "$l.0 lineend"
3482    set cflist_top $l
3483    if {$l == 1} {
3484        $ctext yview 1.0
3485    } else {
3486        catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
3487    }
3488    suppress_highlighting_file_for_current_scrollpos
3489}
3490
3491proc pop_flist_menu {w X Y x y} {
3492    global ctext cflist cmitmode flist_menu flist_menu_file
3493    global treediffs diffids
3494
3495    stopfinding
3496    set l [lindex [split [$w index "@$x,$y"] "."] 0]
3497    if {$l <= 1} return
3498    if {$cmitmode eq "tree"} {
3499        set e [linetoelt $l]
3500        if {[string index $e end] eq "/"} return
3501    } else {
3502        set e [lindex $treediffs($diffids) [expr {$l-2}]]
3503    }
3504    set flist_menu_file $e
3505    set xdiffstate "normal"
3506    if {$cmitmode eq "tree"} {
3507        set xdiffstate "disabled"
3508    }
3509    # Disable "External diff" item in tree mode
3510    $flist_menu entryconf 2 -state $xdiffstate
3511    tk_popup $flist_menu $X $Y
3512}
3513
3514proc find_ctext_fileinfo {line} {
3515    global ctext_file_names ctext_file_lines
3516
3517    set ok [bsearch $ctext_file_lines $line]
3518    set tline [lindex $ctext_file_lines $ok]
3519
3520    if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3521        return {}
3522    } else {
3523        return [list [lindex $ctext_file_names $ok] $tline]
3524    }
3525}
3526
3527proc pop_diff_menu {w X Y x y} {
3528    global ctext diff_menu flist_menu_file
3529    global diff_menu_txtpos diff_menu_line
3530    global diff_menu_filebase
3531
3532    set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3533    set diff_menu_line [lindex $diff_menu_txtpos 0]
3534    # don't pop up the menu on hunk-separator or file-separator lines
3535    if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3536        return
3537    }
3538    stopfinding
3539    set f [find_ctext_fileinfo $diff_menu_line]
3540    if {$f eq {}} return
3541    set flist_menu_file [lindex $f 0]
3542    set diff_menu_filebase [lindex $f 1]
3543    tk_popup $diff_menu $X $Y
3544}
3545
3546proc flist_hl {only} {
3547    global flist_menu_file findstring gdttype
3548
3549    set x [shellquote $flist_menu_file]
3550    if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
3551        set findstring $x
3552    } else {
3553        append findstring " " $x
3554    }
3555    set gdttype [mc "touching paths:"]
3556}
3557
3558proc gitknewtmpdir {} {
3559    global diffnum gitktmpdir gitdir env
3560
3561    if {![info exists gitktmpdir]} {
3562        if {[info exists env(GITK_TMPDIR)]} {
3563            set tmpdir $env(GITK_TMPDIR)
3564        } elseif {[info exists env(TMPDIR)]} {
3565            set tmpdir $env(TMPDIR)
3566        } else {
3567            set tmpdir $gitdir
3568        }
3569        set gitktmpformat [file join $tmpdir ".gitk-tmp.XXXXXX"]
3570        if {[catch {set gitktmpdir [exec mktemp -d $gitktmpformat]}]} {
3571            set gitktmpdir [file join $gitdir [format ".gitk-tmp.%s" [pid]]]
3572        }
3573        if {[catch {file mkdir $gitktmpdir} err]} {
3574            error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3575            unset gitktmpdir
3576            return {}
3577        }
3578        set diffnum 0
3579    }
3580    incr diffnum
3581    set diffdir [file join $gitktmpdir $diffnum]
3582    if {[catch {file mkdir $diffdir} err]} {
3583        error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3584        return {}
3585    }
3586    return $diffdir
3587}
3588
3589proc save_file_from_commit {filename output what} {
3590    global nullfile
3591
3592    if {[catch {exec git show $filename -- > $output} err]} {
3593        if {[string match "fatal: bad revision *" $err]} {
3594            return $nullfile
3595        }
3596        error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
3597        return {}
3598    }
3599    return $output
3600}
3601
3602proc external_diff_get_one_file {diffid filename diffdir} {
3603    global nullid nullid2 nullfile
3604    global worktree
3605
3606    if {$diffid == $nullid} {
3607        set difffile [file join $worktree $filename]
3608        if {[file exists $difffile]} {
3609            return $difffile
3610        }
3611        return $nullfile
3612    }
3613    if {$diffid == $nullid2} {
3614        set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3615        return [save_file_from_commit :$filename $difffile index]
3616    }
3617    set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3618    return [save_file_from_commit $diffid:$filename $difffile \
3619               "revision $diffid"]
3620}
3621
3622proc external_diff {} {
3623    global nullid nullid2
3624    global flist_menu_file
3625    global diffids
3626    global extdifftool
3627
3628    if {[llength $diffids] == 1} {
3629        # no reference commit given
3630        set diffidto [lindex $diffids 0]
3631        if {$diffidto eq $nullid} {
3632            # diffing working copy with index
3633            set diffidfrom $nullid2
3634        } elseif {$diffidto eq $nullid2} {
3635            # diffing index with HEAD
3636            set diffidfrom "HEAD"
3637        } else {
3638            # use first parent commit
3639            global parentlist selectedline
3640            set diffidfrom [lindex $parentlist $selectedline 0]
3641        }
3642    } else {
3643        set diffidfrom [lindex $diffids 0]
3644        set diffidto [lindex $diffids 1]
3645    }
3646
3647    # make sure that several diffs wont collide
3648    set diffdir [gitknewtmpdir]
3649    if {$diffdir eq {}} return
3650
3651    # gather files to diff
3652    set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3653    set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3654
3655    if {$difffromfile ne {} && $difftofile ne {}} {
3656        set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
3657        if {[catch {set fl [open |$cmd r]} err]} {
3658            file delete -force $diffdir
3659            error_popup "$extdifftool: [mc "command failed:"] $err"
3660        } else {
3661            fconfigure $fl -blocking 0
3662            filerun $fl [list delete_at_eof $fl $diffdir]
3663        }
3664    }
3665}
3666
3667proc find_hunk_blamespec {base line} {
3668    global ctext
3669
3670    # Find and parse the hunk header
3671    set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3672    if {$s_lix eq {}} return
3673
3674    set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3675    if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3676            s_line old_specs osz osz1 new_line nsz]} {
3677        return
3678    }
3679
3680    # base lines for the parents
3681    set base_lines [list $new_line]
3682    foreach old_spec [lrange [split $old_specs " "] 1 end] {
3683        if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3684                old_spec old_line osz]} {
3685            return
3686        }
3687        lappend base_lines $old_line
3688    }
3689
3690    # Now scan the lines to determine offset within the hunk
3691    set max_parent [expr {[llength $base_lines]-2}]
3692    set dline 0
3693    set s_lno [lindex [split $s_lix "."] 0]
3694
3695    # Determine if the line is removed
3696    set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3697    if {[string match {[-+ ]*} $chunk]} {
3698        set removed_idx [string first "-" $chunk]
3699        # Choose a parent index
3700        if {$removed_idx >= 0} {
3701            set parent $removed_idx
3702        } else {
3703            set unchanged_idx [string first " " $chunk]
3704            if {$unchanged_idx >= 0} {
3705                set parent $unchanged_idx
3706            } else {
3707                # blame the current commit
3708                set parent -1
3709            }
3710        }
3711        # then count other lines that belong to it
3712        for {set i $line} {[incr i -1] > $s_lno} {} {
3713            set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3714            # Determine if the line is removed
3715            set removed_idx [string first "-" $chunk]
3716            if {$parent >= 0} {
3717                set code [string index $chunk $parent]
3718                if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3719                    incr dline
3720                }
3721            } else {
3722                if {$removed_idx < 0} {
3723                    incr dline
3724                }
3725            }
3726        }
3727        incr parent
3728    } else {
3729        set parent 0
3730    }
3731
3732    incr dline [lindex $base_lines $parent]
3733    return [list $parent $dline]
3734}
3735
3736proc external_blame_diff {} {
3737    global currentid cmitmode
3738    global diff_menu_txtpos diff_menu_line
3739    global diff_menu_filebase flist_menu_file
3740
3741    if {$cmitmode eq "tree"} {
3742        set parent_idx 0
3743        set line [expr {$diff_menu_line - $diff_menu_filebase}]
3744    } else {
3745        set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3746        if {$hinfo ne {}} {
3747            set parent_idx [lindex $hinfo 0]
3748            set line [lindex $hinfo 1]
3749        } else {
3750            set parent_idx 0
3751            set line 0
3752        }
3753    }
3754
3755    external_blame $parent_idx $line
3756}
3757
3758# Find the SHA1 ID of the blob for file $fname in the index
3759# at stage 0 or 2
3760proc index_sha1 {fname} {
3761    set f [open [list | git ls-files -s $fname] r]
3762    while {[gets $f line] >= 0} {
3763        set info [lindex [split $line "\t"] 0]
3764        set stage [lindex $info 2]
3765        if {$stage eq "0" || $stage eq "2"} {
3766            close $f
3767            return [lindex $info 1]
3768        }
3769    }
3770    close $f
3771    return {}
3772}
3773
3774# Turn an absolute path into one relative to the current directory
3775proc make_relative {f} {
3776    if {[file pathtype $f] eq "relative"} {
3777        return $f
3778    }
3779    set elts [file split $f]
3780    set here [file split [pwd]]
3781    set ei 0
3782    set hi 0
3783    set res {}
3784    foreach d $here {
3785        if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3786            lappend res ".."
3787        } else {
3788            incr ei
3789        }
3790        incr hi
3791    }
3792    set elts [concat $res [lrange $elts $ei end]]
3793    return [eval file join $elts]
3794}
3795
3796proc external_blame {parent_idx {line {}}} {
3797    global flist_menu_file cdup
3798    global nullid nullid2
3799    global parentlist selectedline currentid
3800
3801    if {$parent_idx > 0} {
3802        set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3803    } else {
3804        set base_commit $currentid
3805    }
3806
3807    if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3808        error_popup [mc "No such commit"]
3809        return
3810    }
3811
3812    set cmdline [list git gui blame]
3813    if {$line ne {} && $line > 1} {
3814        lappend cmdline "--line=$line"
3815    }
3816    set f [file join $cdup $flist_menu_file]
3817    # Unfortunately it seems git gui blame doesn't like
3818    # being given an absolute path...
3819    set f [make_relative $f]
3820    lappend cmdline $base_commit $f
3821    if {[catch {eval exec $cmdline &} err]} {
3822        error_popup "[mc "git gui blame: command failed:"] $err"
3823    }
3824}
3825
3826proc show_line_source {} {
3827    global cmitmode currentid parents curview blamestuff blameinst
3828    global diff_menu_line diff_menu_filebase flist_menu_file
3829    global nullid nullid2 gitdir cdup
3830
3831    set from_index {}
3832    if {$cmitmode eq "tree"} {
3833        set id $currentid
3834        set line [expr {$diff_menu_line - $diff_menu_filebase}]
3835    } else {
3836        set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3837        if {$h eq {}} return
3838        set pi [lindex $h 0]
3839        if {$pi == 0} {
3840            mark_ctext_line $diff_menu_line
3841            return
3842        }
3843        incr pi -1
3844        if {$currentid eq $nullid} {
3845            if {$pi > 0} {
3846                # must be a merge in progress...
3847                if {[catch {
3848                    # get the last line from .git/MERGE_HEAD
3849                    set f [open [file join $gitdir MERGE_HEAD] r]
3850                    set id [lindex [split [read $f] "\n"] end-1]
3851                    close $f
3852                } err]} {
3853                    error_popup [mc "Couldn't read merge head: %s" $err]
3854                    return
3855                }
3856            } elseif {$parents($curview,$currentid) eq $nullid2} {
3857                # need to do the blame from the index
3858                if {[catch {
3859                    set from_index [index_sha1 $flist_menu_file]
3860                } err]} {
3861                    error_popup [mc "Error reading index: %s" $err]
3862                    return
3863                }
3864            } else {
3865                set id $parents($curview,$currentid)
3866            }
3867        } else {
3868            set id [lindex $parents($curview,$currentid) $pi]
3869        }
3870        set line [lindex $h 1]
3871    }
3872    set blameargs {}
3873    if {$from_index ne {}} {
3874        lappend blameargs | git cat-file blob $from_index
3875    }
3876    lappend blameargs | git blame -p -L$line,+1
3877    if {$from_index ne {}} {
3878        lappend blameargs --contents -
3879    } else {
3880        lappend blameargs $id
3881    }
3882    lappend blameargs -- [file join $cdup $flist_menu_file]
3883    if {[catch {
3884        set f [open $blameargs r]
3885    } err]} {
3886        error_popup [mc "Couldn't start git blame: %s" $err]
3887        return
3888    }
3889    nowbusy blaming [mc "Searching"]
3890    fconfigure $f -blocking 0
3891    set i [reg_instance $f]
3892    set blamestuff($i) {}
3893    set blameinst $i
3894    filerun $f [list read_line_source $f $i]
3895}
3896
3897proc stopblaming {} {
3898    global blameinst
3899
3900    if {[info exists blameinst]} {
3901        stop_instance $blameinst
3902        unset blameinst
3903        notbusy blaming
3904    }
3905}
3906
3907proc read_line_source {fd inst} {
3908    global blamestuff curview commfd blameinst nullid nullid2
3909
3910    while {[gets $fd line] >= 0} {
3911        lappend blamestuff($inst) $line
3912    }
3913    if {![eof $fd]} {
3914        return 1
3915    }
3916    unset commfd($inst)
3917    unset blameinst
3918    notbusy blaming
3919    fconfigure $fd -blocking 1
3920    if {[catch {close $fd} err]} {
3921        error_popup [mc "Error running git blame: %s" $err]
3922        return 0
3923    }
3924
3925    set fname {}
3926    set line [split [lindex $blamestuff($inst) 0] " "]
3927    set id [lindex $line 0]
3928    set lnum [lindex $line 1]
3929    if {[string length $id] == 40 && [string is xdigit $id] &&
3930        [string is digit -strict $lnum]} {
3931        # look for "filename" line
3932        foreach l $blamestuff($inst) {
3933            if {[string match "filename *" $l]} {
3934                set fname [string range $l 9 end]
3935                break
3936            }
3937        }
3938    }
3939    if {$fname ne {}} {
3940        # all looks good, select it
3941        if {$id eq $nullid} {
3942            # blame uses all-zeroes to mean not committed,
3943            # which would mean a change in the index
3944            set id $nullid2
3945        }
3946        if {[commitinview $id $curview]} {
3947            selectline [rowofcommit $id] 1 [list $fname $lnum] 1
3948        } else {
3949            error_popup [mc "That line comes from commit %s, \
3950                             which is not in this view" [shortids $id]]
3951        }
3952    } else {
3953        puts "oops couldn't parse git blame output"
3954    }
3955    return 0
3956}
3957
3958# delete $dir when we see eof on $f (presumably because the child has exited)
3959proc delete_at_eof {f dir} {
3960    while {[gets $f line] >= 0} {}
3961    if {[eof $f]} {
3962        if {[catch {close $f} err]} {
3963            error_popup "[mc "External diff viewer failed:"] $err"
3964        }
3965        file delete -force $dir
3966        return 0
3967    }
3968    return 1
3969}
3970
3971# Functions for adding and removing shell-type quoting
3972
3973proc shellquote {str} {
3974    if {![string match "*\['\"\\ \t]*" $str]} {
3975        return $str
3976    }
3977    if {![string match "*\['\"\\]*" $str]} {
3978        return "\"$str\""
3979    }
3980    if {![string match "*'*" $str]} {
3981        return "'$str'"
3982    }
3983    return "\"[string map {\" \\\" \\ \\\\} $str]\""
3984}
3985
3986proc shellarglist {l} {
3987    set str {}
3988    foreach a $l {
3989        if {$str ne {}} {
3990            append str " "
3991        }
3992        append str [shellquote $a]
3993    }
3994    return $str
3995}
3996
3997proc shelldequote {str} {
3998    set ret {}
3999    set used -1
4000    while {1} {
4001        incr used
4002        if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
4003            append ret [string range $str $used end]
4004            set used [string length $str]
4005            break
4006        }
4007        set first [lindex $first 0]
4008        set ch [string index $str $first]
4009        if {$first > $used} {
4010            append ret [string range $str $used [expr {$first - 1}]]
4011            set used $first
4012        }
4013        if {$ch eq " " || $ch eq "\t"} break
4014        incr used
4015        if {$ch eq "'"} {
4016            set first [string first "'" $str $used]
4017            if {$first < 0} {
4018                error "unmatched single-quote"
4019            }
4020            append ret [string range $str $used [expr {$first - 1}]]
4021            set used $first
4022            continue
4023        }
4024        if {$ch eq "\\"} {
4025            if {$used >= [string length $str]} {
4026                error "trailing backslash"
4027            }
4028            append ret [string index $str $used]
4029            continue
4030        }
4031        # here ch == "\""
4032        while {1} {
4033            if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
4034                error "unmatched double-quote"
4035            }
4036            set first [lindex $first 0]
4037            set ch [string index $str $first]
4038            if {$first > $used} {
4039                append ret [string range $str $used [expr {$first - 1}]]
4040                set used $first
4041            }
4042            if {$ch eq "\""} break
4043            incr used
4044            append ret [string index $str $used]
4045            incr used
4046        }
4047    }
4048    return [list $used $ret]
4049}
4050
4051proc shellsplit {str} {
4052    set l {}
4053    while {1} {
4054        set str [string trimleft $str]
4055        if {$str eq {}} break
4056        set dq [shelldequote $str]
4057        set n [lindex $dq 0]
4058        set word [lindex $dq 1]
4059        set str [string range $str $n end]
4060        lappend l $word
4061    }
4062    return $l
4063}
4064
4065proc set_window_title {} {
4066    global appname curview viewname vrevs
4067    set rev [mc "All files"]
4068    if {$curview ne 0} {
4069        if {$viewname($curview) eq [mc "Command line"]} {
4070            set rev [string map {"--gitk-symmetric-diff-marker" "--merge"} $vrevs($curview)]
4071        } else {
4072            set rev $viewname($curview)
4073        }
4074    }
4075    wm title . "[reponame]: $rev - $appname"
4076}
4077
4078# Code to implement multiple views
4079
4080proc newview {ishighlight} {
4081    global nextviewnum newviewname newishighlight
4082    global revtreeargs viewargscmd newviewopts curview
4083
4084    set newishighlight $ishighlight
4085    set top .gitkview
4086    if {[winfo exists $top]} {
4087        raise $top
4088        return
4089    }
4090    decode_view_opts $nextviewnum $revtreeargs
4091    set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
4092    set newviewopts($nextviewnum,perm) 0
4093    set newviewopts($nextviewnum,cmd)  $viewargscmd($curview)
4094    vieweditor $top $nextviewnum [mc "Gitk view definition"]
4095}
4096
4097set known_view_options {
4098    {perm      b    .  {}               {mc "Remember this view"}}
4099    {reflabel  l    +  {}               {mc "References (space separated list):"}}
4100    {refs      t15  .. {}               {mc "Branches & tags:"}}
4101    {allrefs   b    *. "--all"          {mc "All refs"}}
4102    {branches  b    .  "--branches"     {mc "All (local) branches"}}
4103    {tags      b    .  "--tags"         {mc "All tags"}}
4104    {remotes   b    .  "--remotes"      {mc "All remote-tracking branches"}}
4105    {commitlbl l    +  {}               {mc "Commit Info (regular expressions):"}}
4106    {author    t15  .. "--author=*"     {mc "Author:"}}
4107    {committer t15  .  "--committer=*"  {mc "Committer:"}}
4108    {loginfo   t15  .. "--grep=*"       {mc "Commit Message:"}}
4109    {allmatch  b    .. "--all-match"    {mc "Matches all Commit Info criteria"}}
4110    {igrep     b    .. "--invert-grep"  {mc "Matches no Commit Info criteria"}}
4111    {changes_l l    +  {}               {mc "Changes to Files:"}}
4112    {pickaxe_s r0   .  {}               {mc "Fixed String"}}
4113    {pickaxe_t r1   .  "--pickaxe-regex"  {mc "Regular Expression"}}
4114    {pickaxe   t15  .. "-S*"            {mc "Search string:"}}
4115    {datelabel l    +  {}               {mc "Commit Dates (\"2 weeks ago\", \"2009-03-17 15:27:38\", \"March 17, 2009 15:27:38\"):"}}
4116    {since     t15  ..  {"--since=*" "--after=*"}  {mc "Since:"}}
4117    {until     t15  .   {"--until=*" "--before=*"} {mc "Until:"}}
4118    {limit_lbl l    +  {}               {mc "Limit and/or skip a number of revisions (positive integer):"}}
4119    {limit     t10  *. "--max-count=*"  {mc "Number to show:"}}
4120    {skip      t10  .  "--skip=*"       {mc "Number to skip:"}}
4121    {misc_lbl  l    +  {}               {mc "Miscellaneous options:"}}
4122    {dorder    b    *. {"--date-order" "-d"}      {mc "Strictly sort by date"}}
4123    {lright    b    .  "--left-right"   {mc "Mark branch sides"}}
4124    {first     b    .  "--first-parent" {mc "Limit to first parent"}}
4125    {smplhst   b    .  "--simplify-by-decoration"   {mc "Simple history"}}
4126    {args      t50  *. {}               {mc "Additional arguments to git log:"}}
4127    {allpaths  path +  {}               {mc "Enter files and directories to include, one per line:"}}
4128    {cmd       t50= +  {}               {mc "Command to generate more commits to include:"}}
4129    }
4130
4131# Convert $newviewopts($n, ...) into args for git log.
4132proc encode_view_opts {n} {
4133    global known_view_options newviewopts
4134
4135    set rargs [list]
4136    foreach opt $known_view_options {
4137        set patterns [lindex $opt 3]
4138        if {$patterns eq {}} continue
4139        set pattern [lindex $patterns 0]
4140
4141        if {[lindex $opt 1] eq "b"} {
4142            set val $newviewopts($n,[lindex $opt 0])
4143            if {$val} {
4144                lappend rargs $pattern
4145            }
4146        } elseif {[regexp {^r(\d+)$} [lindex $opt 1] type value]} {
4147            regexp {^(.*_)} [lindex $opt 0] uselessvar button_id
4148            set val $newviewopts($n,$button_id)
4149            if {$val eq $value} {
4150                lappend rargs $pattern
4151            }
4152        } else {
4153            set val $newviewopts($n,[lindex $opt 0])
4154            set val [string trim $val]
4155            if {$val ne {}} {
4156                set pfix [string range $pattern 0 end-1]
4157                lappend rargs $pfix$val
4158            }
4159        }
4160    }
4161    set rargs [concat $rargs [shellsplit $newviewopts($n,refs)]]
4162    return [concat $rargs [shellsplit $newviewopts($n,args)]]
4163}
4164
4165# Fill $newviewopts($n, ...) based on args for git log.
4166proc decode_view_opts {n view_args} {
4167    global known_view_options newviewopts
4168
4169    foreach opt $known_view_options {
4170        set id [lindex $opt 0]
4171        if {[lindex $opt 1] eq "b"} {
4172            # Checkboxes
4173            set val 0
4174        } elseif {[regexp {^r(\d+)$} [lindex $opt 1]]} {
4175            # Radiobuttons
4176            regexp {^(.*_)} $id uselessvar id
4177            set val 0
4178        } else {
4179            # Text fields
4180            set val {}
4181        }
4182        set newviewopts($n,$id) $val
4183    }
4184    set oargs [list]
4185    set refargs [list]
4186    foreach arg $view_args {
4187        if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
4188            && ![info exists found(limit)]} {
4189            set newviewopts($n,limit) $cnt
4190            set found(limit) 1
4191            continue
4192        }
4193        catch { unset val }
4194        foreach opt $known_view_options {
4195            set id [lindex $opt 0]
4196            if {[info exists found($id)]} continue
4197            foreach pattern [lindex $opt 3] {
4198                if {![string match $pattern $arg]} continue
4199                if {[lindex $opt 1] eq "b"} {
4200                    # Check buttons
4201                    set val 1
4202                } elseif {[regexp {^r(\d+)$} [lindex $opt 1] match num]} {
4203                    # Radio buttons
4204                    regexp {^(.*_)} $id uselessvar id
4205                    set val $num
4206                } else {
4207                    # Text input fields
4208                    set size [string length $pattern]
4209                    set val [string range $arg [expr {$size-1}] end]
4210                }
4211                set newviewopts($n,$id) $val
4212                set found($id) 1
4213                break
4214            }
4215            if {[info exists val]} break
4216        }
4217        if {[info exists val]} continue
4218        if {[regexp {^-} $arg]} {
4219            lappend oargs $arg
4220        } else {
4221            lappend refargs $arg
4222        }
4223    }
4224    set newviewopts($n,refs) [shellarglist $refargs]
4225    set newviewopts($n,args) [shellarglist $oargs]
4226}
4227
4228proc edit_or_newview {} {
4229    global curview
4230
4231    if {$curview > 0} {
4232        editview
4233    } else {
4234        newview 0
4235    }
4236}
4237
4238proc editview {} {
4239    global curview
4240    global viewname viewperm newviewname newviewopts
4241    global viewargs viewargscmd
4242
4243    set top .gitkvedit-$curview
4244    if {[winfo exists $top]} {
4245        raise $top
4246        return
4247    }
4248    decode_view_opts $curview $viewargs($curview)
4249    set newviewname($curview)      $viewname($curview)
4250    set newviewopts($curview,perm) $viewperm($curview)
4251    set newviewopts($curview,cmd)  $viewargscmd($curview)
4252    vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
4253}
4254
4255proc vieweditor {top n title} {
4256    global newviewname newviewopts viewfiles bgcolor
4257    global known_view_options NS
4258
4259    ttk_toplevel $top
4260    wm title $top [concat $title [mc "-- criteria for selecting revisions"]]
4261    make_transient $top .
4262
4263    # View name
4264    ${NS}::frame $top.nfr
4265    ${NS}::label $top.nl -text [mc "View Name"]
4266    ${NS}::entry $top.name -width 20 -textvariable newviewname($n)
4267    pack $top.nfr -in $top -fill x -pady 5 -padx 3
4268    pack $top.nl -in $top.nfr -side left -padx {0 5}
4269    pack $top.name -in $top.nfr -side left -padx {0 25}
4270
4271    # View options
4272    set cframe $top.nfr
4273    set cexpand 0
4274    set cnt 0
4275    foreach opt $known_view_options {
4276        set id [lindex $opt 0]
4277        set type [lindex $opt 1]
4278        set flags [lindex $opt 2]
4279        set title [eval [lindex $opt 4]]
4280        set lxpad 0
4281
4282        if {$flags eq "+" || $flags eq "*"} {
4283            set cframe $top.fr$cnt
4284            incr cnt
4285            ${NS}::frame $cframe
4286            pack $cframe -in $top -fill x -pady 3 -padx 3
4287            set cexpand [expr {$flags eq "*"}]
4288        } elseif {$flags eq ".." || $flags eq "*."} {
4289            set cframe $top.fr$cnt
4290            incr cnt
4291            ${NS}::frame $cframe
4292            pack $cframe -in $top -fill x -pady 3 -padx [list 15 3]
4293            set cexpand [expr {$flags eq "*."}]
4294        } else {
4295            set lxpad 5
4296        }
4297
4298        if {$type eq "l"} {
4299            ${NS}::label $cframe.l_$id -text $title
4300            pack $cframe.l_$id -in $cframe -side left -pady [list 3 0] -anchor w
4301        } elseif {$type eq "b"} {
4302            ${NS}::checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
4303            pack $cframe.c_$id -in $cframe -side left \
4304                -padx [list $lxpad 0] -expand $cexpand -anchor w
4305        } elseif {[regexp {^r(\d+)$} $type type sz]} {
4306            regexp {^(.*_)} $id uselessvar button_id
4307            ${NS}::radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz
4308            pack $cframe.c_$id -in $cframe -side left \
4309                -padx [list $lxpad 0] -expand $cexpand -anchor w
4310        } elseif {[regexp {^t(\d+)$} $type type sz]} {
4311            ${NS}::label $cframe.l_$id -text $title
4312            ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4313                -textvariable newviewopts($n,$id)
4314            pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
4315            pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
4316        } elseif {[regexp {^t(\d+)=$} $type type sz]} {
4317            ${NS}::label $cframe.l_$id -text $title
4318            ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4319                -textvariable newviewopts($n,$id)
4320            pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
4321            pack $cframe.e_$id -in $cframe -side top -fill x
4322        } elseif {$type eq "path"} {
4323            ${NS}::label $top.l -text $title
4324            pack $top.l -in $top -side top -pady [list 3 0] -anchor w -padx 3
4325            text $top.t -width 40 -height 5 -background $bgcolor
4326            if {[info exists viewfiles($n)]} {
4327                foreach f $viewfiles($n) {
4328                    $top.t insert end $f
4329                    $top.t insert end "\n"
4330                }
4331                $top.t delete {end - 1c} end
4332                $top.t mark set insert 0.0
4333            }
4334            pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
4335        }
4336    }
4337
4338    ${NS}::frame $top.buts
4339    ${NS}::button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
4340    ${NS}::button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
4341    ${NS}::button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
4342    bind $top <Control-Return> [list newviewok $top $n]
4343    bind $top <F5> [list newviewok $top $n 1]
4344    bind $top <Escape> [list destroy $top]
4345    grid $top.buts.ok $top.buts.apply $top.buts.can
4346    grid columnconfigure $top.buts 0 -weight 1 -uniform a
4347    grid columnconfigure $top.buts 1 -weight 1 -uniform a
4348    grid columnconfigure $top.buts 2 -weight 1 -uniform a
4349    pack $top.buts -in $top -side top -fill x
4350    focus $top.t
4351}
4352
4353proc doviewmenu {m first cmd op argv} {
4354    set nmenu [$m index end]
4355    for {set i $first} {$i <= $nmenu} {incr i} {
4356        if {[$m entrycget $i -command] eq $cmd} {
4357            eval $m $op $i $argv
4358            break
4359        }
4360    }
4361}
4362
4363proc allviewmenus {n op args} {
4364    # global viewhlmenu
4365
4366    doviewmenu .bar.view 5 [list showview $n] $op $args
4367    # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
4368}
4369
4370proc newviewok {top n {apply 0}} {
4371    global nextviewnum newviewperm newviewname newishighlight
4372    global viewname viewfiles viewperm viewchanged selectedview curview
4373    global viewargs viewargscmd newviewopts viewhlmenu
4374
4375    if {[catch {
4376        set newargs [encode_view_opts $n]
4377    } err]} {
4378        error_popup "[mc "Error in commit selection arguments:"] $err" $top
4379        return
4380    }
4381    set files {}
4382    foreach f [split [$top.t get 0.0 end] "\n"] {
4383        set ft [string trim $f]
4384        if {$ft ne {}} {
4385            lappend files $ft
4386        }
4387    }
4388    if {![info exists viewfiles($n)]} {
4389        # creating a new view
4390        incr nextviewnum
4391        set viewname($n) $newviewname($n)
4392        set viewperm($n) $newviewopts($n,perm)
4393        set viewchanged($n) 1
4394        set viewfiles($n) $files
4395        set viewargs($n) $newargs
4396        set viewargscmd($n) $newviewopts($n,cmd)
4397        addviewmenu $n
4398        if {!$newishighlight} {
4399            run showview $n
4400        } else {
4401            run addvhighlight $n
4402        }
4403    } else {
4404        # editing an existing view
4405        set viewperm($n) $newviewopts($n,perm)
4406        set viewchanged($n) 1
4407        if {$newviewname($n) ne $viewname($n)} {
4408            set viewname($n) $newviewname($n)
4409            doviewmenu .bar.view 5 [list showview $n] \
4410                entryconf [list -label $viewname($n)]
4411            # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
4412                # entryconf [list -label $viewname($n) -value $viewname($n)]
4413        }
4414        if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
4415                $newviewopts($n,cmd) ne $viewargscmd($n)} {
4416            set viewfiles($n) $files
4417            set viewargs($n) $newargs
4418            set viewargscmd($n) $newviewopts($n,cmd)
4419            if {$curview == $n} {
4420                run reloadcommits
4421            }
4422        }
4423    }
4424    if {$apply} return
4425    catch {destroy $top}
4426}
4427
4428proc delview {} {
4429    global curview viewperm hlview selectedhlview viewchanged
4430
4431    if {$curview == 0} return
4432    if {[info exists hlview] && $hlview == $curview} {
4433        set selectedhlview [mc "None"]
4434        unset hlview
4435    }
4436    allviewmenus $curview delete
4437    set viewperm($curview) 0
4438    set viewchanged($curview) 1
4439    showview 0
4440}
4441
4442proc addviewmenu {n} {
4443    global viewname viewhlmenu
4444
4445    .bar.view add radiobutton -label $viewname($n) \
4446        -command [list showview $n] -variable selectedview -value $n
4447    #$viewhlmenu add radiobutton -label $viewname($n) \
4448    #   -command [list addvhighlight $n] -variable selectedhlview
4449}
4450
4451proc showview {n} {
4452    global curview cached_commitrow ordertok
4453    global displayorder parentlist rowidlist rowisopt rowfinal
4454    global colormap rowtextx nextcolor canvxmax
4455    global numcommits viewcomplete
4456    global selectedline currentid canv canvy0
4457    global treediffs
4458    global pending_select mainheadid
4459    global commitidx
4460    global selectedview
4461    global hlview selectedhlview commitinterest
4462
4463    if {$n == $curview} return
4464    set selid {}
4465    set ymax [lindex [$canv cget -scrollregion] 3]
4466    set span [$canv yview]
4467    set ytop [expr {[lindex $span 0] * $ymax}]
4468    set ybot [expr {[lindex $span 1] * $ymax}]
4469    set yscreen [expr {($ybot - $ytop) / 2}]
4470    if {$selectedline ne {}} {
4471        set selid $currentid
4472        set y [yc $selectedline]
4473        if {$ytop < $y && $y < $ybot} {
4474            set yscreen [expr {$y - $ytop}]
4475        }
4476    } elseif {[info exists pending_select]} {
4477        set selid $pending_select
4478        unset pending_select
4479    }
4480    unselectline
4481    normalline
4482    unset -nocomplain treediffs
4483    clear_display
4484    if {[info exists hlview] && $hlview == $n} {
4485        unset hlview
4486        set selectedhlview [mc "None"]
4487    }
4488    unset -nocomplain commitinterest
4489    unset -nocomplain cached_commitrow
4490    unset -nocomplain ordertok
4491
4492    set curview $n
4493    set selectedview $n
4494    .bar.view entryconf [mca "&Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
4495    .bar.view entryconf [mca "&Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
4496
4497    run refill_reflist
4498    if {![info exists viewcomplete($n)]} {
4499        getcommits $selid
4500        return
4501    }
4502
4503    set displayorder {}
4504    set parentlist {}
4505    set rowidlist {}
4506    set rowisopt {}
4507    set rowfinal {}
4508    set numcommits $commitidx($n)
4509
4510    unset -nocomplain colormap
4511    unset -nocomplain rowtextx
4512    set nextcolor 0
4513    set canvxmax [$canv cget -width]
4514    set curview $n
4515    set row 0
4516    setcanvscroll
4517    set yf 0
4518    set row {}
4519    if {$selid ne {} && [commitinview $selid $n]} {
4520        set row [rowofcommit $selid]
4521        # try to get the selected row in the same position on the screen
4522        set ymax [lindex [$canv cget -scrollregion] 3]
4523        set ytop [expr {[yc $row] - $yscreen}]
4524        if {$ytop < 0} {
4525            set ytop 0
4526        }
4527        set yf [expr {$ytop * 1.0 / $ymax}]
4528    }
4529    allcanvs yview moveto $yf
4530    drawvisible
4531    if {$row ne {}} {
4532        selectline $row 0
4533    } elseif {!$viewcomplete($n)} {
4534        reset_pending_select $selid
4535    } else {
4536        reset_pending_select {}
4537
4538        if {[commitinview $pending_select $curview]} {
4539            selectline [rowofcommit $pending_select] 1
4540        } else {
4541            set row [first_real_row]
4542            if {$row < $numcommits} {
4543                selectline $row 0
4544            }
4545        }
4546    }
4547    if {!$viewcomplete($n)} {
4548        if {$numcommits == 0} {
4549            show_status [mc "Reading commits..."]
4550        }
4551    } elseif {$numcommits == 0} {
4552        show_status [mc "No commits selected"]
4553    }
4554    set_window_title
4555}
4556
4557# Stuff relating to the highlighting facility
4558
4559proc ishighlighted {id} {
4560    global vhighlights fhighlights nhighlights rhighlights
4561
4562    if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
4563        return $nhighlights($id)
4564    }
4565    if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
4566        return $vhighlights($id)
4567    }
4568    if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
4569        return $fhighlights($id)
4570    }
4571    if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4572        return $rhighlights($id)
4573    }
4574    return 0
4575}
4576
4577proc bolden {id font} {
4578    global canv linehtag currentid boldids need_redisplay markedid
4579
4580    # need_redisplay = 1 means the display is stale and about to be redrawn
4581    if {$need_redisplay} return
4582    lappend boldids $id
4583    $canv itemconf $linehtag($id) -font $font
4584    if {[info exists currentid] && $id eq $currentid} {
4585        $canv delete secsel
4586        set t [eval $canv create rect [$canv bbox $linehtag($id)] \
4587                   -outline {{}} -tags secsel \
4588                   -fill [$canv cget -selectbackground]]
4589        $canv lower $t
4590    }
4591    if {[info exists markedid] && $id eq $markedid} {
4592        make_idmark $id
4593    }
4594}
4595
4596proc bolden_name {id font} {
4597    global canv2 linentag currentid boldnameids need_redisplay
4598
4599    if {$need_redisplay} return
4600    lappend boldnameids $id
4601    $canv2 itemconf $linentag($id) -font $font
4602    if {[info exists currentid] && $id eq $currentid} {
4603        $canv2 delete secsel
4604        set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
4605                   -outline {{}} -tags secsel \
4606                   -fill [$canv2 cget -selectbackground]]
4607        $canv2 lower $t
4608    }
4609}
4610
4611proc unbolden {} {
4612    global boldids
4613
4614    set stillbold {}
4615    foreach id $boldids {
4616        if {![ishighlighted $id]} {
4617            bolden $id mainfont
4618        } else {
4619            lappend stillbold $id
4620        }
4621    }
4622    set boldids $stillbold
4623}
4624
4625proc addvhighlight {n} {
4626    global hlview viewcomplete curview vhl_done commitidx
4627
4628    if {[info exists hlview]} {
4629        delvhighlight
4630    }
4631    set hlview $n
4632    if {$n != $curview && ![info exists viewcomplete($n)]} {
4633        start_rev_list $n
4634    }
4635    set vhl_done $commitidx($hlview)
4636    if {$vhl_done > 0} {
4637        drawvisible
4638    }
4639}
4640
4641proc delvhighlight {} {
4642    global hlview vhighlights
4643
4644    if {![info exists hlview]} return
4645    unset hlview
4646    unset -nocomplain vhighlights
4647    unbolden
4648}
4649
4650proc vhighlightmore {} {
4651    global hlview vhl_done commitidx vhighlights curview
4652
4653    set max $commitidx($hlview)
4654    set vr [visiblerows]
4655    set r0 [lindex $vr 0]
4656    set r1 [lindex $vr 1]
4657    for {set i $vhl_done} {$i < $max} {incr i} {
4658        set id [commitonrow $i $hlview]
4659        if {[commitinview $id $curview]} {
4660            set row [rowofcommit $id]
4661            if {$r0 <= $row && $row <= $r1} {
4662                if {![highlighted $row]} {
4663                    bolden $id mainfontbold
4664                }
4665                set vhighlights($id) 1
4666            }
4667        }
4668    }
4669    set vhl_done $max
4670    return 0
4671}
4672
4673proc askvhighlight {row id} {
4674    global hlview vhighlights iddrawn
4675
4676    if {[commitinview $id $hlview]} {
4677        if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
4678            bolden $id mainfontbold
4679        }
4680        set vhighlights($id) 1
4681    } else {
4682        set vhighlights($id) 0
4683    }
4684}
4685
4686proc hfiles_change {} {
4687    global highlight_files filehighlight fhighlights fh_serial
4688    global highlight_paths
4689
4690    if {[info exists filehighlight]} {
4691        # delete previous highlights
4692        catch {close $filehighlight}
4693        unset filehighlight
4694        unset -nocomplain fhighlights
4695        unbolden
4696        unhighlight_filelist
4697    }
4698    set highlight_paths {}
4699    after cancel do_file_hl $fh_serial
4700    incr fh_serial
4701    if {$highlight_files ne {}} {
4702        after 300 do_file_hl $fh_serial
4703    }
4704}
4705
4706proc gdttype_change {name ix op} {
4707    global gdttype highlight_files findstring findpattern
4708
4709    stopfinding
4710    if {$findstring ne {}} {
4711        if {$gdttype eq [mc "containing:"]} {
4712            if {$highlight_files ne {}} {
4713                set highlight_files {}
4714                hfiles_change
4715            }
4716            findcom_change
4717        } else {
4718            if {$findpattern ne {}} {
4719                set findpattern {}
4720                findcom_change
4721            }
4722            set highlight_files $findstring
4723            hfiles_change
4724        }
4725        drawvisible
4726    }
4727    # enable/disable findtype/findloc menus too
4728}
4729
4730proc find_change {name ix op} {
4731    global gdttype findstring highlight_files
4732
4733    stopfinding
4734    if {$gdttype eq [mc "containing:"]} {
4735        findcom_change
4736    } else {
4737        if {$highlight_files ne $findstring} {
4738            set highlight_files $findstring
4739            hfiles_change
4740        }
4741    }
4742    drawvisible
4743}
4744
4745proc findcom_change args {
4746    global nhighlights boldnameids
4747    global findpattern findtype findstring gdttype
4748
4749    stopfinding
4750    # delete previous highlights, if any
4751    foreach id $boldnameids {
4752        bolden_name $id mainfont
4753    }
4754    set boldnameids {}
4755    unset -nocomplain nhighlights
4756    unbolden
4757    unmarkmatches
4758    if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
4759        set findpattern {}
4760    } elseif {$findtype eq [mc "Regexp"]} {
4761        set findpattern $findstring
4762    } else {
4763        set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4764                   $findstring]
4765        set findpattern "*$e*"
4766    }
4767}
4768
4769proc makepatterns {l} {
4770    set ret {}
4771    foreach e $l {
4772        set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4773        if {[string index $ee end] eq "/"} {
4774            lappend ret "$ee*"
4775        } else {
4776            lappend ret $ee
4777            lappend ret "$ee/*"
4778        }
4779    }
4780    return $ret
4781}
4782
4783proc do_file_hl {serial} {
4784    global highlight_files filehighlight highlight_paths gdttype fhl_list
4785    global cdup findtype
4786
4787    if {$gdttype eq [mc "touching paths:"]} {
4788        # If "exact" match then convert backslashes to forward slashes.
4789        # Most useful to support Windows-flavoured file paths.
4790        if {$findtype eq [mc "Exact"]} {
4791            set highlight_files [string map {"\\" "/"} $highlight_files]
4792        }
4793        if {[catch {set paths [shellsplit $highlight_files]}]} return
4794        set highlight_paths [makepatterns $paths]
4795        highlight_filelist
4796        set relative_paths {}
4797        foreach path $paths {
4798            lappend relative_paths [file join $cdup $path]
4799        }
4800        set gdtargs [concat -- $relative_paths]
4801    } elseif {$gdttype eq [mc "adding/removing string:"]} {
4802        set gdtargs [list "-S$highlight_files"]
4803    } elseif {$gdttype eq [mc "changing lines matching:"]} {
4804        set gdtargs [list "-G$highlight_files"]
4805    } else {
4806        # must be "containing:", i.e. we're searching commit info
4807        return
4808    }
4809    set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
4810    set filehighlight [open $cmd r+]
4811    fconfigure $filehighlight -blocking 0
4812    filerun $filehighlight readfhighlight
4813    set fhl_list {}
4814    drawvisible
4815    flushhighlights
4816}
4817
4818proc flushhighlights {} {
4819    global filehighlight fhl_list
4820
4821    if {[info exists filehighlight]} {
4822        lappend fhl_list {}
4823        puts $filehighlight ""
4824        flush $filehighlight
4825    }
4826}
4827
4828proc askfilehighlight {row id} {
4829    global filehighlight fhighlights fhl_list
4830
4831    lappend fhl_list $id
4832    set fhighlights($id) -1
4833    puts $filehighlight $id
4834}
4835
4836proc readfhighlight {} {
4837    global filehighlight fhighlights curview iddrawn
4838    global fhl_list find_dirn
4839
4840    if {![info exists filehighlight]} {
4841        return 0
4842    }
4843    set nr 0
4844    while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4845        set line [string trim $line]
4846        set i [lsearch -exact $fhl_list $line]
4847        if {$i < 0} continue
4848        for {set j 0} {$j < $i} {incr j} {
4849            set id [lindex $fhl_list $j]
4850            set fhighlights($id) 0
4851        }
4852        set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4853        if {$line eq {}} continue
4854        if {![commitinview $line $curview]} continue
4855        if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4856            bolden $line mainfontbold
4857        }
4858        set fhighlights($line) 1
4859    }
4860    if {[eof $filehighlight]} {
4861        # strange...
4862        puts "oops, git diff-tree died"
4863        catch {close $filehighlight}
4864        unset filehighlight
4865        return 0
4866    }
4867    if {[info exists find_dirn]} {
4868        run findmore
4869    }
4870    return 1
4871}
4872
4873proc doesmatch {f} {
4874    global findtype findpattern
4875
4876    if {$findtype eq [mc "Regexp"]} {
4877        return [regexp $findpattern $f]
4878    } elseif {$findtype eq [mc "IgnCase"]} {
4879        return [string match -nocase $findpattern $f]
4880    } else {
4881        return [string match $findpattern $f]
4882    }
4883}
4884
4885proc askfindhighlight {row id} {
4886    global nhighlights commitinfo iddrawn
4887    global findloc
4888    global markingmatches
4889
4890    if {![info exists commitinfo($id)]} {
4891        getcommit $id
4892    }
4893    set info $commitinfo($id)
4894    set isbold 0
4895    set fldtypes [list [mc Headline] [mc Author] "" [mc Committer] "" [mc Comments]]
4896    foreach f $info ty $fldtypes {
4897        if {$ty eq ""} continue
4898        if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4899            [doesmatch $f]} {
4900            if {$ty eq [mc "Author"]} {
4901                set isbold 2
4902                break
4903            }
4904            set isbold 1
4905        }
4906    }
4907    if {$isbold && [info exists iddrawn($id)]} {
4908        if {![ishighlighted $id]} {
4909            bolden $id mainfontbold
4910            if {$isbold > 1} {
4911                bolden_name $id mainfontbold
4912            }
4913        }
4914        if {$markingmatches} {
4915            markrowmatches $row $id
4916        }
4917    }
4918    set nhighlights($id) $isbold
4919}
4920
4921proc markrowmatches {row id} {
4922    global canv canv2 linehtag linentag commitinfo findloc
4923
4924    set headline [lindex $commitinfo($id) 0]
4925    set author [lindex $commitinfo($id) 1]
4926    $canv delete match$row
4927    $canv2 delete match$row
4928    if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4929        set m [findmatches $headline]
4930        if {$m ne {}} {
4931            markmatches $canv $row $headline $linehtag($id) $m \
4932                [$canv itemcget $linehtag($id) -font] $row
4933        }
4934    }
4935    if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4936        set m [findmatches $author]
4937        if {$m ne {}} {
4938            markmatches $canv2 $row $author $linentag($id) $m \
4939                [$canv2 itemcget $linentag($id) -font] $row
4940        }
4941    }
4942}
4943
4944proc vrel_change {name ix op} {
4945    global highlight_related
4946
4947    rhighlight_none
4948    if {$highlight_related ne [mc "None"]} {
4949        run drawvisible
4950    }
4951}
4952
4953# prepare for testing whether commits are descendents or ancestors of a
4954proc rhighlight_sel {a} {
4955    global descendent desc_todo ancestor anc_todo
4956    global highlight_related
4957
4958    unset -nocomplain descendent
4959    set desc_todo [list $a]
4960    unset -nocomplain ancestor
4961    set anc_todo [list $a]
4962    if {$highlight_related ne [mc "None"]} {
4963        rhighlight_none
4964        run drawvisible
4965    }
4966}
4967
4968proc rhighlight_none {} {
4969    global rhighlights
4970
4971    unset -nocomplain rhighlights
4972    unbolden
4973}
4974
4975proc is_descendent {a} {
4976    global curview children descendent desc_todo
4977
4978    set v $curview
4979    set la [rowofcommit $a]
4980    set todo $desc_todo
4981    set leftover {}
4982    set done 0
4983    for {set i 0} {$i < [llength $todo]} {incr i} {
4984        set do [lindex $todo $i]
4985        if {[rowofcommit $do] < $la} {
4986            lappend leftover $do
4987            continue
4988        }
4989        foreach nk $children($v,$do) {
4990            if {![info exists descendent($nk)]} {
4991                set descendent($nk) 1
4992                lappend todo $nk
4993                if {$nk eq $a} {
4994                    set done 1
4995                }
4996            }
4997        }
4998        if {$done} {
4999            set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
5000            return
5001        }
5002    }
5003    set descendent($a) 0
5004    set desc_todo $leftover
5005}
5006
5007proc is_ancestor {a} {
5008    global curview parents ancestor anc_todo
5009
5010    set v $curview
5011    set la [rowofcommit $a]
5012    set todo $anc_todo
5013    set leftover {}
5014    set done 0
5015    for {set i 0} {$i < [llength $todo]} {incr i} {
5016        set do [lindex $todo $i]
5017        if {![commitinview $do $v] || [rowofcommit $do] > $la} {
5018            lappend leftover $do
5019            continue
5020        }
5021        foreach np $parents($v,$do) {
5022            if {![info exists ancestor($np)]} {
5023                set ancestor($np) 1
5024                lappend todo $np
5025                if {$np eq $a} {
5026                    set done 1
5027                }
5028            }
5029        }
5030        if {$done} {
5031            set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
5032            return
5033        }
5034    }
5035    set ancestor($a) 0
5036    set anc_todo $leftover
5037}
5038
5039proc askrelhighlight {row id} {
5040    global descendent highlight_related iddrawn rhighlights
5041    global selectedline ancestor
5042
5043    if {$selectedline eq {}} return
5044    set isbold 0
5045    if {$highlight_related eq [mc "Descendant"] ||
5046        $highlight_related eq [mc "Not descendant"]} {
5047        if {![info exists descendent($id)]} {
5048            is_descendent $id
5049        }
5050        if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
5051            set isbold 1
5052        }
5053    } elseif {$highlight_related eq [mc "Ancestor"] ||
5054              $highlight_related eq [mc "Not ancestor"]} {
5055        if {![info exists ancestor($id)]} {
5056            is_ancestor $id
5057        }
5058        if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
5059            set isbold 1
5060        }
5061    }
5062    if {[info exists iddrawn($id)]} {
5063        if {$isbold && ![ishighlighted $id]} {
5064            bolden $id mainfontbold
5065        }
5066    }
5067    set rhighlights($id) $isbold
5068}
5069
5070# Graph layout functions
5071
5072proc shortids {ids} {
5073    set res {}
5074    foreach id $ids {
5075        if {[llength $id] > 1} {
5076            lappend res [shortids $id]
5077        } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
5078            lappend res [string range $id 0 7]
5079        } else {
5080            lappend res $id
5081        }
5082    }
5083    return $res
5084}
5085
5086proc ntimes {n o} {
5087    set ret {}
5088    set o [list $o]
5089    for {set mask 1} {$mask <= $n} {incr mask $mask} {
5090        if {($n & $mask) != 0} {
5091            set ret [concat $ret $o]
5092        }
5093        set o [concat $o $o]
5094    }
5095    return $ret
5096}
5097
5098proc ordertoken {id} {
5099    global ordertok curview varcid varcstart varctok curview parents children
5100    global nullid nullid2
5101
5102    if {[info exists ordertok($id)]} {
5103        return $ordertok($id)
5104    }
5105    set origid $id
5106    set todo {}
5107    while {1} {
5108        if {[info exists varcid($curview,$id)]} {
5109            set a $varcid($curview,$id)
5110            set p [lindex $varcstart($curview) $a]
5111        } else {
5112            set p [lindex $children($curview,$id) 0]
5113        }
5114        if {[info exists ordertok($p)]} {
5115            set tok $ordertok($p)
5116            break
5117        }
5118        set id [first_real_child $curview,$p]
5119        if {$id eq {}} {
5120            # it's a root
5121            set tok [lindex $varctok($curview) $varcid($curview,$p)]
5122            break
5123        }
5124        if {[llength $parents($curview,$id)] == 1} {
5125            lappend todo [list $p {}]
5126        } else {
5127            set j [lsearch -exact $parents($curview,$id) $p]
5128            if {$j < 0} {
5129                puts "oops didn't find [shortids $p] in parents of [shortids $id]"
5130            }
5131            lappend todo [list $p [strrep $j]]
5132        }
5133    }
5134    for {set i [llength $todo]} {[incr i -1] >= 0} {} {
5135        set p [lindex $todo $i 0]
5136        append tok [lindex $todo $i 1]
5137        set ordertok($p) $tok
5138    }
5139    set ordertok($origid) $tok
5140    return $tok
5141}
5142
5143# Work out where id should go in idlist so that order-token
5144# values increase from left to right
5145proc idcol {idlist id {i 0}} {
5146    set t [ordertoken $id]
5147    if {$i < 0} {
5148        set i 0
5149    }
5150    if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
5151        if {$i > [llength $idlist]} {
5152            set i [llength $idlist]
5153        }
5154        while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
5155        incr i
5156    } else {
5157        if {$t > [ordertoken [lindex $idlist $i]]} {
5158            while {[incr i] < [llength $idlist] &&
5159                   $t >= [ordertoken [lindex $idlist $i]]} {}
5160        }
5161    }
5162    return $i
5163}
5164
5165proc initlayout {} {
5166    global rowidlist rowisopt rowfinal displayorder parentlist
5167    global numcommits canvxmax canv
5168    global nextcolor
5169    global colormap rowtextx
5170
5171    set numcommits 0
5172    set displayorder {}
5173    set parentlist {}
5174    set nextcolor 0
5175    set rowidlist {}
5176    set rowisopt {}
5177    set rowfinal {}
5178    set canvxmax [$canv cget -width]
5179    unset -nocomplain colormap
5180    unset -nocomplain rowtextx
5181    setcanvscroll
5182}
5183
5184proc setcanvscroll {} {
5185    global canv canv2 canv3 numcommits linespc canvxmax canvy0
5186    global lastscrollset lastscrollrows
5187
5188    set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
5189    $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
5190    $canv2 conf -scrollregion [list 0 0 0 $ymax]
5191    $canv3 conf -scrollregion [list 0 0 0 $ymax]
5192    set lastscrollset [clock clicks -milliseconds]
5193    set lastscrollrows $numcommits
5194}
5195
5196proc visiblerows {} {
5197    global canv numcommits linespc
5198
5199    set ymax [lindex [$canv cget -scrollregion] 3]
5200    if {$ymax eq {} || $ymax == 0} return
5201    set f [$canv yview]
5202    set y0 [expr {int([lindex $f 0] * $ymax)}]
5203    set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
5204    if {$r0 < 0} {
5205        set r0 0
5206    }
5207    set y1 [expr {int([lindex $f 1] * $ymax)}]
5208    set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
5209    if {$r1 >= $numcommits} {
5210        set r1 [expr {$numcommits - 1}]
5211    }
5212    return [list $r0 $r1]
5213}
5214
5215proc layoutmore {} {
5216    global commitidx viewcomplete curview
5217    global numcommits pending_select curview
5218    global lastscrollset lastscrollrows
5219
5220    if {$lastscrollrows < 100 || $viewcomplete($curview) ||
5221        [clock clicks -milliseconds] - $lastscrollset > 500} {
5222        setcanvscroll
5223    }
5224    if {[info exists pending_select] &&
5225        [commitinview $pending_select $curview]} {
5226        update
5227        selectline [rowofcommit $pending_select] 1
5228    }
5229    drawvisible
5230}
5231
5232# With path limiting, we mightn't get the actual HEAD commit,
5233# so ask git rev-list what is the first ancestor of HEAD that
5234# touches a file in the path limit.
5235proc get_viewmainhead {view} {
5236    global viewmainheadid vfilelimit viewinstances mainheadid
5237
5238    catch {
5239        set rfd [open [concat | git rev-list -1 $mainheadid \
5240                           -- $vfilelimit($view)] r]
5241        set j [reg_instance $rfd]
5242        lappend viewinstances($view) $j
5243        fconfigure $rfd -blocking 0
5244        filerun $rfd [list getviewhead $rfd $j $view]
5245        set viewmainheadid($curview) {}
5246    }
5247}
5248
5249# git rev-list should give us just 1 line to use as viewmainheadid($view)
5250proc getviewhead {fd inst view} {
5251    global viewmainheadid commfd curview viewinstances showlocalchanges
5252
5253    set id {}
5254    if {[gets $fd line] < 0} {
5255        if {![eof $fd]} {
5256            return 1
5257        }
5258    } elseif {[string length $line] == 40 && [string is xdigit $line]} {
5259        set id $line
5260    }
5261    set viewmainheadid($view) $id
5262    close $fd
5263    unset commfd($inst)
5264    set i [lsearch -exact $viewinstances($view) $inst]
5265    if {$i >= 0} {
5266        set viewinstances($view) [lreplace $viewinstances($view) $i $i]
5267    }
5268    if {$showlocalchanges && $id ne {} && $view == $curview} {
5269        doshowlocalchanges
5270    }
5271    return 0
5272}
5273
5274proc doshowlocalchanges {} {
5275    global curview viewmainheadid
5276
5277    if {$viewmainheadid($curview) eq {}} return
5278    if {[commitinview $viewmainheadid($curview) $curview]} {
5279        dodiffindex
5280    } else {
5281        interestedin $viewmainheadid($curview) dodiffindex
5282    }
5283}
5284
5285proc dohidelocalchanges {} {
5286    global nullid nullid2 lserial curview
5287
5288    if {[commitinview $nullid $curview]} {
5289        removefakerow $nullid
5290    }
5291    if {[commitinview $nullid2 $curview]} {
5292        removefakerow $nullid2
5293    }
5294    incr lserial
5295}
5296
5297# spawn off a process to do git diff-index --cached HEAD
5298proc dodiffindex {} {
5299    global lserial showlocalchanges vfilelimit curview
5300    global hasworktree git_version
5301
5302    if {!$showlocalchanges || !$hasworktree} return
5303    incr lserial
5304    if {[package vcompare $git_version "1.7.2"] >= 0} {
5305        set cmd "|git diff-index --cached --ignore-submodules=dirty HEAD"
5306    } else {
5307        set cmd "|git diff-index --cached HEAD"
5308    }
5309    if {$vfilelimit($curview) ne {}} {
5310        set cmd [concat $cmd -- $vfilelimit($curview)]
5311    }
5312    set fd [open $cmd r]
5313    fconfigure $fd -blocking 0
5314    set i [reg_instance $fd]
5315    filerun $fd [list readdiffindex $fd $lserial $i]
5316}
5317
5318proc readdiffindex {fd serial inst} {
5319    global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
5320    global vfilelimit
5321
5322    set isdiff 1
5323    if {[gets $fd line] < 0} {
5324        if {![eof $fd]} {
5325            return 1
5326        }
5327        set isdiff 0
5328    }
5329    # we only need to see one line and we don't really care what it says...
5330    stop_instance $inst
5331
5332    if {$serial != $lserial} {
5333        return 0
5334    }
5335
5336    # now see if there are any local changes not checked in to the index
5337    set cmd "|git diff-files"
5338    if {$vfilelimit($curview) ne {}} {
5339        set cmd [concat $cmd -- $vfilelimit($curview)]
5340    }
5341    set fd [open $cmd r]
5342    fconfigure $fd -blocking 0
5343    set i [reg_instance $fd]
5344    filerun $fd [list readdifffiles $fd $serial $i]
5345
5346    if {$isdiff && ![commitinview $nullid2 $curview]} {
5347        # add the line for the changes in the index to the graph
5348        set hl [mc "Local changes checked in to index but not committed"]
5349        set commitinfo($nullid2) [list  $hl {} {} {} {} "    $hl\n"]
5350        set commitdata($nullid2) "\n    $hl\n"
5351        if {[commitinview $nullid $curview]} {
5352            removefakerow $nullid
5353        }
5354        insertfakerow $nullid2 $viewmainheadid($curview)
5355    } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
5356        if {[commitinview $nullid $curview]} {
5357            removefakerow $nullid
5358        }
5359        removefakerow $nullid2
5360    }
5361    return 0
5362}
5363
5364proc readdifffiles {fd serial inst} {
5365    global viewmainheadid nullid nullid2 curview
5366    global commitinfo commitdata lserial
5367
5368    set isdiff 1
5369    if {[gets $fd line] < 0} {
5370        if {![eof $fd]} {
5371            return 1
5372        }
5373        set isdiff 0
5374    }
5375    # we only need to see one line and we don't really care what it says...
5376    stop_instance $inst
5377
5378    if {$serial != $lserial} {
5379        return 0
5380    }
5381
5382    if {$isdiff && ![commitinview $nullid $curview]} {
5383        # add the line for the local diff to the graph
5384        set hl [mc "Local uncommitted changes, not checked in to index"]
5385        set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
5386        set commitdata($nullid) "\n    $hl\n"
5387        if {[commitinview $nullid2 $curview]} {
5388            set p $nullid2
5389        } else {
5390            set p $viewmainheadid($curview)
5391        }
5392        insertfakerow $nullid $p
5393    } elseif {!$isdiff && [commitinview $nullid $curview]} {
5394        removefakerow $nullid
5395    }
5396    return 0
5397}
5398
5399proc nextuse {id row} {
5400    global curview children
5401
5402    if {[info exists children($curview,$id)]} {
5403        foreach kid $children($curview,$id) {
5404            if {![commitinview $kid $curview]} {
5405                return -1
5406            }
5407            if {[rowofcommit $kid] > $row} {
5408                return [rowofcommit $kid]
5409            }
5410        }
5411    }
5412    if {[commitinview $id $curview]} {
5413        return [rowofcommit $id]
5414    }
5415    return -1
5416}
5417
5418proc prevuse {id row} {
5419    global curview children
5420
5421    set ret -1
5422    if {[info exists children($curview,$id)]} {
5423        foreach kid $children($curview,$id) {
5424            if {![commitinview $kid $curview]} break
5425            if {[rowofcommit $kid] < $row} {
5426                set ret [rowofcommit $kid]
5427            }
5428        }
5429    }
5430    return $ret
5431}
5432
5433proc make_idlist {row} {
5434    global displayorder parentlist uparrowlen downarrowlen mingaplen
5435    global commitidx curview children
5436
5437    set r [expr {$row - $mingaplen - $downarrowlen - 1}]
5438    if {$r < 0} {
5439        set r 0
5440    }
5441    set ra [expr {$row - $downarrowlen}]
5442    if {$ra < 0} {
5443        set ra 0
5444    }
5445    set rb [expr {$row + $uparrowlen}]
5446    if {$rb > $commitidx($curview)} {
5447        set rb $commitidx($curview)
5448    }
5449    make_disporder $r [expr {$rb + 1}]
5450    set ids {}
5451    for {} {$r < $ra} {incr r} {
5452        set nextid [lindex $displayorder [expr {$r + 1}]]
5453        foreach p [lindex $parentlist $r] {
5454            if {$p eq $nextid} continue
5455            set rn [nextuse $p $r]
5456            if {$rn >= $row &&
5457                $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
5458                lappend ids [list [ordertoken $p] $p]
5459            }
5460        }
5461    }
5462    for {} {$r < $row} {incr r} {
5463        set nextid [lindex $displayorder [expr {$r + 1}]]
5464        foreach p [lindex $parentlist $r] {
5465            if {$p eq $nextid} continue
5466            set rn [nextuse $p $r]
5467            if {$rn < 0 || $rn >= $row} {
5468                lappend ids [list [ordertoken $p] $p]
5469            }
5470        }
5471    }
5472    set id [lindex $displayorder $row]
5473    lappend ids [list [ordertoken $id] $id]
5474    while {$r < $rb} {
5475        foreach p [lindex $parentlist $r] {
5476            set firstkid [lindex $children($curview,$p) 0]
5477            if {[rowofcommit $firstkid] < $row} {
5478                lappend ids [list [ordertoken $p] $p]
5479            }
5480        }
5481        incr r
5482        set id [lindex $displayorder $r]
5483        if {$id ne {}} {
5484            set firstkid [lindex $children($curview,$id) 0]
5485            if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
5486                lappend ids [list [ordertoken $id] $id]
5487            }
5488        }
5489    }
5490    set idlist {}
5491    foreach idx [lsort -unique $ids] {
5492        lappend idlist [lindex $idx 1]
5493    }
5494    return $idlist
5495}
5496
5497proc rowsequal {a b} {
5498    while {[set i [lsearch -exact $a {}]] >= 0} {
5499        set a [lreplace $a $i $i]
5500    }
5501    while {[set i [lsearch -exact $b {}]] >= 0} {
5502        set b [lreplace $b $i $i]
5503    }
5504    return [expr {$a eq $b}]
5505}
5506
5507proc makeupline {id row rend col} {
5508    global rowidlist uparrowlen downarrowlen mingaplen
5509
5510    for {set r $rend} {1} {set r $rstart} {
5511        set rstart [prevuse $id $r]
5512        if {$rstart < 0} return
5513        if {$rstart < $row} break
5514    }
5515    if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5516        set rstart [expr {$rend - $uparrowlen - 1}]
5517    }
5518    for {set r $rstart} {[incr r] <= $row} {} {
5519        set idlist [lindex $rowidlist $r]
5520        if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5521            set col [idcol $idlist $id $col]
5522            lset rowidlist $r [linsert $idlist $col $id]
5523            changedrow $r
5524        }
5525    }
5526}
5527
5528proc layoutrows {row endrow} {
5529    global rowidlist rowisopt rowfinal displayorder
5530    global uparrowlen downarrowlen maxwidth mingaplen
5531    global children parentlist
5532    global commitidx viewcomplete curview
5533
5534    make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
5535    set idlist {}
5536    if {$row > 0} {
5537        set rm1 [expr {$row - 1}]
5538        foreach id [lindex $rowidlist $rm1] {
5539            if {$id ne {}} {
5540                lappend idlist $id
5541            }
5542        }
5543        set final [lindex $rowfinal $rm1]
5544    }
5545    for {} {$row < $endrow} {incr row} {
5546        set rm1 [expr {$row - 1}]
5547        if {$rm1 < 0 || $idlist eq {}} {
5548            set idlist [make_idlist $row]
5549            set final 1
5550        } else {
5551            set id [lindex $displayorder $rm1]
5552            set col [lsearch -exact $idlist $id]
5553            set idlist [lreplace $idlist $col $col]
5554            foreach p [lindex $parentlist $rm1] {
5555                if {[lsearch -exact $idlist $p] < 0} {
5556                    set col [idcol $idlist $p $col]
5557                    set idlist [linsert $idlist $col $p]
5558                    # if not the first child, we have to insert a line going up
5559                    if {$id ne [lindex $children($curview,$p) 0]} {
5560                        makeupline $p $rm1 $row $col
5561                    }
5562                }
5563            }
5564            set id [lindex $displayorder $row]
5565            if {$row > $downarrowlen} {
5566                set termrow [expr {$row - $downarrowlen - 1}]
5567                foreach p [lindex $parentlist $termrow] {
5568                    set i [lsearch -exact $idlist $p]
5569                    if {$i < 0} continue
5570                    set nr [nextuse $p $termrow]
5571                    if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5572                        set idlist [lreplace $idlist $i $i]
5573                    }
5574                }
5575            }
5576            set col [lsearch -exact $idlist $id]
5577            if {$col < 0} {
5578                set col [idcol $idlist $id]
5579                set idlist [linsert $idlist $col $id]
5580                if {$children($curview,$id) ne {}} {
5581                    makeupline $id $rm1 $row $col
5582                }
5583            }
5584            set r [expr {$row + $uparrowlen - 1}]
5585            if {$r < $commitidx($curview)} {
5586                set x $col
5587                foreach p [lindex $parentlist $r] {
5588                    if {[lsearch -exact $idlist $p] >= 0} continue
5589                    set fk [lindex $children($curview,$p) 0]
5590                    if {[rowofcommit $fk] < $row} {
5591                        set x [idcol $idlist $p $x]
5592                        set idlist [linsert $idlist $x $p]
5593                    }
5594                }
5595                if {[incr r] < $commitidx($curview)} {
5596                    set p [lindex $displayorder $r]
5597                    if {[lsearch -exact $idlist $p] < 0} {
5598                        set fk [lindex $children($curview,$p) 0]
5599                        if {$fk ne {} && [rowofcommit $fk] < $row} {
5600                            set x [idcol $idlist $p $x]
5601                            set idlist [linsert $idlist $x $p]
5602                        }
5603                    }
5604                }
5605            }
5606        }
5607        if {$final && !$viewcomplete($curview) &&
5608            $row + $uparrowlen + $mingaplen + $downarrowlen
5609                >= $commitidx($curview)} {
5610            set final 0
5611        }
5612        set l [llength $rowidlist]
5613        if {$row == $l} {
5614            lappend rowidlist $idlist
5615            lappend rowisopt 0
5616            lappend rowfinal $final
5617        } elseif {$row < $l} {
5618            if {![rowsequal $idlist [lindex $rowidlist $row]]} {
5619                lset rowidlist $row $idlist
5620                changedrow $row
5621            }
5622            lset rowfinal $row $final
5623        } else {
5624            set pad [ntimes [expr {$row - $l}] {}]
5625            set rowidlist [concat $rowidlist $pad]
5626            lappend rowidlist $idlist
5627            set rowfinal [concat $rowfinal $pad]
5628            lappend rowfinal $final
5629            set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5630        }
5631    }
5632    return $row
5633}
5634
5635proc changedrow {row} {
5636    global displayorder iddrawn rowisopt need_redisplay
5637
5638    set l [llength $rowisopt]
5639    if {$row < $l} {
5640        lset rowisopt $row 0
5641        if {$row + 1 < $l} {
5642            lset rowisopt [expr {$row + 1}] 0
5643            if {$row + 2 < $l} {
5644                lset rowisopt [expr {$row + 2}] 0
5645            }
5646        }
5647    }
5648    set id [lindex $displayorder $row]
5649    if {[info exists iddrawn($id)]} {
5650        set need_redisplay 1
5651    }
5652}
5653
5654proc insert_pad {row col npad} {
5655    global rowidlist
5656
5657    set pad [ntimes $npad {}]
5658    set idlist [lindex $rowidlist $row]
5659    set bef [lrange $idlist 0 [expr {$col - 1}]]
5660    set aft [lrange $idlist $col end]
5661    set i [lsearch -exact $aft {}]
5662    if {$i > 0} {
5663        set aft [lreplace $aft $i $i]
5664    }
5665    lset rowidlist $row [concat $bef $pad $aft]
5666    changedrow $row
5667}
5668
5669proc optimize_rows {row col endrow} {
5670    global rowidlist rowisopt displayorder curview children
5671
5672    if {$row < 1} {
5673        set row 1
5674    }
5675    for {} {$row < $endrow} {incr row; set col 0} {
5676        if {[lindex $rowisopt $row]} continue
5677        set haspad 0
5678        set y0 [expr {$row - 1}]
5679        set ym [expr {$row - 2}]
5680        set idlist [lindex $rowidlist $row]
5681        set previdlist [lindex $rowidlist $y0]
5682        if {$idlist eq {} || $previdlist eq {}} continue
5683        if {$ym >= 0} {
5684            set pprevidlist [lindex $rowidlist $ym]
5685            if {$pprevidlist eq {}} continue
5686        } else {
5687            set pprevidlist {}
5688        }
5689        set x0 -1
5690        set xm -1
5691        for {} {$col < [llength $idlist]} {incr col} {
5692            set id [lindex $idlist $col]
5693            if {[lindex $previdlist $col] eq $id} continue
5694            if {$id eq {}} {
5695                set haspad 1
5696                continue
5697            }
5698            set x0 [lsearch -exact $previdlist $id]
5699            if {$x0 < 0} continue
5700            set z [expr {$x0 - $col}]
5701            set isarrow 0
5702            set z0 {}
5703            if {$ym >= 0} {
5704                set xm [lsearch -exact $pprevidlist $id]
5705                if {$xm >= 0} {
5706                    set z0 [expr {$xm - $x0}]
5707                }
5708            }
5709            if {$z0 eq {}} {
5710                # if row y0 is the first child of $id then it's not an arrow
5711                if {[lindex $children($curview,$id) 0] ne
5712                    [lindex $displayorder $y0]} {
5713                    set isarrow 1
5714                }
5715            }
5716            if {!$isarrow && $id ne [lindex $displayorder $row] &&
5717                [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5718                set isarrow 1
5719            }
5720            # Looking at lines from this row to the previous row,
5721            # make them go straight up if they end in an arrow on
5722            # the previous row; otherwise make them go straight up
5723            # or at 45 degrees.
5724            if {$z < -1 || ($z < 0 && $isarrow)} {
5725                # Line currently goes left too much;
5726                # insert pads in the previous row, then optimize it
5727                set npad [expr {-1 - $z + $isarrow}]
5728                insert_pad $y0 $x0 $npad
5729                if {$y0 > 0} {
5730                    optimize_rows $y0 $x0 $row
5731                }
5732                set previdlist [lindex $rowidlist $y0]
5733                set x0 [lsearch -exact $previdlist $id]
5734                set z [expr {$x0 - $col}]
5735                if {$z0 ne {}} {
5736                    set pprevidlist [lindex $rowidlist $ym]
5737                    set xm [lsearch -exact $pprevidlist $id]
5738                    set z0 [expr {$xm - $x0}]
5739                }
5740            } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5741                # Line currently goes right too much;
5742                # insert pads in this line
5743                set npad [expr {$z - 1 + $isarrow}]
5744                insert_pad $row $col $npad
5745                set idlist [lindex $rowidlist $row]
5746                incr col $npad
5747                set z [expr {$x0 - $col}]
5748                set haspad 1
5749            }
5750            if {$z0 eq {} && !$isarrow && $ym >= 0} {
5751                # this line links to its first child on row $row-2
5752                set id [lindex $displayorder $ym]
5753                set xc [lsearch -exact $pprevidlist $id]
5754                if {$xc >= 0} {
5755                    set z0 [expr {$xc - $x0}]
5756                }
5757            }
5758            # avoid lines jigging left then immediately right
5759            if {$z0 ne {} && $z < 0 && $z0 > 0} {
5760                insert_pad $y0 $x0 1
5761                incr x0
5762                optimize_rows $y0 $x0 $row
5763                set previdlist [lindex $rowidlist $y0]
5764            }
5765        }
5766        if {!$haspad} {
5767            # Find the first column that doesn't have a line going right
5768            for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5769                set id [lindex $idlist $col]
5770                if {$id eq {}} break
5771                set x0 [lsearch -exact $previdlist $id]
5772                if {$x0 < 0} {
5773                    # check if this is the link to the first child
5774                    set kid [lindex $displayorder $y0]
5775                    if {[lindex $children($curview,$id) 0] eq $kid} {
5776                        # it is, work out offset to child
5777                        set x0 [lsearch -exact $previdlist $kid]
5778                    }
5779                }
5780                if {$x0 <= $col} break
5781            }
5782            # Insert a pad at that column as long as it has a line and
5783            # isn't the last column
5784            if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5785                set idlist [linsert $idlist $col {}]
5786                lset rowidlist $row $idlist
5787                changedrow $row
5788            }
5789        }
5790    }
5791}
5792
5793proc xc {row col} {
5794    global canvx0 linespc
5795    return [expr {$canvx0 + $col * $linespc}]
5796}
5797
5798proc yc {row} {
5799    global canvy0 linespc
5800    return [expr {$canvy0 + $row * $linespc}]
5801}
5802
5803proc linewidth {id} {
5804    global thickerline lthickness
5805
5806    set wid $lthickness
5807    if {[info exists thickerline] && $id eq $thickerline} {
5808        set wid [expr {2 * $lthickness}]
5809    }
5810    return $wid
5811}
5812
5813proc rowranges {id} {
5814    global curview children uparrowlen downarrowlen
5815    global rowidlist
5816
5817    set kids $children($curview,$id)
5818    if {$kids eq {}} {
5819        return {}
5820    }
5821    set ret {}
5822    lappend kids $id
5823    foreach child $kids {
5824        if {![commitinview $child $curview]} break
5825        set row [rowofcommit $child]
5826        if {![info exists prev]} {
5827            lappend ret [expr {$row + 1}]
5828        } else {
5829            if {$row <= $prevrow} {
5830                puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5831            }
5832            # see if the line extends the whole way from prevrow to row
5833            if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5834                [lsearch -exact [lindex $rowidlist \
5835                            [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5836                # it doesn't, see where it ends
5837                set r [expr {$prevrow + $downarrowlen}]
5838                if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5839                    while {[incr r -1] > $prevrow &&
5840                           [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5841                } else {
5842                    while {[incr r] <= $row &&
5843                           [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5844                    incr r -1
5845                }
5846                lappend ret $r
5847                # see where it starts up again
5848                set r [expr {$row - $uparrowlen}]
5849                if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5850                    while {[incr r] < $row &&
5851                           [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5852                } else {
5853                    while {[incr r -1] >= $prevrow &&
5854                           [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5855                    incr r
5856                }
5857                lappend ret $r
5858            }
5859        }
5860        if {$child eq $id} {
5861            lappend ret $row
5862        }
5863        set prev $child
5864        set prevrow $row
5865    }
5866    return $ret
5867}
5868
5869proc drawlineseg {id row endrow arrowlow} {
5870    global rowidlist displayorder iddrawn linesegs
5871    global canv colormap linespc curview maxlinelen parentlist
5872
5873    set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5874    set le [expr {$row + 1}]
5875    set arrowhigh 1
5876    while {1} {
5877        set c [lsearch -exact [lindex $rowidlist $le] $id]
5878        if {$c < 0} {
5879            incr le -1
5880            break
5881        }
5882        lappend cols $c
5883        set x [lindex $displayorder $le]
5884        if {$x eq $id} {
5885            set arrowhigh 0
5886            break
5887        }
5888        if {[info exists iddrawn($x)] || $le == $endrow} {
5889            set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5890            if {$c >= 0} {
5891                lappend cols $c
5892                set arrowhigh 0
5893            }
5894            break
5895        }
5896        incr le
5897    }
5898    if {$le <= $row} {
5899        return $row
5900    }
5901
5902    set lines {}
5903    set i 0
5904    set joinhigh 0
5905    if {[info exists linesegs($id)]} {
5906        set lines $linesegs($id)
5907        foreach li $lines {
5908            set r0 [lindex $li 0]
5909            if {$r0 > $row} {
5910                if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5911                    set joinhigh 1
5912                }
5913                break
5914            }
5915            incr i
5916        }
5917    }
5918    set joinlow 0
5919    if {$i > 0} {
5920        set li [lindex $lines [expr {$i-1}]]
5921        set r1 [lindex $li 1]
5922        if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5923            set joinlow 1
5924        }
5925    }
5926
5927    set x [lindex $cols [expr {$le - $row}]]
5928    set xp [lindex $cols [expr {$le - 1 - $row}]]
5929    set dir [expr {$xp - $x}]
5930    if {$joinhigh} {
5931        set ith [lindex $lines $i 2]
5932        set coords [$canv coords $ith]
5933        set ah [$canv itemcget $ith -arrow]
5934        set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5935        set x2 [lindex $cols [expr {$le + 1 - $row}]]
5936        if {$x2 ne {} && $x - $x2 == $dir} {
5937            set coords [lrange $coords 0 end-2]
5938        }
5939    } else {
5940        set coords [list [xc $le $x] [yc $le]]
5941    }
5942    if {$joinlow} {
5943        set itl [lindex $lines [expr {$i-1}] 2]
5944        set al [$canv itemcget $itl -arrow]
5945        set arrowlow [expr {$al eq "last" || $al eq "both"}]
5946    } elseif {$arrowlow} {
5947        if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5948            [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5949            set arrowlow 0
5950        }
5951    }
5952    set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5953    for {set y $le} {[incr y -1] > $row} {} {
5954        set x $xp
5955        set xp [lindex $cols [expr {$y - 1 - $row}]]
5956        set ndir [expr {$xp - $x}]
5957        if {$dir != $ndir || $xp < 0} {
5958            lappend coords [xc $y $x] [yc $y]
5959        }
5960        set dir $ndir
5961    }
5962    if {!$joinlow} {
5963        if {$xp < 0} {
5964            # join parent line to first child
5965            set ch [lindex $displayorder $row]
5966            set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5967            if {$xc < 0} {
5968                puts "oops: drawlineseg: child $ch not on row $row"
5969            } elseif {$xc != $x} {
5970                if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5971                    set d [expr {int(0.5 * $linespc)}]
5972                    set x1 [xc $row $x]
5973                    if {$xc < $x} {
5974                        set x2 [expr {$x1 - $d}]
5975                    } else {
5976                        set x2 [expr {$x1 + $d}]
5977                    }
5978                    set y2 [yc $row]
5979                    set y1 [expr {$y2 + $d}]
5980                    lappend coords $x1 $y1 $x2 $y2
5981                } elseif {$xc < $x - 1} {
5982                    lappend coords [xc $row [expr {$x-1}]] [yc $row]
5983                } elseif {$xc > $x + 1} {
5984                    lappend coords [xc $row [expr {$x+1}]] [yc $row]
5985                }
5986                set x $xc
5987            }
5988            lappend coords [xc $row $x] [yc $row]
5989        } else {
5990            set xn [xc $row $xp]
5991            set yn [yc $row]
5992            lappend coords $xn $yn
5993        }
5994        if {!$joinhigh} {
5995            assigncolor $id
5996            set t [$canv create line $coords -width [linewidth $id] \
5997                       -fill $colormap($id) -tags lines.$id -arrow $arrow]
5998            $canv lower $t
5999            bindline $t $id
6000            set lines [linsert $lines $i [list $row $le $t]]
6001        } else {
6002            $canv coords $ith $coords
6003            if {$arrow ne $ah} {
6004                $canv itemconf $ith -arrow $arrow
6005            }
6006            lset lines $i 0 $row
6007        }
6008    } else {
6009        set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
6010        set ndir [expr {$xo - $xp}]
6011        set clow [$canv coords $itl]
6012        if {$dir == $ndir} {
6013            set clow [lrange $clow 2 end]
6014        }
6015        set coords [concat $coords $clow]
6016        if {!$joinhigh} {
6017            lset lines [expr {$i-1}] 1 $le
6018        } else {
6019            # coalesce two pieces
6020            $canv delete $ith
6021            set b [lindex $lines [expr {$i-1}] 0]
6022            set e [lindex $lines $i 1]
6023            set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
6024        }
6025        $canv coords $itl $coords
6026        if {$arrow ne $al} {
6027            $canv itemconf $itl -arrow $arrow
6028        }
6029    }
6030
6031    set linesegs($id) $lines
6032    return $le
6033}
6034
6035proc drawparentlinks {id row} {
6036    global rowidlist canv colormap curview parentlist
6037    global idpos linespc
6038
6039    set rowids [lindex $rowidlist $row]
6040    set col [lsearch -exact $rowids $id]
6041    if {$col < 0} return
6042    set olds [lindex $parentlist $row]
6043    set row2 [expr {$row + 1}]
6044    set x [xc $row $col]
6045    set y [yc $row]
6046    set y2 [yc $row2]
6047    set d [expr {int(0.5 * $linespc)}]
6048    set ymid [expr {$y + $d}]
6049    set ids [lindex $rowidlist $row2]
6050    # rmx = right-most X coord used
6051    set rmx 0
6052    foreach p $olds {
6053        set i [lsearch -exact $ids $p]
6054        if {$i < 0} {
6055            puts "oops, parent $p of $id not in list"
6056            continue
6057        }
6058        set x2 [xc $row2 $i]
6059        if {$x2 > $rmx} {
6060            set rmx $x2
6061        }
6062        set j [lsearch -exact $rowids $p]
6063        if {$j < 0} {
6064            # drawlineseg will do this one for us
6065            continue
6066        }
6067        assigncolor $p
6068        # should handle duplicated parents here...
6069        set coords [list $x $y]
6070        if {$i != $col} {
6071            # if attaching to a vertical segment, draw a smaller
6072            # slant for visual distinctness
6073            if {$i == $j} {
6074                if {$i < $col} {
6075                    lappend coords [expr {$x2 + $d}] $y $x2 $ymid
6076                } else {
6077                    lappend coords [expr {$x2 - $d}] $y $x2 $ymid
6078                }
6079            } elseif {$i < $col && $i < $j} {
6080                # segment slants towards us already
6081                lappend coords [xc $row $j] $y
6082            } else {
6083                if {$i < $col - 1} {
6084                    lappend coords [expr {$x2 + $linespc}] $y
6085                } elseif {$i > $col + 1} {
6086                    lappend coords [expr {$x2 - $linespc}] $y
6087                }
6088                lappend coords $x2 $y2
6089            }
6090        } else {
6091            lappend coords $x2 $y2
6092        }
6093        set t [$canv create line $coords -width [linewidth $p] \
6094                   -fill $colormap($p) -tags lines.$p]
6095        $canv lower $t
6096        bindline $t $p
6097    }
6098    if {$rmx > [lindex $idpos($id) 1]} {
6099        lset idpos($id) 1 $rmx
6100        redrawtags $id
6101    }
6102}
6103
6104proc drawlines {id} {
6105    global canv
6106
6107    $canv itemconf lines.$id -width [linewidth $id]
6108}
6109
6110proc drawcmittext {id row col} {
6111    global linespc canv canv2 canv3 fgcolor curview
6112    global cmitlisted commitinfo rowidlist parentlist
6113    global rowtextx idpos idtags idheads idotherrefs
6114    global linehtag linentag linedtag selectedline
6115    global canvxmax boldids boldnameids fgcolor markedid
6116    global mainheadid nullid nullid2 circleitem circlecolors ctxbut
6117    global mainheadcirclecolor workingfilescirclecolor indexcirclecolor
6118    global circleoutlinecolor
6119
6120    # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
6121    set listed $cmitlisted($curview,$id)
6122    if {$id eq $nullid} {
6123        set ofill $workingfilescirclecolor
6124    } elseif {$id eq $nullid2} {
6125        set ofill $indexcirclecolor
6126    } elseif {$id eq $mainheadid} {
6127        set ofill $mainheadcirclecolor
6128    } else {
6129        set ofill [lindex $circlecolors $listed]
6130    }
6131    set x [xc $row $col]
6132    set y [yc $row]
6133    set orad [expr {$linespc / 3}]
6134    if {$listed <= 2} {
6135        set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
6136                   [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6137                   -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6138    } elseif {$listed == 3} {
6139        # triangle pointing left for left-side commits
6140        set t [$canv create polygon \
6141                   [expr {$x - $orad}] $y \
6142                   [expr {$x + $orad - 1}] [expr {$y - $orad}] \
6143                   [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6144                   -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6145    } else {
6146        # triangle pointing right for right-side commits
6147        set t [$canv create polygon \
6148                   [expr {$x + $orad - 1}] $y \
6149                   [expr {$x - $orad}] [expr {$y - $orad}] \
6150                   [expr {$x - $orad}] [expr {$y + $orad - 1}] \
6151                   -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6152    }
6153    set circleitem($row) $t
6154    $canv raise $t
6155    $canv bind $t <1> {selcanvline {} %x %y}
6156    set rmx [llength [lindex $rowidlist $row]]
6157    set olds [lindex $parentlist $row]
6158    if {$olds ne {}} {
6159        set nextids [lindex $rowidlist [expr {$row + 1}]]
6160        foreach p $olds {
6161            set i [lsearch -exact $nextids $p]
6162            if {$i > $rmx} {
6163                set rmx $i
6164            }
6165        }
6166    }
6167    set xt [xc $row $rmx]
6168    set rowtextx($row) $xt
6169    set idpos($id) [list $x $xt $y]
6170    if {[info exists idtags($id)] || [info exists idheads($id)]
6171        || [info exists idotherrefs($id)]} {
6172        set xt [drawtags $id $x $xt $y]
6173    }
6174    if {[lindex $commitinfo($id) 6] > 0} {
6175        set xt [drawnotesign $xt $y]
6176    }
6177    set headline [lindex $commitinfo($id) 0]
6178    set name [lindex $commitinfo($id) 1]
6179    set date [lindex $commitinfo($id) 2]
6180    set date [formatdate $date]
6181    set font mainfont
6182    set nfont mainfont
6183    set isbold [ishighlighted $id]
6184    if {$isbold > 0} {
6185        lappend boldids $id
6186        set font mainfontbold
6187        if {$isbold > 1} {
6188            lappend boldnameids $id
6189            set nfont mainfontbold
6190        }
6191    }
6192    set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
6193                           -text $headline -font $font -tags text]
6194    $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
6195    set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
6196                           -text $name -font $nfont -tags text]
6197    set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
6198                           -text $date -font mainfont -tags text]
6199    if {$selectedline == $row} {
6200        make_secsel $id
6201    }
6202    if {[info exists markedid] && $markedid eq $id} {
6203        make_idmark $id
6204    }
6205    set xr [expr {$xt + [font measure $font $headline]}]
6206    if {$xr > $canvxmax} {
6207        set canvxmax $xr
6208        setcanvscroll
6209    }
6210}
6211
6212proc drawcmitrow {row} {
6213    global displayorder rowidlist nrows_drawn
6214    global iddrawn markingmatches
6215    global commitinfo numcommits
6216    global filehighlight fhighlights findpattern nhighlights
6217    global hlview vhighlights
6218    global highlight_related rhighlights
6219
6220    if {$row >= $numcommits} return
6221
6222    set id [lindex $displayorder $row]
6223    if {[info exists hlview] && ![info exists vhighlights($id)]} {
6224        askvhighlight $row $id
6225    }
6226    if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
6227        askfilehighlight $row $id
6228    }
6229    if {$findpattern ne {} && ![info exists nhighlights($id)]} {
6230        askfindhighlight $row $id
6231    }
6232    if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
6233        askrelhighlight $row $id
6234    }
6235    if {![info exists iddrawn($id)]} {
6236        set col [lsearch -exact [lindex $rowidlist $row] $id]
6237        if {$col < 0} {
6238            puts "oops, row $row id $id not in list"
6239            return
6240        }
6241        if {![info exists commitinfo($id)]} {
6242            getcommit $id
6243        }
6244        assigncolor $id
6245        drawcmittext $id $row $col
6246        set iddrawn($id) 1
6247        incr nrows_drawn
6248    }
6249    if {$markingmatches} {
6250        markrowmatches $row $id
6251    }
6252}
6253
6254proc drawcommits {row {endrow {}}} {
6255    global numcommits iddrawn displayorder curview need_redisplay
6256    global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
6257
6258    if {$row < 0} {
6259        set row 0
6260    }
6261    if {$endrow eq {}} {
6262        set endrow $row
6263    }
6264    if {$endrow >= $numcommits} {
6265        set endrow [expr {$numcommits - 1}]
6266    }
6267
6268    set rl1 [expr {$row - $downarrowlen - 3}]
6269    if {$rl1 < 0} {
6270        set rl1 0
6271    }
6272    set ro1 [expr {$row - 3}]
6273    if {$ro1 < 0} {
6274        set ro1 0
6275    }
6276    set r2 [expr {$endrow + $uparrowlen + 3}]
6277    if {$r2 > $numcommits} {
6278        set r2 $numcommits
6279    }
6280    for {set r $rl1} {$r < $r2} {incr r} {
6281        if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
6282            if {$rl1 < $r} {
6283                layoutrows $rl1 $r
6284            }
6285            set rl1 [expr {$r + 1}]
6286        }
6287    }
6288    if {$rl1 < $r} {
6289        layoutrows $rl1 $r
6290    }
6291    optimize_rows $ro1 0 $r2
6292    if {$need_redisplay || $nrows_drawn > 2000} {
6293        clear_display
6294    }
6295
6296    # make the lines join to already-drawn rows either side
6297    set r [expr {$row - 1}]
6298    if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
6299        set r $row
6300    }
6301    set er [expr {$endrow + 1}]
6302    if {$er >= $numcommits ||
6303        ![info exists iddrawn([lindex $displayorder $er])]} {
6304        set er $endrow
6305    }
6306    for {} {$r <= $er} {incr r} {
6307        set id [lindex $displayorder $r]
6308        set wasdrawn [info exists iddrawn($id)]
6309        drawcmitrow $r
6310        if {$r == $er} break
6311        set nextid [lindex $displayorder [expr {$r + 1}]]
6312        if {$wasdrawn && [info exists iddrawn($nextid)]} continue
6313        drawparentlinks $id $r
6314
6315        set rowids [lindex $rowidlist $r]
6316        foreach lid $rowids {
6317            if {$lid eq {}} continue
6318            if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
6319            if {$lid eq $id} {
6320                # see if this is the first child of any of its parents
6321                foreach p [lindex $parentlist $r] {
6322                    if {[lsearch -exact $rowids $p] < 0} {
6323                        # make this line extend up to the child
6324                        set lineend($p) [drawlineseg $p $r $er 0]
6325                    }
6326                }
6327            } else {
6328                set lineend($lid) [drawlineseg $lid $r $er 1]
6329            }
6330        }
6331    }
6332}
6333
6334proc undolayout {row} {
6335    global uparrowlen mingaplen downarrowlen
6336    global rowidlist rowisopt rowfinal need_redisplay
6337
6338    set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
6339    if {$r < 0} {
6340        set r 0
6341    }
6342    if {[llength $rowidlist] > $r} {
6343        incr r -1
6344        set rowidlist [lrange $rowidlist 0 $r]
6345        set rowfinal [lrange $rowfinal 0 $r]
6346        set rowisopt [lrange $rowisopt 0 $r]
6347        set need_redisplay 1
6348        run drawvisible
6349    }
6350}
6351
6352proc drawvisible {} {
6353    global canv linespc curview vrowmod selectedline targetrow targetid
6354    global need_redisplay cscroll numcommits
6355
6356    set fs [$canv yview]
6357    set ymax [lindex [$canv cget -scrollregion] 3]
6358    if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
6359    set f0 [lindex $fs 0]
6360    set f1 [lindex $fs 1]
6361    set y0 [expr {int($f0 * $ymax)}]
6362    set y1 [expr {int($f1 * $ymax)}]
6363
6364    if {[info exists targetid]} {
6365        if {[commitinview $targetid $curview]} {
6366            set r [rowofcommit $targetid]
6367            if {$r != $targetrow} {
6368                # Fix up the scrollregion and change the scrolling position
6369                # now that our target row has moved.
6370                set diff [expr {($r - $targetrow) * $linespc}]
6371                set targetrow $r
6372                setcanvscroll
6373                set ymax [lindex [$canv cget -scrollregion] 3]
6374                incr y0 $diff
6375                incr y1 $diff
6376                set f0 [expr {$y0 / $ymax}]
6377                set f1 [expr {$y1 / $ymax}]
6378                allcanvs yview moveto $f0
6379                $cscroll set $f0 $f1
6380                set need_redisplay 1
6381            }
6382        } else {
6383            unset targetid
6384        }
6385    }
6386
6387    set row [expr {int(($y0 - 3) / $linespc) - 1}]
6388    set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
6389    if {$endrow >= $vrowmod($curview)} {
6390        update_arcrows $curview
6391    }
6392    if {$selectedline ne {} &&
6393        $row <= $selectedline && $selectedline <= $endrow} {
6394        set targetrow $selectedline
6395    } elseif {[info exists targetid]} {
6396        set targetrow [expr {int(($row + $endrow) / 2)}]
6397    }
6398    if {[info exists targetrow]} {
6399        if {$targetrow >= $numcommits} {
6400            set targetrow [expr {$numcommits - 1}]
6401        }
6402        set targetid [commitonrow $targetrow]
6403    }
6404    drawcommits $row $endrow
6405}
6406
6407proc clear_display {} {
6408    global iddrawn linesegs need_redisplay nrows_drawn
6409    global vhighlights fhighlights nhighlights rhighlights
6410    global linehtag linentag linedtag boldids boldnameids
6411
6412    allcanvs delete all
6413    unset -nocomplain iddrawn
6414    unset -nocomplain linesegs
6415    unset -nocomplain linehtag
6416    unset -nocomplain linentag
6417    unset -nocomplain linedtag
6418    set boldids {}
6419    set boldnameids {}
6420    unset -nocomplain vhighlights
6421    unset -nocomplain fhighlights
6422    unset -nocomplain nhighlights
6423    unset -nocomplain rhighlights
6424    set need_redisplay 0
6425    set nrows_drawn 0
6426}
6427
6428proc findcrossings {id} {
6429    global rowidlist parentlist numcommits displayorder
6430
6431    set cross {}
6432    set ccross {}
6433    foreach {s e} [rowranges $id] {
6434        if {$e >= $numcommits} {
6435            set e [expr {$numcommits - 1}]
6436        }
6437        if {$e <= $s} continue
6438        for {set row $e} {[incr row -1] >= $s} {} {
6439            set x [lsearch -exact [lindex $rowidlist $row] $id]
6440            if {$x < 0} break
6441            set olds [lindex $parentlist $row]
6442            set kid [lindex $displayorder $row]
6443            set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
6444            if {$kidx < 0} continue
6445            set nextrow [lindex $rowidlist [expr {$row + 1}]]
6446            foreach p $olds {
6447                set px [lsearch -exact $nextrow $p]
6448                if {$px < 0} continue
6449                if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
6450                    if {[lsearch -exact $ccross $p] >= 0} continue
6451                    if {$x == $px + ($kidx < $px? -1: 1)} {
6452                        lappend ccross $p
6453                    } elseif {[lsearch -exact $cross $p] < 0} {
6454                        lappend cross $p
6455                    }
6456                }
6457            }
6458        }
6459    }
6460    return [concat $ccross {{}} $cross]
6461}
6462
6463proc assigncolor {id} {
6464    global colormap colors nextcolor
6465    global parents children children curview
6466
6467    if {[info exists colormap($id)]} return
6468    set ncolors [llength $colors]
6469    if {[info exists children($curview,$id)]} {
6470        set kids $children($curview,$id)
6471    } else {
6472        set kids {}
6473    }
6474    if {[llength $kids] == 1} {
6475        set child [lindex $kids 0]
6476        if {[info exists colormap($child)]
6477            && [llength $parents($curview,$child)] == 1} {
6478            set colormap($id) $colormap($child)
6479            return
6480        }
6481    }
6482    set badcolors {}
6483    set origbad {}
6484    foreach x [findcrossings $id] {
6485        if {$x eq {}} {
6486            # delimiter between corner crossings and other crossings
6487            if {[llength $badcolors] >= $ncolors - 1} break
6488            set origbad $badcolors
6489        }
6490        if {[info exists colormap($x)]
6491            && [lsearch -exact $badcolors $colormap($x)] < 0} {
6492            lappend badcolors $colormap($x)
6493        }
6494    }
6495    if {[llength $badcolors] >= $ncolors} {
6496        set badcolors $origbad
6497    }
6498    set origbad $badcolors
6499    if {[llength $badcolors] < $ncolors - 1} {
6500        foreach child $kids {
6501            if {[info exists colormap($child)]
6502                && [lsearch -exact $badcolors $colormap($child)] < 0} {
6503                lappend badcolors $colormap($child)
6504            }
6505            foreach p $parents($curview,$child) {
6506                if {[info exists colormap($p)]
6507                    && [lsearch -exact $badcolors $colormap($p)] < 0} {
6508                    lappend badcolors $colormap($p)
6509                }
6510            }
6511        }
6512        if {[llength $badcolors] >= $ncolors} {
6513            set badcolors $origbad
6514        }
6515    }
6516    for {set i 0} {$i <= $ncolors} {incr i} {
6517        set c [lindex $colors $nextcolor]
6518        if {[incr nextcolor] >= $ncolors} {
6519            set nextcolor 0
6520        }
6521        if {[lsearch -exact $badcolors $c]} break
6522    }
6523    set colormap($id) $c
6524}
6525
6526proc bindline {t id} {
6527    global canv
6528
6529    $canv bind $t <Enter> "lineenter %x %y $id"
6530    $canv bind $t <Motion> "linemotion %x %y $id"
6531    $canv bind $t <Leave> "lineleave $id"
6532    $canv bind $t <Button-1> "lineclick %x %y $id 1"
6533}
6534
6535proc graph_pane_width {} {
6536    global use_ttk
6537
6538    if {$use_ttk} {
6539        set g [.tf.histframe.pwclist sashpos 0]
6540    } else {
6541        set g [.tf.histframe.pwclist sash coord 0]
6542    }
6543    return [lindex $g 0]
6544}
6545
6546proc totalwidth {l font extra} {
6547    set tot 0
6548    foreach str $l {
6549        set tot [expr {$tot + [font measure $font $str] + $extra}]
6550    }
6551    return $tot
6552}
6553
6554proc drawtags {id x xt y1} {
6555    global idtags idheads idotherrefs mainhead
6556    global linespc lthickness
6557    global canv rowtextx curview fgcolor bgcolor ctxbut
6558    global headbgcolor headfgcolor headoutlinecolor remotebgcolor
6559    global tagbgcolor tagfgcolor tagoutlinecolor
6560    global reflinecolor
6561
6562    set marks {}
6563    set ntags 0
6564    set nheads 0
6565    set singletag 0
6566    set maxtags 3
6567    set maxtagpct 25
6568    set maxwidth [expr {[graph_pane_width] * $maxtagpct / 100}]
6569    set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6570    set extra [expr {$delta + $lthickness + $linespc}]
6571
6572    if {[info exists idtags($id)]} {
6573        set marks $idtags($id)
6574        set ntags [llength $marks]
6575        if {$ntags > $maxtags ||
6576            [totalwidth $marks mainfont $extra] > $maxwidth} {
6577            # show just a single "n tags..." tag
6578            set singletag 1
6579            if {$ntags == 1} {
6580                set marks [list "tag..."]
6581            } else {
6582                set marks [list [format "%d tags..." $ntags]]
6583            }
6584            set ntags 1
6585        }
6586    }
6587    if {[info exists idheads($id)]} {
6588        set marks [concat $marks $idheads($id)]
6589        set nheads [llength $idheads($id)]
6590    }
6591    if {[info exists idotherrefs($id)]} {
6592        set marks [concat $marks $idotherrefs($id)]
6593    }
6594    if {$marks eq {}} {
6595        return $xt
6596    }
6597
6598    set yt [expr {$y1 - 0.5 * $linespc}]
6599    set yb [expr {$yt + $linespc - 1}]
6600    set xvals {}
6601    set wvals {}
6602    set i -1
6603    foreach tag $marks {
6604        incr i
6605        if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
6606            set wid [font measure mainfontbold $tag]
6607        } else {
6608            set wid [font measure mainfont $tag]
6609        }
6610        lappend xvals $xt
6611        lappend wvals $wid
6612        set xt [expr {$xt + $wid + $extra}]
6613    }
6614    set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
6615               -width $lthickness -fill $reflinecolor -tags tag.$id]
6616    $canv lower $t
6617    foreach tag $marks x $xvals wid $wvals {
6618        set tag_quoted [string map {% %%} $tag]
6619        set xl [expr {$x + $delta}]
6620        set xr [expr {$x + $delta + $wid + $lthickness}]
6621        set font mainfont
6622        if {[incr ntags -1] >= 0} {
6623            # draw a tag
6624            set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6625                       $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
6626                       -width 1 -outline $tagoutlinecolor -fill $tagbgcolor \
6627                       -tags tag.$id]
6628            if {$singletag} {
6629                set tagclick [list showtags $id 1]
6630            } else {
6631                set tagclick [list showtag $tag_quoted 1]
6632            }
6633            $canv bind $t <1> $tagclick
6634            set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
6635        } else {
6636            # draw a head or other ref
6637            if {[incr nheads -1] >= 0} {
6638                set col $headbgcolor
6639                if {$tag eq $mainhead} {
6640                    set font mainfontbold
6641                }
6642            } else {
6643                set col "#ddddff"
6644            }
6645            set xl [expr {$xl - $delta/2}]
6646            $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
6647                -width 1 -outline black -fill $col -tags tag.$id
6648            if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
6649                set rwid [font measure mainfont $remoteprefix]
6650                set xi [expr {$x + 1}]
6651                set yti [expr {$yt + 1}]
6652                set xri [expr {$x + $rwid}]
6653                $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6654                        -width 0 -fill $remotebgcolor -tags tag.$id
6655            }
6656        }
6657        set t [$canv create text $xl $y1 -anchor w -text $tag -fill $headfgcolor \
6658                   -font $font -tags [list tag.$id text]]
6659        if {$ntags >= 0} {
6660            $canv bind $t <1> $tagclick
6661        } elseif {$nheads >= 0} {
6662            $canv bind $t $ctxbut [list headmenu %X %Y $id $tag_quoted]
6663        }
6664    }
6665    return $xt
6666}
6667
6668proc drawnotesign {xt y} {
6669    global linespc canv fgcolor
6670
6671    set orad [expr {$linespc / 3}]
6672    set t [$canv create rectangle [expr {$xt - $orad}] [expr {$y - $orad}] \
6673               [expr {$xt + $orad - 1}] [expr {$y + $orad - 1}] \
6674               -fill yellow -outline $fgcolor -width 1 -tags circle]
6675    set xt [expr {$xt + $orad * 3}]
6676    return $xt
6677}
6678
6679proc xcoord {i level ln} {
6680    global canvx0 xspc1 xspc2
6681
6682    set x [expr {$canvx0 + $i * $xspc1($ln)}]
6683    if {$i > 0 && $i == $level} {
6684        set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6685    } elseif {$i > $level} {
6686        set x [expr {$x + $xspc2 - $xspc1($ln)}]
6687    }
6688    return $x
6689}
6690
6691proc show_status {msg} {
6692    global canv fgcolor
6693
6694    clear_display
6695    set_window_title
6696    $canv create text 3 3 -anchor nw -text $msg -font mainfont \
6697        -tags text -fill $fgcolor
6698}
6699
6700# Don't change the text pane cursor if it is currently the hand cursor,
6701# showing that we are over a sha1 ID link.
6702proc settextcursor {c} {
6703    global ctext curtextcursor
6704
6705    if {[$ctext cget -cursor] == $curtextcursor} {
6706        $ctext config -cursor $c
6707    }
6708    set curtextcursor $c
6709}
6710
6711proc nowbusy {what {name {}}} {
6712    global isbusy busyname statusw
6713
6714    if {[array names isbusy] eq {}} {
6715        . config -cursor watch
6716        settextcursor watch
6717    }
6718    set isbusy($what) 1
6719    set busyname($what) $name
6720    if {$name ne {}} {
6721        $statusw conf -text $name
6722    }
6723}
6724
6725proc notbusy {what} {
6726    global isbusy maincursor textcursor busyname statusw
6727
6728    catch {
6729        unset isbusy($what)
6730        if {$busyname($what) ne {} &&
6731            [$statusw cget -text] eq $busyname($what)} {
6732            $statusw conf -text {}
6733        }
6734    }
6735    if {[array names isbusy] eq {}} {
6736        . config -cursor $maincursor
6737        settextcursor $textcursor
6738    }
6739}
6740
6741proc findmatches {f} {
6742    global findtype findstring
6743    if {$findtype == [mc "Regexp"]} {
6744        set matches [regexp -indices -all -inline $findstring $f]
6745    } else {
6746        set fs $findstring
6747        if {$findtype == [mc "IgnCase"]} {
6748            set f [string tolower $f]
6749            set fs [string tolower $fs]
6750        }
6751        set matches {}
6752        set i 0
6753        set l [string length $fs]
6754        while {[set j [string first $fs $f $i]] >= 0} {
6755            lappend matches [list $j [expr {$j+$l-1}]]
6756            set i [expr {$j + $l}]
6757        }
6758    }
6759    return $matches
6760}
6761
6762proc dofind {{dirn 1} {wrap 1}} {
6763    global findstring findstartline findcurline selectedline numcommits
6764    global gdttype filehighlight fh_serial find_dirn findallowwrap
6765
6766    if {[info exists find_dirn]} {
6767        if {$find_dirn == $dirn} return
6768        stopfinding
6769    }
6770    focus .
6771    if {$findstring eq {} || $numcommits == 0} return
6772    if {$selectedline eq {}} {
6773        set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6774    } else {
6775        set findstartline $selectedline
6776    }
6777    set findcurline $findstartline
6778    nowbusy finding [mc "Searching"]
6779    if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6780        after cancel do_file_hl $fh_serial
6781        do_file_hl $fh_serial
6782    }
6783    set find_dirn $dirn
6784    set findallowwrap $wrap
6785    run findmore
6786}
6787
6788proc stopfinding {} {
6789    global find_dirn findcurline fprogcoord
6790
6791    if {[info exists find_dirn]} {
6792        unset find_dirn
6793        unset findcurline
6794        notbusy finding
6795        set fprogcoord 0
6796        adjustprogress
6797    }
6798    stopblaming
6799}
6800
6801proc findmore {} {
6802    global commitdata commitinfo numcommits findpattern findloc
6803    global findstartline findcurline findallowwrap
6804    global find_dirn gdttype fhighlights fprogcoord
6805    global curview varcorder vrownum varccommits vrowmod
6806
6807    if {![info exists find_dirn]} {
6808        return 0
6809    }
6810    set fldtypes [list [mc "Headline"] [mc "Author"] "" [mc "Committer"] "" [mc "Comments"]]
6811    set l $findcurline
6812    set moretodo 0
6813    if {$find_dirn > 0} {
6814        incr l
6815        if {$l >= $numcommits} {
6816            set l 0
6817        }
6818        if {$l <= $findstartline} {
6819            set lim [expr {$findstartline + 1}]
6820        } else {
6821            set lim $numcommits
6822            set moretodo $findallowwrap
6823        }
6824    } else {
6825        if {$l == 0} {
6826            set l $numcommits
6827        }
6828        incr l -1
6829        if {$l >= $findstartline} {
6830            set lim [expr {$findstartline - 1}]
6831        } else {
6832            set lim -1
6833            set moretodo $findallowwrap
6834        }
6835    }
6836    set n [expr {($lim - $l) * $find_dirn}]
6837    if {$n > 500} {
6838        set n 500
6839        set moretodo 1
6840    }
6841    if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6842        update_arcrows $curview
6843    }
6844    set found 0
6845    set domore 1
6846    set ai [bsearch $vrownum($curview) $l]
6847    set a [lindex $varcorder($curview) $ai]
6848    set arow [lindex $vrownum($curview) $ai]
6849    set ids [lindex $varccommits($curview,$a)]
6850    set arowend [expr {$arow + [llength $ids]}]
6851    if {$gdttype eq [mc "containing:"]} {
6852        for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6853            if {$l < $arow || $l >= $arowend} {
6854                incr ai $find_dirn
6855                set a [lindex $varcorder($curview) $ai]
6856                set arow [lindex $vrownum($curview) $ai]
6857                set ids [lindex $varccommits($curview,$a)]
6858                set arowend [expr {$arow + [llength $ids]}]
6859            }
6860            set id [lindex $ids [expr {$l - $arow}]]
6861            # shouldn't happen unless git log doesn't give all the commits...
6862            if {![info exists commitdata($id)] ||
6863                ![doesmatch $commitdata($id)]} {
6864                continue
6865            }
6866            if {![info exists commitinfo($id)]} {
6867                getcommit $id
6868            }
6869            set info $commitinfo($id)
6870            foreach f $info ty $fldtypes {
6871                if {$ty eq ""} continue
6872                if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6873                    [doesmatch $f]} {
6874                    set found 1
6875                    break
6876                }
6877            }
6878            if {$found} break
6879        }
6880    } else {
6881        for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6882            if {$l < $arow || $l >= $arowend} {
6883                incr ai $find_dirn
6884                set a [lindex $varcorder($curview) $ai]
6885                set arow [lindex $vrownum($curview) $ai]
6886                set ids [lindex $varccommits($curview,$a)]
6887                set arowend [expr {$arow + [llength $ids]}]
6888            }
6889            set id [lindex $ids [expr {$l - $arow}]]
6890            if {![info exists fhighlights($id)]} {
6891                # this sets fhighlights($id) to -1
6892                askfilehighlight $l $id
6893            }
6894            if {$fhighlights($id) > 0} {
6895                set found $domore
6896                break
6897            }
6898            if {$fhighlights($id) < 0} {
6899                if {$domore} {
6900                    set domore 0
6901                    set findcurline [expr {$l - $find_dirn}]
6902                }
6903            }
6904        }
6905    }
6906    if {$found || ($domore && !$moretodo)} {
6907        unset findcurline
6908        unset find_dirn
6909        notbusy finding
6910        set fprogcoord 0
6911        adjustprogress
6912        if {$found} {
6913            findselectline $l
6914        } else {
6915            bell
6916        }
6917        return 0
6918    }
6919    if {!$domore} {
6920        flushhighlights
6921    } else {
6922        set findcurline [expr {$l - $find_dirn}]
6923    }
6924    set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6925    if {$n < 0} {
6926        incr n $numcommits
6927    }
6928    set fprogcoord [expr {$n * 1.0 / $numcommits}]
6929    adjustprogress
6930    return $domore
6931}
6932
6933proc findselectline {l} {
6934    global findloc commentend ctext findcurline markingmatches gdttype
6935
6936    set markingmatches [expr {$gdttype eq [mc "containing:"]}]
6937    set findcurline $l
6938    selectline $l 1
6939    if {$markingmatches &&
6940        ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
6941        # highlight the matches in the comments
6942        set f [$ctext get 1.0 $commentend]
6943        set matches [findmatches $f]
6944        foreach match $matches {
6945            set start [lindex $match 0]
6946            set end [expr {[lindex $match 1] + 1}]
6947            $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6948        }
6949    }
6950    drawvisible
6951}
6952
6953# mark the bits of a headline or author that match a find string
6954proc markmatches {canv l str tag matches font row} {
6955    global selectedline
6956
6957    set bbox [$canv bbox $tag]
6958    set x0 [lindex $bbox 0]
6959    set y0 [lindex $bbox 1]
6960    set y1 [lindex $bbox 3]
6961    foreach match $matches {
6962        set start [lindex $match 0]
6963        set end [lindex $match 1]
6964        if {$start > $end} continue
6965        set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6966        set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6967        set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6968                   [expr {$x0+$xlen+2}] $y1 \
6969                   -outline {} -tags [list match$l matches] -fill yellow]
6970        $canv lower $t
6971        if {$row == $selectedline} {
6972            $canv raise $t secsel
6973        }
6974    }
6975}
6976
6977proc unmarkmatches {} {
6978    global markingmatches
6979
6980    allcanvs delete matches
6981    set markingmatches 0
6982    stopfinding
6983}
6984
6985proc selcanvline {w x y} {
6986    global canv canvy0 ctext linespc
6987    global rowtextx
6988    set ymax [lindex [$canv cget -scrollregion] 3]
6989    if {$ymax == {}} return
6990    set yfrac [lindex [$canv yview] 0]
6991    set y [expr {$y + $yfrac * $ymax}]
6992    set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6993    if {$l < 0} {
6994        set l 0
6995    }
6996    if {$w eq $canv} {
6997        set xmax [lindex [$canv cget -scrollregion] 2]
6998        set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6999        if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
7000    }
7001    unmarkmatches
7002    selectline $l 1
7003}
7004
7005proc commit_descriptor {p} {
7006    global commitinfo
7007    if {![info exists commitinfo($p)]} {
7008        getcommit $p
7009    }
7010    set l "..."
7011    if {[llength $commitinfo($p)] > 1} {
7012        set l [lindex $commitinfo($p) 0]
7013    }
7014    return "$p ($l)\n"
7015}
7016
7017# append some text to the ctext widget, and make any SHA1 ID
7018# that we know about be a clickable link.
7019proc appendwithlinks {text tags} {
7020    global ctext linknum curview
7021
7022    set start [$ctext index "end - 1c"]
7023    $ctext insert end $text $tags
7024    set links [regexp -indices -all -inline {(?:\m|-g)[0-9a-f]{6,40}\M} $text]
7025    foreach l $links {
7026        set s [lindex $l 0]
7027        set e [lindex $l 1]
7028        set linkid [string range $text $s $e]
7029        incr e
7030        $ctext tag delete link$linknum
7031        $ctext tag add link$linknum "$start + $s c" "$start + $e c"
7032        setlink $linkid link$linknum
7033        incr linknum
7034    }
7035}
7036
7037proc setlink {id lk} {
7038    global curview ctext pendinglinks
7039    global linkfgcolor
7040
7041    if {[string range $id 0 1] eq "-g"} {
7042      set id [string range $id 2 end]
7043    }
7044
7045    set known 0
7046    if {[string length $id] < 40} {
7047        set matches [longid $id]
7048        if {[llength $matches] > 0} {
7049            if {[llength $matches] > 1} return
7050            set known 1
7051            set id [lindex $matches 0]
7052        }
7053    } else {
7054        set known [commitinview $id $curview]
7055    }
7056    if {$known} {
7057        $ctext tag conf $lk -foreground $linkfgcolor -underline 1
7058        $ctext tag bind $lk <1> [list selbyid $id]
7059        $ctext tag bind $lk <Enter> {linkcursor %W 1}
7060        $ctext tag bind $lk <Leave> {linkcursor %W -1}
7061    } else {
7062        lappend pendinglinks($id) $lk
7063        interestedin $id {makelink %P}
7064    }
7065}
7066
7067proc appendshortlink {id {pre {}} {post {}}} {
7068    global ctext linknum
7069
7070    $ctext insert end $pre
7071    $ctext tag delete link$linknum
7072    $ctext insert end [string range $id 0 7] link$linknum
7073    $ctext insert end $post
7074    setlink $id link$linknum
7075    incr linknum
7076}
7077
7078proc makelink {id} {
7079    global pendinglinks
7080
7081    if {![info exists pendinglinks($id)]} return
7082    foreach lk $pendinglinks($id) {
7083        setlink $id $lk
7084    }
7085    unset pendinglinks($id)
7086}
7087
7088proc linkcursor {w inc} {
7089    global linkentercount curtextcursor
7090
7091    if {[incr linkentercount $inc] > 0} {
7092        $w configure -cursor hand2
7093    } else {
7094        $w configure -cursor $curtextcursor
7095        if {$linkentercount < 0} {
7096            set linkentercount 0
7097        }
7098    }
7099}
7100
7101proc viewnextline {dir} {
7102    global canv linespc
7103
7104    $canv delete hover
7105    set ymax [lindex [$canv cget -scrollregion] 3]
7106    set wnow [$canv yview]
7107    set wtop [expr {[lindex $wnow 0] * $ymax}]
7108    set newtop [expr {$wtop + $dir * $linespc}]
7109    if {$newtop < 0} {
7110        set newtop 0
7111    } elseif {$newtop > $ymax} {
7112        set newtop $ymax
7113    }
7114    allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7115}
7116
7117# add a list of tag or branch names at position pos
7118# returns the number of names inserted
7119proc appendrefs {pos ids var} {
7120    global ctext linknum curview $var maxrefs visiblerefs mainheadid
7121
7122    if {[catch {$ctext index $pos}]} {
7123        return 0
7124    }
7125    $ctext conf -state normal
7126    $ctext delete $pos "$pos lineend"
7127    set tags {}
7128    foreach id $ids {
7129        foreach tag [set $var\($id\)] {
7130            lappend tags [list $tag $id]
7131        }
7132    }
7133
7134    set sep {}
7135    set tags [lsort -index 0 -decreasing $tags]
7136    set nutags 0
7137
7138    if {[llength $tags] > $maxrefs} {
7139        # If we are displaying heads, and there are too many,
7140        # see if there are some important heads to display.
7141        # Currently that are the current head and heads listed in $visiblerefs option
7142        set itags {}
7143        if {$var eq "idheads"} {
7144            set utags {}
7145            foreach ti $tags {
7146                set hname [lindex $ti 0]
7147                set id [lindex $ti 1]
7148                if {([lsearch -exact $visiblerefs $hname] != -1 || $id eq $mainheadid) &&
7149                    [llength $itags] < $maxrefs} {
7150                    lappend itags $ti
7151                } else {
7152                    lappend utags $ti
7153                }
7154            }
7155            set tags $utags
7156        }
7157        if {$itags ne {}} {
7158            set str [mc "and many more"]
7159            set sep " "
7160        } else {
7161            set str [mc "many"]
7162        }
7163        $ctext insert $pos "$str ([llength $tags])"
7164        set nutags [llength $tags]
7165        set tags $itags
7166    }
7167
7168    foreach ti $tags {
7169        set id [lindex $ti 1]
7170        set lk link$linknum
7171        incr linknum
7172        $ctext tag delete $lk
7173        $ctext insert $pos $sep
7174        $ctext insert $pos [lindex $ti 0] $lk
7175        setlink $id $lk
7176        set sep ", "
7177    }
7178    $ctext tag add wwrap "$pos linestart" "$pos lineend"
7179    $ctext conf -state disabled
7180    return [expr {[llength $tags] + $nutags}]
7181}
7182
7183# called when we have finished computing the nearby tags
7184proc dispneartags {delay} {
7185    global selectedline currentid showneartags tagphase
7186
7187    if {$selectedline eq {} || !$showneartags} return
7188    after cancel dispnexttag
7189    if {$delay} {
7190        after 200 dispnexttag
7191        set tagphase -1
7192    } else {
7193        after idle dispnexttag
7194        set tagphase 0
7195    }
7196}
7197
7198proc dispnexttag {} {
7199    global selectedline currentid showneartags tagphase ctext
7200
7201    if {$selectedline eq {} || !$showneartags} return
7202    switch -- $tagphase {
7203        0 {
7204            set dtags [desctags $currentid]
7205            if {$dtags ne {}} {
7206                appendrefs precedes $dtags idtags
7207            }
7208        }
7209        1 {
7210            set atags [anctags $currentid]
7211            if {$atags ne {}} {
7212                appendrefs follows $atags idtags
7213            }
7214        }
7215        2 {
7216            set dheads [descheads $currentid]
7217            if {$dheads ne {}} {
7218                if {[appendrefs branch $dheads idheads] > 1
7219                    && [$ctext get "branch -3c"] eq "h"} {
7220                    # turn "Branch" into "Branches"
7221                    $ctext conf -state normal
7222                    $ctext insert "branch -2c" "es"
7223                    $ctext conf -state disabled
7224                }
7225            }
7226        }
7227    }
7228    if {[incr tagphase] <= 2} {
7229        after idle dispnexttag
7230    }
7231}
7232
7233proc make_secsel {id} {
7234    global linehtag linentag linedtag canv canv2 canv3
7235
7236    if {![info exists linehtag($id)]} return
7237    $canv delete secsel
7238    set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
7239               -tags secsel -fill [$canv cget -selectbackground]]
7240    $canv lower $t
7241    $canv2 delete secsel
7242    set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
7243               -tags secsel -fill [$canv2 cget -selectbackground]]
7244    $canv2 lower $t
7245    $canv3 delete secsel
7246    set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
7247               -tags secsel -fill [$canv3 cget -selectbackground]]
7248    $canv3 lower $t
7249}
7250
7251proc make_idmark {id} {
7252    global linehtag canv fgcolor
7253
7254    if {![info exists linehtag($id)]} return
7255    $canv delete markid
7256    set t [eval $canv create rect [$canv bbox $linehtag($id)] \
7257               -tags markid -outline $fgcolor]
7258    $canv raise $t
7259}
7260
7261proc selectline {l isnew {desired_loc {}} {switch_to_patch 0}} {
7262    global canv ctext commitinfo selectedline
7263    global canvy0 linespc parents children curview
7264    global currentid sha1entry
7265    global commentend idtags linknum
7266    global mergemax numcommits pending_select
7267    global cmitmode showneartags allcommits
7268    global targetrow targetid lastscrollrows
7269    global autoselect autosellen jump_to_here
7270    global vinlinediff
7271
7272    unset -nocomplain pending_select
7273    $canv delete hover
7274    normalline
7275    unsel_reflist
7276    stopfinding
7277    if {$l < 0 || $l >= $numcommits} return
7278    set id [commitonrow $l]
7279    set targetid $id
7280    set targetrow $l
7281    set selectedline $l
7282    set currentid $id
7283    if {$lastscrollrows < $numcommits} {
7284        setcanvscroll
7285    }
7286
7287    if {$cmitmode ne "patch" && $switch_to_patch} {
7288        set cmitmode "patch"
7289    }
7290
7291    set y [expr {$canvy0 + $l * $linespc}]
7292    set ymax [lindex [$canv cget -scrollregion] 3]
7293    set ytop [expr {$y - $linespc - 1}]
7294    set ybot [expr {$y + $linespc + 1}]
7295    set wnow [$canv yview]
7296    set wtop [expr {[lindex $wnow 0] * $ymax}]
7297    set wbot [expr {[lindex $wnow 1] * $ymax}]
7298    set wh [expr {$wbot - $wtop}]
7299    set newtop $wtop
7300    if {$ytop < $wtop} {
7301        if {$ybot < $wtop} {
7302            set newtop [expr {$y - $wh / 2.0}]
7303        } else {
7304            set newtop $ytop
7305            if {$newtop > $wtop - $linespc} {
7306                set newtop [expr {$wtop - $linespc}]
7307            }
7308        }
7309    } elseif {$ybot > $wbot} {
7310        if {$ytop > $wbot} {
7311            set newtop [expr {$y - $wh / 2.0}]
7312        } else {
7313            set newtop [expr {$ybot - $wh}]
7314            if {$newtop < $wtop + $linespc} {
7315                set newtop [expr {$wtop + $linespc}]
7316            }
7317        }
7318    }
7319    if {$newtop != $wtop} {
7320        if {$newtop < 0} {
7321            set newtop 0
7322        }
7323        allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7324        drawvisible
7325    }
7326
7327    make_secsel $id
7328
7329    if {$isnew} {
7330        addtohistory [list selbyid $id 0] savecmitpos
7331    }
7332
7333    $sha1entry delete 0 end
7334    $sha1entry insert 0 $id
7335    if {$autoselect} {
7336        $sha1entry selection range 0 $autosellen
7337    }
7338    rhighlight_sel $id
7339
7340    $ctext conf -state normal
7341    clear_ctext
7342    set linknum 0
7343    if {![info exists commitinfo($id)]} {
7344        getcommit $id
7345    }
7346    set info $commitinfo($id)
7347    set date [formatdate [lindex $info 2]]
7348    $ctext insert end "[mc "Author"]: [lindex $info 1]  $date\n"
7349    set date [formatdate [lindex $info 4]]
7350    $ctext insert end "[mc "Committer"]: [lindex $info 3]  $date\n"
7351    if {[info exists idtags($id)]} {
7352        $ctext insert end [mc "Tags:"]
7353        foreach tag $idtags($id) {
7354            $ctext insert end " $tag"
7355        }
7356        $ctext insert end "\n"
7357    }
7358
7359    set headers {}
7360    set olds $parents($curview,$id)
7361    if {[llength $olds] > 1} {
7362        set np 0
7363        foreach p $olds {
7364            if {$np >= $mergemax} {
7365                set tag mmax
7366            } else {
7367                set tag m$np
7368            }
7369            $ctext insert end "[mc "Parent"]: " $tag
7370            appendwithlinks [commit_descriptor $p] {}
7371            incr np
7372        }
7373    } else {
7374        foreach p $olds {
7375            append headers "[mc "Parent"]: [commit_descriptor $p]"
7376        }
7377    }
7378
7379    foreach c $children($curview,$id) {
7380        append headers "[mc "Child"]:  [commit_descriptor $c]"
7381    }
7382
7383    # make anything that looks like a SHA1 ID be a clickable link
7384    appendwithlinks $headers {}
7385    if {$showneartags} {
7386        if {![info exists allcommits]} {
7387            getallcommits
7388        }
7389        $ctext insert end "[mc "Branch"]: "
7390        $ctext mark set branch "end -1c"
7391        $ctext mark gravity branch left
7392        $ctext insert end "\n[mc "Follows"]: "
7393        $ctext mark set follows "end -1c"
7394        $ctext mark gravity follows left
7395        $ctext insert end "\n[mc "Precedes"]: "
7396        $ctext mark set precedes "end -1c"
7397        $ctext mark gravity precedes left
7398        $ctext insert end "\n"
7399        dispneartags 1
7400    }
7401    $ctext insert end "\n"
7402    set comment [lindex $info 5]
7403    if {[string first "\r" $comment] >= 0} {
7404        set comment [string map {"\r" "\n    "} $comment]
7405    }
7406    appendwithlinks $comment {comment}
7407
7408    $ctext tag remove found 1.0 end
7409    $ctext conf -state disabled
7410    set commentend [$ctext index "end - 1c"]
7411
7412    set jump_to_here $desired_loc
7413    init_flist [mc "Comments"]
7414    if {$cmitmode eq "tree"} {
7415        gettree $id
7416    } elseif {$vinlinediff($curview) == 1} {
7417        showinlinediff $id
7418    } elseif {[llength $olds] <= 1} {
7419        startdiff $id
7420    } else {
7421        mergediff $id
7422    }
7423}
7424
7425proc selfirstline {} {
7426    unmarkmatches
7427    selectline 0 1
7428}
7429
7430proc sellastline {} {
7431    global numcommits
7432    unmarkmatches
7433    set l [expr {$numcommits - 1}]
7434    selectline $l 1
7435}
7436
7437proc selnextline {dir} {
7438    global selectedline
7439    focus .
7440    if {$selectedline eq {}} return
7441    set l [expr {$selectedline + $dir}]
7442    unmarkmatches
7443    selectline $l 1
7444}
7445
7446proc selnextpage {dir} {
7447    global canv linespc selectedline numcommits
7448
7449    set lpp [expr {([winfo height $canv] - 2) / $linespc}]
7450    if {$lpp < 1} {
7451        set lpp 1
7452    }
7453    allcanvs yview scroll [expr {$dir * $lpp}] units
7454    drawvisible
7455    if {$selectedline eq {}} return
7456    set l [expr {$selectedline + $dir * $lpp}]
7457    if {$l < 0} {
7458        set l 0
7459    } elseif {$l >= $numcommits} {
7460        set l [expr $numcommits - 1]
7461    }
7462    unmarkmatches
7463    selectline $l 1
7464}
7465
7466proc unselectline {} {
7467    global selectedline currentid
7468
7469    set selectedline {}
7470    unset -nocomplain currentid
7471    allcanvs delete secsel
7472    rhighlight_none
7473}
7474
7475proc reselectline {} {
7476    global selectedline
7477
7478    if {$selectedline ne {}} {
7479        selectline $selectedline 0
7480    }
7481}
7482
7483proc addtohistory {cmd {saveproc {}}} {
7484    global history historyindex curview
7485
7486    unset_posvars
7487    save_position
7488    set elt [list $curview $cmd $saveproc {}]
7489    if {$historyindex > 0
7490        && [lindex $history [expr {$historyindex - 1}]] == $elt} {
7491        return
7492    }
7493
7494    if {$historyindex < [llength $history]} {
7495        set history [lreplace $history $historyindex end $elt]
7496    } else {
7497        lappend history $elt
7498    }
7499    incr historyindex
7500    if {$historyindex > 1} {
7501        .tf.bar.leftbut conf -state normal
7502    } else {
7503        .tf.bar.leftbut conf -state disabled
7504    }
7505    .tf.bar.rightbut conf -state disabled
7506}
7507
7508# save the scrolling position of the diff display pane
7509proc save_position {} {
7510    global historyindex history
7511
7512    if {$historyindex < 1} return
7513    set hi [expr {$historyindex - 1}]
7514    set fn [lindex $history $hi 2]
7515    if {$fn ne {}} {
7516        lset history $hi 3 [eval $fn]
7517    }
7518}
7519
7520proc unset_posvars {} {
7521    global last_posvars
7522
7523    if {[info exists last_posvars]} {
7524        foreach {var val} $last_posvars {
7525            global $var
7526            unset -nocomplain $var
7527        }
7528        unset last_posvars
7529    }
7530}
7531
7532proc godo {elt} {
7533    global curview last_posvars
7534
7535    set view [lindex $elt 0]
7536    set cmd [lindex $elt 1]
7537    set pv [lindex $elt 3]
7538    if {$curview != $view} {
7539        showview $view
7540    }
7541    unset_posvars
7542    foreach {var val} $pv {
7543        global $var
7544        set $var $val
7545    }
7546    set last_posvars $pv
7547    eval $cmd
7548}
7549
7550proc goback {} {
7551    global history historyindex
7552    focus .
7553
7554    if {$historyindex > 1} {
7555        save_position
7556        incr historyindex -1
7557        godo [lindex $history [expr {$historyindex - 1}]]
7558        .tf.bar.rightbut conf -state normal
7559    }
7560    if {$historyindex <= 1} {
7561        .tf.bar.leftbut conf -state disabled
7562    }
7563}
7564
7565proc goforw {} {
7566    global history historyindex
7567    focus .
7568
7569    if {$historyindex < [llength $history]} {
7570        save_position
7571        set cmd [lindex $history $historyindex]
7572        incr historyindex
7573        godo $cmd
7574        .tf.bar.leftbut conf -state normal
7575    }
7576    if {$historyindex >= [llength $history]} {
7577        .tf.bar.rightbut conf -state disabled
7578    }
7579}
7580
7581proc go_to_parent {i} {
7582    global parents curview targetid
7583    set ps $parents($curview,$targetid)
7584    if {[llength $ps] >= $i} {
7585        selbyid [lindex $ps [expr $i - 1]]
7586    }
7587}
7588
7589proc gettree {id} {
7590    global treefilelist treeidlist diffids diffmergeid treepending
7591    global nullid nullid2
7592
7593    set diffids $id
7594    unset -nocomplain diffmergeid
7595    if {![info exists treefilelist($id)]} {
7596        if {![info exists treepending]} {
7597            if {$id eq $nullid} {
7598                set cmd [list | git ls-files]
7599            } elseif {$id eq $nullid2} {
7600                set cmd [list | git ls-files --stage -t]
7601            } else {
7602                set cmd [list | git ls-tree -r $id]
7603            }
7604            if {[catch {set gtf [open $cmd r]}]} {
7605                return
7606            }
7607            set treepending $id
7608            set treefilelist($id) {}
7609            set treeidlist($id) {}
7610            fconfigure $gtf -blocking 0 -encoding binary
7611            filerun $gtf [list gettreeline $gtf $id]
7612        }
7613    } else {
7614        setfilelist $id
7615    }
7616}
7617
7618proc gettreeline {gtf id} {
7619    global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
7620
7621    set nl 0
7622    while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
7623        if {$diffids eq $nullid} {
7624            set fname $line
7625        } else {
7626            set i [string first "\t" $line]
7627            if {$i < 0} continue
7628            set fname [string range $line [expr {$i+1}] end]
7629            set line [string range $line 0 [expr {$i-1}]]
7630            if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7631            set sha1 [lindex $line 2]
7632            lappend treeidlist($id) $sha1
7633        }
7634        if {[string index $fname 0] eq "\""} {
7635            set fname [lindex $fname 0]
7636        }
7637        set fname [encoding convertfrom $fname]
7638        lappend treefilelist($id) $fname
7639    }
7640    if {![eof $gtf]} {
7641        return [expr {$nl >= 1000? 2: 1}]
7642    }
7643    close $gtf
7644    unset treepending
7645    if {$cmitmode ne "tree"} {
7646        if {![info exists diffmergeid]} {
7647            gettreediffs $diffids
7648        }
7649    } elseif {$id ne $diffids} {
7650        gettree $diffids
7651    } else {
7652        setfilelist $id
7653    }
7654    return 0
7655}
7656
7657proc showfile {f} {
7658    global treefilelist treeidlist diffids nullid nullid2
7659    global ctext_file_names ctext_file_lines
7660    global ctext commentend
7661
7662    set i [lsearch -exact $treefilelist($diffids) $f]
7663    if {$i < 0} {
7664        puts "oops, $f not in list for id $diffids"
7665        return
7666    }
7667    if {$diffids eq $nullid} {
7668        if {[catch {set bf [open $f r]} err]} {
7669            puts "oops, can't read $f: $err"
7670            return
7671        }
7672    } else {
7673        set blob [lindex $treeidlist($diffids) $i]
7674        if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7675            puts "oops, error reading blob $blob: $err"
7676            return
7677        }
7678    }
7679    fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7680    filerun $bf [list getblobline $bf $diffids]
7681    $ctext config -state normal
7682    clear_ctext $commentend
7683    lappend ctext_file_names $f
7684    lappend ctext_file_lines [lindex [split $commentend "."] 0]
7685    $ctext insert end "\n"
7686    $ctext insert end "$f\n" filesep
7687    $ctext config -state disabled
7688    $ctext yview $commentend
7689    settabs 0
7690}
7691
7692proc getblobline {bf id} {
7693    global diffids cmitmode ctext
7694
7695    if {$id ne $diffids || $cmitmode ne "tree"} {
7696        catch {close $bf}
7697        return 0
7698    }
7699    $ctext config -state normal
7700    set nl 0
7701    while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7702        $ctext insert end "$line\n"
7703    }
7704    if {[eof $bf]} {
7705        global jump_to_here ctext_file_names commentend
7706
7707        # delete last newline
7708        $ctext delete "end - 2c" "end - 1c"
7709        close $bf
7710        if {$jump_to_here ne {} &&
7711            [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7712            set lnum [expr {[lindex $jump_to_here 1] +
7713                            [lindex [split $commentend .] 0]}]
7714            mark_ctext_line $lnum
7715        }
7716        $ctext config -state disabled
7717        return 0
7718    }
7719    $ctext config -state disabled
7720    return [expr {$nl >= 1000? 2: 1}]
7721}
7722
7723proc mark_ctext_line {lnum} {
7724    global ctext markbgcolor
7725
7726    $ctext tag delete omark
7727    $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7728    $ctext tag conf omark -background $markbgcolor
7729    $ctext see $lnum.0
7730}
7731
7732proc mergediff {id} {
7733    global diffmergeid
7734    global diffids treediffs
7735    global parents curview
7736
7737    set diffmergeid $id
7738    set diffids $id
7739    set treediffs($id) {}
7740    set np [llength $parents($curview,$id)]
7741    settabs $np
7742    getblobdiffs $id
7743}
7744
7745proc startdiff {ids} {
7746    global treediffs diffids treepending diffmergeid nullid nullid2
7747
7748    settabs 1
7749    set diffids $ids
7750    unset -nocomplain diffmergeid
7751    if {![info exists treediffs($ids)] ||
7752        [lsearch -exact $ids $nullid] >= 0 ||
7753        [lsearch -exact $ids $nullid2] >= 0} {
7754        if {![info exists treepending]} {
7755            gettreediffs $ids
7756        }
7757    } else {
7758        addtocflist $ids
7759    }
7760}
7761
7762proc showinlinediff {ids} {
7763    global commitinfo commitdata ctext
7764    global treediffs
7765
7766    set info $commitinfo($ids)
7767    set diff [lindex $info 7]
7768    set difflines [split $diff "\n"]
7769
7770    initblobdiffvars
7771    set treediff {}
7772
7773    set inhdr 0
7774    foreach line $difflines {
7775        if {![string compare -length 5 "diff " $line]} {
7776            set inhdr 1
7777        } elseif {$inhdr && ![string compare -length 4 "+++ " $line]} {
7778            # offset also accounts for the b/ prefix
7779            lappend treediff [string range $line 6 end]
7780            set inhdr 0
7781        }
7782    }
7783
7784    set treediffs($ids) $treediff
7785    add_flist $treediff
7786
7787    $ctext conf -state normal
7788    foreach line $difflines {
7789        parseblobdiffline $ids $line
7790    }
7791    maybe_scroll_ctext 1
7792    $ctext conf -state disabled
7793}
7794
7795# If the filename (name) is under any of the passed filter paths
7796# then return true to include the file in the listing.
7797proc path_filter {filter name} {
7798    set worktree [gitworktree]
7799    foreach p $filter {
7800        set fq_p [file normalize $p]
7801        set fq_n [file normalize [file join $worktree $name]]
7802        if {[string match [file normalize $fq_p]* $fq_n]} {
7803            return 1
7804        }
7805    }
7806    return 0
7807}
7808
7809proc addtocflist {ids} {
7810    global treediffs
7811
7812    add_flist $treediffs($ids)
7813    getblobdiffs $ids
7814}
7815
7816proc diffcmd {ids flags} {
7817    global log_showroot nullid nullid2 git_version
7818
7819    set i [lsearch -exact $ids $nullid]
7820    set j [lsearch -exact $ids $nullid2]
7821    if {$i >= 0} {
7822        if {[llength $ids] > 1 && $j < 0} {
7823            # comparing working directory with some specific revision
7824            set cmd [concat | git diff-index $flags]
7825            if {$i == 0} {
7826                lappend cmd -R [lindex $ids 1]
7827            } else {
7828                lappend cmd [lindex $ids 0]
7829            }
7830        } else {
7831            # comparing working directory with index
7832            set cmd [concat | git diff-files $flags]
7833            if {$j == 1} {
7834                lappend cmd -R
7835            }
7836        }
7837    } elseif {$j >= 0} {
7838        if {[package vcompare $git_version "1.7.2"] >= 0} {
7839            set flags "$flags --ignore-submodules=dirty"
7840        }
7841        set cmd [concat | git diff-index --cached $flags]
7842        if {[llength $ids] > 1} {
7843            # comparing index with specific revision
7844            if {$j == 0} {
7845                lappend cmd -R [lindex $ids 1]
7846            } else {
7847                lappend cmd [lindex $ids 0]
7848            }
7849        } else {
7850            # comparing index with HEAD
7851            lappend cmd HEAD
7852        }
7853    } else {
7854        if {$log_showroot} {
7855            lappend flags --root
7856        }
7857        set cmd [concat | git diff-tree -r $flags $ids]
7858    }
7859    return $cmd
7860}
7861
7862proc gettreediffs {ids} {
7863    global treediff treepending limitdiffs vfilelimit curview
7864
7865    set cmd [diffcmd $ids {--no-commit-id}]
7866    if {$limitdiffs && $vfilelimit($curview) ne {}} {
7867            set cmd [concat $cmd -- $vfilelimit($curview)]
7868    }
7869    if {[catch {set gdtf [open $cmd r]}]} return
7870
7871    set treepending $ids
7872    set treediff {}
7873    fconfigure $gdtf -blocking 0 -encoding binary
7874    filerun $gdtf [list gettreediffline $gdtf $ids]
7875}
7876
7877proc gettreediffline {gdtf ids} {
7878    global treediff treediffs treepending diffids diffmergeid
7879    global cmitmode vfilelimit curview limitdiffs perfile_attrs
7880
7881    set nr 0
7882    set sublist {}
7883    set max 1000
7884    if {$perfile_attrs} {
7885        # cache_gitattr is slow, and even slower on win32 where we
7886        # have to invoke it for only about 30 paths at a time
7887        set max 500
7888        if {[tk windowingsystem] == "win32"} {
7889            set max 120
7890        }
7891    }
7892    while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7893        set i [string first "\t" $line]
7894        if {$i >= 0} {
7895            set file [string range $line [expr {$i+1}] end]
7896            if {[string index $file 0] eq "\""} {
7897                set file [lindex $file 0]
7898            }
7899            set file [encoding convertfrom $file]
7900            if {$file ne [lindex $treediff end]} {
7901                lappend treediff $file
7902                lappend sublist $file
7903            }
7904        }
7905    }
7906    if {$perfile_attrs} {
7907        cache_gitattr encoding $sublist
7908    }
7909    if {![eof $gdtf]} {
7910        return [expr {$nr >= $max? 2: 1}]
7911    }
7912    close $gdtf
7913    set treediffs($ids) $treediff
7914    unset treepending
7915    if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7916        gettree $diffids
7917    } elseif {$ids != $diffids} {
7918        if {![info exists diffmergeid]} {
7919            gettreediffs $diffids
7920        }
7921    } else {
7922        addtocflist $ids
7923    }
7924    return 0
7925}
7926
7927# empty string or positive integer
7928proc diffcontextvalidate {v} {
7929    return [regexp {^(|[1-9][0-9]*)$} $v]
7930}
7931
7932proc diffcontextchange {n1 n2 op} {
7933    global diffcontextstring diffcontext
7934
7935    if {[string is integer -strict $diffcontextstring]} {
7936        if {$diffcontextstring >= 0} {
7937            set diffcontext $diffcontextstring
7938            reselectline
7939        }
7940    }
7941}
7942
7943proc changeignorespace {} {
7944    reselectline
7945}
7946
7947proc changeworddiff {name ix op} {
7948    reselectline
7949}
7950
7951proc initblobdiffvars {} {
7952    global diffencoding targetline diffnparents
7953    global diffinhdr currdiffsubmod diffseehere
7954    set targetline {}
7955    set diffnparents 0
7956    set diffinhdr 0
7957    set diffencoding [get_path_encoding {}]
7958    set currdiffsubmod ""
7959    set diffseehere -1
7960}
7961
7962proc getblobdiffs {ids} {
7963    global blobdifffd diffids env
7964    global treediffs
7965    global diffcontext
7966    global ignorespace
7967    global worddiff
7968    global limitdiffs vfilelimit curview
7969    global git_version
7970
7971    set textconv {}
7972    if {[package vcompare $git_version "1.6.1"] >= 0} {
7973        set textconv "--textconv"
7974    }
7975    set submodule {}
7976    if {[package vcompare $git_version "1.6.6"] >= 0} {
7977        set submodule "--submodule"
7978    }
7979    set cmd [diffcmd $ids "-p $textconv $submodule  -C --cc --no-commit-id -U$diffcontext"]
7980    if {$ignorespace} {
7981        append cmd " -w"
7982    }
7983    if {$worddiff ne [mc "Line diff"]} {
7984        append cmd " --word-diff=porcelain"
7985    }
7986    if {$limitdiffs && $vfilelimit($curview) ne {}} {
7987        set cmd [concat $cmd -- $vfilelimit($curview)]
7988    }
7989    if {[catch {set bdf [open $cmd r]} err]} {
7990        error_popup [mc "Error getting diffs: %s" $err]
7991        return
7992    }
7993    fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
7994    set blobdifffd($ids) $bdf
7995    initblobdiffvars
7996    filerun $bdf [list getblobdiffline $bdf $diffids]
7997}
7998
7999proc savecmitpos {} {
8000    global ctext cmitmode
8001
8002    if {$cmitmode eq "tree"} {
8003        return {}
8004    }
8005    return [list target_scrollpos [$ctext index @0,0]]
8006}
8007
8008proc savectextpos {} {
8009    global ctext
8010
8011    return [list target_scrollpos [$ctext index @0,0]]
8012}
8013
8014proc maybe_scroll_ctext {ateof} {
8015    global ctext target_scrollpos
8016
8017    if {![info exists target_scrollpos]} return
8018    if {!$ateof} {
8019        set nlines [expr {[winfo height $ctext]
8020                          / [font metrics textfont -linespace]}]
8021        if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
8022    }
8023    $ctext yview $target_scrollpos
8024    unset target_scrollpos
8025}
8026
8027proc setinlist {var i val} {
8028    global $var
8029
8030    while {[llength [set $var]] < $i} {
8031        lappend $var {}
8032    }
8033    if {[llength [set $var]] == $i} {
8034        lappend $var $val
8035    } else {
8036        lset $var $i $val
8037    }
8038}
8039
8040proc makediffhdr {fname ids} {
8041    global ctext curdiffstart treediffs diffencoding
8042    global ctext_file_names jump_to_here targetline diffline
8043
8044    set fname [encoding convertfrom $fname]
8045    set diffencoding [get_path_encoding $fname]
8046    set i [lsearch -exact $treediffs($ids) $fname]
8047    if {$i >= 0} {
8048        setinlist difffilestart $i $curdiffstart
8049    }
8050    lset ctext_file_names end $fname
8051    set l [expr {(78 - [string length $fname]) / 2}]
8052    set pad [string range "----------------------------------------" 1 $l]
8053    $ctext insert $curdiffstart "$pad $fname $pad" filesep
8054    set targetline {}
8055    if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
8056        set targetline [lindex $jump_to_here 1]
8057    }
8058    set diffline 0
8059}
8060
8061proc blobdiffmaybeseehere {ateof} {
8062    global diffseehere
8063    if {$diffseehere >= 0} {
8064        mark_ctext_line [lindex [split $diffseehere .] 0]
8065    }
8066    maybe_scroll_ctext $ateof
8067}
8068
8069proc getblobdiffline {bdf ids} {
8070    global diffids blobdifffd
8071    global ctext
8072
8073    set nr 0
8074    $ctext conf -state normal
8075    while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
8076        if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
8077            # Older diff read. Abort it.
8078            catch {close $bdf}
8079            if {$ids != $diffids} {
8080                array unset blobdifffd $ids
8081            }
8082            return 0
8083        }
8084        parseblobdiffline $ids $line
8085    }
8086    $ctext conf -state disabled
8087    blobdiffmaybeseehere [eof $bdf]
8088    if {[eof $bdf]} {
8089        catch {close $bdf}
8090        array unset blobdifffd $ids
8091        return 0
8092    }
8093    return [expr {$nr >= 1000? 2: 1}]
8094}
8095
8096proc parseblobdiffline {ids line} {
8097    global ctext curdiffstart
8098    global diffnexthead diffnextnote difffilestart
8099    global ctext_file_names ctext_file_lines
8100    global diffinhdr treediffs mergemax diffnparents
8101    global diffencoding jump_to_here targetline diffline currdiffsubmod
8102    global worddiff diffseehere
8103
8104    if {![string compare -length 5 "diff " $line]} {
8105        if {![regexp {^diff (--cc|--git) } $line m type]} {
8106            set line [encoding convertfrom $line]
8107            $ctext insert end "$line\n" hunksep
8108            continue
8109        }
8110        # start of a new file
8111        set diffinhdr 1
8112        $ctext insert end "\n"
8113        set curdiffstart [$ctext index "end - 1c"]
8114        lappend ctext_file_names ""
8115        lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8116        $ctext insert end "\n" filesep
8117
8118        if {$type eq "--cc"} {
8119            # start of a new file in a merge diff
8120            set fname [string range $line 10 end]
8121            if {[lsearch -exact $treediffs($ids) $fname] < 0} {
8122                lappend treediffs($ids) $fname
8123                add_flist [list $fname]
8124            }
8125
8126        } else {
8127            set line [string range $line 11 end]
8128            # If the name hasn't changed the length will be odd,
8129            # the middle char will be a space, and the two bits either
8130            # side will be a/name and b/name, or "a/name" and "b/name".
8131            # If the name has changed we'll get "rename from" and
8132            # "rename to" or "copy from" and "copy to" lines following
8133            # this, and we'll use them to get the filenames.
8134            # This complexity is necessary because spaces in the
8135            # filename(s) don't get escaped.
8136            set l [string length $line]
8137            set i [expr {$l / 2}]
8138            if {!(($l & 1) && [string index $line $i] eq " " &&
8139                  [string range $line 2 [expr {$i - 1}]] eq \
8140                      [string range $line [expr {$i + 3}] end])} {
8141                return
8142            }
8143            # unescape if quoted and chop off the a/ from the front
8144            if {[string index $line 0] eq "\""} {
8145                set fname [string range [lindex $line 0] 2 end]
8146            } else {
8147                set fname [string range $line 2 [expr {$i - 1}]]
8148            }
8149        }
8150        makediffhdr $fname $ids
8151
8152    } elseif {![string compare -length 16 "* Unmerged path " $line]} {
8153        set fname [encoding convertfrom [string range $line 16 end]]
8154        $ctext insert end "\n"
8155        set curdiffstart [$ctext index "end - 1c"]
8156        lappend ctext_file_names $fname
8157        lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8158        $ctext insert end "$line\n" filesep
8159        set i [lsearch -exact $treediffs($ids) $fname]
8160        if {$i >= 0} {
8161            setinlist difffilestart $i $curdiffstart
8162        }
8163
8164    } elseif {![string compare -length 2 "@@" $line]} {
8165        regexp {^@@+} $line ats
8166        set line [encoding convertfrom $diffencoding $line]
8167        $ctext insert end "$line\n" hunksep
8168        if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
8169            set diffline $nl
8170        }
8171        set diffnparents [expr {[string length $ats] - 1}]
8172        set diffinhdr 0
8173
8174    } elseif {![string compare -length 10 "Submodule " $line]} {
8175        # start of a new submodule
8176        if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
8177            set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
8178        } else {
8179            set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
8180        }
8181        if {$currdiffsubmod != $fname} {
8182            $ctext insert end "\n";     # Add newline after commit message
8183        }
8184        set curdiffstart [$ctext index "end - 1c"]
8185        lappend ctext_file_names ""
8186        if {$currdiffsubmod != $fname} {
8187            lappend ctext_file_lines $fname
8188            makediffhdr $fname $ids
8189            set currdiffsubmod $fname
8190            $ctext insert end "\n$line\n" filesep
8191        } else {
8192            $ctext insert end "$line\n" filesep
8193        }
8194    } elseif {![string compare -length 3 "  >" $line]} {
8195        set $currdiffsubmod ""
8196        set line [encoding convertfrom $diffencoding $line]
8197        $ctext insert end "$line\n" dresult
8198    } elseif {![string compare -length 3 "  <" $line]} {
8199        set $currdiffsubmod ""
8200        set line [encoding convertfrom $diffencoding $line]
8201        $ctext insert end "$line\n" d0
8202    } elseif {$diffinhdr} {
8203        if {![string compare -length 12 "rename from " $line]} {
8204            set fname [string range $line [expr 6 + [string first " from " $line] ] end]
8205            if {[string index $fname 0] eq "\""} {
8206                set fname [lindex $fname 0]
8207            }
8208            set fname [encoding convertfrom $fname]
8209            set i [lsearch -exact $treediffs($ids) $fname]
8210            if {$i >= 0} {
8211                setinlist difffilestart $i $curdiffstart
8212            }
8213        } elseif {![string compare -length 10 $line "rename to "] ||
8214                  ![string compare -length 8 $line "copy to "]} {
8215            set fname [string range $line [expr 4 + [string first " to " $line] ] end]
8216            if {[string index $fname 0] eq "\""} {
8217                set fname [lindex $fname 0]
8218            }
8219            makediffhdr $fname $ids
8220        } elseif {[string compare -length 3 $line "---"] == 0} {
8221            # do nothing
8222            return
8223        } elseif {[string compare -length 3 $line "+++"] == 0} {
8224            set diffinhdr 0
8225            return
8226        }
8227        $ctext insert end "$line\n" filesep
8228
8229    } else {
8230        set line [string map {\x1A ^Z} \
8231                      [encoding convertfrom $diffencoding $line]]
8232        # parse the prefix - one ' ', '-' or '+' for each parent
8233        set prefix [string range $line 0 [expr {$diffnparents - 1}]]
8234        set tag [expr {$diffnparents > 1? "m": "d"}]
8235        set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
8236        set words_pre_markup ""
8237        set words_post_markup ""
8238        if {[string trim $prefix " -+"] eq {}} {
8239            # prefix only has " ", "-" and "+" in it: normal diff line
8240            set num [string first "-" $prefix]
8241            if {$dowords} {
8242                set line [string range $line 1 end]
8243            }
8244            if {$num >= 0} {
8245                # removed line, first parent with line is $num
8246                if {$num >= $mergemax} {
8247                    set num "max"
8248                }
8249                if {$dowords && $worddiff eq [mc "Markup words"]} {
8250                    $ctext insert end "\[-$line-\]" $tag$num
8251                } else {
8252                    $ctext insert end "$line" $tag$num
8253                }
8254                if {!$dowords} {
8255                    $ctext insert end "\n" $tag$num
8256                }
8257            } else {
8258                set tags {}
8259                if {[string first "+" $prefix] >= 0} {
8260                    # added line
8261                    lappend tags ${tag}result
8262                    if {$diffnparents > 1} {
8263                        set num [string first " " $prefix]
8264                        if {$num >= 0} {
8265                            if {$num >= $mergemax} {
8266                                set num "max"
8267                            }
8268                            lappend tags m$num
8269                        }
8270                    }
8271                    set words_pre_markup "{+"
8272                    set words_post_markup "+}"
8273                }
8274                if {$targetline ne {}} {
8275                    if {$diffline == $targetline} {
8276                        set diffseehere [$ctext index "end - 1 chars"]
8277                        set targetline {}
8278                    } else {
8279                        incr diffline
8280                    }
8281                }
8282                if {$dowords && $worddiff eq [mc "Markup words"]} {
8283                    $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
8284                } else {
8285                    $ctext insert end "$line" $tags
8286                }
8287                if {!$dowords} {
8288                    $ctext insert end "\n" $tags
8289                }
8290            }
8291        } elseif {$dowords && $prefix eq "~"} {
8292            $ctext insert end "\n" {}
8293        } else {
8294            # "\ No newline at end of file",
8295            # or something else we don't recognize
8296            $ctext insert end "$line\n" hunksep
8297        }
8298    }
8299}
8300
8301proc changediffdisp {} {
8302    global ctext diffelide
8303
8304    $ctext tag conf d0 -elide [lindex $diffelide 0]
8305    $ctext tag conf dresult -elide [lindex $diffelide 1]
8306}
8307
8308proc highlightfile {cline} {
8309    global cflist cflist_top
8310
8311    if {![info exists cflist_top]} return
8312
8313    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
8314    $cflist tag add highlight $cline.0 "$cline.0 lineend"
8315    $cflist see $cline.0
8316    set cflist_top $cline
8317}
8318
8319proc highlightfile_for_scrollpos {topidx} {
8320    global cmitmode difffilestart
8321
8322    if {$cmitmode eq "tree"} return
8323    if {![info exists difffilestart]} return
8324
8325    set top [lindex [split $topidx .] 0]
8326    if {$difffilestart eq {} || $top < [lindex $difffilestart 0]} {
8327        highlightfile 0
8328    } else {
8329        highlightfile [expr {[bsearch $difffilestart $top] + 2}]
8330    }
8331}
8332
8333proc prevfile {} {
8334    global difffilestart ctext cmitmode
8335
8336    if {$cmitmode eq "tree"} return
8337    set prev 0.0
8338    set here [$ctext index @0,0]
8339    foreach loc $difffilestart {
8340        if {[$ctext compare $loc >= $here]} {
8341            $ctext yview $prev
8342            return
8343        }
8344        set prev $loc
8345    }
8346    $ctext yview $prev
8347}
8348
8349proc nextfile {} {
8350    global difffilestart ctext cmitmode
8351
8352    if {$cmitmode eq "tree"} return
8353    set here [$ctext index @0,0]
8354    foreach loc $difffilestart {
8355        if {[$ctext compare $loc > $here]} {
8356            $ctext yview $loc
8357            return
8358        }
8359    }
8360}
8361
8362proc clear_ctext {{first 1.0}} {
8363    global ctext smarktop smarkbot
8364    global ctext_file_names ctext_file_lines
8365    global pendinglinks
8366
8367    set l [lindex [split $first .] 0]
8368    if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
8369        set smarktop $l
8370    }
8371    if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
8372        set smarkbot $l
8373    }
8374    $ctext delete $first end
8375    if {$first eq "1.0"} {
8376        unset -nocomplain pendinglinks
8377    }
8378    set ctext_file_names {}
8379    set ctext_file_lines {}
8380}
8381
8382proc settabs {{firstab {}}} {
8383    global firsttabstop tabstop ctext have_tk85
8384
8385    if {$firstab ne {} && $have_tk85} {
8386        set firsttabstop $firstab
8387    }
8388    set w [font measure textfont "0"]
8389    if {$firsttabstop != 0} {
8390        $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
8391                               [expr {($firsttabstop + 2 * $tabstop) * $w}]]
8392    } elseif {$have_tk85 || $tabstop != 8} {
8393        $ctext conf -tabs [expr {$tabstop * $w}]
8394    } else {
8395        $ctext conf -tabs {}
8396    }
8397}
8398
8399proc incrsearch {name ix op} {
8400    global ctext searchstring searchdirn
8401
8402    if {[catch {$ctext index anchor}]} {
8403        # no anchor set, use start of selection, or of visible area
8404        set sel [$ctext tag ranges sel]
8405        if {$sel ne {}} {
8406            $ctext mark set anchor [lindex $sel 0]
8407        } elseif {$searchdirn eq "-forwards"} {
8408            $ctext mark set anchor @0,0
8409        } else {
8410            $ctext mark set anchor @0,[winfo height $ctext]
8411        }
8412    }
8413    if {$searchstring ne {}} {
8414        set here [$ctext search -count mlen $searchdirn -- $searchstring anchor]
8415        if {$here ne {}} {
8416            $ctext see $here
8417            set mend "$here + $mlen c"
8418            $ctext tag remove sel 1.0 end
8419            $ctext tag add sel $here $mend
8420            suppress_highlighting_file_for_current_scrollpos
8421            highlightfile_for_scrollpos $here
8422        }
8423    }
8424    rehighlight_search_results
8425}
8426
8427proc dosearch {} {
8428    global sstring ctext searchstring searchdirn
8429
8430    focus $sstring
8431    $sstring icursor end
8432    set searchdirn -forwards
8433    if {$searchstring ne {}} {
8434        set sel [$ctext tag ranges sel]
8435        if {$sel ne {}} {
8436            set start "[lindex $sel 0] + 1c"
8437        } elseif {[catch {set start [$ctext index anchor]}]} {
8438            set start "@0,0"
8439        }
8440        set match [$ctext search -count mlen -- $searchstring $start]
8441        $ctext tag remove sel 1.0 end
8442        if {$match eq {}} {
8443            bell
8444            return
8445        }
8446        $ctext see $match
8447        suppress_highlighting_file_for_current_scrollpos
8448        highlightfile_for_scrollpos $match
8449        set mend "$match + $mlen c"
8450        $ctext tag add sel $match $mend
8451        $ctext mark unset anchor
8452        rehighlight_search_results
8453    }
8454}
8455
8456proc dosearchback {} {
8457    global sstring ctext searchstring searchdirn
8458
8459    focus $sstring
8460    $sstring icursor end
8461    set searchdirn -backwards
8462    if {$searchstring ne {}} {
8463        set sel [$ctext tag ranges sel]
8464        if {$sel ne {}} {
8465            set start [lindex $sel 0]
8466        } elseif {[catch {set start [$ctext index anchor]}]} {
8467            set start @0,[winfo height $ctext]
8468        }
8469        set match [$ctext search -backwards -count ml -- $searchstring $start]
8470        $ctext tag remove sel 1.0 end
8471        if {$match eq {}} {
8472            bell
8473            return
8474        }
8475        $ctext see $match
8476        suppress_highlighting_file_for_current_scrollpos
8477        highlightfile_for_scrollpos $match
8478        set mend "$match + $ml c"
8479        $ctext tag add sel $match $mend
8480        $ctext mark unset anchor
8481        rehighlight_search_results
8482    }
8483}
8484
8485proc rehighlight_search_results {} {
8486    global ctext searchstring
8487
8488    $ctext tag remove found 1.0 end
8489    $ctext tag remove currentsearchhit 1.0 end
8490
8491    if {$searchstring ne {}} {
8492        searchmarkvisible 1
8493    }
8494}
8495
8496proc searchmark {first last} {
8497    global ctext searchstring
8498
8499    set sel [$ctext tag ranges sel]
8500
8501    set mend $first.0
8502    while {1} {
8503        set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8504        if {$match eq {}} break
8505        set mend "$match + $mlen c"
8506        if {$sel ne {} && [$ctext compare $match == [lindex $sel 0]]} {
8507            $ctext tag add currentsearchhit $match $mend
8508        } else {
8509            $ctext tag add found $match $mend
8510        }
8511    }
8512}
8513
8514proc searchmarkvisible {doall} {
8515    global ctext smarktop smarkbot
8516
8517    set topline [lindex [split [$ctext index @0,0] .] 0]
8518    set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8519    if {$doall || $botline < $smarktop || $topline > $smarkbot} {
8520        # no overlap with previous
8521        searchmark $topline $botline
8522        set smarktop $topline
8523        set smarkbot $botline
8524    } else {
8525        if {$topline < $smarktop} {
8526            searchmark $topline [expr {$smarktop-1}]
8527            set smarktop $topline
8528        }
8529        if {$botline > $smarkbot} {
8530            searchmark [expr {$smarkbot+1}] $botline
8531            set smarkbot $botline
8532        }
8533    }
8534}
8535
8536proc suppress_highlighting_file_for_current_scrollpos {} {
8537    global ctext suppress_highlighting_file_for_this_scrollpos
8538
8539    set suppress_highlighting_file_for_this_scrollpos [$ctext index @0,0]
8540}
8541
8542proc scrolltext {f0 f1} {
8543    global searchstring cmitmode ctext
8544    global suppress_highlighting_file_for_this_scrollpos
8545
8546    set topidx [$ctext index @0,0]
8547    if {![info exists suppress_highlighting_file_for_this_scrollpos]
8548        || $topidx ne $suppress_highlighting_file_for_this_scrollpos} {
8549        highlightfile_for_scrollpos $topidx
8550    }
8551
8552    unset -nocomplain suppress_highlighting_file_for_this_scrollpos
8553
8554    .bleft.bottom.sb set $f0 $f1
8555    if {$searchstring ne {}} {
8556        searchmarkvisible 0
8557    }
8558}
8559
8560proc setcoords {} {
8561    global linespc charspc canvx0 canvy0
8562    global xspc1 xspc2 lthickness
8563
8564    set linespc [font metrics mainfont -linespace]
8565    set charspc [font measure mainfont "m"]
8566    set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8567    set canvx0 [expr {int(3 + 0.5 * $linespc)}]
8568    set lthickness [expr {int($linespc / 9) + 1}]
8569    set xspc1(0) $linespc
8570    set xspc2 $linespc
8571}
8572
8573proc redisplay {} {
8574    global canv
8575    global selectedline
8576
8577    set ymax [lindex [$canv cget -scrollregion] 3]
8578    if {$ymax eq {} || $ymax == 0} return
8579    set span [$canv yview]
8580    clear_display
8581    setcanvscroll
8582    allcanvs yview moveto [lindex $span 0]
8583    drawvisible
8584    if {$selectedline ne {}} {
8585        selectline $selectedline 0
8586        allcanvs yview moveto [lindex $span 0]
8587    }
8588}
8589
8590proc parsefont {f n} {
8591    global fontattr
8592
8593    set fontattr($f,family) [lindex $n 0]
8594    set s [lindex $n 1]
8595    if {$s eq {} || $s == 0} {
8596        set s 10
8597    } elseif {$s < 0} {
8598        set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
8599    }
8600    set fontattr($f,size) $s
8601    set fontattr($f,weight) normal
8602    set fontattr($f,slant) roman
8603    foreach style [lrange $n 2 end] {
8604        switch -- $style {
8605            "normal" -
8606            "bold"   {set fontattr($f,weight) $style}
8607            "roman" -
8608            "italic" {set fontattr($f,slant) $style}
8609        }
8610    }
8611}
8612
8613proc fontflags {f {isbold 0}} {
8614    global fontattr
8615
8616    return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8617                -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8618                -slant $fontattr($f,slant)]
8619}
8620
8621proc fontname {f} {
8622    global fontattr
8623
8624    set n [list $fontattr($f,family) $fontattr($f,size)]
8625    if {$fontattr($f,weight) eq "bold"} {
8626        lappend n "bold"
8627    }
8628    if {$fontattr($f,slant) eq "italic"} {
8629        lappend n "italic"
8630    }
8631    return $n
8632}
8633
8634proc incrfont {inc} {
8635    global mainfont textfont ctext canv cflist showrefstop
8636    global stopped entries fontattr
8637
8638    unmarkmatches
8639    set s $fontattr(mainfont,size)
8640    incr s $inc
8641    if {$s < 1} {
8642        set s 1
8643    }
8644    set fontattr(mainfont,size) $s
8645    font config mainfont -size $s
8646    font config mainfontbold -size $s
8647    set mainfont [fontname mainfont]
8648    set s $fontattr(textfont,size)
8649    incr s $inc
8650    if {$s < 1} {
8651        set s 1
8652    }
8653    set fontattr(textfont,size) $s
8654    font config textfont -size $s
8655    font config textfontbold -size $s
8656    set textfont [fontname textfont]
8657    setcoords
8658    settabs
8659    redisplay
8660}
8661
8662proc clearsha1 {} {
8663    global sha1entry sha1string
8664    if {[string length $sha1string] == 40} {
8665        $sha1entry delete 0 end
8666    }
8667}
8668
8669proc sha1change {n1 n2 op} {
8670    global sha1string currentid sha1but
8671    if {$sha1string == {}
8672        || ([info exists currentid] && $sha1string == $currentid)} {
8673        set state disabled
8674    } else {
8675        set state normal
8676    }
8677    if {[$sha1but cget -state] == $state} return
8678    if {$state == "normal"} {
8679        $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
8680    } else {
8681        $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
8682    }
8683}
8684
8685proc gotocommit {} {
8686    global sha1string tagids headids curview varcid
8687
8688    if {$sha1string == {}
8689        || ([info exists currentid] && $sha1string == $currentid)} return
8690    if {[info exists tagids($sha1string)]} {
8691        set id $tagids($sha1string)
8692    } elseif {[info exists headids($sha1string)]} {
8693        set id $headids($sha1string)
8694    } else {
8695        set id [string tolower $sha1string]
8696        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
8697            set matches [longid $id]
8698            if {$matches ne {}} {
8699                if {[llength $matches] > 1} {
8700                    error_popup [mc "Short SHA1 id %s is ambiguous" $id]
8701                    return
8702                }
8703                set id [lindex $matches 0]
8704            }
8705        } else {
8706            if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8707                error_popup [mc "Revision %s is not known" $sha1string]
8708                return
8709            }
8710        }
8711    }
8712    if {[commitinview $id $curview]} {
8713        selectline [rowofcommit $id] 1
8714        return
8715    }
8716    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
8717        set msg [mc "SHA1 id %s is not known" $sha1string]
8718    } else {
8719        set msg [mc "Revision %s is not in the current view" $sha1string]
8720    }
8721    error_popup $msg
8722}
8723
8724proc lineenter {x y id} {
8725    global hoverx hovery hoverid hovertimer
8726    global commitinfo canv
8727
8728    if {![info exists commitinfo($id)] && ![getcommit $id]} return
8729    set hoverx $x
8730    set hovery $y
8731    set hoverid $id
8732    if {[info exists hovertimer]} {
8733        after cancel $hovertimer
8734    }
8735    set hovertimer [after 500 linehover]
8736    $canv delete hover
8737}
8738
8739proc linemotion {x y id} {
8740    global hoverx hovery hoverid hovertimer
8741
8742    if {[info exists hoverid] && $id == $hoverid} {
8743        set hoverx $x
8744        set hovery $y
8745        if {[info exists hovertimer]} {
8746            after cancel $hovertimer
8747        }
8748        set hovertimer [after 500 linehover]
8749    }
8750}
8751
8752proc lineleave {id} {
8753    global hoverid hovertimer canv
8754
8755    if {[info exists hoverid] && $id == $hoverid} {
8756        $canv delete hover
8757        if {[info exists hovertimer]} {
8758            after cancel $hovertimer
8759            unset hovertimer
8760        }
8761        unset hoverid
8762    }
8763}
8764
8765proc linehover {} {
8766    global hoverx hovery hoverid hovertimer
8767    global canv linespc lthickness
8768    global linehoverbgcolor linehoverfgcolor linehoveroutlinecolor
8769
8770    global commitinfo
8771
8772    set text [lindex $commitinfo($hoverid) 0]
8773    set ymax [lindex [$canv cget -scrollregion] 3]
8774    if {$ymax == {}} return
8775    set yfrac [lindex [$canv yview] 0]
8776    set x [expr {$hoverx + 2 * $linespc}]
8777    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8778    set x0 [expr {$x - 2 * $lthickness}]
8779    set y0 [expr {$y - 2 * $lthickness}]
8780    set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
8781    set y1 [expr {$y + $linespc + 2 * $lthickness}]
8782    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8783               -fill $linehoverbgcolor -outline $linehoveroutlinecolor \
8784               -width 1 -tags hover]
8785    $canv raise $t
8786    set t [$canv create text $x $y -anchor nw -text $text -tags hover \
8787               -font mainfont -fill $linehoverfgcolor]
8788    $canv raise $t
8789}
8790
8791proc clickisonarrow {id y} {
8792    global lthickness
8793
8794    set ranges [rowranges $id]
8795    set thresh [expr {2 * $lthickness + 6}]
8796    set n [expr {[llength $ranges] - 1}]
8797    for {set i 1} {$i < $n} {incr i} {
8798        set row [lindex $ranges $i]
8799        if {abs([yc $row] - $y) < $thresh} {
8800            return $i
8801        }
8802    }
8803    return {}
8804}
8805
8806proc arrowjump {id n y} {
8807    global canv
8808
8809    # 1 <-> 2, 3 <-> 4, etc...
8810    set n [expr {(($n - 1) ^ 1) + 1}]
8811    set row [lindex [rowranges $id] $n]
8812    set yt [yc $row]
8813    set ymax [lindex [$canv cget -scrollregion] 3]
8814    if {$ymax eq {} || $ymax <= 0} return
8815    set view [$canv yview]
8816    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8817    set yfrac [expr {$yt / $ymax - $yspan / 2}]
8818    if {$yfrac < 0} {
8819        set yfrac 0
8820    }
8821    allcanvs yview moveto $yfrac
8822}
8823
8824proc lineclick {x y id isnew} {
8825    global ctext commitinfo children canv thickerline curview
8826
8827    if {![info exists commitinfo($id)] && ![getcommit $id]} return
8828    unmarkmatches
8829    unselectline
8830    normalline
8831    $canv delete hover
8832    # draw this line thicker than normal
8833    set thickerline $id
8834    drawlines $id
8835    if {$isnew} {
8836        set ymax [lindex [$canv cget -scrollregion] 3]
8837        if {$ymax eq {}} return
8838        set yfrac [lindex [$canv yview] 0]
8839        set y [expr {$y + $yfrac * $ymax}]
8840    }
8841    set dirn [clickisonarrow $id $y]
8842    if {$dirn ne {}} {
8843        arrowjump $id $dirn $y
8844        return
8845    }
8846
8847    if {$isnew} {
8848        addtohistory [list lineclick $x $y $id 0] savectextpos
8849    }
8850    # fill the details pane with info about this line
8851    $ctext conf -state normal
8852    clear_ctext
8853    settabs 0
8854    $ctext insert end "[mc "Parent"]:\t"
8855    $ctext insert end $id link0
8856    setlink $id link0
8857    set info $commitinfo($id)
8858    $ctext insert end "\n\t[lindex $info 0]\n"
8859    $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8860    set date [formatdate [lindex $info 2]]
8861    $ctext insert end "\t[mc "Date"]:\t$date\n"
8862    set kids $children($curview,$id)
8863    if {$kids ne {}} {
8864        $ctext insert end "\n[mc "Children"]:"
8865        set i 0
8866        foreach child $kids {
8867            incr i
8868            if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8869            set info $commitinfo($child)
8870            $ctext insert end "\n\t"
8871            $ctext insert end $child link$i
8872            setlink $child link$i
8873            $ctext insert end "\n\t[lindex $info 0]"
8874            $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8875            set date [formatdate [lindex $info 2]]
8876            $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8877        }
8878    }
8879    maybe_scroll_ctext 1
8880    $ctext conf -state disabled
8881    init_flist {}
8882}
8883
8884proc normalline {} {
8885    global thickerline
8886    if {[info exists thickerline]} {
8887        set id $thickerline
8888        unset thickerline
8889        drawlines $id
8890    }
8891}
8892
8893proc selbyid {id {isnew 1}} {
8894    global curview
8895    if {[commitinview $id $curview]} {
8896        selectline [rowofcommit $id] $isnew
8897    }
8898}
8899
8900proc mstime {} {
8901    global startmstime
8902    if {![info exists startmstime]} {
8903        set startmstime [clock clicks -milliseconds]
8904    }
8905    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8906}
8907
8908proc rowmenu {x y id} {
8909    global rowctxmenu selectedline rowmenuid curview
8910    global nullid nullid2 fakerowmenu mainhead markedid
8911
8912    stopfinding
8913    set rowmenuid $id
8914    if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8915        set state disabled
8916    } else {
8917        set state normal
8918    }
8919    if {[info exists markedid] && $markedid ne $id} {
8920        set mstate normal
8921    } else {
8922        set mstate disabled
8923    }
8924    if {$id ne $nullid && $id ne $nullid2} {
8925        set menu $rowctxmenu
8926        if {$mainhead ne {}} {
8927            $menu entryconfigure 8 -label [mc "Reset %s branch to here" $mainhead] -state normal
8928        } else {
8929            $menu entryconfigure 8 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8930        }
8931        $menu entryconfigure 10 -state $mstate
8932        $menu entryconfigure 11 -state $mstate
8933        $menu entryconfigure 12 -state $mstate
8934    } else {
8935        set menu $fakerowmenu
8936    }
8937    $menu entryconfigure [mca "Diff this -> selected"] -state $state
8938    $menu entryconfigure [mca "Diff selected -> this"] -state $state
8939    $menu entryconfigure [mca "Make patch"] -state $state
8940    $menu entryconfigure [mca "Diff this -> marked commit"] -state $mstate
8941    $menu entryconfigure [mca "Diff marked commit -> this"] -state $mstate
8942    tk_popup $menu $x $y
8943}
8944
8945proc markhere {} {
8946    global rowmenuid markedid canv
8947
8948    set markedid $rowmenuid
8949    make_idmark $markedid
8950}
8951
8952proc gotomark {} {
8953    global markedid
8954
8955    if {[info exists markedid]} {
8956        selbyid $markedid
8957    }
8958}
8959
8960proc replace_by_kids {l r} {
8961    global curview children
8962
8963    set id [commitonrow $r]
8964    set l [lreplace $l 0 0]
8965    foreach kid $children($curview,$id) {
8966        lappend l [rowofcommit $kid]
8967    }
8968    return [lsort -integer -decreasing -unique $l]
8969}
8970
8971proc find_common_desc {} {
8972    global markedid rowmenuid curview children
8973
8974    if {![info exists markedid]} return
8975    if {![commitinview $markedid $curview] ||
8976        ![commitinview $rowmenuid $curview]} return
8977    #set t1 [clock clicks -milliseconds]
8978    set l1 [list [rowofcommit $markedid]]
8979    set l2 [list [rowofcommit $rowmenuid]]
8980    while 1 {
8981        set r1 [lindex $l1 0]
8982        set r2 [lindex $l2 0]
8983        if {$r1 eq {} || $r2 eq {}} break
8984        if {$r1 == $r2} {
8985            selectline $r1 1
8986            break
8987        }
8988        if {$r1 > $r2} {
8989            set l1 [replace_by_kids $l1 $r1]
8990        } else {
8991            set l2 [replace_by_kids $l2 $r2]
8992        }
8993    }
8994    #set t2 [clock clicks -milliseconds]
8995    #puts "took [expr {$t2-$t1}]ms"
8996}
8997
8998proc compare_commits {} {
8999    global markedid rowmenuid curview children
9000
9001    if {![info exists markedid]} return
9002    if {![commitinview $markedid $curview]} return
9003    addtohistory [list do_cmp_commits $markedid $rowmenuid]
9004    do_cmp_commits $markedid $rowmenuid
9005}
9006
9007proc getpatchid {id} {
9008    global patchids
9009
9010    if {![info exists patchids($id)]} {
9011        set cmd [diffcmd [list $id] {-p --root}]
9012        # trim off the initial "|"
9013        set cmd [lrange $cmd 1 end]
9014        if {[catch {
9015            set x [eval exec $cmd | git patch-id]
9016            set patchids($id) [lindex $x 0]
9017        }]} {
9018            set patchids($id) "error"
9019        }
9020    }
9021    return $patchids($id)
9022}
9023
9024proc do_cmp_commits {a b} {
9025    global ctext curview parents children patchids commitinfo
9026
9027    $ctext conf -state normal
9028    clear_ctext
9029    init_flist {}
9030    for {set i 0} {$i < 100} {incr i} {
9031        set skipa 0
9032        set skipb 0
9033        if {[llength $parents($curview,$a)] > 1} {
9034            appendshortlink $a [mc "Skipping merge commit "] "\n"
9035            set skipa 1
9036        } else {
9037            set patcha [getpatchid $a]
9038        }
9039        if {[llength $parents($curview,$b)] > 1} {
9040            appendshortlink $b [mc "Skipping merge commit "] "\n"
9041            set skipb 1
9042        } else {
9043            set patchb [getpatchid $b]
9044        }
9045        if {!$skipa && !$skipb} {
9046            set heada [lindex $commitinfo($a) 0]
9047            set headb [lindex $commitinfo($b) 0]
9048            if {$patcha eq "error"} {
9049                appendshortlink $a [mc "Error getting patch ID for "] \
9050                    [mc " - stopping\n"]
9051                break
9052            }
9053            if {$patchb eq "error"} {
9054                appendshortlink $b [mc "Error getting patch ID for "] \
9055                    [mc " - stopping\n"]
9056                break
9057            }
9058            if {$patcha eq $patchb} {
9059                if {$heada eq $headb} {
9060                    appendshortlink $a [mc "Commit "]
9061                    appendshortlink $b " == " "  $heada\n"
9062                } else {
9063                    appendshortlink $a [mc "Commit "] "  $heada\n"
9064                    appendshortlink $b [mc " is the same patch as\n       "] \
9065                        "  $headb\n"
9066                }
9067                set skipa 1
9068                set skipb 1
9069            } else {
9070                $ctext insert end "\n"
9071                appendshortlink $a [mc "Commit "] "  $heada\n"
9072                appendshortlink $b [mc " differs from\n       "] \
9073                    "  $headb\n"
9074                $ctext insert end [mc "Diff of commits:\n\n"]
9075                $ctext conf -state disabled
9076                update
9077                diffcommits $a $b
9078                return
9079            }
9080        }
9081        if {$skipa} {
9082            set kids [real_children $curview,$a]
9083            if {[llength $kids] != 1} {
9084                $ctext insert end "\n"
9085                appendshortlink $a [mc "Commit "] \
9086                    [mc " has %s children - stopping\n" [llength $kids]]
9087                break
9088            }
9089            set a [lindex $kids 0]
9090        }
9091        if {$skipb} {
9092            set kids [real_children $curview,$b]
9093            if {[llength $kids] != 1} {
9094                appendshortlink $b [mc "Commit "] \
9095                    [mc " has %s children - stopping\n" [llength $kids]]
9096                break
9097            }
9098            set b [lindex $kids 0]
9099        }
9100    }
9101    $ctext conf -state disabled
9102}
9103
9104proc diffcommits {a b} {
9105    global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
9106
9107    set tmpdir [gitknewtmpdir]
9108    set fna [file join $tmpdir "commit-[string range $a 0 7]"]
9109    set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
9110    if {[catch {
9111        exec git diff-tree -p --pretty $a >$fna
9112        exec git diff-tree -p --pretty $b >$fnb
9113    } err]} {
9114        error_popup [mc "Error writing commit to file: %s" $err]
9115        return
9116    }
9117    if {[catch {
9118        set fd [open "| diff -U$diffcontext $fna $fnb" r]
9119    } err]} {
9120        error_popup [mc "Error diffing commits: %s" $err]
9121        return
9122    }
9123    set diffids [list commits $a $b]
9124    set blobdifffd($diffids) $fd
9125    set diffinhdr 0
9126    set currdiffsubmod ""
9127    filerun $fd [list getblobdiffline $fd $diffids]
9128}
9129
9130proc diffvssel {dirn} {
9131    global rowmenuid selectedline
9132
9133    if {$selectedline eq {}} return
9134    if {$dirn} {
9135        set oldid [commitonrow $selectedline]
9136        set newid $rowmenuid
9137    } else {
9138        set oldid $rowmenuid
9139        set newid [commitonrow $selectedline]
9140    }
9141    addtohistory [list doseldiff $oldid $newid] savectextpos
9142    doseldiff $oldid $newid
9143}
9144
9145proc diffvsmark {dirn} {
9146    global rowmenuid markedid
9147
9148    if {![info exists markedid]} return
9149    if {$dirn} {
9150        set oldid $markedid
9151        set newid $rowmenuid
9152    } else {
9153        set oldid $rowmenuid
9154        set newid $markedid
9155    }
9156    addtohistory [list doseldiff $oldid $newid] savectextpos
9157    doseldiff $oldid $newid
9158}
9159
9160proc doseldiff {oldid newid} {
9161    global ctext
9162    global commitinfo
9163
9164    $ctext conf -state normal
9165    clear_ctext
9166    init_flist [mc "Top"]
9167    $ctext insert end "[mc "From"] "
9168    $ctext insert end $oldid link0
9169    setlink $oldid link0
9170    $ctext insert end "\n     "
9171    $ctext insert end [lindex $commitinfo($oldid) 0]
9172    $ctext insert end "\n\n[mc "To"]   "
9173    $ctext insert end $newid link1
9174    setlink $newid link1
9175    $ctext insert end "\n     "
9176    $ctext insert end [lindex $commitinfo($newid) 0]
9177    $ctext insert end "\n"
9178    $ctext conf -state disabled
9179    $ctext tag remove found 1.0 end
9180    startdiff [list $oldid $newid]
9181}
9182
9183proc mkpatch {} {
9184    global rowmenuid currentid commitinfo patchtop patchnum NS
9185
9186    if {![info exists currentid]} return
9187    set oldid $currentid
9188    set oldhead [lindex $commitinfo($oldid) 0]
9189    set newid $rowmenuid
9190    set newhead [lindex $commitinfo($newid) 0]
9191    set top .patch
9192    set patchtop $top
9193    catch {destroy $top}
9194    ttk_toplevel $top
9195    make_transient $top .
9196    ${NS}::label $top.title -text [mc "Generate patch"]
9197    grid $top.title - -pady 10
9198    ${NS}::label $top.from -text [mc "From:"]
9199    ${NS}::entry $top.fromsha1 -width 40
9200    $top.fromsha1 insert 0 $oldid
9201    $top.fromsha1 conf -state readonly
9202    grid $top.from $top.fromsha1 -sticky w
9203    ${NS}::entry $top.fromhead -width 60
9204    $top.fromhead insert 0 $oldhead
9205    $top.fromhead conf -state readonly
9206    grid x $top.fromhead -sticky w
9207    ${NS}::label $top.to -text [mc "To:"]
9208    ${NS}::entry $top.tosha1 -width 40
9209    $top.tosha1 insert 0 $newid
9210    $top.tosha1 conf -state readonly
9211    grid $top.to $top.tosha1 -sticky w
9212    ${NS}::entry $top.tohead -width 60
9213    $top.tohead insert 0 $newhead
9214    $top.tohead conf -state readonly
9215    grid x $top.tohead -sticky w
9216    ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
9217    grid $top.rev x -pady 10 -padx 5
9218    ${NS}::label $top.flab -text [mc "Output file:"]
9219    ${NS}::entry $top.fname -width 60
9220    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
9221    incr patchnum
9222    grid $top.flab $top.fname -sticky w
9223    ${NS}::frame $top.buts
9224    ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
9225    ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
9226    bind $top <Key-Return> mkpatchgo
9227    bind $top <Key-Escape> mkpatchcan
9228    grid $top.buts.gen $top.buts.can
9229    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9230    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9231    grid $top.buts - -pady 10 -sticky ew
9232    focus $top.fname
9233}
9234
9235proc mkpatchrev {} {
9236    global patchtop
9237
9238    set oldid [$patchtop.fromsha1 get]
9239    set oldhead [$patchtop.fromhead get]
9240    set newid [$patchtop.tosha1 get]
9241    set newhead [$patchtop.tohead get]
9242    foreach e [list fromsha1 fromhead tosha1 tohead] \
9243            v [list $newid $newhead $oldid $oldhead] {
9244        $patchtop.$e conf -state normal
9245        $patchtop.$e delete 0 end
9246        $patchtop.$e insert 0 $v
9247        $patchtop.$e conf -state readonly
9248    }
9249}
9250
9251proc mkpatchgo {} {
9252    global patchtop nullid nullid2
9253
9254    set oldid [$patchtop.fromsha1 get]
9255    set newid [$patchtop.tosha1 get]
9256    set fname [$patchtop.fname get]
9257    set cmd [diffcmd [list $oldid $newid] -p]
9258    # trim off the initial "|"
9259    set cmd [lrange $cmd 1 end]
9260    lappend cmd >$fname &
9261    if {[catch {eval exec $cmd} err]} {
9262        error_popup "[mc "Error creating patch:"] $err" $patchtop
9263    }
9264    catch {destroy $patchtop}
9265    unset patchtop
9266}
9267
9268proc mkpatchcan {} {
9269    global patchtop
9270
9271    catch {destroy $patchtop}
9272    unset patchtop
9273}
9274
9275proc mktag {} {
9276    global rowmenuid mktagtop commitinfo NS
9277
9278    set top .maketag
9279    set mktagtop $top
9280    catch {destroy $top}
9281    ttk_toplevel $top
9282    make_transient $top .
9283    ${NS}::label $top.title -text [mc "Create tag"]
9284    grid $top.title - -pady 10
9285    ${NS}::label $top.id -text [mc "ID:"]
9286    ${NS}::entry $top.sha1 -width 40
9287    $top.sha1 insert 0 $rowmenuid
9288    $top.sha1 conf -state readonly
9289    grid $top.id $top.sha1 -sticky w
9290    ${NS}::entry $top.head -width 60
9291    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9292    $top.head conf -state readonly
9293    grid x $top.head -sticky w
9294    ${NS}::label $top.tlab -text [mc "Tag name:"]
9295    ${NS}::entry $top.tag -width 60
9296    grid $top.tlab $top.tag -sticky w
9297    ${NS}::label $top.op -text [mc "Tag message is optional"]
9298    grid $top.op -columnspan 2 -sticky we
9299    ${NS}::label $top.mlab -text [mc "Tag message:"]
9300    ${NS}::entry $top.msg -width 60
9301    grid $top.mlab $top.msg -sticky w
9302    ${NS}::frame $top.buts
9303    ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
9304    ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
9305    bind $top <Key-Return> mktaggo
9306    bind $top <Key-Escape> mktagcan
9307    grid $top.buts.gen $top.buts.can
9308    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9309    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9310    grid $top.buts - -pady 10 -sticky ew
9311    focus $top.tag
9312}
9313
9314proc domktag {} {
9315    global mktagtop env tagids idtags
9316
9317    set id [$mktagtop.sha1 get]
9318    set tag [$mktagtop.tag get]
9319    set msg [$mktagtop.msg get]
9320    if {$tag == {}} {
9321        error_popup [mc "No tag name specified"] $mktagtop
9322        return 0
9323    }
9324    if {[info exists tagids($tag)]} {
9325        error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
9326        return 0
9327    }
9328    if {[catch {
9329        if {$msg != {}} {
9330            exec git tag -a -m $msg $tag $id
9331        } else {
9332            exec git tag $tag $id
9333        }
9334    } err]} {
9335        error_popup "[mc "Error creating tag:"] $err" $mktagtop
9336        return 0
9337    }
9338
9339    set tagids($tag) $id
9340    lappend idtags($id) $tag
9341    redrawtags $id
9342    addedtag $id
9343    dispneartags 0
9344    run refill_reflist
9345    return 1
9346}
9347
9348proc redrawtags {id} {
9349    global canv linehtag idpos currentid curview cmitlisted markedid
9350    global canvxmax iddrawn circleitem mainheadid circlecolors
9351    global mainheadcirclecolor
9352
9353    if {![commitinview $id $curview]} return
9354    if {![info exists iddrawn($id)]} return
9355    set row [rowofcommit $id]
9356    if {$id eq $mainheadid} {
9357        set ofill $mainheadcirclecolor
9358    } else {
9359        set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
9360    }
9361    $canv itemconf $circleitem($row) -fill $ofill
9362    $canv delete tag.$id
9363    set xt [eval drawtags $id $idpos($id)]
9364    $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
9365    set text [$canv itemcget $linehtag($id) -text]
9366    set font [$canv itemcget $linehtag($id) -font]
9367    set xr [expr {$xt + [font measure $font $text]}]
9368    if {$xr > $canvxmax} {
9369        set canvxmax $xr
9370        setcanvscroll
9371    }
9372    if {[info exists currentid] && $currentid == $id} {
9373        make_secsel $id
9374    }
9375    if {[info exists markedid] && $markedid eq $id} {
9376        make_idmark $id
9377    }
9378}
9379
9380proc mktagcan {} {
9381    global mktagtop
9382
9383    catch {destroy $mktagtop}
9384    unset mktagtop
9385}
9386
9387proc mktaggo {} {
9388    if {![domktag]} return
9389    mktagcan
9390}
9391
9392proc copysummary {} {
9393    global rowmenuid autosellen
9394
9395    set format "%h (\"%s\", %ad)"
9396    set cmd [list git show -s --pretty=format:$format --date=short]
9397    if {$autosellen < 40} {
9398        lappend cmd --abbrev=$autosellen
9399    }
9400    set summary [eval exec $cmd $rowmenuid]
9401
9402    clipboard clear
9403    clipboard append $summary
9404}
9405
9406proc writecommit {} {
9407    global rowmenuid wrcomtop commitinfo wrcomcmd NS
9408
9409    set top .writecommit
9410    set wrcomtop $top
9411    catch {destroy $top}
9412    ttk_toplevel $top
9413    make_transient $top .
9414    ${NS}::label $top.title -text [mc "Write commit to file"]
9415    grid $top.title - -pady 10
9416    ${NS}::label $top.id -text [mc "ID:"]
9417    ${NS}::entry $top.sha1 -width 40
9418    $top.sha1 insert 0 $rowmenuid
9419    $top.sha1 conf -state readonly
9420    grid $top.id $top.sha1 -sticky w
9421    ${NS}::entry $top.head -width 60
9422    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9423    $top.head conf -state readonly
9424    grid x $top.head -sticky w
9425    ${NS}::label $top.clab -text [mc "Command:"]
9426    ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
9427    grid $top.clab $top.cmd -sticky w -pady 10
9428    ${NS}::label $top.flab -text [mc "Output file:"]
9429    ${NS}::entry $top.fname -width 60
9430    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
9431    grid $top.flab $top.fname -sticky w
9432    ${NS}::frame $top.buts
9433    ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
9434    ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
9435    bind $top <Key-Return> wrcomgo
9436    bind $top <Key-Escape> wrcomcan
9437    grid $top.buts.gen $top.buts.can
9438    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9439    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9440    grid $top.buts - -pady 10 -sticky ew
9441    focus $top.fname
9442}
9443
9444proc wrcomgo {} {
9445    global wrcomtop
9446
9447    set id [$wrcomtop.sha1 get]
9448    set cmd "echo $id | [$wrcomtop.cmd get]"
9449    set fname [$wrcomtop.fname get]
9450    if {[catch {exec sh -c $cmd >$fname &} err]} {
9451        error_popup "[mc "Error writing commit:"] $err" $wrcomtop
9452    }
9453    catch {destroy $wrcomtop}
9454    unset wrcomtop
9455}
9456
9457proc wrcomcan {} {
9458    global wrcomtop
9459
9460    catch {destroy $wrcomtop}
9461    unset wrcomtop
9462}
9463
9464proc mkbranch {} {
9465    global NS rowmenuid
9466
9467    set top .branchdialog
9468
9469    set val(name) ""
9470    set val(id) $rowmenuid
9471    set val(command) [list mkbrgo $top]
9472
9473    set ui(title) [mc "Create branch"]
9474    set ui(accept) [mc "Create"]
9475
9476    branchdia $top val ui
9477}
9478
9479proc mvbranch {} {
9480    global NS
9481    global headmenuid headmenuhead
9482
9483    set top .branchdialog
9484
9485    set val(name) $headmenuhead
9486    set val(id) $headmenuid
9487    set val(command) [list mvbrgo $top $headmenuhead]
9488
9489    set ui(title) [mc "Rename branch %s" $headmenuhead]
9490    set ui(accept) [mc "Rename"]
9491
9492    branchdia $top val ui
9493}
9494
9495proc branchdia {top valvar uivar} {
9496    global NS commitinfo
9497    upvar $valvar val $uivar ui
9498
9499    catch {destroy $top}
9500    ttk_toplevel $top
9501    make_transient $top .
9502    ${NS}::label $top.title -text $ui(title)
9503    grid $top.title - -pady 10
9504    ${NS}::label $top.id -text [mc "ID:"]
9505    ${NS}::entry $top.sha1 -width 40
9506    $top.sha1 insert 0 $val(id)
9507    $top.sha1 conf -state readonly
9508    grid $top.id $top.sha1 -sticky w
9509    ${NS}::entry $top.head -width 60
9510    $top.head insert 0 [lindex $commitinfo($val(id)) 0]
9511    $top.head conf -state readonly
9512    grid x $top.head -sticky ew
9513    grid columnconfigure $top 1 -weight 1
9514    ${NS}::label $top.nlab -text [mc "Name:"]
9515    ${NS}::entry $top.name -width 40
9516    $top.name insert 0 $val(name)
9517    grid $top.nlab $top.name -sticky w
9518    ${NS}::frame $top.buts
9519    ${NS}::button $top.buts.go -text $ui(accept) -command $val(command)
9520    ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
9521    bind $top <Key-Return> $val(command)
9522    bind $top <Key-Escape> "catch {destroy $top}"
9523    grid $top.buts.go $top.buts.can
9524    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9525    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9526    grid $top.buts - -pady 10 -sticky ew
9527    focus $top.name
9528}
9529
9530proc mkbrgo {top} {
9531    global headids idheads
9532
9533    set name [$top.name get]
9534    set id [$top.sha1 get]
9535    set cmdargs {}
9536    set old_id {}
9537    if {$name eq {}} {
9538        error_popup [mc "Please specify a name for the new branch"] $top
9539        return
9540    }
9541    if {[info exists headids($name)]} {
9542        if {![confirm_popup [mc \
9543                "Branch '%s' already exists. Overwrite?" $name] $top]} {
9544            return
9545        }
9546        set old_id $headids($name)
9547        lappend cmdargs -f
9548    }
9549    catch {destroy $top}
9550    lappend cmdargs $name $id
9551    nowbusy newbranch
9552    update
9553    if {[catch {
9554        eval exec git branch $cmdargs
9555    } err]} {
9556        notbusy newbranch
9557        error_popup $err
9558    } else {
9559        notbusy newbranch
9560        if {$old_id ne {}} {
9561            movehead $id $name
9562            movedhead $id $name
9563            redrawtags $old_id
9564            redrawtags $id
9565        } else {
9566            set headids($name) $id
9567            lappend idheads($id) $name
9568            addedhead $id $name
9569            redrawtags $id
9570        }
9571        dispneartags 0
9572        run refill_reflist
9573    }
9574}
9575
9576proc mvbrgo {top prevname} {
9577    global headids idheads mainhead mainheadid
9578
9579    set name [$top.name get]
9580    set id [$top.sha1 get]
9581    set cmdargs {}
9582    if {$name eq $prevname} {
9583        catch {destroy $top}
9584        return
9585    }
9586    if {$name eq {}} {
9587        error_popup [mc "Please specify a new name for the branch"] $top
9588        return
9589    }
9590    catch {destroy $top}
9591    lappend cmdargs -m $prevname $name
9592    nowbusy renamebranch
9593    update
9594    if {[catch {
9595        eval exec git branch $cmdargs
9596    } err]} {
9597        notbusy renamebranch
9598        error_popup $err
9599    } else {
9600        notbusy renamebranch
9601        removehead $id $prevname
9602        removedhead $id $prevname
9603        set headids($name) $id
9604        lappend idheads($id) $name
9605        addedhead $id $name
9606        if {$prevname eq $mainhead} {
9607            set mainhead $name
9608            set mainheadid $id
9609        }
9610        redrawtags $id
9611        dispneartags 0
9612        run refill_reflist
9613    }
9614}
9615
9616proc exec_citool {tool_args {baseid {}}} {
9617    global commitinfo env
9618
9619    set save_env [array get env GIT_AUTHOR_*]
9620
9621    if {$baseid ne {}} {
9622        if {![info exists commitinfo($baseid)]} {
9623            getcommit $baseid
9624        }
9625        set author [lindex $commitinfo($baseid) 1]
9626        set date [lindex $commitinfo($baseid) 2]
9627        if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9628                    $author author name email]
9629            && $date ne {}} {
9630            set env(GIT_AUTHOR_NAME) $name
9631            set env(GIT_AUTHOR_EMAIL) $email
9632            set env(GIT_AUTHOR_DATE) $date
9633        }
9634    }
9635
9636    eval exec git citool $tool_args &
9637
9638    array unset env GIT_AUTHOR_*
9639    array set env $save_env
9640}
9641
9642proc cherrypick {} {
9643    global rowmenuid curview
9644    global mainhead mainheadid
9645    global gitdir
9646
9647    set oldhead [exec git rev-parse HEAD]
9648    set dheads [descheads $rowmenuid]
9649    if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
9650        set ok [confirm_popup [mc "Commit %s is already\
9651                included in branch %s -- really re-apply it?" \
9652                                   [string range $rowmenuid 0 7] $mainhead]]
9653        if {!$ok} return
9654    }
9655    nowbusy cherrypick [mc "Cherry-picking"]
9656    update
9657    # Unfortunately git-cherry-pick writes stuff to stderr even when
9658    # no error occurs, and exec takes that as an indication of error...
9659    if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9660        notbusy cherrypick
9661        if {[regexp -line \
9662                 {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9663                 $err msg fname]} {
9664            error_popup [mc "Cherry-pick failed because of local changes\
9665                        to file '%s'.\nPlease commit, reset or stash\
9666                        your changes and try again." $fname]
9667        } elseif {[regexp -line \
9668                       {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
9669                       $err]} {
9670            if {[confirm_popup [mc "Cherry-pick failed because of merge\
9671                        conflict.\nDo you wish to run git citool to\
9672                        resolve it?"]]} {
9673                # Force citool to read MERGE_MSG
9674                file delete [file join $gitdir "GITGUI_MSG"]
9675                exec_citool {} $rowmenuid
9676            }
9677        } else {
9678            error_popup $err
9679        }
9680        run updatecommits
9681        return
9682    }
9683    set newhead [exec git rev-parse HEAD]
9684    if {$newhead eq $oldhead} {
9685        notbusy cherrypick
9686        error_popup [mc "No changes committed"]
9687        return
9688    }
9689    addnewchild $newhead $oldhead
9690    if {[commitinview $oldhead $curview]} {
9691        # XXX this isn't right if we have a path limit...
9692        insertrow $newhead $oldhead $curview
9693        if {$mainhead ne {}} {
9694            movehead $newhead $mainhead
9695            movedhead $newhead $mainhead
9696        }
9697        set mainheadid $newhead
9698        redrawtags $oldhead
9699        redrawtags $newhead
9700        selbyid $newhead
9701    }
9702    notbusy cherrypick
9703}
9704
9705proc revert {} {
9706    global rowmenuid curview
9707    global mainhead mainheadid
9708    global gitdir
9709
9710    set oldhead [exec git rev-parse HEAD]
9711    set dheads [descheads $rowmenuid]
9712    if { $dheads eq {} || [lsearch -exact $dheads $oldhead] == -1 } {
9713       set ok [confirm_popup [mc "Commit %s is not\
9714           included in branch %s -- really revert it?" \
9715                      [string range $rowmenuid 0 7] $mainhead]]
9716       if {!$ok} return
9717    }
9718    nowbusy revert [mc "Reverting"]
9719    update
9720
9721    if [catch {exec git revert --no-edit $rowmenuid} err] {
9722        notbusy revert
9723        if [regexp {files would be overwritten by merge:(\n(( |\t)+[^\n]+\n)+)}\
9724                $err match files] {
9725            regsub {\n( |\t)+} $files "\n" files
9726            error_popup [mc "Revert failed because of local changes to\
9727                the following files:%s Please commit, reset or stash \
9728                your changes and try again." $files]
9729        } elseif [regexp {error: could not revert} $err] {
9730            if [confirm_popup [mc "Revert failed because of merge conflict.\n\
9731                Do you wish to run git citool to resolve it?"]] {
9732                # Force citool to read MERGE_MSG
9733                file delete [file join $gitdir "GITGUI_MSG"]
9734                exec_citool {} $rowmenuid
9735            }
9736        } else { error_popup $err }
9737        run updatecommits
9738        return
9739    }
9740
9741    set newhead [exec git rev-parse HEAD]
9742    if { $newhead eq $oldhead } {
9743        notbusy revert
9744        error_popup [mc "No changes committed"]
9745        return
9746    }
9747
9748    addnewchild $newhead $oldhead
9749
9750    if [commitinview $oldhead $curview] {
9751        # XXX this isn't right if we have a path limit...
9752        insertrow $newhead $oldhead $curview
9753        if {$mainhead ne {}} {
9754            movehead $newhead $mainhead
9755            movedhead $newhead $mainhead
9756        }
9757        set mainheadid $newhead
9758        redrawtags $oldhead
9759        redrawtags $newhead
9760        selbyid $newhead
9761    }
9762
9763    notbusy revert
9764}
9765
9766proc resethead {} {
9767    global mainhead rowmenuid confirm_ok resettype NS
9768
9769    set confirm_ok 0
9770    set w ".confirmreset"
9771    ttk_toplevel $w
9772    make_transient $w .
9773    wm title $w [mc "Confirm reset"]
9774    ${NS}::label $w.m -text \
9775        [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
9776    pack $w.m -side top -fill x -padx 20 -pady 20
9777    ${NS}::labelframe $w.f -text [mc "Reset type:"]
9778    set resettype mixed
9779    ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
9780        -text [mc "Soft: Leave working tree and index untouched"]
9781    grid $w.f.soft -sticky w
9782    ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
9783        -text [mc "Mixed: Leave working tree untouched, reset index"]
9784    grid $w.f.mixed -sticky w
9785    ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
9786        -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
9787    grid $w.f.hard -sticky w
9788    pack $w.f -side top -fill x -padx 4
9789    ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
9790    pack $w.ok -side left -fill x -padx 20 -pady 20
9791    ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
9792    bind $w <Key-Escape> [list destroy $w]
9793    pack $w.cancel -side right -fill x -padx 20 -pady 20
9794    bind $w <Visibility> "grab $w; focus $w"
9795    tkwait window $w
9796    if {!$confirm_ok} return
9797    if {[catch {set fd [open \
9798            [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
9799        error_popup $err
9800    } else {
9801        dohidelocalchanges
9802        filerun $fd [list readresetstat $fd]
9803        nowbusy reset [mc "Resetting"]
9804        selbyid $rowmenuid
9805    }
9806}
9807
9808proc readresetstat {fd} {
9809    global mainhead mainheadid showlocalchanges rprogcoord
9810
9811    if {[gets $fd line] >= 0} {
9812        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9813            set rprogcoord [expr {1.0 * $m / $n}]
9814            adjustprogress
9815        }
9816        return 1
9817    }
9818    set rprogcoord 0
9819    adjustprogress
9820    notbusy reset
9821    if {[catch {close $fd} err]} {
9822        error_popup $err
9823    }
9824    set oldhead $mainheadid
9825    set newhead [exec git rev-parse HEAD]
9826    if {$newhead ne $oldhead} {
9827        movehead $newhead $mainhead
9828        movedhead $newhead $mainhead
9829        set mainheadid $newhead
9830        redrawtags $oldhead
9831        redrawtags $newhead
9832    }
9833    if {$showlocalchanges} {
9834        doshowlocalchanges
9835    }
9836    return 0
9837}
9838
9839# context menu for a head
9840proc headmenu {x y id head} {
9841    global headmenuid headmenuhead headctxmenu mainhead headids
9842
9843    stopfinding
9844    set headmenuid $id
9845    set headmenuhead $head
9846    array set state {0 normal 1 normal 2 normal}
9847    if {[string match "remotes/*" $head]} {
9848        set localhead [string range $head [expr [string last / $head] + 1] end]
9849        if {[info exists headids($localhead)]} {
9850            set state(0) disabled
9851        }
9852        array set state {1 disabled 2 disabled}
9853    }
9854    if {$head eq $mainhead} {
9855        array set state {0 disabled 2 disabled}
9856    }
9857    foreach i {0 1 2} {
9858        $headctxmenu entryconfigure $i -state $state($i)
9859    }
9860    tk_popup $headctxmenu $x $y
9861}
9862
9863proc cobranch {} {
9864    global headmenuid headmenuhead headids
9865    global showlocalchanges
9866
9867    # check the tree is clean first??
9868    set newhead $headmenuhead
9869    set command [list | git checkout]
9870    if {[string match "remotes/*" $newhead]} {
9871        set remote $newhead
9872        set newhead [string range $newhead [expr [string last / $newhead] + 1] end]
9873        # The following check is redundant - the menu option should
9874        # be disabled to begin with...
9875        if {[info exists headids($newhead)]} {
9876            error_popup [mc "A local branch named %s exists already" $newhead]
9877            return
9878        }
9879        lappend command -b $newhead --track $remote
9880    } else {
9881        lappend command $newhead
9882    }
9883    lappend command 2>@1
9884    nowbusy checkout [mc "Checking out"]
9885    update
9886    dohidelocalchanges
9887    if {[catch {
9888        set fd [open $command r]
9889    } err]} {
9890        notbusy checkout
9891        error_popup $err
9892        if {$showlocalchanges} {
9893            dodiffindex
9894        }
9895    } else {
9896        filerun $fd [list readcheckoutstat $fd $newhead $headmenuid]
9897    }
9898}
9899
9900proc readcheckoutstat {fd newhead newheadid} {
9901    global mainhead mainheadid headids idheads showlocalchanges progresscoords
9902    global viewmainheadid curview
9903
9904    if {[gets $fd line] >= 0} {
9905        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9906            set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9907            adjustprogress
9908        }
9909        return 1
9910    }
9911    set progresscoords {0 0}
9912    adjustprogress
9913    notbusy checkout
9914    if {[catch {close $fd} err]} {
9915        error_popup $err
9916        return
9917    }
9918    set oldmainid $mainheadid
9919    if {! [info exists headids($newhead)]} {
9920        set headids($newhead) $newheadid
9921        lappend idheads($newheadid) $newhead
9922        addedhead $newheadid $newhead
9923    }
9924    set mainhead $newhead
9925    set mainheadid $newheadid
9926    set viewmainheadid($curview) $newheadid
9927    redrawtags $oldmainid
9928    redrawtags $newheadid
9929    selbyid $newheadid
9930    if {$showlocalchanges} {
9931        dodiffindex
9932    }
9933}
9934
9935proc rmbranch {} {
9936    global headmenuid headmenuhead mainhead
9937    global idheads
9938
9939    set head $headmenuhead
9940    set id $headmenuid
9941    # this check shouldn't be needed any more...
9942    if {$head eq $mainhead} {
9943        error_popup [mc "Cannot delete the currently checked-out branch"]
9944        return
9945    }
9946    set dheads [descheads $id]
9947    if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
9948        # the stuff on this branch isn't on any other branch
9949        if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9950                        branch.\nReally delete branch %s?" $head $head]]} return
9951    }
9952    nowbusy rmbranch
9953    update
9954    if {[catch {exec git branch -D $head} err]} {
9955        notbusy rmbranch
9956        error_popup $err
9957        return
9958    }
9959    removehead $id $head
9960    removedhead $id $head
9961    redrawtags $id
9962    notbusy rmbranch
9963    dispneartags 0
9964    run refill_reflist
9965}
9966
9967# Display a list of tags and heads
9968proc showrefs {} {
9969    global showrefstop bgcolor fgcolor selectbgcolor NS
9970    global bglist fglist reflistfilter reflist maincursor
9971
9972    set top .showrefs
9973    set showrefstop $top
9974    if {[winfo exists $top]} {
9975        raise $top
9976        refill_reflist
9977        return
9978    }
9979    ttk_toplevel $top
9980    wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
9981    make_transient $top .
9982    text $top.list -background $bgcolor -foreground $fgcolor \
9983        -selectbackground $selectbgcolor -font mainfont \
9984        -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
9985        -width 30 -height 20 -cursor $maincursor \
9986        -spacing1 1 -spacing3 1 -state disabled
9987    $top.list tag configure highlight -background $selectbgcolor
9988    if {![lsearch -exact $bglist $top.list]} {
9989        lappend bglist $top.list
9990        lappend fglist $top.list
9991    }
9992    ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
9993    ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
9994    grid $top.list $top.ysb -sticky nsew
9995    grid $top.xsb x -sticky ew
9996    ${NS}::frame $top.f
9997    ${NS}::label $top.f.l -text "[mc "Filter"]: "
9998    ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
9999    set reflistfilter "*"
10000    trace add variable reflistfilter write reflistfilter_change
10001    pack $top.f.e -side right -fill x -expand 1
10002    pack $top.f.l -side left
10003    grid $top.f - -sticky ew -pady 2
10004    ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
10005    bind $top <Key-Escape> [list destroy $top]
10006    grid $top.close -
10007    grid columnconfigure $top 0 -weight 1
10008    grid rowconfigure $top 0 -weight 1
10009    bind $top.list <1> {break}
10010    bind $top.list <B1-Motion> {break}
10011    bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
10012    set reflist {}
10013    refill_reflist
10014}
10015
10016proc sel_reflist {w x y} {
10017    global showrefstop reflist headids tagids otherrefids
10018
10019    if {![winfo exists $showrefstop]} return
10020    set l [lindex [split [$w index "@$x,$y"] "."] 0]
10021    set ref [lindex $reflist [expr {$l-1}]]
10022    set n [lindex $ref 0]
10023    switch -- [lindex $ref 1] {
10024        "H" {selbyid $headids($n)}
10025        "T" {selbyid $tagids($n)}
10026        "o" {selbyid $otherrefids($n)}
10027    }
10028    $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
10029}
10030
10031proc unsel_reflist {} {
10032    global showrefstop
10033
10034    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
10035    $showrefstop.list tag remove highlight 0.0 end
10036}
10037
10038proc reflistfilter_change {n1 n2 op} {
10039    global reflistfilter
10040
10041    after cancel refill_reflist
10042    after 200 refill_reflist
10043}
10044
10045proc refill_reflist {} {
10046    global reflist reflistfilter showrefstop headids tagids otherrefids
10047    global curview
10048
10049    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
10050    set refs {}
10051    foreach n [array names headids] {
10052        if {[string match $reflistfilter $n]} {
10053            if {[commitinview $headids($n) $curview]} {
10054                lappend refs [list $n H]
10055            } else {
10056                interestedin $headids($n) {run refill_reflist}
10057            }
10058        }
10059    }
10060    foreach n [array names tagids] {
10061        if {[string match $reflistfilter $n]} {
10062            if {[commitinview $tagids($n) $curview]} {
10063                lappend refs [list $n T]
10064            } else {
10065                interestedin $tagids($n) {run refill_reflist}
10066            }
10067        }
10068    }
10069    foreach n [array names otherrefids] {
10070        if {[string match $reflistfilter $n]} {
10071            if {[commitinview $otherrefids($n) $curview]} {
10072                lappend refs [list $n o]
10073            } else {
10074                interestedin $otherrefids($n) {run refill_reflist}
10075            }
10076        }
10077    }
10078    set refs [lsort -index 0 $refs]
10079    if {$refs eq $reflist} return
10080
10081    # Update the contents of $showrefstop.list according to the
10082    # differences between $reflist (old) and $refs (new)
10083    $showrefstop.list conf -state normal
10084    $showrefstop.list insert end "\n"
10085    set i 0
10086    set j 0
10087    while {$i < [llength $reflist] || $j < [llength $refs]} {
10088        if {$i < [llength $reflist]} {
10089            if {$j < [llength $refs]} {
10090                set cmp [string compare [lindex $reflist $i 0] \
10091                             [lindex $refs $j 0]]
10092                if {$cmp == 0} {
10093                    set cmp [string compare [lindex $reflist $i 1] \
10094                                 [lindex $refs $j 1]]
10095                }
10096            } else {
10097                set cmp -1
10098            }
10099        } else {
10100            set cmp 1
10101        }
10102        switch -- $cmp {
10103            -1 {
10104                $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
10105                incr i
10106            }
10107            0 {
10108                incr i
10109                incr j
10110            }
10111            1 {
10112                set l [expr {$j + 1}]
10113                $showrefstop.list image create $l.0 -align baseline \
10114                    -image reficon-[lindex $refs $j 1] -padx 2
10115                $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
10116                incr j
10117            }
10118        }
10119    }
10120    set reflist $refs
10121    # delete last newline
10122    $showrefstop.list delete end-2c end-1c
10123    $showrefstop.list conf -state disabled
10124}
10125
10126# Stuff for finding nearby tags
10127proc getallcommits {} {
10128    global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
10129    global idheads idtags idotherrefs allparents tagobjid
10130    global gitdir
10131
10132    if {![info exists allcommits]} {
10133        set nextarc 0
10134        set allcommits 0
10135        set seeds {}
10136        set allcwait 0
10137        set cachedarcs 0
10138        set allccache [file join $gitdir "gitk.cache"]
10139        if {![catch {
10140            set f [open $allccache r]
10141            set allcwait 1
10142            getcache $f
10143        }]} return
10144    }
10145
10146    if {$allcwait} {
10147        return
10148    }
10149    set cmd [list | git rev-list --parents]
10150    set allcupdate [expr {$seeds ne {}}]
10151    if {!$allcupdate} {
10152        set ids "--all"
10153    } else {
10154        set refs [concat [array names idheads] [array names idtags] \
10155                      [array names idotherrefs]]
10156        set ids {}
10157        set tagobjs {}
10158        foreach name [array names tagobjid] {
10159            lappend tagobjs $tagobjid($name)
10160        }
10161        foreach id [lsort -unique $refs] {
10162            if {![info exists allparents($id)] &&
10163                [lsearch -exact $tagobjs $id] < 0} {
10164                lappend ids $id
10165            }
10166        }
10167        if {$ids ne {}} {
10168            foreach id $seeds {
10169                lappend ids "^$id"
10170            }
10171        }
10172    }
10173    if {$ids ne {}} {
10174        set fd [open [concat $cmd $ids] r]
10175        fconfigure $fd -blocking 0
10176        incr allcommits
10177        nowbusy allcommits
10178        filerun $fd [list getallclines $fd]
10179    } else {
10180        dispneartags 0
10181    }
10182}
10183
10184# Since most commits have 1 parent and 1 child, we group strings of
10185# such commits into "arcs" joining branch/merge points (BMPs), which
10186# are commits that either don't have 1 parent or don't have 1 child.
10187#
10188# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
10189# arcout(id) - outgoing arcs for BMP
10190# arcids(a) - list of IDs on arc including end but not start
10191# arcstart(a) - BMP ID at start of arc
10192# arcend(a) - BMP ID at end of arc
10193# growing(a) - arc a is still growing
10194# arctags(a) - IDs out of arcids (excluding end) that have tags
10195# archeads(a) - IDs out of arcids (excluding end) that have heads
10196# The start of an arc is at the descendent end, so "incoming" means
10197# coming from descendents, and "outgoing" means going towards ancestors.
10198
10199proc getallclines {fd} {
10200    global allparents allchildren idtags idheads nextarc
10201    global arcnos arcids arctags arcout arcend arcstart archeads growing
10202    global seeds allcommits cachedarcs allcupdate
10203
10204    set nid 0
10205    while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
10206        set id [lindex $line 0]
10207        if {[info exists allparents($id)]} {
10208            # seen it already
10209            continue
10210        }
10211        set cachedarcs 0
10212        set olds [lrange $line 1 end]
10213        set allparents($id) $olds
10214        if {![info exists allchildren($id)]} {
10215            set allchildren($id) {}
10216            set arcnos($id) {}
10217            lappend seeds $id
10218        } else {
10219            set a $arcnos($id)
10220            if {[llength $olds] == 1 && [llength $a] == 1} {
10221                lappend arcids($a) $id
10222                if {[info exists idtags($id)]} {
10223                    lappend arctags($a) $id
10224                }
10225                if {[info exists idheads($id)]} {
10226                    lappend archeads($a) $id
10227                }
10228                if {[info exists allparents($olds)]} {
10229                    # seen parent already
10230                    if {![info exists arcout($olds)]} {
10231                        splitarc $olds
10232                    }
10233                    lappend arcids($a) $olds
10234                    set arcend($a) $olds
10235                    unset growing($a)
10236                }
10237                lappend allchildren($olds) $id
10238                lappend arcnos($olds) $a
10239                continue
10240            }
10241        }
10242        foreach a $arcnos($id) {
10243            lappend arcids($a) $id
10244            set arcend($a) $id
10245            unset growing($a)
10246        }
10247
10248        set ao {}
10249        foreach p $olds {
10250            lappend allchildren($p) $id
10251            set a [incr nextarc]
10252            set arcstart($a) $id
10253            set archeads($a) {}
10254            set arctags($a) {}
10255            set archeads($a) {}
10256            set arcids($a) {}
10257            lappend ao $a
10258            set growing($a) 1
10259            if {[info exists allparents($p)]} {
10260                # seen it already, may need to make a new branch
10261                if {![info exists arcout($p)]} {
10262                    splitarc $p
10263                }
10264                lappend arcids($a) $p
10265                set arcend($a) $p
10266                unset growing($a)
10267            }
10268            lappend arcnos($p) $a
10269        }
10270        set arcout($id) $ao
10271    }
10272    if {$nid > 0} {
10273        global cached_dheads cached_dtags cached_atags
10274        unset -nocomplain cached_dheads
10275        unset -nocomplain cached_dtags
10276        unset -nocomplain cached_atags
10277    }
10278    if {![eof $fd]} {
10279        return [expr {$nid >= 1000? 2: 1}]
10280    }
10281    set cacheok 1
10282    if {[catch {
10283        fconfigure $fd -blocking 1
10284        close $fd
10285    } err]} {
10286        # got an error reading the list of commits
10287        # if we were updating, try rereading the whole thing again
10288        if {$allcupdate} {
10289            incr allcommits -1
10290            dropcache $err
10291            return
10292        }
10293        error_popup "[mc "Error reading commit topology information;\
10294                branch and preceding/following tag information\
10295                will be incomplete."]\n($err)"
10296        set cacheok 0
10297    }
10298    if {[incr allcommits -1] == 0} {
10299        notbusy allcommits
10300        if {$cacheok} {
10301            run savecache
10302        }
10303    }
10304    dispneartags 0
10305    return 0
10306}
10307
10308proc recalcarc {a} {
10309    global arctags archeads arcids idtags idheads
10310
10311    set at {}
10312    set ah {}
10313    foreach id [lrange $arcids($a) 0 end-1] {
10314        if {[info exists idtags($id)]} {
10315            lappend at $id
10316        }
10317        if {[info exists idheads($id)]} {
10318            lappend ah $id
10319        }
10320    }
10321    set arctags($a) $at
10322    set archeads($a) $ah
10323}
10324
10325proc splitarc {p} {
10326    global arcnos arcids nextarc arctags archeads idtags idheads
10327    global arcstart arcend arcout allparents growing
10328
10329    set a $arcnos($p)
10330    if {[llength $a] != 1} {
10331        puts "oops splitarc called but [llength $a] arcs already"
10332        return
10333    }
10334    set a [lindex $a 0]
10335    set i [lsearch -exact $arcids($a) $p]
10336    if {$i < 0} {
10337        puts "oops splitarc $p not in arc $a"
10338        return
10339    }
10340    set na [incr nextarc]
10341    if {[info exists arcend($a)]} {
10342        set arcend($na) $arcend($a)
10343    } else {
10344        set l [lindex $allparents([lindex $arcids($a) end]) 0]
10345        set j [lsearch -exact $arcnos($l) $a]
10346        set arcnos($l) [lreplace $arcnos($l) $j $j $na]
10347    }
10348    set tail [lrange $arcids($a) [expr {$i+1}] end]
10349    set arcids($a) [lrange $arcids($a) 0 $i]
10350    set arcend($a) $p
10351    set arcstart($na) $p
10352    set arcout($p) $na
10353    set arcids($na) $tail
10354    if {[info exists growing($a)]} {
10355        set growing($na) 1
10356        unset growing($a)
10357    }
10358
10359    foreach id $tail {
10360        if {[llength $arcnos($id)] == 1} {
10361            set arcnos($id) $na
10362        } else {
10363            set j [lsearch -exact $arcnos($id) $a]
10364            set arcnos($id) [lreplace $arcnos($id) $j $j $na]
10365        }
10366    }
10367
10368    # reconstruct tags and heads lists
10369    if {$arctags($a) ne {} || $archeads($a) ne {}} {
10370        recalcarc $a
10371        recalcarc $na
10372    } else {
10373        set arctags($na) {}
10374        set archeads($na) {}
10375    }
10376}
10377
10378# Update things for a new commit added that is a child of one
10379# existing commit.  Used when cherry-picking.
10380proc addnewchild {id p} {
10381    global allparents allchildren idtags nextarc
10382    global arcnos arcids arctags arcout arcend arcstart archeads growing
10383    global seeds allcommits
10384
10385    if {![info exists allcommits] || ![info exists arcnos($p)]} return
10386    set allparents($id) [list $p]
10387    set allchildren($id) {}
10388    set arcnos($id) {}
10389    lappend seeds $id
10390    lappend allchildren($p) $id
10391    set a [incr nextarc]
10392    set arcstart($a) $id
10393    set archeads($a) {}
10394    set arctags($a) {}
10395    set arcids($a) [list $p]
10396    set arcend($a) $p
10397    if {![info exists arcout($p)]} {
10398        splitarc $p
10399    }
10400    lappend arcnos($p) $a
10401    set arcout($id) [list $a]
10402}
10403
10404# This implements a cache for the topology information.
10405# The cache saves, for each arc, the start and end of the arc,
10406# the ids on the arc, and the outgoing arcs from the end.
10407proc readcache {f} {
10408    global arcnos arcids arcout arcstart arcend arctags archeads nextarc
10409    global idtags idheads allparents cachedarcs possible_seeds seeds growing
10410    global allcwait
10411
10412    set a $nextarc
10413    set lim $cachedarcs
10414    if {$lim - $a > 500} {
10415        set lim [expr {$a + 500}]
10416    }
10417    if {[catch {
10418        if {$a == $lim} {
10419            # finish reading the cache and setting up arctags, etc.
10420            set line [gets $f]
10421            if {$line ne "1"} {error "bad final version"}
10422            close $f
10423            foreach id [array names idtags] {
10424                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10425                    [llength $allparents($id)] == 1} {
10426                    set a [lindex $arcnos($id) 0]
10427                    if {$arctags($a) eq {}} {
10428                        recalcarc $a
10429                    }
10430                }
10431            }
10432            foreach id [array names idheads] {
10433                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10434                    [llength $allparents($id)] == 1} {
10435                    set a [lindex $arcnos($id) 0]
10436                    if {$archeads($a) eq {}} {
10437                        recalcarc $a
10438                    }
10439                }
10440            }
10441            foreach id [lsort -unique $possible_seeds] {
10442                if {$arcnos($id) eq {}} {
10443                    lappend seeds $id
10444                }
10445            }
10446            set allcwait 0
10447        } else {
10448            while {[incr a] <= $lim} {
10449                set line [gets $f]
10450                if {[llength $line] != 3} {error "bad line"}
10451                set s [lindex $line 0]
10452                set arcstart($a) $s
10453                lappend arcout($s) $a
10454                if {![info exists arcnos($s)]} {
10455                    lappend possible_seeds $s
10456                    set arcnos($s) {}
10457                }
10458                set e [lindex $line 1]
10459                if {$e eq {}} {
10460                    set growing($a) 1
10461                } else {
10462                    set arcend($a) $e
10463                    if {![info exists arcout($e)]} {
10464                        set arcout($e) {}
10465                    }
10466                }
10467                set arcids($a) [lindex $line 2]
10468                foreach id $arcids($a) {
10469                    lappend allparents($s) $id
10470                    set s $id
10471                    lappend arcnos($id) $a
10472                }
10473                if {![info exists allparents($s)]} {
10474                    set allparents($s) {}
10475                }
10476                set arctags($a) {}
10477                set archeads($a) {}
10478            }
10479            set nextarc [expr {$a - 1}]
10480        }
10481    } err]} {
10482        dropcache $err
10483        return 0
10484    }
10485    if {!$allcwait} {
10486        getallcommits
10487    }
10488    return $allcwait
10489}
10490
10491proc getcache {f} {
10492    global nextarc cachedarcs possible_seeds
10493
10494    if {[catch {
10495        set line [gets $f]
10496        if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
10497        # make sure it's an integer
10498        set cachedarcs [expr {int([lindex $line 1])}]
10499        if {$cachedarcs < 0} {error "bad number of arcs"}
10500        set nextarc 0
10501        set possible_seeds {}
10502        run readcache $f
10503    } err]} {
10504        dropcache $err
10505    }
10506    return 0
10507}
10508
10509proc dropcache {err} {
10510    global allcwait nextarc cachedarcs seeds
10511
10512    #puts "dropping cache ($err)"
10513    foreach v {arcnos arcout arcids arcstart arcend growing \
10514                   arctags archeads allparents allchildren} {
10515        global $v
10516        unset -nocomplain $v
10517    }
10518    set allcwait 0
10519    set nextarc 0
10520    set cachedarcs 0
10521    set seeds {}
10522    getallcommits
10523}
10524
10525proc writecache {f} {
10526    global cachearc cachedarcs allccache
10527    global arcstart arcend arcnos arcids arcout
10528
10529    set a $cachearc
10530    set lim $cachedarcs
10531    if {$lim - $a > 1000} {
10532        set lim [expr {$a + 1000}]
10533    }
10534    if {[catch {
10535        while {[incr a] <= $lim} {
10536            if {[info exists arcend($a)]} {
10537                puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
10538            } else {
10539                puts $f [list $arcstart($a) {} $arcids($a)]
10540            }
10541        }
10542    } err]} {
10543        catch {close $f}
10544        catch {file delete $allccache}
10545        #puts "writing cache failed ($err)"
10546        return 0
10547    }
10548    set cachearc [expr {$a - 1}]
10549    if {$a > $cachedarcs} {
10550        puts $f "1"
10551        close $f
10552        return 0
10553    }
10554    return 1
10555}
10556
10557proc savecache {} {
10558    global nextarc cachedarcs cachearc allccache
10559
10560    if {$nextarc == $cachedarcs} return
10561    set cachearc 0
10562    set cachedarcs $nextarc
10563    catch {
10564        set f [open $allccache w]
10565        puts $f [list 1 $cachedarcs]
10566        run writecache $f
10567    }
10568}
10569
10570# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
10571# or 0 if neither is true.
10572proc anc_or_desc {a b} {
10573    global arcout arcstart arcend arcnos cached_isanc
10574
10575    if {$arcnos($a) eq $arcnos($b)} {
10576        # Both are on the same arc(s); either both are the same BMP,
10577        # or if one is not a BMP, the other is also not a BMP or is
10578        # the BMP at end of the arc (and it only has 1 incoming arc).
10579        # Or both can be BMPs with no incoming arcs.
10580        if {$a eq $b || $arcnos($a) eq {}} {
10581            return 0
10582        }
10583        # assert {[llength $arcnos($a)] == 1}
10584        set arc [lindex $arcnos($a) 0]
10585        set i [lsearch -exact $arcids($arc) $a]
10586        set j [lsearch -exact $arcids($arc) $b]
10587        if {$i < 0 || $i > $j} {
10588            return 1
10589        } else {
10590            return -1
10591        }
10592    }
10593
10594    if {![info exists arcout($a)]} {
10595        set arc [lindex $arcnos($a) 0]
10596        if {[info exists arcend($arc)]} {
10597            set aend $arcend($arc)
10598        } else {
10599            set aend {}
10600        }
10601        set a $arcstart($arc)
10602    } else {
10603        set aend $a
10604    }
10605    if {![info exists arcout($b)]} {
10606        set arc [lindex $arcnos($b) 0]
10607        if {[info exists arcend($arc)]} {
10608            set bend $arcend($arc)
10609        } else {
10610            set bend {}
10611        }
10612        set b $arcstart($arc)
10613    } else {
10614        set bend $b
10615    }
10616    if {$a eq $bend} {
10617        return 1
10618    }
10619    if {$b eq $aend} {
10620        return -1
10621    }
10622    if {[info exists cached_isanc($a,$bend)]} {
10623        if {$cached_isanc($a,$bend)} {
10624            return 1
10625        }
10626    }
10627    if {[info exists cached_isanc($b,$aend)]} {
10628        if {$cached_isanc($b,$aend)} {
10629            return -1
10630        }
10631        if {[info exists cached_isanc($a,$bend)]} {
10632            return 0
10633        }
10634    }
10635
10636    set todo [list $a $b]
10637    set anc($a) a
10638    set anc($b) b
10639    for {set i 0} {$i < [llength $todo]} {incr i} {
10640        set x [lindex $todo $i]
10641        if {$anc($x) eq {}} {
10642            continue
10643        }
10644        foreach arc $arcnos($x) {
10645            set xd $arcstart($arc)
10646            if {$xd eq $bend} {
10647                set cached_isanc($a,$bend) 1
10648                set cached_isanc($b,$aend) 0
10649                return 1
10650            } elseif {$xd eq $aend} {
10651                set cached_isanc($b,$aend) 1
10652                set cached_isanc($a,$bend) 0
10653                return -1
10654            }
10655            if {![info exists anc($xd)]} {
10656                set anc($xd) $anc($x)
10657                lappend todo $xd
10658            } elseif {$anc($xd) ne $anc($x)} {
10659                set anc($xd) {}
10660            }
10661        }
10662    }
10663    set cached_isanc($a,$bend) 0
10664    set cached_isanc($b,$aend) 0
10665    return 0
10666}
10667
10668# This identifies whether $desc has an ancestor that is
10669# a growing tip of the graph and which is not an ancestor of $anc
10670# and returns 0 if so and 1 if not.
10671# If we subsequently discover a tag on such a growing tip, and that
10672# turns out to be a descendent of $anc (which it could, since we
10673# don't necessarily see children before parents), then $desc
10674# isn't a good choice to display as a descendent tag of
10675# $anc (since it is the descendent of another tag which is
10676# a descendent of $anc).  Similarly, $anc isn't a good choice to
10677# display as a ancestor tag of $desc.
10678#
10679proc is_certain {desc anc} {
10680    global arcnos arcout arcstart arcend growing problems
10681
10682    set certain {}
10683    if {[llength $arcnos($anc)] == 1} {
10684        # tags on the same arc are certain
10685        if {$arcnos($desc) eq $arcnos($anc)} {
10686            return 1
10687        }
10688        if {![info exists arcout($anc)]} {
10689            # if $anc is partway along an arc, use the start of the arc instead
10690            set a [lindex $arcnos($anc) 0]
10691            set anc $arcstart($a)
10692        }
10693    }
10694    if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
10695        set x $desc
10696    } else {
10697        set a [lindex $arcnos($desc) 0]
10698        set x $arcend($a)
10699    }
10700    if {$x == $anc} {
10701        return 1
10702    }
10703    set anclist [list $x]
10704    set dl($x) 1
10705    set nnh 1
10706    set ngrowanc 0
10707    for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
10708        set x [lindex $anclist $i]
10709        if {$dl($x)} {
10710            incr nnh -1
10711        }
10712        set done($x) 1
10713        foreach a $arcout($x) {
10714            if {[info exists growing($a)]} {
10715                if {![info exists growanc($x)] && $dl($x)} {
10716                    set growanc($x) 1
10717                    incr ngrowanc
10718                }
10719            } else {
10720                set y $arcend($a)
10721                if {[info exists dl($y)]} {
10722                    if {$dl($y)} {
10723                        if {!$dl($x)} {
10724                            set dl($y) 0
10725                            if {![info exists done($y)]} {
10726                                incr nnh -1
10727                            }
10728                            if {[info exists growanc($x)]} {
10729                                incr ngrowanc -1
10730                            }
10731                            set xl [list $y]
10732                            for {set k 0} {$k < [llength $xl]} {incr k} {
10733                                set z [lindex $xl $k]
10734                                foreach c $arcout($z) {
10735                                    if {[info exists arcend($c)]} {
10736                                        set v $arcend($c)
10737                                        if {[info exists dl($v)] && $dl($v)} {
10738                                            set dl($v) 0
10739                                            if {![info exists done($v)]} {
10740                                                incr nnh -1
10741                                            }
10742                                            if {[info exists growanc($v)]} {
10743                                                incr ngrowanc -1
10744                                            }
10745                                            lappend xl $v
10746                                        }
10747                                    }
10748                                }
10749                            }
10750                        }
10751                    }
10752                } elseif {$y eq $anc || !$dl($x)} {
10753                    set dl($y) 0
10754                    lappend anclist $y
10755                } else {
10756                    set dl($y) 1
10757                    lappend anclist $y
10758                    incr nnh
10759                }
10760            }
10761        }
10762    }
10763    foreach x [array names growanc] {
10764        if {$dl($x)} {
10765            return 0
10766        }
10767        return 0
10768    }
10769    return 1
10770}
10771
10772proc validate_arctags {a} {
10773    global arctags idtags
10774
10775    set i -1
10776    set na $arctags($a)
10777    foreach id $arctags($a) {
10778        incr i
10779        if {![info exists idtags($id)]} {
10780            set na [lreplace $na $i $i]
10781            incr i -1
10782        }
10783    }
10784    set arctags($a) $na
10785}
10786
10787proc validate_archeads {a} {
10788    global archeads idheads
10789
10790    set i -1
10791    set na $archeads($a)
10792    foreach id $archeads($a) {
10793        incr i
10794        if {![info exists idheads($id)]} {
10795            set na [lreplace $na $i $i]
10796            incr i -1
10797        }
10798    }
10799    set archeads($a) $na
10800}
10801
10802# Return the list of IDs that have tags that are descendents of id,
10803# ignoring IDs that are descendents of IDs already reported.
10804proc desctags {id} {
10805    global arcnos arcstart arcids arctags idtags allparents
10806    global growing cached_dtags
10807
10808    if {![info exists allparents($id)]} {
10809        return {}
10810    }
10811    set t1 [clock clicks -milliseconds]
10812    set argid $id
10813    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10814        # part-way along an arc; check that arc first
10815        set a [lindex $arcnos($id) 0]
10816        if {$arctags($a) ne {}} {
10817            validate_arctags $a
10818            set i [lsearch -exact $arcids($a) $id]
10819            set tid {}
10820            foreach t $arctags($a) {
10821                set j [lsearch -exact $arcids($a) $t]
10822                if {$j >= $i} break
10823                set tid $t
10824            }
10825            if {$tid ne {}} {
10826                return $tid
10827            }
10828        }
10829        set id $arcstart($a)
10830        if {[info exists idtags($id)]} {
10831            return $id
10832        }
10833    }
10834    if {[info exists cached_dtags($id)]} {
10835        return $cached_dtags($id)
10836    }
10837
10838    set origid $id
10839    set todo [list $id]
10840    set queued($id) 1
10841    set nc 1
10842    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10843        set id [lindex $todo $i]
10844        set done($id) 1
10845        set ta [info exists hastaggedancestor($id)]
10846        if {!$ta} {
10847            incr nc -1
10848        }
10849        # ignore tags on starting node
10850        if {!$ta && $i > 0} {
10851            if {[info exists idtags($id)]} {
10852                set tagloc($id) $id
10853                set ta 1
10854            } elseif {[info exists cached_dtags($id)]} {
10855                set tagloc($id) $cached_dtags($id)
10856                set ta 1
10857            }
10858        }
10859        foreach a $arcnos($id) {
10860            set d $arcstart($a)
10861            if {!$ta && $arctags($a) ne {}} {
10862                validate_arctags $a
10863                if {$arctags($a) ne {}} {
10864                    lappend tagloc($id) [lindex $arctags($a) end]
10865                }
10866            }
10867            if {$ta || $arctags($a) ne {}} {
10868                set tomark [list $d]
10869                for {set j 0} {$j < [llength $tomark]} {incr j} {
10870                    set dd [lindex $tomark $j]
10871                    if {![info exists hastaggedancestor($dd)]} {
10872                        if {[info exists done($dd)]} {
10873                            foreach b $arcnos($dd) {
10874                                lappend tomark $arcstart($b)
10875                            }
10876                            if {[info exists tagloc($dd)]} {
10877                                unset tagloc($dd)
10878                            }
10879                        } elseif {[info exists queued($dd)]} {
10880                            incr nc -1
10881                        }
10882                        set hastaggedancestor($dd) 1
10883                    }
10884                }
10885            }
10886            if {![info exists queued($d)]} {
10887                lappend todo $d
10888                set queued($d) 1
10889                if {![info exists hastaggedancestor($d)]} {
10890                    incr nc
10891                }
10892            }
10893        }
10894    }
10895    set tags {}
10896    foreach id [array names tagloc] {
10897        if {![info exists hastaggedancestor($id)]} {
10898            foreach t $tagloc($id) {
10899                if {[lsearch -exact $tags $t] < 0} {
10900                    lappend tags $t
10901                }
10902            }
10903        }
10904    }
10905    set t2 [clock clicks -milliseconds]
10906    set loopix $i
10907
10908    # remove tags that are descendents of other tags
10909    for {set i 0} {$i < [llength $tags]} {incr i} {
10910        set a [lindex $tags $i]
10911        for {set j 0} {$j < $i} {incr j} {
10912            set b [lindex $tags $j]
10913            set r [anc_or_desc $a $b]
10914            if {$r == 1} {
10915                set tags [lreplace $tags $j $j]
10916                incr j -1
10917                incr i -1
10918            } elseif {$r == -1} {
10919                set tags [lreplace $tags $i $i]
10920                incr i -1
10921                break
10922            }
10923        }
10924    }
10925
10926    if {[array names growing] ne {}} {
10927        # graph isn't finished, need to check if any tag could get
10928        # eclipsed by another tag coming later.  Simply ignore any
10929        # tags that could later get eclipsed.
10930        set ctags {}
10931        foreach t $tags {
10932            if {[is_certain $t $origid]} {
10933                lappend ctags $t
10934            }
10935        }
10936        if {$tags eq $ctags} {
10937            set cached_dtags($origid) $tags
10938        } else {
10939            set tags $ctags
10940        }
10941    } else {
10942        set cached_dtags($origid) $tags
10943    }
10944    set t3 [clock clicks -milliseconds]
10945    if {0 && $t3 - $t1 >= 100} {
10946        puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10947            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10948    }
10949    return $tags
10950}
10951
10952proc anctags {id} {
10953    global arcnos arcids arcout arcend arctags idtags allparents
10954    global growing cached_atags
10955
10956    if {![info exists allparents($id)]} {
10957        return {}
10958    }
10959    set t1 [clock clicks -milliseconds]
10960    set argid $id
10961    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10962        # part-way along an arc; check that arc first
10963        set a [lindex $arcnos($id) 0]
10964        if {$arctags($a) ne {}} {
10965            validate_arctags $a
10966            set i [lsearch -exact $arcids($a) $id]
10967            foreach t $arctags($a) {
10968                set j [lsearch -exact $arcids($a) $t]
10969                if {$j > $i} {
10970                    return $t
10971                }
10972            }
10973        }
10974        if {![info exists arcend($a)]} {
10975            return {}
10976        }
10977        set id $arcend($a)
10978        if {[info exists idtags($id)]} {
10979            return $id
10980        }
10981    }
10982    if {[info exists cached_atags($id)]} {
10983        return $cached_atags($id)
10984    }
10985
10986    set origid $id
10987    set todo [list $id]
10988    set queued($id) 1
10989    set taglist {}
10990    set nc 1
10991    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10992        set id [lindex $todo $i]
10993        set done($id) 1
10994        set td [info exists hastaggeddescendent($id)]
10995        if {!$td} {
10996            incr nc -1
10997        }
10998        # ignore tags on starting node
10999        if {!$td && $i > 0} {
11000            if {[info exists idtags($id)]} {
11001                set tagloc($id) $id
11002                set td 1
11003            } elseif {[info exists cached_atags($id)]} {
11004                set tagloc($id) $cached_atags($id)
11005                set td 1
11006            }
11007        }
11008        foreach a $arcout($id) {
11009            if {!$td && $arctags($a) ne {}} {
11010                validate_arctags $a
11011                if {$arctags($a) ne {}} {
11012                    lappend tagloc($id) [lindex $arctags($a) 0]
11013                }
11014            }
11015            if {![info exists arcend($a)]} continue
11016            set d $arcend($a)
11017            if {$td || $arctags($a) ne {}} {
11018                set tomark [list $d]
11019                for {set j 0} {$j < [llength $tomark]} {incr j} {
11020                    set dd [lindex $tomark $j]
11021                    if {![info exists hastaggeddescendent($dd)]} {
11022                        if {[info exists done($dd)]} {
11023                            foreach b $arcout($dd) {
11024                                if {[info exists arcend($b)]} {
11025                                    lappend tomark $arcend($b)
11026                                }
11027                            }
11028                            if {[info exists tagloc($dd)]} {
11029                                unset tagloc($dd)
11030                            }
11031                        } elseif {[info exists queued($dd)]} {
11032                            incr nc -1
11033                        }
11034                        set hastaggeddescendent($dd) 1
11035                    }
11036                }
11037            }
11038            if {![info exists queued($d)]} {
11039                lappend todo $d
11040                set queued($d) 1
11041                if {![info exists hastaggeddescendent($d)]} {
11042                    incr nc
11043                }
11044            }
11045        }
11046    }
11047    set t2 [clock clicks -milliseconds]
11048    set loopix $i
11049    set tags {}
11050    foreach id [array names tagloc] {
11051        if {![info exists hastaggeddescendent($id)]} {
11052            foreach t $tagloc($id) {
11053                if {[lsearch -exact $tags $t] < 0} {
11054                    lappend tags $t
11055                }
11056            }
11057        }
11058    }
11059
11060    # remove tags that are ancestors of other tags
11061    for {set i 0} {$i < [llength $tags]} {incr i} {
11062        set a [lindex $tags $i]
11063        for {set j 0} {$j < $i} {incr j} {
11064            set b [lindex $tags $j]
11065            set r [anc_or_desc $a $b]
11066            if {$r == -1} {
11067                set tags [lreplace $tags $j $j]
11068                incr j -1
11069                incr i -1
11070            } elseif {$r == 1} {
11071                set tags [lreplace $tags $i $i]
11072                incr i -1
11073                break
11074            }
11075        }
11076    }
11077
11078    if {[array names growing] ne {}} {
11079        # graph isn't finished, need to check if any tag could get
11080        # eclipsed by another tag coming later.  Simply ignore any
11081        # tags that could later get eclipsed.
11082        set ctags {}
11083        foreach t $tags {
11084            if {[is_certain $origid $t]} {
11085                lappend ctags $t
11086            }
11087        }
11088        if {$tags eq $ctags} {
11089            set cached_atags($origid) $tags
11090        } else {
11091            set tags $ctags
11092        }
11093    } else {
11094        set cached_atags($origid) $tags
11095    }
11096    set t3 [clock clicks -milliseconds]
11097    if {0 && $t3 - $t1 >= 100} {
11098        puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
11099            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
11100    }
11101    return $tags
11102}
11103
11104# Return the list of IDs that have heads that are descendents of id,
11105# including id itself if it has a head.
11106proc descheads {id} {
11107    global arcnos arcstart arcids archeads idheads cached_dheads
11108    global allparents arcout
11109
11110    if {![info exists allparents($id)]} {
11111        return {}
11112    }
11113    set aret {}
11114    if {![info exists arcout($id)]} {
11115        # part-way along an arc; check it first
11116        set a [lindex $arcnos($id) 0]
11117        if {$archeads($a) ne {}} {
11118            validate_archeads $a
11119            set i [lsearch -exact $arcids($a) $id]
11120            foreach t $archeads($a) {
11121                set j [lsearch -exact $arcids($a) $t]
11122                if {$j > $i} break
11123                lappend aret $t
11124            }
11125        }
11126        set id $arcstart($a)
11127    }
11128    set origid $id
11129    set todo [list $id]
11130    set seen($id) 1
11131    set ret {}
11132    for {set i 0} {$i < [llength $todo]} {incr i} {
11133        set id [lindex $todo $i]
11134        if {[info exists cached_dheads($id)]} {
11135            set ret [concat $ret $cached_dheads($id)]
11136        } else {
11137            if {[info exists idheads($id)]} {
11138                lappend ret $id
11139            }
11140            foreach a $arcnos($id) {
11141                if {$archeads($a) ne {}} {
11142                    validate_archeads $a
11143                    if {$archeads($a) ne {}} {
11144                        set ret [concat $ret $archeads($a)]
11145                    }
11146                }
11147                set d $arcstart($a)
11148                if {![info exists seen($d)]} {
11149                    lappend todo $d
11150                    set seen($d) 1
11151                }
11152            }
11153        }
11154    }
11155    set ret [lsort -unique $ret]
11156    set cached_dheads($origid) $ret
11157    return [concat $ret $aret]
11158}
11159
11160proc addedtag {id} {
11161    global arcnos arcout cached_dtags cached_atags
11162
11163    if {![info exists arcnos($id)]} return
11164    if {![info exists arcout($id)]} {
11165        recalcarc [lindex $arcnos($id) 0]
11166    }
11167    unset -nocomplain cached_dtags
11168    unset -nocomplain cached_atags
11169}
11170
11171proc addedhead {hid head} {
11172    global arcnos arcout cached_dheads
11173
11174    if {![info exists arcnos($hid)]} return
11175    if {![info exists arcout($hid)]} {
11176        recalcarc [lindex $arcnos($hid) 0]
11177    }
11178    unset -nocomplain cached_dheads
11179}
11180
11181proc removedhead {hid head} {
11182    global cached_dheads
11183
11184    unset -nocomplain cached_dheads
11185}
11186
11187proc movedhead {hid head} {
11188    global arcnos arcout cached_dheads
11189
11190    if {![info exists arcnos($hid)]} return
11191    if {![info exists arcout($hid)]} {
11192        recalcarc [lindex $arcnos($hid) 0]
11193    }
11194    unset -nocomplain cached_dheads
11195}
11196
11197proc changedrefs {} {
11198    global cached_dheads cached_dtags cached_atags cached_tagcontent
11199    global arctags archeads arcnos arcout idheads idtags
11200
11201    foreach id [concat [array names idheads] [array names idtags]] {
11202        if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
11203            set a [lindex $arcnos($id) 0]
11204            if {![info exists donearc($a)]} {
11205                recalcarc $a
11206                set donearc($a) 1
11207            }
11208        }
11209    }
11210    unset -nocomplain cached_tagcontent
11211    unset -nocomplain cached_dtags
11212    unset -nocomplain cached_atags
11213    unset -nocomplain cached_dheads
11214}
11215
11216proc rereadrefs {} {
11217    global idtags idheads idotherrefs mainheadid
11218
11219    set refids [concat [array names idtags] \
11220                    [array names idheads] [array names idotherrefs]]
11221    foreach id $refids {
11222        if {![info exists ref($id)]} {
11223            set ref($id) [listrefs $id]
11224        }
11225    }
11226    set oldmainhead $mainheadid
11227    readrefs
11228    changedrefs
11229    set refids [lsort -unique [concat $refids [array names idtags] \
11230                        [array names idheads] [array names idotherrefs]]]
11231    foreach id $refids {
11232        set v [listrefs $id]
11233        if {![info exists ref($id)] || $ref($id) != $v} {
11234            redrawtags $id
11235        }
11236    }
11237    if {$oldmainhead ne $mainheadid} {
11238        redrawtags $oldmainhead
11239        redrawtags $mainheadid
11240    }
11241    run refill_reflist
11242}
11243
11244proc listrefs {id} {
11245    global idtags idheads idotherrefs
11246
11247    set x {}
11248    if {[info exists idtags($id)]} {
11249        set x $idtags($id)
11250    }
11251    set y {}
11252    if {[info exists idheads($id)]} {
11253        set y $idheads($id)
11254    }
11255    set z {}
11256    if {[info exists idotherrefs($id)]} {
11257        set z $idotherrefs($id)
11258    }
11259    return [list $x $y $z]
11260}
11261
11262proc add_tag_ctext {tag} {
11263    global ctext cached_tagcontent tagids
11264
11265    if {![info exists cached_tagcontent($tag)]} {
11266        catch {
11267            set cached_tagcontent($tag) [exec git cat-file -p $tag]
11268        }
11269    }
11270    $ctext insert end "[mc "Tag"]: $tag\n" bold
11271    if {[info exists cached_tagcontent($tag)]} {
11272        set text $cached_tagcontent($tag)
11273    } else {
11274        set text "[mc "Id"]:  $tagids($tag)"
11275    }
11276    appendwithlinks $text {}
11277}
11278
11279proc showtag {tag isnew} {
11280    global ctext cached_tagcontent tagids linknum tagobjid
11281
11282    if {$isnew} {
11283        addtohistory [list showtag $tag 0] savectextpos
11284    }
11285    $ctext conf -state normal
11286    clear_ctext
11287    settabs 0
11288    set linknum 0
11289    add_tag_ctext $tag
11290    maybe_scroll_ctext 1
11291    $ctext conf -state disabled
11292    init_flist {}
11293}
11294
11295proc showtags {id isnew} {
11296    global idtags ctext linknum
11297
11298    if {$isnew} {
11299        addtohistory [list showtags $id 0] savectextpos
11300    }
11301    $ctext conf -state normal
11302    clear_ctext
11303    settabs 0
11304    set linknum 0
11305    set sep {}
11306    foreach tag $idtags($id) {
11307        $ctext insert end $sep
11308        add_tag_ctext $tag
11309        set sep "\n\n"
11310    }
11311    maybe_scroll_ctext 1
11312    $ctext conf -state disabled
11313    init_flist {}
11314}
11315
11316proc doquit {} {
11317    global stopped
11318    global gitktmpdir
11319
11320    set stopped 100
11321    savestuff .
11322    destroy .
11323
11324    if {[info exists gitktmpdir]} {
11325        catch {file delete -force $gitktmpdir}
11326    }
11327}
11328
11329proc mkfontdisp {font top which} {
11330    global fontattr fontpref $font NS use_ttk
11331
11332    set fontpref($font) [set $font]
11333    ${NS}::button $top.${font}but -text $which \
11334        -command [list choosefont $font $which]
11335    ${NS}::label $top.$font -relief flat -font $font \
11336        -text $fontattr($font,family) -justify left
11337    grid x $top.${font}but $top.$font -sticky w
11338}
11339
11340proc choosefont {font which} {
11341    global fontparam fontlist fonttop fontattr
11342    global prefstop NS
11343
11344    set fontparam(which) $which
11345    set fontparam(font) $font
11346    set fontparam(family) [font actual $font -family]
11347    set fontparam(size) $fontattr($font,size)
11348    set fontparam(weight) $fontattr($font,weight)
11349    set fontparam(slant) $fontattr($font,slant)
11350    set top .gitkfont
11351    set fonttop $top
11352    if {![winfo exists $top]} {
11353        font create sample
11354        eval font config sample [font actual $font]
11355        ttk_toplevel $top
11356        make_transient $top $prefstop
11357        wm title $top [mc "Gitk font chooser"]
11358        ${NS}::label $top.l -textvariable fontparam(which)
11359        pack $top.l -side top
11360        set fontlist [lsort [font families]]
11361        ${NS}::frame $top.f
11362        listbox $top.f.fam -listvariable fontlist \
11363            -yscrollcommand [list $top.f.sb set]
11364        bind $top.f.fam <<ListboxSelect>> selfontfam
11365        ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
11366        pack $top.f.sb -side right -fill y
11367        pack $top.f.fam -side left -fill both -expand 1
11368        pack $top.f -side top -fill both -expand 1
11369        ${NS}::frame $top.g
11370        spinbox $top.g.size -from 4 -to 40 -width 4 \
11371            -textvariable fontparam(size) \
11372            -validatecommand {string is integer -strict %s}
11373        checkbutton $top.g.bold -padx 5 \
11374            -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
11375            -variable fontparam(weight) -onvalue bold -offvalue normal
11376        checkbutton $top.g.ital -padx 5 \
11377            -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
11378            -variable fontparam(slant) -onvalue italic -offvalue roman
11379        pack $top.g.size $top.g.bold $top.g.ital -side left
11380        pack $top.g -side top
11381        canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
11382            -background white
11383        $top.c create text 100 25 -anchor center -text $which -font sample \
11384            -fill black -tags text
11385        bind $top.c <Configure> [list centertext $top.c]
11386        pack $top.c -side top -fill x
11387        ${NS}::frame $top.buts
11388        ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
11389        ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
11390        bind $top <Key-Return> fontok
11391        bind $top <Key-Escape> fontcan
11392        grid $top.buts.ok $top.buts.can
11393        grid columnconfigure $top.buts 0 -weight 1 -uniform a
11394        grid columnconfigure $top.buts 1 -weight 1 -uniform a
11395        pack $top.buts -side bottom -fill x
11396        trace add variable fontparam write chg_fontparam
11397    } else {
11398        raise $top
11399        $top.c itemconf text -text $which
11400    }
11401    set i [lsearch -exact $fontlist $fontparam(family)]
11402    if {$i >= 0} {
11403        $top.f.fam selection set $i
11404        $top.f.fam see $i
11405    }
11406}
11407
11408proc centertext {w} {
11409    $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
11410}
11411
11412proc fontok {} {
11413    global fontparam fontpref prefstop
11414
11415    set f $fontparam(font)
11416    set fontpref($f) [list $fontparam(family) $fontparam(size)]
11417    if {$fontparam(weight) eq "bold"} {
11418        lappend fontpref($f) "bold"
11419    }
11420    if {$fontparam(slant) eq "italic"} {
11421        lappend fontpref($f) "italic"
11422    }
11423    set w $prefstop.notebook.fonts.$f
11424    $w conf -text $fontparam(family) -font $fontpref($f)
11425
11426    fontcan
11427}
11428
11429proc fontcan {} {
11430    global fonttop fontparam
11431
11432    if {[info exists fonttop]} {
11433        catch {destroy $fonttop}
11434        catch {font delete sample}
11435        unset fonttop
11436        unset fontparam
11437    }
11438}
11439
11440if {[package vsatisfies [package provide Tk] 8.6]} {
11441    # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
11442    # function to make use of it.
11443    proc choosefont {font which} {
11444        tk fontchooser configure -title $which -font $font \
11445            -command [list on_choosefont $font $which]
11446        tk fontchooser show
11447    }
11448    proc on_choosefont {font which newfont} {
11449        global fontparam
11450        puts stderr "$font $newfont"
11451        array set f [font actual $newfont]
11452        set fontparam(which) $which
11453        set fontparam(font) $font
11454        set fontparam(family) $f(-family)
11455        set fontparam(size) $f(-size)
11456        set fontparam(weight) $f(-weight)
11457        set fontparam(slant) $f(-slant)
11458        fontok
11459    }
11460}
11461
11462proc selfontfam {} {
11463    global fonttop fontparam
11464
11465    set i [$fonttop.f.fam curselection]
11466    if {$i ne {}} {
11467        set fontparam(family) [$fonttop.f.fam get $i]
11468    }
11469}
11470
11471proc chg_fontparam {v sub op} {
11472    global fontparam
11473
11474    font config sample -$sub $fontparam($sub)
11475}
11476
11477# Create a property sheet tab page
11478proc create_prefs_page {w} {
11479    global NS
11480    set parent [join [lrange [split $w .] 0 end-1] .]
11481    if {[winfo class $parent] eq "TNotebook"} {
11482        ${NS}::frame $w
11483    } else {
11484        ${NS}::labelframe $w
11485    }
11486}
11487
11488proc prefspage_general {notebook} {
11489    global NS maxwidth maxgraphpct showneartags showlocalchanges
11490    global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11491    global hideremotes want_ttk have_ttk maxrefs
11492
11493    set page [create_prefs_page $notebook.general]
11494
11495    ${NS}::label $page.ldisp -text [mc "Commit list display options"]
11496    grid $page.ldisp - -sticky w -pady 10
11497    ${NS}::label $page.spacer -text " "
11498    ${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
11499    spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
11500    grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w
11501                                         #xgettext:no-tcl-format
11502    ${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
11503    spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
11504    grid x $page.maxpctl $page.maxpct -sticky w
11505    ${NS}::checkbutton $page.showlocal -text [mc "Show local changes"] \
11506        -variable showlocalchanges
11507    grid x $page.showlocal -sticky w
11508    ${NS}::checkbutton $page.autoselect -text [mc "Auto-select SHA1 (length)"] \
11509        -variable autoselect
11510    spinbox $page.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
11511    grid x $page.autoselect $page.autosellen -sticky w
11512    ${NS}::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \
11513        -variable hideremotes
11514    grid x $page.hideremotes -sticky w
11515
11516    ${NS}::label $page.ddisp -text [mc "Diff display options"]
11517    grid $page.ddisp - -sticky w -pady 10
11518    ${NS}::label $page.tabstopl -text [mc "Tab spacing"]
11519    spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
11520    grid x $page.tabstopl $page.tabstop -sticky w
11521    ${NS}::checkbutton $page.ntag -text [mc "Display nearby tags/heads"] \
11522        -variable showneartags
11523    grid x $page.ntag -sticky w
11524    ${NS}::label $page.maxrefsl -text [mc "Maximum # tags/heads to show"]
11525    spinbox $page.maxrefs -from 1 -to 1000 -width 4 -textvariable maxrefs
11526    grid x $page.maxrefsl $page.maxrefs -sticky w
11527    ${NS}::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \
11528        -variable limitdiffs
11529    grid x $page.ldiff -sticky w
11530    ${NS}::checkbutton $page.lattr -text [mc "Support per-file encodings"] \
11531        -variable perfile_attrs
11532    grid x $page.lattr -sticky w
11533
11534    ${NS}::entry $page.extdifft -textvariable extdifftool
11535    ${NS}::frame $page.extdifff
11536    ${NS}::label $page.extdifff.l -text [mc "External diff tool" ]
11537    ${NS}::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff
11538    pack $page.extdifff.l $page.extdifff.b -side left
11539    pack configure $page.extdifff.l -padx 10
11540    grid x $page.extdifff $page.extdifft -sticky ew
11541
11542    ${NS}::label $page.lgen -text [mc "General options"]
11543    grid $page.lgen - -sticky w -pady 10
11544    ${NS}::checkbutton $page.want_ttk -variable want_ttk \
11545        -text [mc "Use themed widgets"]
11546    if {$have_ttk} {
11547        ${NS}::label $page.ttk_note -text [mc "(change requires restart)"]
11548    } else {
11549        ${NS}::label $page.ttk_note -text [mc "(currently unavailable)"]
11550    }
11551    grid x $page.want_ttk $page.ttk_note -sticky w
11552    return $page
11553}
11554
11555proc prefspage_colors {notebook} {
11556    global NS uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11557
11558    set page [create_prefs_page $notebook.colors]
11559
11560    ${NS}::label $page.cdisp -text [mc "Colors: press to choose"]
11561    grid $page.cdisp - -sticky w -pady 10
11562    label $page.ui -padx 40 -relief sunk -background $uicolor
11563    ${NS}::button $page.uibut -text [mc "Interface"] \
11564       -command [list choosecolor uicolor {} $page.ui [mc "interface"] setui]
11565    grid x $page.uibut $page.ui -sticky w
11566    label $page.bg -padx 40 -relief sunk -background $bgcolor
11567    ${NS}::button $page.bgbut -text [mc "Background"] \
11568        -command [list choosecolor bgcolor {} $page.bg [mc "background"] setbg]
11569    grid x $page.bgbut $page.bg -sticky w
11570    label $page.fg -padx 40 -relief sunk -background $fgcolor
11571    ${NS}::button $page.fgbut -text [mc "Foreground"] \
11572        -command [list choosecolor fgcolor {} $page.fg [mc "foreground"] setfg]
11573    grid x $page.fgbut $page.fg -sticky w
11574    label $page.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
11575    ${NS}::button $page.diffoldbut -text [mc "Diff: old lines"] \
11576        -command [list choosecolor diffcolors 0 $page.diffold [mc "diff old lines"] \
11577                      [list $ctext tag conf d0 -foreground]]
11578    grid x $page.diffoldbut $page.diffold -sticky w
11579    label $page.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
11580    ${NS}::button $page.diffnewbut -text [mc "Diff: new lines"] \
11581        -command [list choosecolor diffcolors 1 $page.diffnew [mc "diff new lines"] \
11582                      [list $ctext tag conf dresult -foreground]]
11583    grid x $page.diffnewbut $page.diffnew -sticky w
11584    label $page.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
11585    ${NS}::button $page.hunksepbut -text [mc "Diff: hunk header"] \
11586        -command [list choosecolor diffcolors 2 $page.hunksep \
11587                      [mc "diff hunk header"] \
11588                      [list $ctext tag conf hunksep -foreground]]
11589    grid x $page.hunksepbut $page.hunksep -sticky w
11590    label $page.markbgsep -padx 40 -relief sunk -background $markbgcolor
11591    ${NS}::button $page.markbgbut -text [mc "Marked line bg"] \
11592        -command [list choosecolor markbgcolor {} $page.markbgsep \
11593                      [mc "marked line background"] \
11594                      [list $ctext tag conf omark -background]]
11595    grid x $page.markbgbut $page.markbgsep -sticky w
11596    label $page.selbgsep -padx 40 -relief sunk -background $selectbgcolor
11597    ${NS}::button $page.selbgbut -text [mc "Select bg"] \
11598        -command [list choosecolor selectbgcolor {} $page.selbgsep [mc "background"] setselbg]
11599    grid x $page.selbgbut $page.selbgsep -sticky w
11600    return $page
11601}
11602
11603proc prefspage_fonts {notebook} {
11604    global NS
11605    set page [create_prefs_page $notebook.fonts]
11606    ${NS}::label $page.cfont -text [mc "Fonts: press to choose"]
11607    grid $page.cfont - -sticky w -pady 10
11608    mkfontdisp mainfont $page [mc "Main font"]
11609    mkfontdisp textfont $page [mc "Diff display font"]
11610    mkfontdisp uifont $page [mc "User interface font"]
11611    return $page
11612}
11613
11614proc doprefs {} {
11615    global maxwidth maxgraphpct use_ttk NS
11616    global oldprefs prefstop showneartags showlocalchanges
11617    global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11618    global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11619    global hideremotes want_ttk have_ttk
11620
11621    set top .gitkprefs
11622    set prefstop $top
11623    if {[winfo exists $top]} {
11624        raise $top
11625        return
11626    }
11627    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11628                   limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11629        set oldprefs($v) [set $v]
11630    }
11631    ttk_toplevel $top
11632    wm title $top [mc "Gitk preferences"]
11633    make_transient $top .
11634
11635    if {[set use_notebook [expr {$use_ttk && [info command ::ttk::notebook] ne ""}]]} {
11636        set notebook [ttk::notebook $top.notebook]
11637    } else {
11638        set notebook [${NS}::frame $top.notebook -borderwidth 0 -relief flat]
11639    }
11640
11641    lappend pages [prefspage_general $notebook] [mc "General"]
11642    lappend pages [prefspage_colors $notebook] [mc "Colors"]
11643    lappend pages [prefspage_fonts $notebook] [mc "Fonts"]
11644    set col 0
11645    foreach {page title} $pages {
11646        if {$use_notebook} {
11647            $notebook add $page -text $title
11648        } else {
11649            set btn [${NS}::button $notebook.b_[string map {. X} $page] \
11650                         -text $title -command [list raise $page]]
11651            $page configure -text $title
11652            grid $btn -row 0 -column [incr col] -sticky w
11653            grid $page -row 1 -column 0 -sticky news -columnspan 100
11654        }
11655    }
11656
11657    if {!$use_notebook} {
11658        grid columnconfigure $notebook 0 -weight 1
11659        grid rowconfigure $notebook 1 -weight 1
11660        raise [lindex $pages 0]
11661    }
11662
11663    grid $notebook -sticky news -padx 2 -pady 2
11664    grid rowconfigure $top 0 -weight 1
11665    grid columnconfigure $top 0 -weight 1
11666
11667    ${NS}::frame $top.buts
11668    ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
11669    ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
11670    bind $top <Key-Return> prefsok
11671    bind $top <Key-Escape> prefscan
11672    grid $top.buts.ok $top.buts.can
11673    grid columnconfigure $top.buts 0 -weight 1 -uniform a
11674    grid columnconfigure $top.buts 1 -weight 1 -uniform a
11675    grid $top.buts - - -pady 10 -sticky ew
11676    grid columnconfigure $top 2 -weight 1
11677    bind $top <Visibility> [list focus $top.buts.ok]
11678}
11679
11680proc choose_extdiff {} {
11681    global extdifftool
11682
11683    set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
11684    if {$prog ne {}} {
11685        set extdifftool $prog
11686    }
11687}
11688
11689proc choosecolor {v vi w x cmd} {
11690    global $v
11691
11692    set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
11693               -title [mc "Gitk: choose color for %s" $x]]
11694    if {$c eq {}} return
11695    $w conf -background $c
11696    lset $v $vi $c
11697    eval $cmd $c
11698}
11699
11700proc setselbg {c} {
11701    global bglist cflist
11702    foreach w $bglist {
11703        if {[winfo exists $w]} {
11704            $w configure -selectbackground $c
11705        }
11706    }
11707    $cflist tag configure highlight \
11708        -background [$cflist cget -selectbackground]
11709    allcanvs itemconf secsel -fill $c
11710}
11711
11712# This sets the background color and the color scheme for the whole UI.
11713# For some reason, tk_setPalette chooses a nasty dark red for selectColor
11714# if we don't specify one ourselves, which makes the checkbuttons and
11715# radiobuttons look bad.  This chooses white for selectColor if the
11716# background color is light, or black if it is dark.
11717proc setui {c} {
11718    if {[tk windowingsystem] eq "win32"} { return }
11719    set bg [winfo rgb . $c]
11720    set selc black
11721    if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
11722        set selc white
11723    }
11724    tk_setPalette background $c selectColor $selc
11725}
11726
11727proc setbg {c} {
11728    global bglist
11729
11730    foreach w $bglist {
11731        if {[winfo exists $w]} {
11732            $w conf -background $c
11733        }
11734    }
11735}
11736
11737proc setfg {c} {
11738    global fglist canv
11739
11740    foreach w $fglist {
11741        if {[winfo exists $w]} {
11742            $w conf -foreground $c
11743        }
11744    }
11745    allcanvs itemconf text -fill $c
11746    $canv itemconf circle -outline $c
11747    $canv itemconf markid -outline $c
11748}
11749
11750proc prefscan {} {
11751    global oldprefs prefstop
11752
11753    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11754                   limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11755        global $v
11756        set $v $oldprefs($v)
11757    }
11758    catch {destroy $prefstop}
11759    unset prefstop
11760    fontcan
11761}
11762
11763proc prefsok {} {
11764    global maxwidth maxgraphpct
11765    global oldprefs prefstop showneartags showlocalchanges
11766    global fontpref mainfont textfont uifont
11767    global limitdiffs treediffs perfile_attrs
11768    global hideremotes
11769
11770    catch {destroy $prefstop}
11771    unset prefstop
11772    fontcan
11773    set fontchanged 0
11774    if {$mainfont ne $fontpref(mainfont)} {
11775        set mainfont $fontpref(mainfont)
11776        parsefont mainfont $mainfont
11777        eval font configure mainfont [fontflags mainfont]
11778        eval font configure mainfontbold [fontflags mainfont 1]
11779        setcoords
11780        set fontchanged 1
11781    }
11782    if {$textfont ne $fontpref(textfont)} {
11783        set textfont $fontpref(textfont)
11784        parsefont textfont $textfont
11785        eval font configure textfont [fontflags textfont]
11786        eval font configure textfontbold [fontflags textfont 1]
11787    }
11788    if {$uifont ne $fontpref(uifont)} {
11789        set uifont $fontpref(uifont)
11790        parsefont uifont $uifont
11791        eval font configure uifont [fontflags uifont]
11792    }
11793    settabs
11794    if {$showlocalchanges != $oldprefs(showlocalchanges)} {
11795        if {$showlocalchanges} {
11796            doshowlocalchanges
11797        } else {
11798            dohidelocalchanges
11799        }
11800    }
11801    if {$limitdiffs != $oldprefs(limitdiffs) ||
11802        ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11803        # treediffs elements are limited by path;
11804        # won't have encodings cached if perfile_attrs was just turned on
11805        unset -nocomplain treediffs
11806    }
11807    if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
11808        || $maxgraphpct != $oldprefs(maxgraphpct)} {
11809        redisplay
11810    } elseif {$showneartags != $oldprefs(showneartags) ||
11811          $limitdiffs != $oldprefs(limitdiffs)} {
11812        reselectline
11813    }
11814    if {$hideremotes != $oldprefs(hideremotes)} {
11815        rereadrefs
11816    }
11817}
11818
11819proc formatdate {d} {
11820    global datetimeformat
11821    if {$d ne {}} {
11822        # If $datetimeformat includes a timezone, display in the
11823        # timezone of the argument.  Otherwise, display in local time.
11824        if {[string match {*%[zZ]*} $datetimeformat]} {
11825            if {[catch {set d [clock format [lindex $d 0] -timezone [lindex $d 1] -format $datetimeformat]}]} {
11826                # Tcl < 8.5 does not support -timezone.  Emulate it by
11827                # setting TZ (e.g. TZ=<-0430>+04:30).
11828                global env
11829                if {[info exists env(TZ)]} {
11830                    set savedTZ $env(TZ)
11831                }
11832                set zone [lindex $d 1]
11833                set sign [string map {+ - - +} [string index $zone 0]]
11834                set env(TZ) <$zone>$sign[string range $zone 1 2]:[string range $zone 3 4]
11835                set d [clock format [lindex $d 0] -format $datetimeformat]
11836                if {[info exists savedTZ]} {
11837                    set env(TZ) $savedTZ
11838                } else {
11839                    unset env(TZ)
11840                }
11841            }
11842        } else {
11843            set d [clock format [lindex $d 0] -format $datetimeformat]
11844        }
11845    }
11846    return $d
11847}
11848
11849# This list of encoding names and aliases is distilled from
11850# http://www.iana.org/assignments/character-sets.
11851# Not all of them are supported by Tcl.
11852set encoding_aliases {
11853    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11854      ISO646-US US-ASCII us IBM367 cp367 csASCII }
11855    { ISO-10646-UTF-1 csISO10646UTF1 }
11856    { ISO_646.basic:1983 ref csISO646basic1983 }
11857    { INVARIANT csINVARIANT }
11858    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11859    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11860    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11861    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11862    { NATS-DANO iso-ir-9-1 csNATSDANO }
11863    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11864    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11865    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11866    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11867    { ISO-2022-KR csISO2022KR }
11868    { EUC-KR csEUCKR }
11869    { ISO-2022-JP csISO2022JP }
11870    { ISO-2022-JP-2 csISO2022JP2 }
11871    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11872      csISO13JISC6220jp }
11873    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11874    { IT iso-ir-15 ISO646-IT csISO15Italian }
11875    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11876    { ES iso-ir-17 ISO646-ES csISO17Spanish }
11877    { greek7-old iso-ir-18 csISO18Greek7Old }
11878    { latin-greek iso-ir-19 csISO19LatinGreek }
11879    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11880    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11881    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11882    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11883    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11884    { BS_viewdata iso-ir-47 csISO47BSViewdata }
11885    { INIS iso-ir-49 csISO49INIS }
11886    { INIS-8 iso-ir-50 csISO50INIS8 }
11887    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11888    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11889    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11890    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11891    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11892    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11893      csISO60Norwegian1 }
11894    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11895    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11896    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11897    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11898    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11899    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11900    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11901    { greek7 iso-ir-88 csISO88Greek7 }
11902    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11903    { iso-ir-90 csISO90 }
11904    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11905    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11906      csISO92JISC62991984b }
11907    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11908    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11909    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11910      csISO95JIS62291984handadd }
11911    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11912    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11913    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11914    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11915      CP819 csISOLatin1 }
11916    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11917    { T.61-7bit iso-ir-102 csISO102T617bit }
11918    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11919    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
11920    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
11921    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
11922    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
11923    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
11924    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
11925    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
11926      arabic csISOLatinArabic }
11927    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
11928    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
11929    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
11930      greek greek8 csISOLatinGreek }
11931    { T.101-G2 iso-ir-128 csISO128T101G2 }
11932    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
11933      csISOLatinHebrew }
11934    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
11935    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
11936    { CSN_369103 iso-ir-139 csISO139CSN369103 }
11937    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
11938    { ISO_6937-2-add iso-ir-142 csISOTextComm }
11939    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
11940    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
11941      csISOLatinCyrillic }
11942    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
11943    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
11944    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
11945    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
11946    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
11947    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
11948    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
11949    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
11950    { ISO_10367-box iso-ir-155 csISO10367Box }
11951    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
11952    { latin-lap lap iso-ir-158 csISO158Lap }
11953    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
11954    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
11955    { us-dk csUSDK }
11956    { dk-us csDKUS }
11957    { JIS_X0201 X0201 csHalfWidthKatakana }
11958    { KSC5636 ISO646-KR csKSC5636 }
11959    { ISO-10646-UCS-2 csUnicode }
11960    { ISO-10646-UCS-4 csUCS4 }
11961    { DEC-MCS dec csDECMCS }
11962    { hp-roman8 roman8 r8 csHPRoman8 }
11963    { macintosh mac csMacintosh }
11964    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
11965      csIBM037 }
11966    { IBM038 EBCDIC-INT cp038 csIBM038 }
11967    { IBM273 CP273 csIBM273 }
11968    { IBM274 EBCDIC-BE CP274 csIBM274 }
11969    { IBM275 EBCDIC-BR cp275 csIBM275 }
11970    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
11971    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
11972    { IBM280 CP280 ebcdic-cp-it csIBM280 }
11973    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
11974    { IBM284 CP284 ebcdic-cp-es csIBM284 }
11975    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
11976    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
11977    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
11978    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
11979    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
11980    { IBM424 cp424 ebcdic-cp-he csIBM424 }
11981    { IBM437 cp437 437 csPC8CodePage437 }
11982    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
11983    { IBM775 cp775 csPC775Baltic }
11984    { IBM850 cp850 850 csPC850Multilingual }
11985    { IBM851 cp851 851 csIBM851 }
11986    { IBM852 cp852 852 csPCp852 }
11987    { IBM855 cp855 855 csIBM855 }
11988    { IBM857 cp857 857 csIBM857 }
11989    { IBM860 cp860 860 csIBM860 }
11990    { IBM861 cp861 861 cp-is csIBM861 }
11991    { IBM862 cp862 862 csPC862LatinHebrew }
11992    { IBM863 cp863 863 csIBM863 }
11993    { IBM864 cp864 csIBM864 }
11994    { IBM865 cp865 865 csIBM865 }
11995    { IBM866 cp866 866 csIBM866 }
11996    { IBM868 CP868 cp-ar csIBM868 }
11997    { IBM869 cp869 869 cp-gr csIBM869 }
11998    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
11999    { IBM871 CP871 ebcdic-cp-is csIBM871 }
12000    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
12001    { IBM891 cp891 csIBM891 }
12002    { IBM903 cp903 csIBM903 }
12003    { IBM904 cp904 904 csIBBM904 }
12004    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
12005    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
12006    { IBM1026 CP1026 csIBM1026 }
12007    { EBCDIC-AT-DE csIBMEBCDICATDE }
12008    { EBCDIC-AT-DE-A csEBCDICATDEA }
12009    { EBCDIC-CA-FR csEBCDICCAFR }
12010    { EBCDIC-DK-NO csEBCDICDKNO }
12011    { EBCDIC-DK-NO-A csEBCDICDKNOA }
12012    { EBCDIC-FI-SE csEBCDICFISE }
12013    { EBCDIC-FI-SE-A csEBCDICFISEA }
12014    { EBCDIC-FR csEBCDICFR }
12015    { EBCDIC-IT csEBCDICIT }
12016    { EBCDIC-PT csEBCDICPT }
12017    { EBCDIC-ES csEBCDICES }
12018    { EBCDIC-ES-A csEBCDICESA }
12019    { EBCDIC-ES-S csEBCDICESS }
12020    { EBCDIC-UK csEBCDICUK }
12021    { EBCDIC-US csEBCDICUS }
12022    { UNKNOWN-8BIT csUnknown8BiT }
12023    { MNEMONIC csMnemonic }
12024    { MNEM csMnem }
12025    { VISCII csVISCII }
12026    { VIQR csVIQR }
12027    { KOI8-R csKOI8R }
12028    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
12029    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
12030    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
12031    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
12032    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
12033    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
12034    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
12035    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
12036    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
12037    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
12038    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
12039    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
12040    { IBM1047 IBM-1047 }
12041    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
12042    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
12043    { UNICODE-1-1 csUnicode11 }
12044    { CESU-8 csCESU-8 }
12045    { BOCU-1 csBOCU-1 }
12046    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
12047    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
12048      l8 }
12049    { ISO-8859-15 ISO_8859-15 Latin-9 }
12050    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
12051    { GBK CP936 MS936 windows-936 }
12052    { JIS_Encoding csJISEncoding }
12053    { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
12054    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
12055      EUC-JP }
12056    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
12057    { ISO-10646-UCS-Basic csUnicodeASCII }
12058    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
12059    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
12060    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
12061    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
12062    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
12063    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
12064    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
12065    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
12066    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
12067    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
12068    { Adobe-Standard-Encoding csAdobeStandardEncoding }
12069    { Ventura-US csVenturaUS }
12070    { Ventura-International csVenturaInternational }
12071    { PC8-Danish-Norwegian csPC8DanishNorwegian }
12072    { PC8-Turkish csPC8Turkish }
12073    { IBM-Symbols csIBMSymbols }
12074    { IBM-Thai csIBMThai }
12075    { HP-Legal csHPLegal }
12076    { HP-Pi-font csHPPiFont }
12077    { HP-Math8 csHPMath8 }
12078    { Adobe-Symbol-Encoding csHPPSMath }
12079    { HP-DeskTop csHPDesktop }
12080    { Ventura-Math csVenturaMath }
12081    { Microsoft-Publishing csMicrosoftPublishing }
12082    { Windows-31J csWindows31J }
12083    { GB2312 csGB2312 }
12084    { Big5 csBig5 }
12085}
12086
12087proc tcl_encoding {enc} {
12088    global encoding_aliases tcl_encoding_cache
12089    if {[info exists tcl_encoding_cache($enc)]} {
12090        return $tcl_encoding_cache($enc)
12091    }
12092    set names [encoding names]
12093    set lcnames [string tolower $names]
12094    set enc [string tolower $enc]
12095    set i [lsearch -exact $lcnames $enc]
12096    if {$i < 0} {
12097        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
12098        if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
12099            set i [lsearch -exact $lcnames $encx]
12100        }
12101    }
12102    if {$i < 0} {
12103        foreach l $encoding_aliases {
12104            set ll [string tolower $l]
12105            if {[lsearch -exact $ll $enc] < 0} continue
12106            # look through the aliases for one that tcl knows about
12107            foreach e $ll {
12108                set i [lsearch -exact $lcnames $e]
12109                if {$i < 0} {
12110                    if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
12111                        set i [lsearch -exact $lcnames $ex]
12112                    }
12113                }
12114                if {$i >= 0} break
12115            }
12116            break
12117        }
12118    }
12119    set tclenc {}
12120    if {$i >= 0} {
12121        set tclenc [lindex $names $i]
12122    }
12123    set tcl_encoding_cache($enc) $tclenc
12124    return $tclenc
12125}
12126
12127proc gitattr {path attr default} {
12128    global path_attr_cache
12129    if {[info exists path_attr_cache($attr,$path)]} {
12130        set r $path_attr_cache($attr,$path)
12131    } else {
12132        set r "unspecified"
12133        if {![catch {set line [exec git check-attr $attr -- $path]}]} {
12134            regexp "(.*): $attr: (.*)" $line m f r
12135        }
12136        set path_attr_cache($attr,$path) $r
12137    }
12138    if {$r eq "unspecified"} {
12139        return $default
12140    }
12141    return $r
12142}
12143
12144proc cache_gitattr {attr pathlist} {
12145    global path_attr_cache
12146    set newlist {}
12147    foreach path $pathlist {
12148        if {![info exists path_attr_cache($attr,$path)]} {
12149            lappend newlist $path
12150        }
12151    }
12152    set lim 1000
12153    if {[tk windowingsystem] == "win32"} {
12154        # windows has a 32k limit on the arguments to a command...
12155        set lim 30
12156    }
12157    while {$newlist ne {}} {
12158        set head [lrange $newlist 0 [expr {$lim - 1}]]
12159        set newlist [lrange $newlist $lim end]
12160        if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
12161            foreach row [split $rlist "\n"] {
12162                if {[regexp "(.*): $attr: (.*)" $row m path value]} {
12163                    if {[string index $path 0] eq "\""} {
12164                        set path [encoding convertfrom [lindex $path 0]]
12165                    }
12166                    set path_attr_cache($attr,$path) $value
12167                }
12168            }
12169        }
12170    }
12171}
12172
12173proc get_path_encoding {path} {
12174    global gui_encoding perfile_attrs
12175    set tcl_enc $gui_encoding
12176    if {$path ne {} && $perfile_attrs} {
12177        set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
12178        if {$enc2 ne {}} {
12179            set tcl_enc $enc2
12180        }
12181    }
12182    return $tcl_enc
12183}
12184
12185## For msgcat loading, first locate the installation location.
12186if { [info exists ::env(GITK_MSGSDIR)] } {
12187    ## Msgsdir was manually set in the environment.
12188    set gitk_msgsdir $::env(GITK_MSGSDIR)
12189} else {
12190    ## Let's guess the prefix from argv0.
12191    set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
12192    set gitk_libdir [file join $gitk_prefix share gitk lib]
12193    set gitk_msgsdir [file join $gitk_libdir msgs]
12194    unset gitk_prefix
12195}
12196
12197## Internationalization (i18n) through msgcat and gettext. See
12198## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
12199package require msgcat
12200namespace import ::msgcat::mc
12201## And eventually load the actual message catalog
12202::msgcat::mcload $gitk_msgsdir
12203
12204# First check that Tcl/Tk is recent enough
12205if {[catch {package require Tk 8.4} err]} {
12206    show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
12207                         Gitk requires at least Tcl/Tk 8.4."]
12208    exit 1
12209}
12210
12211# on OSX bring the current Wish process window to front
12212if {[tk windowingsystem] eq "aqua"} {
12213    exec osascript -e [format {
12214        tell application "System Events"
12215            set frontmost of processes whose unix id is %d to true
12216        end tell
12217    } [pid] ]
12218}
12219
12220# Unset GIT_TRACE var if set
12221if { [info exists ::env(GIT_TRACE)] } {
12222    unset ::env(GIT_TRACE)
12223}
12224
12225# defaults...
12226set wrcomcmd "git diff-tree --stdin -p --pretty=email"
12227
12228set gitencoding {}
12229catch {
12230    set gitencoding [exec git config --get i18n.commitencoding]
12231}
12232catch {
12233    set gitencoding [exec git config --get i18n.logoutputencoding]
12234}
12235if {$gitencoding == ""} {
12236    set gitencoding "utf-8"
12237}
12238set tclencoding [tcl_encoding $gitencoding]
12239if {$tclencoding == {}} {
12240    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
12241}
12242
12243set gui_encoding [encoding system]
12244catch {
12245    set enc [exec git config --get gui.encoding]
12246    if {$enc ne {}} {
12247        set tclenc [tcl_encoding $enc]
12248        if {$tclenc ne {}} {
12249            set gui_encoding $tclenc
12250        } else {
12251            puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
12252        }
12253    }
12254}
12255
12256set log_showroot true
12257catch {
12258    set log_showroot [exec git config --bool --get log.showroot]
12259}
12260
12261if {[tk windowingsystem] eq "aqua"} {
12262    set mainfont {{Lucida Grande} 9}
12263    set textfont {Monaco 9}
12264    set uifont {{Lucida Grande} 9 bold}
12265} elseif {![catch {::tk::pkgconfig get fontsystem} xft] && $xft eq "xft"} {
12266    # fontconfig!
12267    set mainfont {sans 9}
12268    set textfont {monospace 9}
12269    set uifont {sans 9 bold}
12270} else {
12271    set mainfont {Helvetica 9}
12272    set textfont {Courier 9}
12273    set uifont {Helvetica 9 bold}
12274}
12275set tabstop 8
12276set findmergefiles 0
12277set maxgraphpct 50
12278set maxwidth 16
12279set revlistorder 0
12280set fastdate 0
12281set uparrowlen 5
12282set downarrowlen 5
12283set mingaplen 100
12284set cmitmode "patch"
12285set wrapcomment "none"
12286set showneartags 1
12287set hideremotes 0
12288set maxrefs 20
12289set visiblerefs {"master"}
12290set maxlinelen 200
12291set showlocalchanges 1
12292set limitdiffs 1
12293set datetimeformat "%Y-%m-%d %H:%M:%S"
12294set autoselect 1
12295set autosellen 40
12296set perfile_attrs 0
12297set want_ttk 1
12298
12299if {[tk windowingsystem] eq "aqua"} {
12300    set extdifftool "opendiff"
12301} else {
12302    set extdifftool "meld"
12303}
12304
12305set colors {"#00ff00" red blue magenta darkgrey brown orange}
12306if {[tk windowingsystem] eq "win32"} {
12307    set uicolor SystemButtonFace
12308    set uifgcolor SystemButtonText
12309    set uifgdisabledcolor SystemDisabledText
12310    set bgcolor SystemWindow
12311    set fgcolor SystemWindowText
12312    set selectbgcolor SystemHighlight
12313} else {
12314    set uicolor grey85
12315    set uifgcolor black
12316    set uifgdisabledcolor "#999"
12317    set bgcolor white
12318    set fgcolor black
12319    set selectbgcolor gray85
12320}
12321set diffcolors {red "#00a000" blue}
12322set diffcontext 3
12323set mergecolors {red blue "#00ff00" purple brown "#009090" magenta "#808000" "#009000" "#ff0080" cyan "#b07070" "#70b0f0" "#70f0b0" "#f0b070" "#ff70b0"}
12324set ignorespace 0
12325set worddiff ""
12326set markbgcolor "#e0e0ff"
12327
12328set headbgcolor "#00ff00"
12329set headfgcolor black
12330set headoutlinecolor black
12331set remotebgcolor #ffddaa
12332set tagbgcolor yellow
12333set tagfgcolor black
12334set tagoutlinecolor black
12335set reflinecolor black
12336set filesepbgcolor #aaaaaa
12337set filesepfgcolor black
12338set linehoverbgcolor #ffff80
12339set linehoverfgcolor black
12340set linehoveroutlinecolor black
12341set mainheadcirclecolor yellow
12342set workingfilescirclecolor red
12343set indexcirclecolor "#00ff00"
12344set circlecolors {white blue gray blue blue}
12345set linkfgcolor blue
12346set circleoutlinecolor $fgcolor
12347set foundbgcolor yellow
12348set currentsearchhitbgcolor orange
12349
12350# button for popping up context menus
12351if {[tk windowingsystem] eq "aqua"} {
12352    set ctxbut <Button-2>
12353} else {
12354    set ctxbut <Button-3>
12355}
12356
12357catch {
12358    # follow the XDG base directory specification by default. See
12359    # http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html
12360    if {[info exists env(XDG_CONFIG_HOME)] && $env(XDG_CONFIG_HOME) ne ""} {
12361        # XDG_CONFIG_HOME environment variable is set
12362        set config_file [file join $env(XDG_CONFIG_HOME) git gitk]
12363        set config_file_tmp [file join $env(XDG_CONFIG_HOME) git gitk-tmp]
12364    } else {
12365        # default XDG_CONFIG_HOME
12366        set config_file "~/.config/git/gitk"
12367        set config_file_tmp "~/.config/git/gitk-tmp"
12368    }
12369    if {![file exists $config_file]} {
12370        # for backward compatibility use the old config file if it exists
12371        if {[file exists "~/.gitk"]} {
12372            set config_file "~/.gitk"
12373            set config_file_tmp "~/.gitk-tmp"
12374        } elseif {![file exists [file dirname $config_file]]} {
12375            file mkdir [file dirname $config_file]
12376        }
12377    }
12378    source $config_file
12379}
12380config_check_tmp_exists 50
12381
12382set config_variables {
12383    mainfont textfont uifont tabstop findmergefiles maxgraphpct maxwidth
12384    cmitmode wrapcomment autoselect autosellen showneartags maxrefs visiblerefs
12385    hideremotes showlocalchanges datetimeformat limitdiffs uicolor want_ttk
12386    bgcolor fgcolor uifgcolor uifgdisabledcolor colors diffcolors mergecolors
12387    markbgcolor diffcontext selectbgcolor foundbgcolor currentsearchhitbgcolor
12388    extdifftool perfile_attrs headbgcolor headfgcolor headoutlinecolor
12389    remotebgcolor tagbgcolor tagfgcolor tagoutlinecolor reflinecolor
12390    filesepbgcolor filesepfgcolor linehoverbgcolor linehoverfgcolor
12391    linehoveroutlinecolor mainheadcirclecolor workingfilescirclecolor
12392    indexcirclecolor circlecolors linkfgcolor circleoutlinecolor
12393}
12394foreach var $config_variables {
12395    config_init_trace $var
12396    trace add variable $var write config_variable_change_cb
12397}
12398
12399parsefont mainfont $mainfont
12400eval font create mainfont [fontflags mainfont]
12401eval font create mainfontbold [fontflags mainfont 1]
12402
12403parsefont textfont $textfont
12404eval font create textfont [fontflags textfont]
12405eval font create textfontbold [fontflags textfont 1]
12406
12407parsefont uifont $uifont
12408eval font create uifont [fontflags uifont]
12409
12410setui $uicolor
12411
12412setoptions
12413
12414# check that we can find a .git directory somewhere...
12415if {[catch {set gitdir [exec git rev-parse --git-dir]}]} {
12416    show_error {} . [mc "Cannot find a git repository here."]
12417    exit 1
12418}
12419
12420set selecthead {}
12421set selectheadid {}
12422
12423set revtreeargs {}
12424set cmdline_files {}
12425set i 0
12426set revtreeargscmd {}
12427foreach arg $argv {
12428    switch -glob -- $arg {
12429        "" { }
12430        "--" {
12431            set cmdline_files [lrange $argv [expr {$i + 1}] end]
12432            break
12433        }
12434        "--select-commit=*" {
12435            set selecthead [string range $arg 16 end]
12436        }
12437        "--argscmd=*" {
12438            set revtreeargscmd [string range $arg 10 end]
12439        }
12440        default {
12441            lappend revtreeargs $arg
12442        }
12443    }
12444    incr i
12445}
12446
12447if {$selecthead eq "HEAD"} {
12448    set selecthead {}
12449}
12450
12451if {$i >= [llength $argv] && $revtreeargs ne {}} {
12452    # no -- on command line, but some arguments (other than --argscmd)
12453    if {[catch {
12454        set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
12455        set cmdline_files [split $f "\n"]
12456        set n [llength $cmdline_files]
12457        set revtreeargs [lrange $revtreeargs 0 end-$n]
12458        # Unfortunately git rev-parse doesn't produce an error when
12459        # something is both a revision and a filename.  To be consistent
12460        # with git log and git rev-list, check revtreeargs for filenames.
12461        foreach arg $revtreeargs {
12462            if {[file exists $arg]} {
12463                show_error {} . [mc "Ambiguous argument '%s': both revision\
12464                                 and filename" $arg]
12465                exit 1
12466            }
12467        }
12468    } err]} {
12469        # unfortunately we get both stdout and stderr in $err,
12470        # so look for "fatal:".
12471        set i [string first "fatal:" $err]
12472        if {$i > 0} {
12473            set err [string range $err [expr {$i + 6}] end]
12474        }
12475        show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
12476        exit 1
12477    }
12478}
12479
12480set nullid "0000000000000000000000000000000000000000"
12481set nullid2 "0000000000000000000000000000000000000001"
12482set nullfile "/dev/null"
12483
12484set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
12485if {![info exists have_ttk]} {
12486    set have_ttk [llength [info commands ::ttk::style]]
12487}
12488set use_ttk [expr {$have_ttk && $want_ttk}]
12489set NS [expr {$use_ttk ? "ttk" : ""}]
12490
12491if {$use_ttk} {
12492    setttkstyle
12493}
12494
12495regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
12496
12497set show_notes {}
12498if {[package vcompare $git_version "1.6.6.2"] >= 0} {
12499    set show_notes "--show-notes"
12500}
12501
12502set appname "gitk"
12503
12504set runq {}
12505set history {}
12506set historyindex 0
12507set fh_serial 0
12508set nhl_names {}
12509set highlight_paths {}
12510set findpattern {}
12511set searchdirn -forwards
12512set boldids {}
12513set boldnameids {}
12514set diffelide {0 0}
12515set markingmatches 0
12516set linkentercount 0
12517set need_redisplay 0
12518set nrows_drawn 0
12519set firsttabstop 0
12520
12521set nextviewnum 1
12522set curview 0
12523set selectedview 0
12524set selectedhlview [mc "None"]
12525set highlight_related [mc "None"]
12526set highlight_files {}
12527set viewfiles(0) {}
12528set viewperm(0) 0
12529set viewchanged(0) 0
12530set viewargs(0) {}
12531set viewargscmd(0) {}
12532
12533set selectedline {}
12534set numcommits 0
12535set loginstance 0
12536set cmdlineok 0
12537set stopped 0
12538set stuffsaved 0
12539set patchnum 0
12540set lserial 0
12541set hasworktree [hasworktree]
12542set cdup {}
12543if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} {
12544    set cdup [exec git rev-parse --show-cdup]
12545}
12546set worktree [exec git rev-parse --show-toplevel]
12547setcoords
12548makewindow
12549catch {
12550    image create photo gitlogo      -width 16 -height 16
12551
12552    image create photo gitlogominus -width  4 -height  2
12553    gitlogominus put #C00000 -to 0 0 4 2
12554    gitlogo copy gitlogominus -to  1 5
12555    gitlogo copy gitlogominus -to  6 5
12556    gitlogo copy gitlogominus -to 11 5
12557    image delete gitlogominus
12558
12559    image create photo gitlogoplus  -width  4 -height  4
12560    gitlogoplus  put #008000 -to 1 0 3 4
12561    gitlogoplus  put #008000 -to 0 1 4 3
12562    gitlogo copy gitlogoplus  -to  1 9
12563    gitlogo copy gitlogoplus  -to  6 9
12564    gitlogo copy gitlogoplus  -to 11 9
12565    image delete gitlogoplus
12566
12567    image create photo gitlogo32    -width 32 -height 32
12568    gitlogo32 copy gitlogo -zoom 2 2
12569
12570    wm iconphoto . -default gitlogo gitlogo32
12571}
12572# wait for the window to become visible
12573tkwait visibility .
12574set_window_title
12575update
12576readrefs
12577
12578if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
12579    # create a view for the files/dirs specified on the command line
12580    set curview 1
12581    set selectedview 1
12582    set nextviewnum 2
12583    set viewname(1) [mc "Command line"]
12584    set viewfiles(1) $cmdline_files
12585    set viewargs(1) $revtreeargs
12586    set viewargscmd(1) $revtreeargscmd
12587    set viewperm(1) 0
12588    set viewchanged(1) 0
12589    set vdatemode(1) 0
12590    addviewmenu 1
12591    .bar.view entryconf [mca "&Edit view..."] -state normal
12592    .bar.view entryconf [mca "&Delete view"] -state normal
12593}
12594
12595if {[info exists permviews]} {
12596    foreach v $permviews {
12597        set n $nextviewnum
12598        incr nextviewnum
12599        set viewname($n) [lindex $v 0]
12600        set viewfiles($n) [lindex $v 1]
12601        set viewargs($n) [lindex $v 2]
12602        set viewargscmd($n) [lindex $v 3]
12603        set viewperm($n) 1
12604        set viewchanged($n) 0
12605        addviewmenu $n
12606    }
12607}
12608
12609if {[tk windowingsystem] eq "win32"} {
12610    focus -force .
12611}
12612
12613getcommits {}
12614
12615# Local variables:
12616# mode: tcl
12617# indent-tabs-mode: t
12618# tab-width: 8
12619# End: