gitk-git / gitkon commit Merge branch 'dl/compat-cleanup' (00bb744)
   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-R -background black -foreground "#ffddaa" \
3408    -data $rectdata -maskdata $rectmask
3409image create bitmap reficon-o -background black -foreground "#ddddff" \
3410    -data $rectdata -maskdata $rectmask
3411
3412proc init_flist {first} {
3413    global cflist cflist_top difffilestart
3414
3415    $cflist conf -state normal
3416    $cflist delete 0.0 end
3417    if {$first ne {}} {
3418        $cflist insert end $first
3419        set cflist_top 1
3420        $cflist tag add highlight 1.0 "1.0 lineend"
3421    } else {
3422        unset -nocomplain cflist_top
3423    }
3424    $cflist conf -state disabled
3425    set difffilestart {}
3426}
3427
3428proc highlight_tag {f} {
3429    global highlight_paths
3430
3431    foreach p $highlight_paths {
3432        if {[string match $p $f]} {
3433            return "bold"
3434        }
3435    }
3436    return {}
3437}
3438
3439proc highlight_filelist {} {
3440    global cmitmode cflist
3441
3442    $cflist conf -state normal
3443    if {$cmitmode ne "tree"} {
3444        set end [lindex [split [$cflist index end] .] 0]
3445        for {set l 2} {$l < $end} {incr l} {
3446            set line [$cflist get $l.0 "$l.0 lineend"]
3447            if {[highlight_tag $line] ne {}} {
3448                $cflist tag add bold $l.0 "$l.0 lineend"
3449            }
3450        }
3451    } else {
3452        highlight_tree 2 {}
3453    }
3454    $cflist conf -state disabled
3455}
3456
3457proc unhighlight_filelist {} {
3458    global cflist
3459
3460    $cflist conf -state normal
3461    $cflist tag remove bold 1.0 end
3462    $cflist conf -state disabled
3463}
3464
3465proc add_flist {fl} {
3466    global cflist
3467
3468    $cflist conf -state normal
3469    foreach f $fl {
3470        $cflist insert end "\n"
3471        $cflist insert end $f [highlight_tag $f]
3472    }
3473    $cflist conf -state disabled
3474}
3475
3476proc sel_flist {w x y} {
3477    global ctext difffilestart cflist cflist_top cmitmode
3478
3479    if {$cmitmode eq "tree"} return
3480    if {![info exists cflist_top]} return
3481    set l [lindex [split [$w index "@$x,$y"] "."] 0]
3482    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3483    $cflist tag add highlight $l.0 "$l.0 lineend"
3484    set cflist_top $l
3485    if {$l == 1} {
3486        $ctext yview 1.0
3487    } else {
3488        catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
3489    }
3490    suppress_highlighting_file_for_current_scrollpos
3491}
3492
3493proc pop_flist_menu {w X Y x y} {
3494    global ctext cflist cmitmode flist_menu flist_menu_file
3495    global treediffs diffids
3496
3497    stopfinding
3498    set l [lindex [split [$w index "@$x,$y"] "."] 0]
3499    if {$l <= 1} return
3500    if {$cmitmode eq "tree"} {
3501        set e [linetoelt $l]
3502        if {[string index $e end] eq "/"} return
3503    } else {
3504        set e [lindex $treediffs($diffids) [expr {$l-2}]]
3505    }
3506    set flist_menu_file $e
3507    set xdiffstate "normal"
3508    if {$cmitmode eq "tree"} {
3509        set xdiffstate "disabled"
3510    }
3511    # Disable "External diff" item in tree mode
3512    $flist_menu entryconf 2 -state $xdiffstate
3513    tk_popup $flist_menu $X $Y
3514}
3515
3516proc find_ctext_fileinfo {line} {
3517    global ctext_file_names ctext_file_lines
3518
3519    set ok [bsearch $ctext_file_lines $line]
3520    set tline [lindex $ctext_file_lines $ok]
3521
3522    if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3523        return {}
3524    } else {
3525        return [list [lindex $ctext_file_names $ok] $tline]
3526    }
3527}
3528
3529proc pop_diff_menu {w X Y x y} {
3530    global ctext diff_menu flist_menu_file
3531    global diff_menu_txtpos diff_menu_line
3532    global diff_menu_filebase
3533
3534    set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3535    set diff_menu_line [lindex $diff_menu_txtpos 0]
3536    # don't pop up the menu on hunk-separator or file-separator lines
3537    if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3538        return
3539    }
3540    stopfinding
3541    set f [find_ctext_fileinfo $diff_menu_line]
3542    if {$f eq {}} return
3543    set flist_menu_file [lindex $f 0]
3544    set diff_menu_filebase [lindex $f 1]
3545    tk_popup $diff_menu $X $Y
3546}
3547
3548proc flist_hl {only} {
3549    global flist_menu_file findstring gdttype
3550
3551    set x [shellquote $flist_menu_file]
3552    if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
3553        set findstring $x
3554    } else {
3555        append findstring " " $x
3556    }
3557    set gdttype [mc "touching paths:"]
3558}
3559
3560proc gitknewtmpdir {} {
3561    global diffnum gitktmpdir gitdir env
3562
3563    if {![info exists gitktmpdir]} {
3564        if {[info exists env(GITK_TMPDIR)]} {
3565            set tmpdir $env(GITK_TMPDIR)
3566        } elseif {[info exists env(TMPDIR)]} {
3567            set tmpdir $env(TMPDIR)
3568        } else {
3569            set tmpdir $gitdir
3570        }
3571        set gitktmpformat [file join $tmpdir ".gitk-tmp.XXXXXX"]
3572        if {[catch {set gitktmpdir [exec mktemp -d $gitktmpformat]}]} {
3573            set gitktmpdir [file join $gitdir [format ".gitk-tmp.%s" [pid]]]
3574        }
3575        if {[catch {file mkdir $gitktmpdir} err]} {
3576            error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3577            unset gitktmpdir
3578            return {}
3579        }
3580        set diffnum 0
3581    }
3582    incr diffnum
3583    set diffdir [file join $gitktmpdir $diffnum]
3584    if {[catch {file mkdir $diffdir} err]} {
3585        error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3586        return {}
3587    }
3588    return $diffdir
3589}
3590
3591proc save_file_from_commit {filename output what} {
3592    global nullfile
3593
3594    if {[catch {exec git show $filename -- > $output} err]} {
3595        if {[string match "fatal: bad revision *" $err]} {
3596            return $nullfile
3597        }
3598        error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
3599        return {}
3600    }
3601    return $output
3602}
3603
3604proc external_diff_get_one_file {diffid filename diffdir} {
3605    global nullid nullid2 nullfile
3606    global worktree
3607
3608    if {$diffid == $nullid} {
3609        set difffile [file join $worktree $filename]
3610        if {[file exists $difffile]} {
3611            return $difffile
3612        }
3613        return $nullfile
3614    }
3615    if {$diffid == $nullid2} {
3616        set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3617        return [save_file_from_commit :$filename $difffile index]
3618    }
3619    set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3620    return [save_file_from_commit $diffid:$filename $difffile \
3621               "revision $diffid"]
3622}
3623
3624proc external_diff {} {
3625    global nullid nullid2
3626    global flist_menu_file
3627    global diffids
3628    global extdifftool
3629
3630    if {[llength $diffids] == 1} {
3631        # no reference commit given
3632        set diffidto [lindex $diffids 0]
3633        if {$diffidto eq $nullid} {
3634            # diffing working copy with index
3635            set diffidfrom $nullid2
3636        } elseif {$diffidto eq $nullid2} {
3637            # diffing index with HEAD
3638            set diffidfrom "HEAD"
3639        } else {
3640            # use first parent commit
3641            global parentlist selectedline
3642            set diffidfrom [lindex $parentlist $selectedline 0]
3643        }
3644    } else {
3645        set diffidfrom [lindex $diffids 0]
3646        set diffidto [lindex $diffids 1]
3647    }
3648
3649    # make sure that several diffs wont collide
3650    set diffdir [gitknewtmpdir]
3651    if {$diffdir eq {}} return
3652
3653    # gather files to diff
3654    set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3655    set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3656
3657    if {$difffromfile ne {} && $difftofile ne {}} {
3658        set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
3659        if {[catch {set fl [open |$cmd r]} err]} {
3660            file delete -force $diffdir
3661            error_popup "$extdifftool: [mc "command failed:"] $err"
3662        } else {
3663            fconfigure $fl -blocking 0
3664            filerun $fl [list delete_at_eof $fl $diffdir]
3665        }
3666    }
3667}
3668
3669proc find_hunk_blamespec {base line} {
3670    global ctext
3671
3672    # Find and parse the hunk header
3673    set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3674    if {$s_lix eq {}} return
3675
3676    set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3677    if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3678            s_line old_specs osz osz1 new_line nsz]} {
3679        return
3680    }
3681
3682    # base lines for the parents
3683    set base_lines [list $new_line]
3684    foreach old_spec [lrange [split $old_specs " "] 1 end] {
3685        if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3686                old_spec old_line osz]} {
3687            return
3688        }
3689        lappend base_lines $old_line
3690    }
3691
3692    # Now scan the lines to determine offset within the hunk
3693    set max_parent [expr {[llength $base_lines]-2}]
3694    set dline 0
3695    set s_lno [lindex [split $s_lix "."] 0]
3696
3697    # Determine if the line is removed
3698    set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3699    if {[string match {[-+ ]*} $chunk]} {
3700        set removed_idx [string first "-" $chunk]
3701        # Choose a parent index
3702        if {$removed_idx >= 0} {
3703            set parent $removed_idx
3704        } else {
3705            set unchanged_idx [string first " " $chunk]
3706            if {$unchanged_idx >= 0} {
3707                set parent $unchanged_idx
3708            } else {
3709                # blame the current commit
3710                set parent -1
3711            }
3712        }
3713        # then count other lines that belong to it
3714        for {set i $line} {[incr i -1] > $s_lno} {} {
3715            set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3716            # Determine if the line is removed
3717            set removed_idx [string first "-" $chunk]
3718            if {$parent >= 0} {
3719                set code [string index $chunk $parent]
3720                if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3721                    incr dline
3722                }
3723            } else {
3724                if {$removed_idx < 0} {
3725                    incr dline
3726                }
3727            }
3728        }
3729        incr parent
3730    } else {
3731        set parent 0
3732    }
3733
3734    incr dline [lindex $base_lines $parent]
3735    return [list $parent $dline]
3736}
3737
3738proc external_blame_diff {} {
3739    global currentid cmitmode
3740    global diff_menu_txtpos diff_menu_line
3741    global diff_menu_filebase flist_menu_file
3742
3743    if {$cmitmode eq "tree"} {
3744        set parent_idx 0
3745        set line [expr {$diff_menu_line - $diff_menu_filebase}]
3746    } else {
3747        set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3748        if {$hinfo ne {}} {
3749            set parent_idx [lindex $hinfo 0]
3750            set line [lindex $hinfo 1]
3751        } else {
3752            set parent_idx 0
3753            set line 0
3754        }
3755    }
3756
3757    external_blame $parent_idx $line
3758}
3759
3760# Find the SHA1 ID of the blob for file $fname in the index
3761# at stage 0 or 2
3762proc index_sha1 {fname} {
3763    set f [open [list | git ls-files -s $fname] r]
3764    while {[gets $f line] >= 0} {
3765        set info [lindex [split $line "\t"] 0]
3766        set stage [lindex $info 2]
3767        if {$stage eq "0" || $stage eq "2"} {
3768            close $f
3769            return [lindex $info 1]
3770        }
3771    }
3772    close $f
3773    return {}
3774}
3775
3776# Turn an absolute path into one relative to the current directory
3777proc make_relative {f} {
3778    if {[file pathtype $f] eq "relative"} {
3779        return $f
3780    }
3781    set elts [file split $f]
3782    set here [file split [pwd]]
3783    set ei 0
3784    set hi 0
3785    set res {}
3786    foreach d $here {
3787        if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3788            lappend res ".."
3789        } else {
3790            incr ei
3791        }
3792        incr hi
3793    }
3794    set elts [concat $res [lrange $elts $ei end]]
3795    return [eval file join $elts]
3796}
3797
3798proc external_blame {parent_idx {line {}}} {
3799    global flist_menu_file cdup
3800    global nullid nullid2
3801    global parentlist selectedline currentid
3802
3803    if {$parent_idx > 0} {
3804        set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3805    } else {
3806        set base_commit $currentid
3807    }
3808
3809    if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3810        error_popup [mc "No such commit"]
3811        return
3812    }
3813
3814    set cmdline [list git gui blame]
3815    if {$line ne {} && $line > 1} {
3816        lappend cmdline "--line=$line"
3817    }
3818    set f [file join $cdup $flist_menu_file]
3819    # Unfortunately it seems git gui blame doesn't like
3820    # being given an absolute path...
3821    set f [make_relative $f]
3822    lappend cmdline $base_commit $f
3823    if {[catch {eval exec $cmdline &} err]} {
3824        error_popup "[mc "git gui blame: command failed:"] $err"
3825    }
3826}
3827
3828proc show_line_source {} {
3829    global cmitmode currentid parents curview blamestuff blameinst
3830    global diff_menu_line diff_menu_filebase flist_menu_file
3831    global nullid nullid2 gitdir cdup
3832
3833    set from_index {}
3834    if {$cmitmode eq "tree"} {
3835        set id $currentid
3836        set line [expr {$diff_menu_line - $diff_menu_filebase}]
3837    } else {
3838        set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3839        if {$h eq {}} return
3840        set pi [lindex $h 0]
3841        if {$pi == 0} {
3842            mark_ctext_line $diff_menu_line
3843            return
3844        }
3845        incr pi -1
3846        if {$currentid eq $nullid} {
3847            if {$pi > 0} {
3848                # must be a merge in progress...
3849                if {[catch {
3850                    # get the last line from .git/MERGE_HEAD
3851                    set f [open [file join $gitdir MERGE_HEAD] r]
3852                    set id [lindex [split [read $f] "\n"] end-1]
3853                    close $f
3854                } err]} {
3855                    error_popup [mc "Couldn't read merge head: %s" $err]
3856                    return
3857                }
3858            } elseif {$parents($curview,$currentid) eq $nullid2} {
3859                # need to do the blame from the index
3860                if {[catch {
3861                    set from_index [index_sha1 $flist_menu_file]
3862                } err]} {
3863                    error_popup [mc "Error reading index: %s" $err]
3864                    return
3865                }
3866            } else {
3867                set id $parents($curview,$currentid)
3868            }
3869        } else {
3870            set id [lindex $parents($curview,$currentid) $pi]
3871        }
3872        set line [lindex $h 1]
3873    }
3874    set blameargs {}
3875    if {$from_index ne {}} {
3876        lappend blameargs | git cat-file blob $from_index
3877    }
3878    lappend blameargs | git blame -p -L$line,+1
3879    if {$from_index ne {}} {
3880        lappend blameargs --contents -
3881    } else {
3882        lappend blameargs $id
3883    }
3884    lappend blameargs -- [file join $cdup $flist_menu_file]
3885    if {[catch {
3886        set f [open $blameargs r]
3887    } err]} {
3888        error_popup [mc "Couldn't start git blame: %s" $err]
3889        return
3890    }
3891    nowbusy blaming [mc "Searching"]
3892    fconfigure $f -blocking 0
3893    set i [reg_instance $f]
3894    set blamestuff($i) {}
3895    set blameinst $i
3896    filerun $f [list read_line_source $f $i]
3897}
3898
3899proc stopblaming {} {
3900    global blameinst
3901
3902    if {[info exists blameinst]} {
3903        stop_instance $blameinst
3904        unset blameinst
3905        notbusy blaming
3906    }
3907}
3908
3909proc read_line_source {fd inst} {
3910    global blamestuff curview commfd blameinst nullid nullid2
3911
3912    while {[gets $fd line] >= 0} {
3913        lappend blamestuff($inst) $line
3914    }
3915    if {![eof $fd]} {
3916        return 1
3917    }
3918    unset commfd($inst)
3919    unset blameinst
3920    notbusy blaming
3921    fconfigure $fd -blocking 1
3922    if {[catch {close $fd} err]} {
3923        error_popup [mc "Error running git blame: %s" $err]
3924        return 0
3925    }
3926
3927    set fname {}
3928    set line [split [lindex $blamestuff($inst) 0] " "]
3929    set id [lindex $line 0]
3930    set lnum [lindex $line 1]
3931    if {[string length $id] == 40 && [string is xdigit $id] &&
3932        [string is digit -strict $lnum]} {
3933        # look for "filename" line
3934        foreach l $blamestuff($inst) {
3935            if {[string match "filename *" $l]} {
3936                set fname [string range $l 9 end]
3937                break
3938            }
3939        }
3940    }
3941    if {$fname ne {}} {
3942        # all looks good, select it
3943        if {$id eq $nullid} {
3944            # blame uses all-zeroes to mean not committed,
3945            # which would mean a change in the index
3946            set id $nullid2
3947        }
3948        if {[commitinview $id $curview]} {
3949            selectline [rowofcommit $id] 1 [list $fname $lnum] 1
3950        } else {
3951            error_popup [mc "That line comes from commit %s, \
3952                             which is not in this view" [shortids $id]]
3953        }
3954    } else {
3955        puts "oops couldn't parse git blame output"
3956    }
3957    return 0
3958}
3959
3960# delete $dir when we see eof on $f (presumably because the child has exited)
3961proc delete_at_eof {f dir} {
3962    while {[gets $f line] >= 0} {}
3963    if {[eof $f]} {
3964        if {[catch {close $f} err]} {
3965            error_popup "[mc "External diff viewer failed:"] $err"
3966        }
3967        file delete -force $dir
3968        return 0
3969    }
3970    return 1
3971}
3972
3973# Functions for adding and removing shell-type quoting
3974
3975proc shellquote {str} {
3976    if {![string match "*\['\"\\ \t]*" $str]} {
3977        return $str
3978    }
3979    if {![string match "*\['\"\\]*" $str]} {
3980        return "\"$str\""
3981    }
3982    if {![string match "*'*" $str]} {
3983        return "'$str'"
3984    }
3985    return "\"[string map {\" \\\" \\ \\\\} $str]\""
3986}
3987
3988proc shellarglist {l} {
3989    set str {}
3990    foreach a $l {
3991        if {$str ne {}} {
3992            append str " "
3993        }
3994        append str [shellquote $a]
3995    }
3996    return $str
3997}
3998
3999proc shelldequote {str} {
4000    set ret {}
4001    set used -1
4002    while {1} {
4003        incr used
4004        if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
4005            append ret [string range $str $used end]
4006            set used [string length $str]
4007            break
4008        }
4009        set first [lindex $first 0]
4010        set ch [string index $str $first]
4011        if {$first > $used} {
4012            append ret [string range $str $used [expr {$first - 1}]]
4013            set used $first
4014        }
4015        if {$ch eq " " || $ch eq "\t"} break
4016        incr used
4017        if {$ch eq "'"} {
4018            set first [string first "'" $str $used]
4019            if {$first < 0} {
4020                error "unmatched single-quote"
4021            }
4022            append ret [string range $str $used [expr {$first - 1}]]
4023            set used $first
4024            continue
4025        }
4026        if {$ch eq "\\"} {
4027            if {$used >= [string length $str]} {
4028                error "trailing backslash"
4029            }
4030            append ret [string index $str $used]
4031            continue
4032        }
4033        # here ch == "\""
4034        while {1} {
4035            if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
4036                error "unmatched double-quote"
4037            }
4038            set first [lindex $first 0]
4039            set ch [string index $str $first]
4040            if {$first > $used} {
4041                append ret [string range $str $used [expr {$first - 1}]]
4042                set used $first
4043            }
4044            if {$ch eq "\""} break
4045            incr used
4046            append ret [string index $str $used]
4047            incr used
4048        }
4049    }
4050    return [list $used $ret]
4051}
4052
4053proc shellsplit {str} {
4054    set l {}
4055    while {1} {
4056        set str [string trimleft $str]
4057        if {$str eq {}} break
4058        set dq [shelldequote $str]
4059        set n [lindex $dq 0]
4060        set word [lindex $dq 1]
4061        set str [string range $str $n end]
4062        lappend l $word
4063    }
4064    return $l
4065}
4066
4067proc set_window_title {} {
4068    global appname curview viewname vrevs
4069    set rev [mc "All files"]
4070    if {$curview ne 0} {
4071        if {$viewname($curview) eq [mc "Command line"]} {
4072            set rev [string map {"--gitk-symmetric-diff-marker" "--merge"} $vrevs($curview)]
4073        } else {
4074            set rev $viewname($curview)
4075        }
4076    }
4077    wm title . "[reponame]: $rev - $appname"
4078}
4079
4080# Code to implement multiple views
4081
4082proc newview {ishighlight} {
4083    global nextviewnum newviewname newishighlight
4084    global revtreeargs viewargscmd newviewopts curview
4085
4086    set newishighlight $ishighlight
4087    set top .gitkview
4088    if {[winfo exists $top]} {
4089        raise $top
4090        return
4091    }
4092    decode_view_opts $nextviewnum $revtreeargs
4093    set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
4094    set newviewopts($nextviewnum,perm) 0
4095    set newviewopts($nextviewnum,cmd)  $viewargscmd($curview)
4096    vieweditor $top $nextviewnum [mc "Gitk view definition"]
4097}
4098
4099set known_view_options {
4100    {perm      b    .  {}               {mc "Remember this view"}}
4101    {reflabel  l    +  {}               {mc "References (space separated list):"}}
4102    {refs      t15  .. {}               {mc "Branches & tags:"}}
4103    {allrefs   b    *. "--all"          {mc "All refs"}}
4104    {branches  b    .  "--branches"     {mc "All (local) branches"}}
4105    {tags      b    .  "--tags"         {mc "All tags"}}
4106    {remotes   b    .  "--remotes"      {mc "All remote-tracking branches"}}
4107    {commitlbl l    +  {}               {mc "Commit Info (regular expressions):"}}
4108    {author    t15  .. "--author=*"     {mc "Author:"}}
4109    {committer t15  .  "--committer=*"  {mc "Committer:"}}
4110    {loginfo   t15  .. "--grep=*"       {mc "Commit Message:"}}
4111    {allmatch  b    .. "--all-match"    {mc "Matches all Commit Info criteria"}}
4112    {igrep     b    .. "--invert-grep"  {mc "Matches no Commit Info criteria"}}
4113    {changes_l l    +  {}               {mc "Changes to Files:"}}
4114    {pickaxe_s r0   .  {}               {mc "Fixed String"}}
4115    {pickaxe_t r1   .  "--pickaxe-regex"  {mc "Regular Expression"}}
4116    {pickaxe   t15  .. "-S*"            {mc "Search string:"}}
4117    {datelabel l    +  {}               {mc "Commit Dates (\"2 weeks ago\", \"2009-03-17 15:27:38\", \"March 17, 2009 15:27:38\"):"}}
4118    {since     t15  ..  {"--since=*" "--after=*"}  {mc "Since:"}}
4119    {until     t15  .   {"--until=*" "--before=*"} {mc "Until:"}}
4120    {limit_lbl l    +  {}               {mc "Limit and/or skip a number of revisions (positive integer):"}}
4121    {limit     t10  *. "--max-count=*"  {mc "Number to show:"}}
4122    {skip      t10  .  "--skip=*"       {mc "Number to skip:"}}
4123    {misc_lbl  l    +  {}               {mc "Miscellaneous options:"}}
4124    {dorder    b    *. {"--date-order" "-d"}      {mc "Strictly sort by date"}}
4125    {lright    b    .  "--left-right"   {mc "Mark branch sides"}}
4126    {first     b    .  "--first-parent" {mc "Limit to first parent"}}
4127    {smplhst   b    .  "--simplify-by-decoration"   {mc "Simple history"}}
4128    {args      t50  *. {}               {mc "Additional arguments to git log:"}}
4129    {allpaths  path +  {}               {mc "Enter files and directories to include, one per line:"}}
4130    {cmd       t50= +  {}               {mc "Command to generate more commits to include:"}}
4131    }
4132
4133# Convert $newviewopts($n, ...) into args for git log.
4134proc encode_view_opts {n} {
4135    global known_view_options newviewopts
4136
4137    set rargs [list]
4138    foreach opt $known_view_options {
4139        set patterns [lindex $opt 3]
4140        if {$patterns eq {}} continue
4141        set pattern [lindex $patterns 0]
4142
4143        if {[lindex $opt 1] eq "b"} {
4144            set val $newviewopts($n,[lindex $opt 0])
4145            if {$val} {
4146                lappend rargs $pattern
4147            }
4148        } elseif {[regexp {^r(\d+)$} [lindex $opt 1] type value]} {
4149            regexp {^(.*_)} [lindex $opt 0] uselessvar button_id
4150            set val $newviewopts($n,$button_id)
4151            if {$val eq $value} {
4152                lappend rargs $pattern
4153            }
4154        } else {
4155            set val $newviewopts($n,[lindex $opt 0])
4156            set val [string trim $val]
4157            if {$val ne {}} {
4158                set pfix [string range $pattern 0 end-1]
4159                lappend rargs $pfix$val
4160            }
4161        }
4162    }
4163    set rargs [concat $rargs [shellsplit $newviewopts($n,refs)]]
4164    return [concat $rargs [shellsplit $newviewopts($n,args)]]
4165}
4166
4167# Fill $newviewopts($n, ...) based on args for git log.
4168proc decode_view_opts {n view_args} {
4169    global known_view_options newviewopts
4170
4171    foreach opt $known_view_options {
4172        set id [lindex $opt 0]
4173        if {[lindex $opt 1] eq "b"} {
4174            # Checkboxes
4175            set val 0
4176        } elseif {[regexp {^r(\d+)$} [lindex $opt 1]]} {
4177            # Radiobuttons
4178            regexp {^(.*_)} $id uselessvar id
4179            set val 0
4180        } else {
4181            # Text fields
4182            set val {}
4183        }
4184        set newviewopts($n,$id) $val
4185    }
4186    set oargs [list]
4187    set refargs [list]
4188    foreach arg $view_args {
4189        if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
4190            && ![info exists found(limit)]} {
4191            set newviewopts($n,limit) $cnt
4192            set found(limit) 1
4193            continue
4194        }
4195        catch { unset val }
4196        foreach opt $known_view_options {
4197            set id [lindex $opt 0]
4198            if {[info exists found($id)]} continue
4199            foreach pattern [lindex $opt 3] {
4200                if {![string match $pattern $arg]} continue
4201                if {[lindex $opt 1] eq "b"} {
4202                    # Check buttons
4203                    set val 1
4204                } elseif {[regexp {^r(\d+)$} [lindex $opt 1] match num]} {
4205                    # Radio buttons
4206                    regexp {^(.*_)} $id uselessvar id
4207                    set val $num
4208                } else {
4209                    # Text input fields
4210                    set size [string length $pattern]
4211                    set val [string range $arg [expr {$size-1}] end]
4212                }
4213                set newviewopts($n,$id) $val
4214                set found($id) 1
4215                break
4216            }
4217            if {[info exists val]} break
4218        }
4219        if {[info exists val]} continue
4220        if {[regexp {^-} $arg]} {
4221            lappend oargs $arg
4222        } else {
4223            lappend refargs $arg
4224        }
4225    }
4226    set newviewopts($n,refs) [shellarglist $refargs]
4227    set newviewopts($n,args) [shellarglist $oargs]
4228}
4229
4230proc edit_or_newview {} {
4231    global curview
4232
4233    if {$curview > 0} {
4234        editview
4235    } else {
4236        newview 0
4237    }
4238}
4239
4240proc editview {} {
4241    global curview
4242    global viewname viewperm newviewname newviewopts
4243    global viewargs viewargscmd
4244
4245    set top .gitkvedit-$curview
4246    if {[winfo exists $top]} {
4247        raise $top
4248        return
4249    }
4250    decode_view_opts $curview $viewargs($curview)
4251    set newviewname($curview)      $viewname($curview)
4252    set newviewopts($curview,perm) $viewperm($curview)
4253    set newviewopts($curview,cmd)  $viewargscmd($curview)
4254    vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
4255}
4256
4257proc vieweditor {top n title} {
4258    global newviewname newviewopts viewfiles bgcolor
4259    global known_view_options NS
4260
4261    ttk_toplevel $top
4262    wm title $top [concat $title [mc "-- criteria for selecting revisions"]]
4263    make_transient $top .
4264
4265    # View name
4266    ${NS}::frame $top.nfr
4267    ${NS}::label $top.nl -text [mc "View Name"]
4268    ${NS}::entry $top.name -width 20 -textvariable newviewname($n)
4269    pack $top.nfr -in $top -fill x -pady 5 -padx 3
4270    pack $top.nl -in $top.nfr -side left -padx {0 5}
4271    pack $top.name -in $top.nfr -side left -padx {0 25}
4272
4273    # View options
4274    set cframe $top.nfr
4275    set cexpand 0
4276    set cnt 0
4277    foreach opt $known_view_options {
4278        set id [lindex $opt 0]
4279        set type [lindex $opt 1]
4280        set flags [lindex $opt 2]
4281        set title [eval [lindex $opt 4]]
4282        set lxpad 0
4283
4284        if {$flags eq "+" || $flags eq "*"} {
4285            set cframe $top.fr$cnt
4286            incr cnt
4287            ${NS}::frame $cframe
4288            pack $cframe -in $top -fill x -pady 3 -padx 3
4289            set cexpand [expr {$flags eq "*"}]
4290        } elseif {$flags eq ".." || $flags eq "*."} {
4291            set cframe $top.fr$cnt
4292            incr cnt
4293            ${NS}::frame $cframe
4294            pack $cframe -in $top -fill x -pady 3 -padx [list 15 3]
4295            set cexpand [expr {$flags eq "*."}]
4296        } else {
4297            set lxpad 5
4298        }
4299
4300        if {$type eq "l"} {
4301            ${NS}::label $cframe.l_$id -text $title
4302            pack $cframe.l_$id -in $cframe -side left -pady [list 3 0] -anchor w
4303        } elseif {$type eq "b"} {
4304            ${NS}::checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
4305            pack $cframe.c_$id -in $cframe -side left \
4306                -padx [list $lxpad 0] -expand $cexpand -anchor w
4307        } elseif {[regexp {^r(\d+)$} $type type sz]} {
4308            regexp {^(.*_)} $id uselessvar button_id
4309            ${NS}::radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz
4310            pack $cframe.c_$id -in $cframe -side left \
4311                -padx [list $lxpad 0] -expand $cexpand -anchor w
4312        } elseif {[regexp {^t(\d+)$} $type type sz]} {
4313            ${NS}::label $cframe.l_$id -text $title
4314            ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4315                -textvariable newviewopts($n,$id)
4316            pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
4317            pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
4318        } elseif {[regexp {^t(\d+)=$} $type type sz]} {
4319            ${NS}::label $cframe.l_$id -text $title
4320            ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4321                -textvariable newviewopts($n,$id)
4322            pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
4323            pack $cframe.e_$id -in $cframe -side top -fill x
4324        } elseif {$type eq "path"} {
4325            ${NS}::label $top.l -text $title
4326            pack $top.l -in $top -side top -pady [list 3 0] -anchor w -padx 3
4327            text $top.t -width 40 -height 5 -background $bgcolor
4328            if {[info exists viewfiles($n)]} {
4329                foreach f $viewfiles($n) {
4330                    $top.t insert end $f
4331                    $top.t insert end "\n"
4332                }
4333                $top.t delete {end - 1c} end
4334                $top.t mark set insert 0.0
4335            }
4336            pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
4337        }
4338    }
4339
4340    ${NS}::frame $top.buts
4341    ${NS}::button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
4342    ${NS}::button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
4343    ${NS}::button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
4344    bind $top <Control-Return> [list newviewok $top $n]
4345    bind $top <F5> [list newviewok $top $n 1]
4346    bind $top <Escape> [list destroy $top]
4347    grid $top.buts.ok $top.buts.apply $top.buts.can
4348    grid columnconfigure $top.buts 0 -weight 1 -uniform a
4349    grid columnconfigure $top.buts 1 -weight 1 -uniform a
4350    grid columnconfigure $top.buts 2 -weight 1 -uniform a
4351    pack $top.buts -in $top -side top -fill x
4352    focus $top.t
4353}
4354
4355proc doviewmenu {m first cmd op argv} {
4356    set nmenu [$m index end]
4357    for {set i $first} {$i <= $nmenu} {incr i} {
4358        if {[$m entrycget $i -command] eq $cmd} {
4359            eval $m $op $i $argv
4360            break
4361        }
4362    }
4363}
4364
4365proc allviewmenus {n op args} {
4366    # global viewhlmenu
4367
4368    doviewmenu .bar.view 5 [list showview $n] $op $args
4369    # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
4370}
4371
4372proc newviewok {top n {apply 0}} {
4373    global nextviewnum newviewperm newviewname newishighlight
4374    global viewname viewfiles viewperm viewchanged selectedview curview
4375    global viewargs viewargscmd newviewopts viewhlmenu
4376
4377    if {[catch {
4378        set newargs [encode_view_opts $n]
4379    } err]} {
4380        error_popup "[mc "Error in commit selection arguments:"] $err" $top
4381        return
4382    }
4383    set files {}
4384    foreach f [split [$top.t get 0.0 end] "\n"] {
4385        set ft [string trim $f]
4386        if {$ft ne {}} {
4387            lappend files $ft
4388        }
4389    }
4390    if {![info exists viewfiles($n)]} {
4391        # creating a new view
4392        incr nextviewnum
4393        set viewname($n) $newviewname($n)
4394        set viewperm($n) $newviewopts($n,perm)
4395        set viewchanged($n) 1
4396        set viewfiles($n) $files
4397        set viewargs($n) $newargs
4398        set viewargscmd($n) $newviewopts($n,cmd)
4399        addviewmenu $n
4400        if {!$newishighlight} {
4401            run showview $n
4402        } else {
4403            run addvhighlight $n
4404        }
4405    } else {
4406        # editing an existing view
4407        set viewperm($n) $newviewopts($n,perm)
4408        set viewchanged($n) 1
4409        if {$newviewname($n) ne $viewname($n)} {
4410            set viewname($n) $newviewname($n)
4411            doviewmenu .bar.view 5 [list showview $n] \
4412                entryconf [list -label $viewname($n)]
4413            # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
4414                # entryconf [list -label $viewname($n) -value $viewname($n)]
4415        }
4416        if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
4417                $newviewopts($n,cmd) ne $viewargscmd($n)} {
4418            set viewfiles($n) $files
4419            set viewargs($n) $newargs
4420            set viewargscmd($n) $newviewopts($n,cmd)
4421            if {$curview == $n} {
4422                run reloadcommits
4423            }
4424        }
4425    }
4426    if {$apply} return
4427    catch {destroy $top}
4428}
4429
4430proc delview {} {
4431    global curview viewperm hlview selectedhlview viewchanged
4432
4433    if {$curview == 0} return
4434    if {[info exists hlview] && $hlview == $curview} {
4435        set selectedhlview [mc "None"]
4436        unset hlview
4437    }
4438    allviewmenus $curview delete
4439    set viewperm($curview) 0
4440    set viewchanged($curview) 1
4441    showview 0
4442}
4443
4444proc addviewmenu {n} {
4445    global viewname viewhlmenu
4446
4447    .bar.view add radiobutton -label $viewname($n) \
4448        -command [list showview $n] -variable selectedview -value $n
4449    #$viewhlmenu add radiobutton -label $viewname($n) \
4450    #   -command [list addvhighlight $n] -variable selectedhlview
4451}
4452
4453proc showview {n} {
4454    global curview cached_commitrow ordertok
4455    global displayorder parentlist rowidlist rowisopt rowfinal
4456    global colormap rowtextx nextcolor canvxmax
4457    global numcommits viewcomplete
4458    global selectedline currentid canv canvy0
4459    global treediffs
4460    global pending_select mainheadid
4461    global commitidx
4462    global selectedview
4463    global hlview selectedhlview commitinterest
4464
4465    if {$n == $curview} return
4466    set selid {}
4467    set ymax [lindex [$canv cget -scrollregion] 3]
4468    set span [$canv yview]
4469    set ytop [expr {[lindex $span 0] * $ymax}]
4470    set ybot [expr {[lindex $span 1] * $ymax}]
4471    set yscreen [expr {($ybot - $ytop) / 2}]
4472    if {$selectedline ne {}} {
4473        set selid $currentid
4474        set y [yc $selectedline]
4475        if {$ytop < $y && $y < $ybot} {
4476            set yscreen [expr {$y - $ytop}]
4477        }
4478    } elseif {[info exists pending_select]} {
4479        set selid $pending_select
4480        unset pending_select
4481    }
4482    unselectline
4483    normalline
4484    unset -nocomplain treediffs
4485    clear_display
4486    if {[info exists hlview] && $hlview == $n} {
4487        unset hlview
4488        set selectedhlview [mc "None"]
4489    }
4490    unset -nocomplain commitinterest
4491    unset -nocomplain cached_commitrow
4492    unset -nocomplain ordertok
4493
4494    set curview $n
4495    set selectedview $n
4496    .bar.view entryconf [mca "&Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
4497    .bar.view entryconf [mca "&Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
4498
4499    run refill_reflist
4500    if {![info exists viewcomplete($n)]} {
4501        getcommits $selid
4502        return
4503    }
4504
4505    set displayorder {}
4506    set parentlist {}
4507    set rowidlist {}
4508    set rowisopt {}
4509    set rowfinal {}
4510    set numcommits $commitidx($n)
4511
4512    unset -nocomplain colormap
4513    unset -nocomplain rowtextx
4514    set nextcolor 0
4515    set canvxmax [$canv cget -width]
4516    set curview $n
4517    set row 0
4518    setcanvscroll
4519    set yf 0
4520    set row {}
4521    if {$selid ne {} && [commitinview $selid $n]} {
4522        set row [rowofcommit $selid]
4523        # try to get the selected row in the same position on the screen
4524        set ymax [lindex [$canv cget -scrollregion] 3]
4525        set ytop [expr {[yc $row] - $yscreen}]
4526        if {$ytop < 0} {
4527            set ytop 0
4528        }
4529        set yf [expr {$ytop * 1.0 / $ymax}]
4530    }
4531    allcanvs yview moveto $yf
4532    drawvisible
4533    if {$row ne {}} {
4534        selectline $row 0
4535    } elseif {!$viewcomplete($n)} {
4536        reset_pending_select $selid
4537    } else {
4538        reset_pending_select {}
4539
4540        if {[commitinview $pending_select $curview]} {
4541            selectline [rowofcommit $pending_select] 1
4542        } else {
4543            set row [first_real_row]
4544            if {$row < $numcommits} {
4545                selectline $row 0
4546            }
4547        }
4548    }
4549    if {!$viewcomplete($n)} {
4550        if {$numcommits == 0} {
4551            show_status [mc "Reading commits..."]
4552        }
4553    } elseif {$numcommits == 0} {
4554        show_status [mc "No commits selected"]
4555    }
4556    set_window_title
4557}
4558
4559# Stuff relating to the highlighting facility
4560
4561proc ishighlighted {id} {
4562    global vhighlights fhighlights nhighlights rhighlights
4563
4564    if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
4565        return $nhighlights($id)
4566    }
4567    if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
4568        return $vhighlights($id)
4569    }
4570    if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
4571        return $fhighlights($id)
4572    }
4573    if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4574        return $rhighlights($id)
4575    }
4576    return 0
4577}
4578
4579proc bolden {id font} {
4580    global canv linehtag currentid boldids need_redisplay markedid
4581
4582    # need_redisplay = 1 means the display is stale and about to be redrawn
4583    if {$need_redisplay} return
4584    lappend boldids $id
4585    $canv itemconf $linehtag($id) -font $font
4586    if {[info exists currentid] && $id eq $currentid} {
4587        $canv delete secsel
4588        set t [eval $canv create rect [$canv bbox $linehtag($id)] \
4589                   -outline {{}} -tags secsel \
4590                   -fill [$canv cget -selectbackground]]
4591        $canv lower $t
4592    }
4593    if {[info exists markedid] && $id eq $markedid} {
4594        make_idmark $id
4595    }
4596}
4597
4598proc bolden_name {id font} {
4599    global canv2 linentag currentid boldnameids need_redisplay
4600
4601    if {$need_redisplay} return
4602    lappend boldnameids $id
4603    $canv2 itemconf $linentag($id) -font $font
4604    if {[info exists currentid] && $id eq $currentid} {
4605        $canv2 delete secsel
4606        set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
4607                   -outline {{}} -tags secsel \
4608                   -fill [$canv2 cget -selectbackground]]
4609        $canv2 lower $t
4610    }
4611}
4612
4613proc unbolden {} {
4614    global boldids
4615
4616    set stillbold {}
4617    foreach id $boldids {
4618        if {![ishighlighted $id]} {
4619            bolden $id mainfont
4620        } else {
4621            lappend stillbold $id
4622        }
4623    }
4624    set boldids $stillbold
4625}
4626
4627proc addvhighlight {n} {
4628    global hlview viewcomplete curview vhl_done commitidx
4629
4630    if {[info exists hlview]} {
4631        delvhighlight
4632    }
4633    set hlview $n
4634    if {$n != $curview && ![info exists viewcomplete($n)]} {
4635        start_rev_list $n
4636    }
4637    set vhl_done $commitidx($hlview)
4638    if {$vhl_done > 0} {
4639        drawvisible
4640    }
4641}
4642
4643proc delvhighlight {} {
4644    global hlview vhighlights
4645
4646    if {![info exists hlview]} return
4647    unset hlview
4648    unset -nocomplain vhighlights
4649    unbolden
4650}
4651
4652proc vhighlightmore {} {
4653    global hlview vhl_done commitidx vhighlights curview
4654
4655    set max $commitidx($hlview)
4656    set vr [visiblerows]
4657    set r0 [lindex $vr 0]
4658    set r1 [lindex $vr 1]
4659    for {set i $vhl_done} {$i < $max} {incr i} {
4660        set id [commitonrow $i $hlview]
4661        if {[commitinview $id $curview]} {
4662            set row [rowofcommit $id]
4663            if {$r0 <= $row && $row <= $r1} {
4664                if {![highlighted $row]} {
4665                    bolden $id mainfontbold
4666                }
4667                set vhighlights($id) 1
4668            }
4669        }
4670    }
4671    set vhl_done $max
4672    return 0
4673}
4674
4675proc askvhighlight {row id} {
4676    global hlview vhighlights iddrawn
4677
4678    if {[commitinview $id $hlview]} {
4679        if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
4680            bolden $id mainfontbold
4681        }
4682        set vhighlights($id) 1
4683    } else {
4684        set vhighlights($id) 0
4685    }
4686}
4687
4688proc hfiles_change {} {
4689    global highlight_files filehighlight fhighlights fh_serial
4690    global highlight_paths
4691
4692    if {[info exists filehighlight]} {
4693        # delete previous highlights
4694        catch {close $filehighlight}
4695        unset filehighlight
4696        unset -nocomplain fhighlights
4697        unbolden
4698        unhighlight_filelist
4699    }
4700    set highlight_paths {}
4701    after cancel do_file_hl $fh_serial
4702    incr fh_serial
4703    if {$highlight_files ne {}} {
4704        after 300 do_file_hl $fh_serial
4705    }
4706}
4707
4708proc gdttype_change {name ix op} {
4709    global gdttype highlight_files findstring findpattern
4710
4711    stopfinding
4712    if {$findstring ne {}} {
4713        if {$gdttype eq [mc "containing:"]} {
4714            if {$highlight_files ne {}} {
4715                set highlight_files {}
4716                hfiles_change
4717            }
4718            findcom_change
4719        } else {
4720            if {$findpattern ne {}} {
4721                set findpattern {}
4722                findcom_change
4723            }
4724            set highlight_files $findstring
4725            hfiles_change
4726        }
4727        drawvisible
4728    }
4729    # enable/disable findtype/findloc menus too
4730}
4731
4732proc find_change {name ix op} {
4733    global gdttype findstring highlight_files
4734
4735    stopfinding
4736    if {$gdttype eq [mc "containing:"]} {
4737        findcom_change
4738    } else {
4739        if {$highlight_files ne $findstring} {
4740            set highlight_files $findstring
4741            hfiles_change
4742        }
4743    }
4744    drawvisible
4745}
4746
4747proc findcom_change args {
4748    global nhighlights boldnameids
4749    global findpattern findtype findstring gdttype
4750
4751    stopfinding
4752    # delete previous highlights, if any
4753    foreach id $boldnameids {
4754        bolden_name $id mainfont
4755    }
4756    set boldnameids {}
4757    unset -nocomplain nhighlights
4758    unbolden
4759    unmarkmatches
4760    if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
4761        set findpattern {}
4762    } elseif {$findtype eq [mc "Regexp"]} {
4763        set findpattern $findstring
4764    } else {
4765        set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4766                   $findstring]
4767        set findpattern "*$e*"
4768    }
4769}
4770
4771proc makepatterns {l} {
4772    set ret {}
4773    foreach e $l {
4774        set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4775        if {[string index $ee end] eq "/"} {
4776            lappend ret "$ee*"
4777        } else {
4778            lappend ret $ee
4779            lappend ret "$ee/*"
4780        }
4781    }
4782    return $ret
4783}
4784
4785proc do_file_hl {serial} {
4786    global highlight_files filehighlight highlight_paths gdttype fhl_list
4787    global cdup findtype
4788
4789    if {$gdttype eq [mc "touching paths:"]} {
4790        # If "exact" match then convert backslashes to forward slashes.
4791        # Most useful to support Windows-flavoured file paths.
4792        if {$findtype eq [mc "Exact"]} {
4793            set highlight_files [string map {"\\" "/"} $highlight_files]
4794        }
4795        if {[catch {set paths [shellsplit $highlight_files]}]} return
4796        set highlight_paths [makepatterns $paths]
4797        highlight_filelist
4798        set relative_paths {}
4799        foreach path $paths {
4800            lappend relative_paths [file join $cdup $path]
4801        }
4802        set gdtargs [concat -- $relative_paths]
4803    } elseif {$gdttype eq [mc "adding/removing string:"]} {
4804        set gdtargs [list "-S$highlight_files"]
4805    } elseif {$gdttype eq [mc "changing lines matching:"]} {
4806        set gdtargs [list "-G$highlight_files"]
4807    } else {
4808        # must be "containing:", i.e. we're searching commit info
4809        return
4810    }
4811    set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
4812    set filehighlight [open $cmd r+]
4813    fconfigure $filehighlight -blocking 0
4814    filerun $filehighlight readfhighlight
4815    set fhl_list {}
4816    drawvisible
4817    flushhighlights
4818}
4819
4820proc flushhighlights {} {
4821    global filehighlight fhl_list
4822
4823    if {[info exists filehighlight]} {
4824        lappend fhl_list {}
4825        puts $filehighlight ""
4826        flush $filehighlight
4827    }
4828}
4829
4830proc askfilehighlight {row id} {
4831    global filehighlight fhighlights fhl_list
4832
4833    lappend fhl_list $id
4834    set fhighlights($id) -1
4835    puts $filehighlight $id
4836}
4837
4838proc readfhighlight {} {
4839    global filehighlight fhighlights curview iddrawn
4840    global fhl_list find_dirn
4841
4842    if {![info exists filehighlight]} {
4843        return 0
4844    }
4845    set nr 0
4846    while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4847        set line [string trim $line]
4848        set i [lsearch -exact $fhl_list $line]
4849        if {$i < 0} continue
4850        for {set j 0} {$j < $i} {incr j} {
4851            set id [lindex $fhl_list $j]
4852            set fhighlights($id) 0
4853        }
4854        set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4855        if {$line eq {}} continue
4856        if {![commitinview $line $curview]} continue
4857        if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4858            bolden $line mainfontbold
4859        }
4860        set fhighlights($line) 1
4861    }
4862    if {[eof $filehighlight]} {
4863        # strange...
4864        puts "oops, git diff-tree died"
4865        catch {close $filehighlight}
4866        unset filehighlight
4867        return 0
4868    }
4869    if {[info exists find_dirn]} {
4870        run findmore
4871    }
4872    return 1
4873}
4874
4875proc doesmatch {f} {
4876    global findtype findpattern
4877
4878    if {$findtype eq [mc "Regexp"]} {
4879        return [regexp $findpattern $f]
4880    } elseif {$findtype eq [mc "IgnCase"]} {
4881        return [string match -nocase $findpattern $f]
4882    } else {
4883        return [string match $findpattern $f]
4884    }
4885}
4886
4887proc askfindhighlight {row id} {
4888    global nhighlights commitinfo iddrawn
4889    global findloc
4890    global markingmatches
4891
4892    if {![info exists commitinfo($id)]} {
4893        getcommit $id
4894    }
4895    set info $commitinfo($id)
4896    set isbold 0
4897    set fldtypes [list [mc Headline] [mc Author] "" [mc Committer] "" [mc Comments]]
4898    foreach f $info ty $fldtypes {
4899        if {$ty eq ""} continue
4900        if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4901            [doesmatch $f]} {
4902            if {$ty eq [mc "Author"]} {
4903                set isbold 2
4904                break
4905            }
4906            set isbold 1
4907        }
4908    }
4909    if {$isbold && [info exists iddrawn($id)]} {
4910        if {![ishighlighted $id]} {
4911            bolden $id mainfontbold
4912            if {$isbold > 1} {
4913                bolden_name $id mainfontbold
4914            }
4915        }
4916        if {$markingmatches} {
4917            markrowmatches $row $id
4918        }
4919    }
4920    set nhighlights($id) $isbold
4921}
4922
4923proc markrowmatches {row id} {
4924    global canv canv2 linehtag linentag commitinfo findloc
4925
4926    set headline [lindex $commitinfo($id) 0]
4927    set author [lindex $commitinfo($id) 1]
4928    $canv delete match$row
4929    $canv2 delete match$row
4930    if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4931        set m [findmatches $headline]
4932        if {$m ne {}} {
4933            markmatches $canv $row $headline $linehtag($id) $m \
4934                [$canv itemcget $linehtag($id) -font] $row
4935        }
4936    }
4937    if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4938        set m [findmatches $author]
4939        if {$m ne {}} {
4940            markmatches $canv2 $row $author $linentag($id) $m \
4941                [$canv2 itemcget $linentag($id) -font] $row
4942        }
4943    }
4944}
4945
4946proc vrel_change {name ix op} {
4947    global highlight_related
4948
4949    rhighlight_none
4950    if {$highlight_related ne [mc "None"]} {
4951        run drawvisible
4952    }
4953}
4954
4955# prepare for testing whether commits are descendents or ancestors of a
4956proc rhighlight_sel {a} {
4957    global descendent desc_todo ancestor anc_todo
4958    global highlight_related
4959
4960    unset -nocomplain descendent
4961    set desc_todo [list $a]
4962    unset -nocomplain ancestor
4963    set anc_todo [list $a]
4964    if {$highlight_related ne [mc "None"]} {
4965        rhighlight_none
4966        run drawvisible
4967    }
4968}
4969
4970proc rhighlight_none {} {
4971    global rhighlights
4972
4973    unset -nocomplain rhighlights
4974    unbolden
4975}
4976
4977proc is_descendent {a} {
4978    global curview children descendent desc_todo
4979
4980    set v $curview
4981    set la [rowofcommit $a]
4982    set todo $desc_todo
4983    set leftover {}
4984    set done 0
4985    for {set i 0} {$i < [llength $todo]} {incr i} {
4986        set do [lindex $todo $i]
4987        if {[rowofcommit $do] < $la} {
4988            lappend leftover $do
4989            continue
4990        }
4991        foreach nk $children($v,$do) {
4992            if {![info exists descendent($nk)]} {
4993                set descendent($nk) 1
4994                lappend todo $nk
4995                if {$nk eq $a} {
4996                    set done 1
4997                }
4998            }
4999        }
5000        if {$done} {
5001            set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
5002            return
5003        }
5004    }
5005    set descendent($a) 0
5006    set desc_todo $leftover
5007}
5008
5009proc is_ancestor {a} {
5010    global curview parents ancestor anc_todo
5011
5012    set v $curview
5013    set la [rowofcommit $a]
5014    set todo $anc_todo
5015    set leftover {}
5016    set done 0
5017    for {set i 0} {$i < [llength $todo]} {incr i} {
5018        set do [lindex $todo $i]
5019        if {![commitinview $do $v] || [rowofcommit $do] > $la} {
5020            lappend leftover $do
5021            continue
5022        }
5023        foreach np $parents($v,$do) {
5024            if {![info exists ancestor($np)]} {
5025                set ancestor($np) 1
5026                lappend todo $np
5027                if {$np eq $a} {
5028                    set done 1
5029                }
5030            }
5031        }
5032        if {$done} {
5033            set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
5034            return
5035        }
5036    }
5037    set ancestor($a) 0
5038    set anc_todo $leftover
5039}
5040
5041proc askrelhighlight {row id} {
5042    global descendent highlight_related iddrawn rhighlights
5043    global selectedline ancestor
5044
5045    if {$selectedline eq {}} return
5046    set isbold 0
5047    if {$highlight_related eq [mc "Descendant"] ||
5048        $highlight_related eq [mc "Not descendant"]} {
5049        if {![info exists descendent($id)]} {
5050            is_descendent $id
5051        }
5052        if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
5053            set isbold 1
5054        }
5055    } elseif {$highlight_related eq [mc "Ancestor"] ||
5056              $highlight_related eq [mc "Not ancestor"]} {
5057        if {![info exists ancestor($id)]} {
5058            is_ancestor $id
5059        }
5060        if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
5061            set isbold 1
5062        }
5063    }
5064    if {[info exists iddrawn($id)]} {
5065        if {$isbold && ![ishighlighted $id]} {
5066            bolden $id mainfontbold
5067        }
5068    }
5069    set rhighlights($id) $isbold
5070}
5071
5072# Graph layout functions
5073
5074proc shortids {ids} {
5075    set res {}
5076    foreach id $ids {
5077        if {[llength $id] > 1} {
5078            lappend res [shortids $id]
5079        } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
5080            lappend res [string range $id 0 7]
5081        } else {
5082            lappend res $id
5083        }
5084    }
5085    return $res
5086}
5087
5088proc ntimes {n o} {
5089    set ret {}
5090    set o [list $o]
5091    for {set mask 1} {$mask <= $n} {incr mask $mask} {
5092        if {($n & $mask) != 0} {
5093            set ret [concat $ret $o]
5094        }
5095        set o [concat $o $o]
5096    }
5097    return $ret
5098}
5099
5100proc ordertoken {id} {
5101    global ordertok curview varcid varcstart varctok curview parents children
5102    global nullid nullid2
5103
5104    if {[info exists ordertok($id)]} {
5105        return $ordertok($id)
5106    }
5107    set origid $id
5108    set todo {}
5109    while {1} {
5110        if {[info exists varcid($curview,$id)]} {
5111            set a $varcid($curview,$id)
5112            set p [lindex $varcstart($curview) $a]
5113        } else {
5114            set p [lindex $children($curview,$id) 0]
5115        }
5116        if {[info exists ordertok($p)]} {
5117            set tok $ordertok($p)
5118            break
5119        }
5120        set id [first_real_child $curview,$p]
5121        if {$id eq {}} {
5122            # it's a root
5123            set tok [lindex $varctok($curview) $varcid($curview,$p)]
5124            break
5125        }
5126        if {[llength $parents($curview,$id)] == 1} {
5127            lappend todo [list $p {}]
5128        } else {
5129            set j [lsearch -exact $parents($curview,$id) $p]
5130            if {$j < 0} {
5131                puts "oops didn't find [shortids $p] in parents of [shortids $id]"
5132            }
5133            lappend todo [list $p [strrep $j]]
5134        }
5135    }
5136    for {set i [llength $todo]} {[incr i -1] >= 0} {} {
5137        set p [lindex $todo $i 0]
5138        append tok [lindex $todo $i 1]
5139        set ordertok($p) $tok
5140    }
5141    set ordertok($origid) $tok
5142    return $tok
5143}
5144
5145# Work out where id should go in idlist so that order-token
5146# values increase from left to right
5147proc idcol {idlist id {i 0}} {
5148    set t [ordertoken $id]
5149    if {$i < 0} {
5150        set i 0
5151    }
5152    if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
5153        if {$i > [llength $idlist]} {
5154            set i [llength $idlist]
5155        }
5156        while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
5157        incr i
5158    } else {
5159        if {$t > [ordertoken [lindex $idlist $i]]} {
5160            while {[incr i] < [llength $idlist] &&
5161                   $t >= [ordertoken [lindex $idlist $i]]} {}
5162        }
5163    }
5164    return $i
5165}
5166
5167proc initlayout {} {
5168    global rowidlist rowisopt rowfinal displayorder parentlist
5169    global numcommits canvxmax canv
5170    global nextcolor
5171    global colormap rowtextx
5172
5173    set numcommits 0
5174    set displayorder {}
5175    set parentlist {}
5176    set nextcolor 0
5177    set rowidlist {}
5178    set rowisopt {}
5179    set rowfinal {}
5180    set canvxmax [$canv cget -width]
5181    unset -nocomplain colormap
5182    unset -nocomplain rowtextx
5183    setcanvscroll
5184}
5185
5186proc setcanvscroll {} {
5187    global canv canv2 canv3 numcommits linespc canvxmax canvy0
5188    global lastscrollset lastscrollrows
5189
5190    set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
5191    $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
5192    $canv2 conf -scrollregion [list 0 0 0 $ymax]
5193    $canv3 conf -scrollregion [list 0 0 0 $ymax]
5194    set lastscrollset [clock clicks -milliseconds]
5195    set lastscrollrows $numcommits
5196}
5197
5198proc visiblerows {} {
5199    global canv numcommits linespc
5200
5201    set ymax [lindex [$canv cget -scrollregion] 3]
5202    if {$ymax eq {} || $ymax == 0} return
5203    set f [$canv yview]
5204    set y0 [expr {int([lindex $f 0] * $ymax)}]
5205    set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
5206    if {$r0 < 0} {
5207        set r0 0
5208    }
5209    set y1 [expr {int([lindex $f 1] * $ymax)}]
5210    set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
5211    if {$r1 >= $numcommits} {
5212        set r1 [expr {$numcommits - 1}]
5213    }
5214    return [list $r0 $r1]
5215}
5216
5217proc layoutmore {} {
5218    global commitidx viewcomplete curview
5219    global numcommits pending_select curview
5220    global lastscrollset lastscrollrows
5221
5222    if {$lastscrollrows < 100 || $viewcomplete($curview) ||
5223        [clock clicks -milliseconds] - $lastscrollset > 500} {
5224        setcanvscroll
5225    }
5226    if {[info exists pending_select] &&
5227        [commitinview $pending_select $curview]} {
5228        update
5229        selectline [rowofcommit $pending_select] 1
5230    }
5231    drawvisible
5232}
5233
5234# With path limiting, we mightn't get the actual HEAD commit,
5235# so ask git rev-list what is the first ancestor of HEAD that
5236# touches a file in the path limit.
5237proc get_viewmainhead {view} {
5238    global viewmainheadid vfilelimit viewinstances mainheadid
5239
5240    catch {
5241        set rfd [open [concat | git rev-list -1 $mainheadid \
5242                           -- $vfilelimit($view)] r]
5243        set j [reg_instance $rfd]
5244        lappend viewinstances($view) $j
5245        fconfigure $rfd -blocking 0
5246        filerun $rfd [list getviewhead $rfd $j $view]
5247        set viewmainheadid($curview) {}
5248    }
5249}
5250
5251# git rev-list should give us just 1 line to use as viewmainheadid($view)
5252proc getviewhead {fd inst view} {
5253    global viewmainheadid commfd curview viewinstances showlocalchanges
5254
5255    set id {}
5256    if {[gets $fd line] < 0} {
5257        if {![eof $fd]} {
5258            return 1
5259        }
5260    } elseif {[string length $line] == 40 && [string is xdigit $line]} {
5261        set id $line
5262    }
5263    set viewmainheadid($view) $id
5264    close $fd
5265    unset commfd($inst)
5266    set i [lsearch -exact $viewinstances($view) $inst]
5267    if {$i >= 0} {
5268        set viewinstances($view) [lreplace $viewinstances($view) $i $i]
5269    }
5270    if {$showlocalchanges && $id ne {} && $view == $curview} {
5271        doshowlocalchanges
5272    }
5273    return 0
5274}
5275
5276proc doshowlocalchanges {} {
5277    global curview viewmainheadid
5278
5279    if {$viewmainheadid($curview) eq {}} return
5280    if {[commitinview $viewmainheadid($curview) $curview]} {
5281        dodiffindex
5282    } else {
5283        interestedin $viewmainheadid($curview) dodiffindex
5284    }
5285}
5286
5287proc dohidelocalchanges {} {
5288    global nullid nullid2 lserial curview
5289
5290    if {[commitinview $nullid $curview]} {
5291        removefakerow $nullid
5292    }
5293    if {[commitinview $nullid2 $curview]} {
5294        removefakerow $nullid2
5295    }
5296    incr lserial
5297}
5298
5299# spawn off a process to do git diff-index --cached HEAD
5300proc dodiffindex {} {
5301    global lserial showlocalchanges vfilelimit curview
5302    global hasworktree git_version
5303
5304    if {!$showlocalchanges || !$hasworktree} return
5305    incr lserial
5306    if {[package vcompare $git_version "1.7.2"] >= 0} {
5307        set cmd "|git diff-index --cached --ignore-submodules=dirty HEAD"
5308    } else {
5309        set cmd "|git diff-index --cached HEAD"
5310    }
5311    if {$vfilelimit($curview) ne {}} {
5312        set cmd [concat $cmd -- $vfilelimit($curview)]
5313    }
5314    set fd [open $cmd r]
5315    fconfigure $fd -blocking 0
5316    set i [reg_instance $fd]
5317    filerun $fd [list readdiffindex $fd $lserial $i]
5318}
5319
5320proc readdiffindex {fd serial inst} {
5321    global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
5322    global vfilelimit
5323
5324    set isdiff 1
5325    if {[gets $fd line] < 0} {
5326        if {![eof $fd]} {
5327            return 1
5328        }
5329        set isdiff 0
5330    }
5331    # we only need to see one line and we don't really care what it says...
5332    stop_instance $inst
5333
5334    if {$serial != $lserial} {
5335        return 0
5336    }
5337
5338    # now see if there are any local changes not checked in to the index
5339    set cmd "|git diff-files"
5340    if {$vfilelimit($curview) ne {}} {
5341        set cmd [concat $cmd -- $vfilelimit($curview)]
5342    }
5343    set fd [open $cmd r]
5344    fconfigure $fd -blocking 0
5345    set i [reg_instance $fd]
5346    filerun $fd [list readdifffiles $fd $serial $i]
5347
5348    if {$isdiff && ![commitinview $nullid2 $curview]} {
5349        # add the line for the changes in the index to the graph
5350        set hl [mc "Local changes checked in to index but not committed"]
5351        set commitinfo($nullid2) [list  $hl {} {} {} {} "    $hl\n"]
5352        set commitdata($nullid2) "\n    $hl\n"
5353        if {[commitinview $nullid $curview]} {
5354            removefakerow $nullid
5355        }
5356        insertfakerow $nullid2 $viewmainheadid($curview)
5357    } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
5358        if {[commitinview $nullid $curview]} {
5359            removefakerow $nullid
5360        }
5361        removefakerow $nullid2
5362    }
5363    return 0
5364}
5365
5366proc readdifffiles {fd serial inst} {
5367    global viewmainheadid nullid nullid2 curview
5368    global commitinfo commitdata lserial
5369
5370    set isdiff 1
5371    if {[gets $fd line] < 0} {
5372        if {![eof $fd]} {
5373            return 1
5374        }
5375        set isdiff 0
5376    }
5377    # we only need to see one line and we don't really care what it says...
5378    stop_instance $inst
5379
5380    if {$serial != $lserial} {
5381        return 0
5382    }
5383
5384    if {$isdiff && ![commitinview $nullid $curview]} {
5385        # add the line for the local diff to the graph
5386        set hl [mc "Local uncommitted changes, not checked in to index"]
5387        set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
5388        set commitdata($nullid) "\n    $hl\n"
5389        if {[commitinview $nullid2 $curview]} {
5390            set p $nullid2
5391        } else {
5392            set p $viewmainheadid($curview)
5393        }
5394        insertfakerow $nullid $p
5395    } elseif {!$isdiff && [commitinview $nullid $curview]} {
5396        removefakerow $nullid
5397    }
5398    return 0
5399}
5400
5401proc nextuse {id row} {
5402    global curview children
5403
5404    if {[info exists children($curview,$id)]} {
5405        foreach kid $children($curview,$id) {
5406            if {![commitinview $kid $curview]} {
5407                return -1
5408            }
5409            if {[rowofcommit $kid] > $row} {
5410                return [rowofcommit $kid]
5411            }
5412        }
5413    }
5414    if {[commitinview $id $curview]} {
5415        return [rowofcommit $id]
5416    }
5417    return -1
5418}
5419
5420proc prevuse {id row} {
5421    global curview children
5422
5423    set ret -1
5424    if {[info exists children($curview,$id)]} {
5425        foreach kid $children($curview,$id) {
5426            if {![commitinview $kid $curview]} break
5427            if {[rowofcommit $kid] < $row} {
5428                set ret [rowofcommit $kid]
5429            }
5430        }
5431    }
5432    return $ret
5433}
5434
5435proc make_idlist {row} {
5436    global displayorder parentlist uparrowlen downarrowlen mingaplen
5437    global commitidx curview children
5438
5439    set r [expr {$row - $mingaplen - $downarrowlen - 1}]
5440    if {$r < 0} {
5441        set r 0
5442    }
5443    set ra [expr {$row - $downarrowlen}]
5444    if {$ra < 0} {
5445        set ra 0
5446    }
5447    set rb [expr {$row + $uparrowlen}]
5448    if {$rb > $commitidx($curview)} {
5449        set rb $commitidx($curview)
5450    }
5451    make_disporder $r [expr {$rb + 1}]
5452    set ids {}
5453    for {} {$r < $ra} {incr r} {
5454        set nextid [lindex $displayorder [expr {$r + 1}]]
5455        foreach p [lindex $parentlist $r] {
5456            if {$p eq $nextid} continue
5457            set rn [nextuse $p $r]
5458            if {$rn >= $row &&
5459                $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
5460                lappend ids [list [ordertoken $p] $p]
5461            }
5462        }
5463    }
5464    for {} {$r < $row} {incr r} {
5465        set nextid [lindex $displayorder [expr {$r + 1}]]
5466        foreach p [lindex $parentlist $r] {
5467            if {$p eq $nextid} continue
5468            set rn [nextuse $p $r]
5469            if {$rn < 0 || $rn >= $row} {
5470                lappend ids [list [ordertoken $p] $p]
5471            }
5472        }
5473    }
5474    set id [lindex $displayorder $row]
5475    lappend ids [list [ordertoken $id] $id]
5476    while {$r < $rb} {
5477        foreach p [lindex $parentlist $r] {
5478            set firstkid [lindex $children($curview,$p) 0]
5479            if {[rowofcommit $firstkid] < $row} {
5480                lappend ids [list [ordertoken $p] $p]
5481            }
5482        }
5483        incr r
5484        set id [lindex $displayorder $r]
5485        if {$id ne {}} {
5486            set firstkid [lindex $children($curview,$id) 0]
5487            if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
5488                lappend ids [list [ordertoken $id] $id]
5489            }
5490        }
5491    }
5492    set idlist {}
5493    foreach idx [lsort -unique $ids] {
5494        lappend idlist [lindex $idx 1]
5495    }
5496    return $idlist
5497}
5498
5499proc rowsequal {a b} {
5500    while {[set i [lsearch -exact $a {}]] >= 0} {
5501        set a [lreplace $a $i $i]
5502    }
5503    while {[set i [lsearch -exact $b {}]] >= 0} {
5504        set b [lreplace $b $i $i]
5505    }
5506    return [expr {$a eq $b}]
5507}
5508
5509proc makeupline {id row rend col} {
5510    global rowidlist uparrowlen downarrowlen mingaplen
5511
5512    for {set r $rend} {1} {set r $rstart} {
5513        set rstart [prevuse $id $r]
5514        if {$rstart < 0} return
5515        if {$rstart < $row} break
5516    }
5517    if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5518        set rstart [expr {$rend - $uparrowlen - 1}]
5519    }
5520    for {set r $rstart} {[incr r] <= $row} {} {
5521        set idlist [lindex $rowidlist $r]
5522        if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5523            set col [idcol $idlist $id $col]
5524            lset rowidlist $r [linsert $idlist $col $id]
5525            changedrow $r
5526        }
5527    }
5528}
5529
5530proc layoutrows {row endrow} {
5531    global rowidlist rowisopt rowfinal displayorder
5532    global uparrowlen downarrowlen maxwidth mingaplen
5533    global children parentlist
5534    global commitidx viewcomplete curview
5535
5536    make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
5537    set idlist {}
5538    if {$row > 0} {
5539        set rm1 [expr {$row - 1}]
5540        foreach id [lindex $rowidlist $rm1] {
5541            if {$id ne {}} {
5542                lappend idlist $id
5543            }
5544        }
5545        set final [lindex $rowfinal $rm1]
5546    }
5547    for {} {$row < $endrow} {incr row} {
5548        set rm1 [expr {$row - 1}]
5549        if {$rm1 < 0 || $idlist eq {}} {
5550            set idlist [make_idlist $row]
5551            set final 1
5552        } else {
5553            set id [lindex $displayorder $rm1]
5554            set col [lsearch -exact $idlist $id]
5555            set idlist [lreplace $idlist $col $col]
5556            foreach p [lindex $parentlist $rm1] {
5557                if {[lsearch -exact $idlist $p] < 0} {
5558                    set col [idcol $idlist $p $col]
5559                    set idlist [linsert $idlist $col $p]
5560                    # if not the first child, we have to insert a line going up
5561                    if {$id ne [lindex $children($curview,$p) 0]} {
5562                        makeupline $p $rm1 $row $col
5563                    }
5564                }
5565            }
5566            set id [lindex $displayorder $row]
5567            if {$row > $downarrowlen} {
5568                set termrow [expr {$row - $downarrowlen - 1}]
5569                foreach p [lindex $parentlist $termrow] {
5570                    set i [lsearch -exact $idlist $p]
5571                    if {$i < 0} continue
5572                    set nr [nextuse $p $termrow]
5573                    if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5574                        set idlist [lreplace $idlist $i $i]
5575                    }
5576                }
5577            }
5578            set col [lsearch -exact $idlist $id]
5579            if {$col < 0} {
5580                set col [idcol $idlist $id]
5581                set idlist [linsert $idlist $col $id]
5582                if {$children($curview,$id) ne {}} {
5583                    makeupline $id $rm1 $row $col
5584                }
5585            }
5586            set r [expr {$row + $uparrowlen - 1}]
5587            if {$r < $commitidx($curview)} {
5588                set x $col
5589                foreach p [lindex $parentlist $r] {
5590                    if {[lsearch -exact $idlist $p] >= 0} continue
5591                    set fk [lindex $children($curview,$p) 0]
5592                    if {[rowofcommit $fk] < $row} {
5593                        set x [idcol $idlist $p $x]
5594                        set idlist [linsert $idlist $x $p]
5595                    }
5596                }
5597                if {[incr r] < $commitidx($curview)} {
5598                    set p [lindex $displayorder $r]
5599                    if {[lsearch -exact $idlist $p] < 0} {
5600                        set fk [lindex $children($curview,$p) 0]
5601                        if {$fk ne {} && [rowofcommit $fk] < $row} {
5602                            set x [idcol $idlist $p $x]
5603                            set idlist [linsert $idlist $x $p]
5604                        }
5605                    }
5606                }
5607            }
5608        }
5609        if {$final && !$viewcomplete($curview) &&
5610            $row + $uparrowlen + $mingaplen + $downarrowlen
5611                >= $commitidx($curview)} {
5612            set final 0
5613        }
5614        set l [llength $rowidlist]
5615        if {$row == $l} {
5616            lappend rowidlist $idlist
5617            lappend rowisopt 0
5618            lappend rowfinal $final
5619        } elseif {$row < $l} {
5620            if {![rowsequal $idlist [lindex $rowidlist $row]]} {
5621                lset rowidlist $row $idlist
5622                changedrow $row
5623            }
5624            lset rowfinal $row $final
5625        } else {
5626            set pad [ntimes [expr {$row - $l}] {}]
5627            set rowidlist [concat $rowidlist $pad]
5628            lappend rowidlist $idlist
5629            set rowfinal [concat $rowfinal $pad]
5630            lappend rowfinal $final
5631            set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5632        }
5633    }
5634    return $row
5635}
5636
5637proc changedrow {row} {
5638    global displayorder iddrawn rowisopt need_redisplay
5639
5640    set l [llength $rowisopt]
5641    if {$row < $l} {
5642        lset rowisopt $row 0
5643        if {$row + 1 < $l} {
5644            lset rowisopt [expr {$row + 1}] 0
5645            if {$row + 2 < $l} {
5646                lset rowisopt [expr {$row + 2}] 0
5647            }
5648        }
5649    }
5650    set id [lindex $displayorder $row]
5651    if {[info exists iddrawn($id)]} {
5652        set need_redisplay 1
5653    }
5654}
5655
5656proc insert_pad {row col npad} {
5657    global rowidlist
5658
5659    set pad [ntimes $npad {}]
5660    set idlist [lindex $rowidlist $row]
5661    set bef [lrange $idlist 0 [expr {$col - 1}]]
5662    set aft [lrange $idlist $col end]
5663    set i [lsearch -exact $aft {}]
5664    if {$i > 0} {
5665        set aft [lreplace $aft $i $i]
5666    }
5667    lset rowidlist $row [concat $bef $pad $aft]
5668    changedrow $row
5669}
5670
5671proc optimize_rows {row col endrow} {
5672    global rowidlist rowisopt displayorder curview children
5673
5674    if {$row < 1} {
5675        set row 1
5676    }
5677    for {} {$row < $endrow} {incr row; set col 0} {
5678        if {[lindex $rowisopt $row]} continue
5679        set haspad 0
5680        set y0 [expr {$row - 1}]
5681        set ym [expr {$row - 2}]
5682        set idlist [lindex $rowidlist $row]
5683        set previdlist [lindex $rowidlist $y0]
5684        if {$idlist eq {} || $previdlist eq {}} continue
5685        if {$ym >= 0} {
5686            set pprevidlist [lindex $rowidlist $ym]
5687            if {$pprevidlist eq {}} continue
5688        } else {
5689            set pprevidlist {}
5690        }
5691        set x0 -1
5692        set xm -1
5693        for {} {$col < [llength $idlist]} {incr col} {
5694            set id [lindex $idlist $col]
5695            if {[lindex $previdlist $col] eq $id} continue
5696            if {$id eq {}} {
5697                set haspad 1
5698                continue
5699            }
5700            set x0 [lsearch -exact $previdlist $id]
5701            if {$x0 < 0} continue
5702            set z [expr {$x0 - $col}]
5703            set isarrow 0
5704            set z0 {}
5705            if {$ym >= 0} {
5706                set xm [lsearch -exact $pprevidlist $id]
5707                if {$xm >= 0} {
5708                    set z0 [expr {$xm - $x0}]
5709                }
5710            }
5711            if {$z0 eq {}} {
5712                # if row y0 is the first child of $id then it's not an arrow
5713                if {[lindex $children($curview,$id) 0] ne
5714                    [lindex $displayorder $y0]} {
5715                    set isarrow 1
5716                }
5717            }
5718            if {!$isarrow && $id ne [lindex $displayorder $row] &&
5719                [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5720                set isarrow 1
5721            }
5722            # Looking at lines from this row to the previous row,
5723            # make them go straight up if they end in an arrow on
5724            # the previous row; otherwise make them go straight up
5725            # or at 45 degrees.
5726            if {$z < -1 || ($z < 0 && $isarrow)} {
5727                # Line currently goes left too much;
5728                # insert pads in the previous row, then optimize it
5729                set npad [expr {-1 - $z + $isarrow}]
5730                insert_pad $y0 $x0 $npad
5731                if {$y0 > 0} {
5732                    optimize_rows $y0 $x0 $row
5733                }
5734                set previdlist [lindex $rowidlist $y0]
5735                set x0 [lsearch -exact $previdlist $id]
5736                set z [expr {$x0 - $col}]
5737                if {$z0 ne {}} {
5738                    set pprevidlist [lindex $rowidlist $ym]
5739                    set xm [lsearch -exact $pprevidlist $id]
5740                    set z0 [expr {$xm - $x0}]
5741                }
5742            } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5743                # Line currently goes right too much;
5744                # insert pads in this line
5745                set npad [expr {$z - 1 + $isarrow}]
5746                insert_pad $row $col $npad
5747                set idlist [lindex $rowidlist $row]
5748                incr col $npad
5749                set z [expr {$x0 - $col}]
5750                set haspad 1
5751            }
5752            if {$z0 eq {} && !$isarrow && $ym >= 0} {
5753                # this line links to its first child on row $row-2
5754                set id [lindex $displayorder $ym]
5755                set xc [lsearch -exact $pprevidlist $id]
5756                if {$xc >= 0} {
5757                    set z0 [expr {$xc - $x0}]
5758                }
5759            }
5760            # avoid lines jigging left then immediately right
5761            if {$z0 ne {} && $z < 0 && $z0 > 0} {
5762                insert_pad $y0 $x0 1
5763                incr x0
5764                optimize_rows $y0 $x0 $row
5765                set previdlist [lindex $rowidlist $y0]
5766            }
5767        }
5768        if {!$haspad} {
5769            # Find the first column that doesn't have a line going right
5770            for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5771                set id [lindex $idlist $col]
5772                if {$id eq {}} break
5773                set x0 [lsearch -exact $previdlist $id]
5774                if {$x0 < 0} {
5775                    # check if this is the link to the first child
5776                    set kid [lindex $displayorder $y0]
5777                    if {[lindex $children($curview,$id) 0] eq $kid} {
5778                        # it is, work out offset to child
5779                        set x0 [lsearch -exact $previdlist $kid]
5780                    }
5781                }
5782                if {$x0 <= $col} break
5783            }
5784            # Insert a pad at that column as long as it has a line and
5785            # isn't the last column
5786            if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5787                set idlist [linsert $idlist $col {}]
5788                lset rowidlist $row $idlist
5789                changedrow $row
5790            }
5791        }
5792    }
5793}
5794
5795proc xc {row col} {
5796    global canvx0 linespc
5797    return [expr {$canvx0 + $col * $linespc}]
5798}
5799
5800proc yc {row} {
5801    global canvy0 linespc
5802    return [expr {$canvy0 + $row * $linespc}]
5803}
5804
5805proc linewidth {id} {
5806    global thickerline lthickness
5807
5808    set wid $lthickness
5809    if {[info exists thickerline] && $id eq $thickerline} {
5810        set wid [expr {2 * $lthickness}]
5811    }
5812    return $wid
5813}
5814
5815proc rowranges {id} {
5816    global curview children uparrowlen downarrowlen
5817    global rowidlist
5818
5819    set kids $children($curview,$id)
5820    if {$kids eq {}} {
5821        return {}
5822    }
5823    set ret {}
5824    lappend kids $id
5825    foreach child $kids {
5826        if {![commitinview $child $curview]} break
5827        set row [rowofcommit $child]
5828        if {![info exists prev]} {
5829            lappend ret [expr {$row + 1}]
5830        } else {
5831            if {$row <= $prevrow} {
5832                puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5833            }
5834            # see if the line extends the whole way from prevrow to row
5835            if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5836                [lsearch -exact [lindex $rowidlist \
5837                            [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5838                # it doesn't, see where it ends
5839                set r [expr {$prevrow + $downarrowlen}]
5840                if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5841                    while {[incr r -1] > $prevrow &&
5842                           [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5843                } else {
5844                    while {[incr r] <= $row &&
5845                           [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5846                    incr r -1
5847                }
5848                lappend ret $r
5849                # see where it starts up again
5850                set r [expr {$row - $uparrowlen}]
5851                if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5852                    while {[incr r] < $row &&
5853                           [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5854                } else {
5855                    while {[incr r -1] >= $prevrow &&
5856                           [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5857                    incr r
5858                }
5859                lappend ret $r
5860            }
5861        }
5862        if {$child eq $id} {
5863            lappend ret $row
5864        }
5865        set prev $child
5866        set prevrow $row
5867    }
5868    return $ret
5869}
5870
5871proc drawlineseg {id row endrow arrowlow} {
5872    global rowidlist displayorder iddrawn linesegs
5873    global canv colormap linespc curview maxlinelen parentlist
5874
5875    set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5876    set le [expr {$row + 1}]
5877    set arrowhigh 1
5878    while {1} {
5879        set c [lsearch -exact [lindex $rowidlist $le] $id]
5880        if {$c < 0} {
5881            incr le -1
5882            break
5883        }
5884        lappend cols $c
5885        set x [lindex $displayorder $le]
5886        if {$x eq $id} {
5887            set arrowhigh 0
5888            break
5889        }
5890        if {[info exists iddrawn($x)] || $le == $endrow} {
5891            set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5892            if {$c >= 0} {
5893                lappend cols $c
5894                set arrowhigh 0
5895            }
5896            break
5897        }
5898        incr le
5899    }
5900    if {$le <= $row} {
5901        return $row
5902    }
5903
5904    set lines {}
5905    set i 0
5906    set joinhigh 0
5907    if {[info exists linesegs($id)]} {
5908        set lines $linesegs($id)
5909        foreach li $lines {
5910            set r0 [lindex $li 0]
5911            if {$r0 > $row} {
5912                if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5913                    set joinhigh 1
5914                }
5915                break
5916            }
5917            incr i
5918        }
5919    }
5920    set joinlow 0
5921    if {$i > 0} {
5922        set li [lindex $lines [expr {$i-1}]]
5923        set r1 [lindex $li 1]
5924        if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5925            set joinlow 1
5926        }
5927    }
5928
5929    set x [lindex $cols [expr {$le - $row}]]
5930    set xp [lindex $cols [expr {$le - 1 - $row}]]
5931    set dir [expr {$xp - $x}]
5932    if {$joinhigh} {
5933        set ith [lindex $lines $i 2]
5934        set coords [$canv coords $ith]
5935        set ah [$canv itemcget $ith -arrow]
5936        set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5937        set x2 [lindex $cols [expr {$le + 1 - $row}]]
5938        if {$x2 ne {} && $x - $x2 == $dir} {
5939            set coords [lrange $coords 0 end-2]
5940        }
5941    } else {
5942        set coords [list [xc $le $x] [yc $le]]
5943    }
5944    if {$joinlow} {
5945        set itl [lindex $lines [expr {$i-1}] 2]
5946        set al [$canv itemcget $itl -arrow]
5947        set arrowlow [expr {$al eq "last" || $al eq "both"}]
5948    } elseif {$arrowlow} {
5949        if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5950            [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5951            set arrowlow 0
5952        }
5953    }
5954    set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5955    for {set y $le} {[incr y -1] > $row} {} {
5956        set x $xp
5957        set xp [lindex $cols [expr {$y - 1 - $row}]]
5958        set ndir [expr {$xp - $x}]
5959        if {$dir != $ndir || $xp < 0} {
5960            lappend coords [xc $y $x] [yc $y]
5961        }
5962        set dir $ndir
5963    }
5964    if {!$joinlow} {
5965        if {$xp < 0} {
5966            # join parent line to first child
5967            set ch [lindex $displayorder $row]
5968            set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5969            if {$xc < 0} {
5970                puts "oops: drawlineseg: child $ch not on row $row"
5971            } elseif {$xc != $x} {
5972                if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5973                    set d [expr {int(0.5 * $linespc)}]
5974                    set x1 [xc $row $x]
5975                    if {$xc < $x} {
5976                        set x2 [expr {$x1 - $d}]
5977                    } else {
5978                        set x2 [expr {$x1 + $d}]
5979                    }
5980                    set y2 [yc $row]
5981                    set y1 [expr {$y2 + $d}]
5982                    lappend coords $x1 $y1 $x2 $y2
5983                } elseif {$xc < $x - 1} {
5984                    lappend coords [xc $row [expr {$x-1}]] [yc $row]
5985                } elseif {$xc > $x + 1} {
5986                    lappend coords [xc $row [expr {$x+1}]] [yc $row]
5987                }
5988                set x $xc
5989            }
5990            lappend coords [xc $row $x] [yc $row]
5991        } else {
5992            set xn [xc $row $xp]
5993            set yn [yc $row]
5994            lappend coords $xn $yn
5995        }
5996        if {!$joinhigh} {
5997            assigncolor $id
5998            set t [$canv create line $coords -width [linewidth $id] \
5999                       -fill $colormap($id) -tags lines.$id -arrow $arrow]
6000            $canv lower $t
6001            bindline $t $id
6002            set lines [linsert $lines $i [list $row $le $t]]
6003        } else {
6004            $canv coords $ith $coords
6005            if {$arrow ne $ah} {
6006                $canv itemconf $ith -arrow $arrow
6007            }
6008            lset lines $i 0 $row
6009        }
6010    } else {
6011        set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
6012        set ndir [expr {$xo - $xp}]
6013        set clow [$canv coords $itl]
6014        if {$dir == $ndir} {
6015            set clow [lrange $clow 2 end]
6016        }
6017        set coords [concat $coords $clow]
6018        if {!$joinhigh} {
6019            lset lines [expr {$i-1}] 1 $le
6020        } else {
6021            # coalesce two pieces
6022            $canv delete $ith
6023            set b [lindex $lines [expr {$i-1}] 0]
6024            set e [lindex $lines $i 1]
6025            set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
6026        }
6027        $canv coords $itl $coords
6028        if {$arrow ne $al} {
6029            $canv itemconf $itl -arrow $arrow
6030        }
6031    }
6032
6033    set linesegs($id) $lines
6034    return $le
6035}
6036
6037proc drawparentlinks {id row} {
6038    global rowidlist canv colormap curview parentlist
6039    global idpos linespc
6040
6041    set rowids [lindex $rowidlist $row]
6042    set col [lsearch -exact $rowids $id]
6043    if {$col < 0} return
6044    set olds [lindex $parentlist $row]
6045    set row2 [expr {$row + 1}]
6046    set x [xc $row $col]
6047    set y [yc $row]
6048    set y2 [yc $row2]
6049    set d [expr {int(0.5 * $linespc)}]
6050    set ymid [expr {$y + $d}]
6051    set ids [lindex $rowidlist $row2]
6052    # rmx = right-most X coord used
6053    set rmx 0
6054    foreach p $olds {
6055        set i [lsearch -exact $ids $p]
6056        if {$i < 0} {
6057            puts "oops, parent $p of $id not in list"
6058            continue
6059        }
6060        set x2 [xc $row2 $i]
6061        if {$x2 > $rmx} {
6062            set rmx $x2
6063        }
6064        set j [lsearch -exact $rowids $p]
6065        if {$j < 0} {
6066            # drawlineseg will do this one for us
6067            continue
6068        }
6069        assigncolor $p
6070        # should handle duplicated parents here...
6071        set coords [list $x $y]
6072        if {$i != $col} {
6073            # if attaching to a vertical segment, draw a smaller
6074            # slant for visual distinctness
6075            if {$i == $j} {
6076                if {$i < $col} {
6077                    lappend coords [expr {$x2 + $d}] $y $x2 $ymid
6078                } else {
6079                    lappend coords [expr {$x2 - $d}] $y $x2 $ymid
6080                }
6081            } elseif {$i < $col && $i < $j} {
6082                # segment slants towards us already
6083                lappend coords [xc $row $j] $y
6084            } else {
6085                if {$i < $col - 1} {
6086                    lappend coords [expr {$x2 + $linespc}] $y
6087                } elseif {$i > $col + 1} {
6088                    lappend coords [expr {$x2 - $linespc}] $y
6089                }
6090                lappend coords $x2 $y2
6091            }
6092        } else {
6093            lappend coords $x2 $y2
6094        }
6095        set t [$canv create line $coords -width [linewidth $p] \
6096                   -fill $colormap($p) -tags lines.$p]
6097        $canv lower $t
6098        bindline $t $p
6099    }
6100    if {$rmx > [lindex $idpos($id) 1]} {
6101        lset idpos($id) 1 $rmx
6102        redrawtags $id
6103    }
6104}
6105
6106proc drawlines {id} {
6107    global canv
6108
6109    $canv itemconf lines.$id -width [linewidth $id]
6110}
6111
6112proc drawcmittext {id row col} {
6113    global linespc canv canv2 canv3 fgcolor curview
6114    global cmitlisted commitinfo rowidlist parentlist
6115    global rowtextx idpos idtags idheads idotherrefs
6116    global linehtag linentag linedtag selectedline
6117    global canvxmax boldids boldnameids fgcolor markedid
6118    global mainheadid nullid nullid2 circleitem circlecolors ctxbut
6119    global mainheadcirclecolor workingfilescirclecolor indexcirclecolor
6120    global circleoutlinecolor
6121
6122    # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
6123    set listed $cmitlisted($curview,$id)
6124    if {$id eq $nullid} {
6125        set ofill $workingfilescirclecolor
6126    } elseif {$id eq $nullid2} {
6127        set ofill $indexcirclecolor
6128    } elseif {$id eq $mainheadid} {
6129        set ofill $mainheadcirclecolor
6130    } else {
6131        set ofill [lindex $circlecolors $listed]
6132    }
6133    set x [xc $row $col]
6134    set y [yc $row]
6135    set orad [expr {$linespc / 3}]
6136    if {$listed <= 2} {
6137        set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
6138                   [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6139                   -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6140    } elseif {$listed == 3} {
6141        # triangle pointing left for left-side commits
6142        set t [$canv create polygon \
6143                   [expr {$x - $orad}] $y \
6144                   [expr {$x + $orad - 1}] [expr {$y - $orad}] \
6145                   [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6146                   -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6147    } else {
6148        # triangle pointing right for right-side commits
6149        set t [$canv create polygon \
6150                   [expr {$x + $orad - 1}] $y \
6151                   [expr {$x - $orad}] [expr {$y - $orad}] \
6152                   [expr {$x - $orad}] [expr {$y + $orad - 1}] \
6153                   -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6154    }
6155    set circleitem($row) $t
6156    $canv raise $t
6157    $canv bind $t <1> {selcanvline {} %x %y}
6158    set rmx [llength [lindex $rowidlist $row]]
6159    set olds [lindex $parentlist $row]
6160    if {$olds ne {}} {
6161        set nextids [lindex $rowidlist [expr {$row + 1}]]
6162        foreach p $olds {
6163            set i [lsearch -exact $nextids $p]
6164            if {$i > $rmx} {
6165                set rmx $i
6166            }
6167        }
6168    }
6169    set xt [xc $row $rmx]
6170    set rowtextx($row) $xt
6171    set idpos($id) [list $x $xt $y]
6172    if {[info exists idtags($id)] || [info exists idheads($id)]
6173        || [info exists idotherrefs($id)]} {
6174        set xt [drawtags $id $x $xt $y]
6175    }
6176    if {[lindex $commitinfo($id) 6] > 0} {
6177        set xt [drawnotesign $xt $y]
6178    }
6179    set headline [lindex $commitinfo($id) 0]
6180    set name [lindex $commitinfo($id) 1]
6181    set date [lindex $commitinfo($id) 2]
6182    set date [formatdate $date]
6183    set font mainfont
6184    set nfont mainfont
6185    set isbold [ishighlighted $id]
6186    if {$isbold > 0} {
6187        lappend boldids $id
6188        set font mainfontbold
6189        if {$isbold > 1} {
6190            lappend boldnameids $id
6191            set nfont mainfontbold
6192        }
6193    }
6194    set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
6195                           -text $headline -font $font -tags text]
6196    $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
6197    set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
6198                           -text $name -font $nfont -tags text]
6199    set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
6200                           -text $date -font mainfont -tags text]
6201    if {$selectedline == $row} {
6202        make_secsel $id
6203    }
6204    if {[info exists markedid] && $markedid eq $id} {
6205        make_idmark $id
6206    }
6207    set xr [expr {$xt + [font measure $font $headline]}]
6208    if {$xr > $canvxmax} {
6209        set canvxmax $xr
6210        setcanvscroll
6211    }
6212}
6213
6214proc drawcmitrow {row} {
6215    global displayorder rowidlist nrows_drawn
6216    global iddrawn markingmatches
6217    global commitinfo numcommits
6218    global filehighlight fhighlights findpattern nhighlights
6219    global hlview vhighlights
6220    global highlight_related rhighlights
6221
6222    if {$row >= $numcommits} return
6223
6224    set id [lindex $displayorder $row]
6225    if {[info exists hlview] && ![info exists vhighlights($id)]} {
6226        askvhighlight $row $id
6227    }
6228    if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
6229        askfilehighlight $row $id
6230    }
6231    if {$findpattern ne {} && ![info exists nhighlights($id)]} {
6232        askfindhighlight $row $id
6233    }
6234    if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
6235        askrelhighlight $row $id
6236    }
6237    if {![info exists iddrawn($id)]} {
6238        set col [lsearch -exact [lindex $rowidlist $row] $id]
6239        if {$col < 0} {
6240            puts "oops, row $row id $id not in list"
6241            return
6242        }
6243        if {![info exists commitinfo($id)]} {
6244            getcommit $id
6245        }
6246        assigncolor $id
6247        drawcmittext $id $row $col
6248        set iddrawn($id) 1
6249        incr nrows_drawn
6250    }
6251    if {$markingmatches} {
6252        markrowmatches $row $id
6253    }
6254}
6255
6256proc drawcommits {row {endrow {}}} {
6257    global numcommits iddrawn displayorder curview need_redisplay
6258    global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
6259
6260    if {$row < 0} {
6261        set row 0
6262    }
6263    if {$endrow eq {}} {
6264        set endrow $row
6265    }
6266    if {$endrow >= $numcommits} {
6267        set endrow [expr {$numcommits - 1}]
6268    }
6269
6270    set rl1 [expr {$row - $downarrowlen - 3}]
6271    if {$rl1 < 0} {
6272        set rl1 0
6273    }
6274    set ro1 [expr {$row - 3}]
6275    if {$ro1 < 0} {
6276        set ro1 0
6277    }
6278    set r2 [expr {$endrow + $uparrowlen + 3}]
6279    if {$r2 > $numcommits} {
6280        set r2 $numcommits
6281    }
6282    for {set r $rl1} {$r < $r2} {incr r} {
6283        if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
6284            if {$rl1 < $r} {
6285                layoutrows $rl1 $r
6286            }
6287            set rl1 [expr {$r + 1}]
6288        }
6289    }
6290    if {$rl1 < $r} {
6291        layoutrows $rl1 $r
6292    }
6293    optimize_rows $ro1 0 $r2
6294    if {$need_redisplay || $nrows_drawn > 2000} {
6295        clear_display
6296    }
6297
6298    # make the lines join to already-drawn rows either side
6299    set r [expr {$row - 1}]
6300    if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
6301        set r $row
6302    }
6303    set er [expr {$endrow + 1}]
6304    if {$er >= $numcommits ||
6305        ![info exists iddrawn([lindex $displayorder $er])]} {
6306        set er $endrow
6307    }
6308    for {} {$r <= $er} {incr r} {
6309        set id [lindex $displayorder $r]
6310        set wasdrawn [info exists iddrawn($id)]
6311        drawcmitrow $r
6312        if {$r == $er} break
6313        set nextid [lindex $displayorder [expr {$r + 1}]]
6314        if {$wasdrawn && [info exists iddrawn($nextid)]} continue
6315        drawparentlinks $id $r
6316
6317        set rowids [lindex $rowidlist $r]
6318        foreach lid $rowids {
6319            if {$lid eq {}} continue
6320            if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
6321            if {$lid eq $id} {
6322                # see if this is the first child of any of its parents
6323                foreach p [lindex $parentlist $r] {
6324                    if {[lsearch -exact $rowids $p] < 0} {
6325                        # make this line extend up to the child
6326                        set lineend($p) [drawlineseg $p $r $er 0]
6327                    }
6328                }
6329            } else {
6330                set lineend($lid) [drawlineseg $lid $r $er 1]
6331            }
6332        }
6333    }
6334}
6335
6336proc undolayout {row} {
6337    global uparrowlen mingaplen downarrowlen
6338    global rowidlist rowisopt rowfinal need_redisplay
6339
6340    set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
6341    if {$r < 0} {
6342        set r 0
6343    }
6344    if {[llength $rowidlist] > $r} {
6345        incr r -1
6346        set rowidlist [lrange $rowidlist 0 $r]
6347        set rowfinal [lrange $rowfinal 0 $r]
6348        set rowisopt [lrange $rowisopt 0 $r]
6349        set need_redisplay 1
6350        run drawvisible
6351    }
6352}
6353
6354proc drawvisible {} {
6355    global canv linespc curview vrowmod selectedline targetrow targetid
6356    global need_redisplay cscroll numcommits
6357
6358    set fs [$canv yview]
6359    set ymax [lindex [$canv cget -scrollregion] 3]
6360    if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
6361    set f0 [lindex $fs 0]
6362    set f1 [lindex $fs 1]
6363    set y0 [expr {int($f0 * $ymax)}]
6364    set y1 [expr {int($f1 * $ymax)}]
6365
6366    if {[info exists targetid]} {
6367        if {[commitinview $targetid $curview]} {
6368            set r [rowofcommit $targetid]
6369            if {$r != $targetrow} {
6370                # Fix up the scrollregion and change the scrolling position
6371                # now that our target row has moved.
6372                set diff [expr {($r - $targetrow) * $linespc}]
6373                set targetrow $r
6374                setcanvscroll
6375                set ymax [lindex [$canv cget -scrollregion] 3]
6376                incr y0 $diff
6377                incr y1 $diff
6378                set f0 [expr {$y0 / $ymax}]
6379                set f1 [expr {$y1 / $ymax}]
6380                allcanvs yview moveto $f0
6381                $cscroll set $f0 $f1
6382                set need_redisplay 1
6383            }
6384        } else {
6385            unset targetid
6386        }
6387    }
6388
6389    set row [expr {int(($y0 - 3) / $linespc) - 1}]
6390    set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
6391    if {$endrow >= $vrowmod($curview)} {
6392        update_arcrows $curview
6393    }
6394    if {$selectedline ne {} &&
6395        $row <= $selectedline && $selectedline <= $endrow} {
6396        set targetrow $selectedline
6397    } elseif {[info exists targetid]} {
6398        set targetrow [expr {int(($row + $endrow) / 2)}]
6399    }
6400    if {[info exists targetrow]} {
6401        if {$targetrow >= $numcommits} {
6402            set targetrow [expr {$numcommits - 1}]
6403        }
6404        set targetid [commitonrow $targetrow]
6405    }
6406    drawcommits $row $endrow
6407}
6408
6409proc clear_display {} {
6410    global iddrawn linesegs need_redisplay nrows_drawn
6411    global vhighlights fhighlights nhighlights rhighlights
6412    global linehtag linentag linedtag boldids boldnameids
6413
6414    allcanvs delete all
6415    unset -nocomplain iddrawn
6416    unset -nocomplain linesegs
6417    unset -nocomplain linehtag
6418    unset -nocomplain linentag
6419    unset -nocomplain linedtag
6420    set boldids {}
6421    set boldnameids {}
6422    unset -nocomplain vhighlights
6423    unset -nocomplain fhighlights
6424    unset -nocomplain nhighlights
6425    unset -nocomplain rhighlights
6426    set need_redisplay 0
6427    set nrows_drawn 0
6428}
6429
6430proc findcrossings {id} {
6431    global rowidlist parentlist numcommits displayorder
6432
6433    set cross {}
6434    set ccross {}
6435    foreach {s e} [rowranges $id] {
6436        if {$e >= $numcommits} {
6437            set e [expr {$numcommits - 1}]
6438        }
6439        if {$e <= $s} continue
6440        for {set row $e} {[incr row -1] >= $s} {} {
6441            set x [lsearch -exact [lindex $rowidlist $row] $id]
6442            if {$x < 0} break
6443            set olds [lindex $parentlist $row]
6444            set kid [lindex $displayorder $row]
6445            set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
6446            if {$kidx < 0} continue
6447            set nextrow [lindex $rowidlist [expr {$row + 1}]]
6448            foreach p $olds {
6449                set px [lsearch -exact $nextrow $p]
6450                if {$px < 0} continue
6451                if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
6452                    if {[lsearch -exact $ccross $p] >= 0} continue
6453                    if {$x == $px + ($kidx < $px? -1: 1)} {
6454                        lappend ccross $p
6455                    } elseif {[lsearch -exact $cross $p] < 0} {
6456                        lappend cross $p
6457                    }
6458                }
6459            }
6460        }
6461    }
6462    return [concat $ccross {{}} $cross]
6463}
6464
6465proc assigncolor {id} {
6466    global colormap colors nextcolor
6467    global parents children children curview
6468
6469    if {[info exists colormap($id)]} return
6470    set ncolors [llength $colors]
6471    if {[info exists children($curview,$id)]} {
6472        set kids $children($curview,$id)
6473    } else {
6474        set kids {}
6475    }
6476    if {[llength $kids] == 1} {
6477        set child [lindex $kids 0]
6478        if {[info exists colormap($child)]
6479            && [llength $parents($curview,$child)] == 1} {
6480            set colormap($id) $colormap($child)
6481            return
6482        }
6483    }
6484    set badcolors {}
6485    set origbad {}
6486    foreach x [findcrossings $id] {
6487        if {$x eq {}} {
6488            # delimiter between corner crossings and other crossings
6489            if {[llength $badcolors] >= $ncolors - 1} break
6490            set origbad $badcolors
6491        }
6492        if {[info exists colormap($x)]
6493            && [lsearch -exact $badcolors $colormap($x)] < 0} {
6494            lappend badcolors $colormap($x)
6495        }
6496    }
6497    if {[llength $badcolors] >= $ncolors} {
6498        set badcolors $origbad
6499    }
6500    set origbad $badcolors
6501    if {[llength $badcolors] < $ncolors - 1} {
6502        foreach child $kids {
6503            if {[info exists colormap($child)]
6504                && [lsearch -exact $badcolors $colormap($child)] < 0} {
6505                lappend badcolors $colormap($child)
6506            }
6507            foreach p $parents($curview,$child) {
6508                if {[info exists colormap($p)]
6509                    && [lsearch -exact $badcolors $colormap($p)] < 0} {
6510                    lappend badcolors $colormap($p)
6511                }
6512            }
6513        }
6514        if {[llength $badcolors] >= $ncolors} {
6515            set badcolors $origbad
6516        }
6517    }
6518    for {set i 0} {$i <= $ncolors} {incr i} {
6519        set c [lindex $colors $nextcolor]
6520        if {[incr nextcolor] >= $ncolors} {
6521            set nextcolor 0
6522        }
6523        if {[lsearch -exact $badcolors $c]} break
6524    }
6525    set colormap($id) $c
6526}
6527
6528proc bindline {t id} {
6529    global canv
6530
6531    $canv bind $t <Enter> "lineenter %x %y $id"
6532    $canv bind $t <Motion> "linemotion %x %y $id"
6533    $canv bind $t <Leave> "lineleave $id"
6534    $canv bind $t <Button-1> "lineclick %x %y $id 1"
6535}
6536
6537proc graph_pane_width {} {
6538    global use_ttk
6539
6540    if {$use_ttk} {
6541        set g [.tf.histframe.pwclist sashpos 0]
6542    } else {
6543        set g [.tf.histframe.pwclist sash coord 0]
6544    }
6545    return [lindex $g 0]
6546}
6547
6548proc totalwidth {l font extra} {
6549    set tot 0
6550    foreach str $l {
6551        set tot [expr {$tot + [font measure $font $str] + $extra}]
6552    }
6553    return $tot
6554}
6555
6556proc drawtags {id x xt y1} {
6557    global idtags idheads idotherrefs mainhead
6558    global linespc lthickness
6559    global canv rowtextx curview fgcolor bgcolor ctxbut
6560    global headbgcolor headfgcolor headoutlinecolor remotebgcolor
6561    global tagbgcolor tagfgcolor tagoutlinecolor
6562    global reflinecolor
6563
6564    set marks {}
6565    set ntags 0
6566    set nheads 0
6567    set singletag 0
6568    set maxtags 3
6569    set maxtagpct 25
6570    set maxwidth [expr {[graph_pane_width] * $maxtagpct / 100}]
6571    set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6572    set extra [expr {$delta + $lthickness + $linespc}]
6573
6574    if {[info exists idtags($id)]} {
6575        set marks $idtags($id)
6576        set ntags [llength $marks]
6577        if {$ntags > $maxtags ||
6578            [totalwidth $marks mainfont $extra] > $maxwidth} {
6579            # show just a single "n tags..." tag
6580            set singletag 1
6581            if {$ntags == 1} {
6582                set marks [list "tag..."]
6583            } else {
6584                set marks [list [format "%d tags..." $ntags]]
6585            }
6586            set ntags 1
6587        }
6588    }
6589    if {[info exists idheads($id)]} {
6590        set marks [concat $marks $idheads($id)]
6591        set nheads [llength $idheads($id)]
6592    }
6593    if {[info exists idotherrefs($id)]} {
6594        set marks [concat $marks $idotherrefs($id)]
6595    }
6596    if {$marks eq {}} {
6597        return $xt
6598    }
6599
6600    set yt [expr {$y1 - 0.5 * $linespc}]
6601    set yb [expr {$yt + $linespc - 1}]
6602    set xvals {}
6603    set wvals {}
6604    set i -1
6605    foreach tag $marks {
6606        incr i
6607        if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
6608            set wid [font measure mainfontbold $tag]
6609        } else {
6610            set wid [font measure mainfont $tag]
6611        }
6612        lappend xvals $xt
6613        lappend wvals $wid
6614        set xt [expr {$xt + $wid + $extra}]
6615    }
6616    set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
6617               -width $lthickness -fill $reflinecolor -tags tag.$id]
6618    $canv lower $t
6619    foreach tag $marks x $xvals wid $wvals {
6620        set tag_quoted [string map {% %%} $tag]
6621        set xl [expr {$x + $delta}]
6622        set xr [expr {$x + $delta + $wid + $lthickness}]
6623        set font mainfont
6624        if {[incr ntags -1] >= 0} {
6625            # draw a tag
6626            set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6627                       $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
6628                       -width 1 -outline $tagoutlinecolor -fill $tagbgcolor \
6629                       -tags tag.$id]
6630            if {$singletag} {
6631                set tagclick [list showtags $id 1]
6632            } else {
6633                set tagclick [list showtag $tag_quoted 1]
6634            }
6635            $canv bind $t <1> $tagclick
6636            set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
6637        } else {
6638            # draw a head or other ref
6639            if {[incr nheads -1] >= 0} {
6640                set col $headbgcolor
6641                if {$tag eq $mainhead} {
6642                    set font mainfontbold
6643                }
6644            } else {
6645                set col "#ddddff"
6646            }
6647            set xl [expr {$xl - $delta/2}]
6648            $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
6649                -width 1 -outline black -fill $col -tags tag.$id
6650            if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
6651                set rwid [font measure mainfont $remoteprefix]
6652                set xi [expr {$x + 1}]
6653                set yti [expr {$yt + 1}]
6654                set xri [expr {$x + $rwid}]
6655                $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6656                        -width 0 -fill $remotebgcolor -tags tag.$id
6657            }
6658        }
6659        set t [$canv create text $xl $y1 -anchor w -text $tag -fill $headfgcolor \
6660                   -font $font -tags [list tag.$id text]]
6661        if {$ntags >= 0} {
6662            $canv bind $t <1> $tagclick
6663        } elseif {$nheads >= 0} {
6664            $canv bind $t $ctxbut [list headmenu %X %Y $id $tag_quoted]
6665        }
6666    }
6667    return $xt
6668}
6669
6670proc drawnotesign {xt y} {
6671    global linespc canv fgcolor
6672
6673    set orad [expr {$linespc / 3}]
6674    set t [$canv create rectangle [expr {$xt - $orad}] [expr {$y - $orad}] \
6675               [expr {$xt + $orad - 1}] [expr {$y + $orad - 1}] \
6676               -fill yellow -outline $fgcolor -width 1 -tags circle]
6677    set xt [expr {$xt + $orad * 3}]
6678    return $xt
6679}
6680
6681proc xcoord {i level ln} {
6682    global canvx0 xspc1 xspc2
6683
6684    set x [expr {$canvx0 + $i * $xspc1($ln)}]
6685    if {$i > 0 && $i == $level} {
6686        set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6687    } elseif {$i > $level} {
6688        set x [expr {$x + $xspc2 - $xspc1($ln)}]
6689    }
6690    return $x
6691}
6692
6693proc show_status {msg} {
6694    global canv fgcolor
6695
6696    clear_display
6697    set_window_title
6698    $canv create text 3 3 -anchor nw -text $msg -font mainfont \
6699        -tags text -fill $fgcolor
6700}
6701
6702# Don't change the text pane cursor if it is currently the hand cursor,
6703# showing that we are over a sha1 ID link.
6704proc settextcursor {c} {
6705    global ctext curtextcursor
6706
6707    if {[$ctext cget -cursor] == $curtextcursor} {
6708        $ctext config -cursor $c
6709    }
6710    set curtextcursor $c
6711}
6712
6713proc nowbusy {what {name {}}} {
6714    global isbusy busyname statusw
6715
6716    if {[array names isbusy] eq {}} {
6717        . config -cursor watch
6718        settextcursor watch
6719    }
6720    set isbusy($what) 1
6721    set busyname($what) $name
6722    if {$name ne {}} {
6723        $statusw conf -text $name
6724    }
6725}
6726
6727proc notbusy {what} {
6728    global isbusy maincursor textcursor busyname statusw
6729
6730    catch {
6731        unset isbusy($what)
6732        if {$busyname($what) ne {} &&
6733            [$statusw cget -text] eq $busyname($what)} {
6734            $statusw conf -text {}
6735        }
6736    }
6737    if {[array names isbusy] eq {}} {
6738        . config -cursor $maincursor
6739        settextcursor $textcursor
6740    }
6741}
6742
6743proc findmatches {f} {
6744    global findtype findstring
6745    if {$findtype == [mc "Regexp"]} {
6746        set matches [regexp -indices -all -inline $findstring $f]
6747    } else {
6748        set fs $findstring
6749        if {$findtype == [mc "IgnCase"]} {
6750            set f [string tolower $f]
6751            set fs [string tolower $fs]
6752        }
6753        set matches {}
6754        set i 0
6755        set l [string length $fs]
6756        while {[set j [string first $fs $f $i]] >= 0} {
6757            lappend matches [list $j [expr {$j+$l-1}]]
6758            set i [expr {$j + $l}]
6759        }
6760    }
6761    return $matches
6762}
6763
6764proc dofind {{dirn 1} {wrap 1}} {
6765    global findstring findstartline findcurline selectedline numcommits
6766    global gdttype filehighlight fh_serial find_dirn findallowwrap
6767
6768    if {[info exists find_dirn]} {
6769        if {$find_dirn == $dirn} return
6770        stopfinding
6771    }
6772    focus .
6773    if {$findstring eq {} || $numcommits == 0} return
6774    if {$selectedline eq {}} {
6775        set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6776    } else {
6777        set findstartline $selectedline
6778    }
6779    set findcurline $findstartline
6780    nowbusy finding [mc "Searching"]
6781    if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6782        after cancel do_file_hl $fh_serial
6783        do_file_hl $fh_serial
6784    }
6785    set find_dirn $dirn
6786    set findallowwrap $wrap
6787    run findmore
6788}
6789
6790proc stopfinding {} {
6791    global find_dirn findcurline fprogcoord
6792
6793    if {[info exists find_dirn]} {
6794        unset find_dirn
6795        unset findcurline
6796        notbusy finding
6797        set fprogcoord 0
6798        adjustprogress
6799    }
6800    stopblaming
6801}
6802
6803proc findmore {} {
6804    global commitdata commitinfo numcommits findpattern findloc
6805    global findstartline findcurline findallowwrap
6806    global find_dirn gdttype fhighlights fprogcoord
6807    global curview varcorder vrownum varccommits vrowmod
6808
6809    if {![info exists find_dirn]} {
6810        return 0
6811    }
6812    set fldtypes [list [mc "Headline"] [mc "Author"] "" [mc "Committer"] "" [mc "Comments"]]
6813    set l $findcurline
6814    set moretodo 0
6815    if {$find_dirn > 0} {
6816        incr l
6817        if {$l >= $numcommits} {
6818            set l 0
6819        }
6820        if {$l <= $findstartline} {
6821            set lim [expr {$findstartline + 1}]
6822        } else {
6823            set lim $numcommits
6824            set moretodo $findallowwrap
6825        }
6826    } else {
6827        if {$l == 0} {
6828            set l $numcommits
6829        }
6830        incr l -1
6831        if {$l >= $findstartline} {
6832            set lim [expr {$findstartline - 1}]
6833        } else {
6834            set lim -1
6835            set moretodo $findallowwrap
6836        }
6837    }
6838    set n [expr {($lim - $l) * $find_dirn}]
6839    if {$n > 500} {
6840        set n 500
6841        set moretodo 1
6842    }
6843    if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6844        update_arcrows $curview
6845    }
6846    set found 0
6847    set domore 1
6848    set ai [bsearch $vrownum($curview) $l]
6849    set a [lindex $varcorder($curview) $ai]
6850    set arow [lindex $vrownum($curview) $ai]
6851    set ids [lindex $varccommits($curview,$a)]
6852    set arowend [expr {$arow + [llength $ids]}]
6853    if {$gdttype eq [mc "containing:"]} {
6854        for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6855            if {$l < $arow || $l >= $arowend} {
6856                incr ai $find_dirn
6857                set a [lindex $varcorder($curview) $ai]
6858                set arow [lindex $vrownum($curview) $ai]
6859                set ids [lindex $varccommits($curview,$a)]
6860                set arowend [expr {$arow + [llength $ids]}]
6861            }
6862            set id [lindex $ids [expr {$l - $arow}]]
6863            # shouldn't happen unless git log doesn't give all the commits...
6864            if {![info exists commitdata($id)] ||
6865                ![doesmatch $commitdata($id)]} {
6866                continue
6867            }
6868            if {![info exists commitinfo($id)]} {
6869                getcommit $id
6870            }
6871            set info $commitinfo($id)
6872            foreach f $info ty $fldtypes {
6873                if {$ty eq ""} continue
6874                if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6875                    [doesmatch $f]} {
6876                    set found 1
6877                    break
6878                }
6879            }
6880            if {$found} break
6881        }
6882    } else {
6883        for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6884            if {$l < $arow || $l >= $arowend} {
6885                incr ai $find_dirn
6886                set a [lindex $varcorder($curview) $ai]
6887                set arow [lindex $vrownum($curview) $ai]
6888                set ids [lindex $varccommits($curview,$a)]
6889                set arowend [expr {$arow + [llength $ids]}]
6890            }
6891            set id [lindex $ids [expr {$l - $arow}]]
6892            if {![info exists fhighlights($id)]} {
6893                # this sets fhighlights($id) to -1
6894                askfilehighlight $l $id
6895            }
6896            if {$fhighlights($id) > 0} {
6897                set found $domore
6898                break
6899            }
6900            if {$fhighlights($id) < 0} {
6901                if {$domore} {
6902                    set domore 0
6903                    set findcurline [expr {$l - $find_dirn}]
6904                }
6905            }
6906        }
6907    }
6908    if {$found || ($domore && !$moretodo)} {
6909        unset findcurline
6910        unset find_dirn
6911        notbusy finding
6912        set fprogcoord 0
6913        adjustprogress
6914        if {$found} {
6915            findselectline $l
6916        } else {
6917            bell
6918        }
6919        return 0
6920    }
6921    if {!$domore} {
6922        flushhighlights
6923    } else {
6924        set findcurline [expr {$l - $find_dirn}]
6925    }
6926    set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6927    if {$n < 0} {
6928        incr n $numcommits
6929    }
6930    set fprogcoord [expr {$n * 1.0 / $numcommits}]
6931    adjustprogress
6932    return $domore
6933}
6934
6935proc findselectline {l} {
6936    global findloc commentend ctext findcurline markingmatches gdttype
6937
6938    set markingmatches [expr {$gdttype eq [mc "containing:"]}]
6939    set findcurline $l
6940    selectline $l 1
6941    if {$markingmatches &&
6942        ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
6943        # highlight the matches in the comments
6944        set f [$ctext get 1.0 $commentend]
6945        set matches [findmatches $f]
6946        foreach match $matches {
6947            set start [lindex $match 0]
6948            set end [expr {[lindex $match 1] + 1}]
6949            $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6950        }
6951    }
6952    drawvisible
6953}
6954
6955# mark the bits of a headline or author that match a find string
6956proc markmatches {canv l str tag matches font row} {
6957    global selectedline
6958
6959    set bbox [$canv bbox $tag]
6960    set x0 [lindex $bbox 0]
6961    set y0 [lindex $bbox 1]
6962    set y1 [lindex $bbox 3]
6963    foreach match $matches {
6964        set start [lindex $match 0]
6965        set end [lindex $match 1]
6966        if {$start > $end} continue
6967        set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6968        set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6969        set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6970                   [expr {$x0+$xlen+2}] $y1 \
6971                   -outline {} -tags [list match$l matches] -fill yellow]
6972        $canv lower $t
6973        if {$row == $selectedline} {
6974            $canv raise $t secsel
6975        }
6976    }
6977}
6978
6979proc unmarkmatches {} {
6980    global markingmatches
6981
6982    allcanvs delete matches
6983    set markingmatches 0
6984    stopfinding
6985}
6986
6987proc selcanvline {w x y} {
6988    global canv canvy0 ctext linespc
6989    global rowtextx
6990    set ymax [lindex [$canv cget -scrollregion] 3]
6991    if {$ymax == {}} return
6992    set yfrac [lindex [$canv yview] 0]
6993    set y [expr {$y + $yfrac * $ymax}]
6994    set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6995    if {$l < 0} {
6996        set l 0
6997    }
6998    if {$w eq $canv} {
6999        set xmax [lindex [$canv cget -scrollregion] 2]
7000        set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
7001        if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
7002    }
7003    unmarkmatches
7004    selectline $l 1
7005}
7006
7007proc commit_descriptor {p} {
7008    global commitinfo
7009    if {![info exists commitinfo($p)]} {
7010        getcommit $p
7011    }
7012    set l "..."
7013    if {[llength $commitinfo($p)] > 1} {
7014        set l [lindex $commitinfo($p) 0]
7015    }
7016    return "$p ($l)\n"
7017}
7018
7019# append some text to the ctext widget, and make any SHA1 ID
7020# that we know about be a clickable link.
7021# Also look for URLs of the form "http[s]://..." and make them web links.
7022proc appendwithlinks {text tags} {
7023    global ctext linknum curview
7024
7025    set start [$ctext index "end - 1c"]
7026    $ctext insert end $text $tags
7027    set links [regexp -indices -all -inline {(?:\m|-g)[0-9a-f]{6,40}\M} $text]
7028    foreach l $links {
7029        set s [lindex $l 0]
7030        set e [lindex $l 1]
7031        set linkid [string range $text $s $e]
7032        incr e
7033        $ctext tag delete link$linknum
7034        $ctext tag add link$linknum "$start + $s c" "$start + $e c"
7035        setlink $linkid link$linknum
7036        incr linknum
7037    }
7038    set wlinks [regexp -indices -all -inline -line \
7039                    {https?://[^[:space:]]+} $text]
7040    foreach l $wlinks {
7041        set s2 [lindex $l 0]
7042        set e2 [lindex $l 1]
7043        set url [string range $text $s2 $e2]
7044        incr e2
7045        $ctext tag delete link$linknum
7046        $ctext tag add link$linknum "$start + $s2 c" "$start + $e2 c"
7047        setwlink $url link$linknum
7048        incr linknum
7049    }
7050}
7051
7052proc setlink {id lk} {
7053    global curview ctext pendinglinks
7054    global linkfgcolor
7055
7056    if {[string range $id 0 1] eq "-g"} {
7057      set id [string range $id 2 end]
7058    }
7059
7060    set known 0
7061    if {[string length $id] < 40} {
7062        set matches [longid $id]
7063        if {[llength $matches] > 0} {
7064            if {[llength $matches] > 1} return
7065            set known 1
7066            set id [lindex $matches 0]
7067        }
7068    } else {
7069        set known [commitinview $id $curview]
7070    }
7071    if {$known} {
7072        $ctext tag conf $lk -foreground $linkfgcolor -underline 1
7073        $ctext tag bind $lk <1> [list selbyid $id]
7074        $ctext tag bind $lk <Enter> {linkcursor %W 1}
7075        $ctext tag bind $lk <Leave> {linkcursor %W -1}
7076    } else {
7077        lappend pendinglinks($id) $lk
7078        interestedin $id {makelink %P}
7079    }
7080}
7081
7082proc setwlink {url lk} {
7083    global ctext
7084    global linkfgcolor
7085    global web_browser
7086
7087    if {$web_browser eq {}} return
7088    $ctext tag conf $lk -foreground $linkfgcolor -underline 1
7089    $ctext tag bind $lk <1> [list browseweb $url]
7090    $ctext tag bind $lk <Enter> {linkcursor %W 1}
7091    $ctext tag bind $lk <Leave> {linkcursor %W -1}
7092}
7093
7094proc appendshortlink {id {pre {}} {post {}}} {
7095    global ctext linknum
7096
7097    $ctext insert end $pre
7098    $ctext tag delete link$linknum
7099    $ctext insert end [string range $id 0 7] link$linknum
7100    $ctext insert end $post
7101    setlink $id link$linknum
7102    incr linknum
7103}
7104
7105proc makelink {id} {
7106    global pendinglinks
7107
7108    if {![info exists pendinglinks($id)]} return
7109    foreach lk $pendinglinks($id) {
7110        setlink $id $lk
7111    }
7112    unset pendinglinks($id)
7113}
7114
7115proc linkcursor {w inc} {
7116    global linkentercount curtextcursor
7117
7118    if {[incr linkentercount $inc] > 0} {
7119        $w configure -cursor hand2
7120    } else {
7121        $w configure -cursor $curtextcursor
7122        if {$linkentercount < 0} {
7123            set linkentercount 0
7124        }
7125    }
7126}
7127
7128proc browseweb {url} {
7129    global web_browser
7130
7131    if {$web_browser eq {}} return
7132    # Use eval here in case $web_browser is a command plus some arguments
7133    if {[catch {eval exec $web_browser [list $url] &} err]} {
7134        error_popup "[mc "Error starting web browser:"] $err"
7135    }
7136}
7137
7138proc viewnextline {dir} {
7139    global canv linespc
7140
7141    $canv delete hover
7142    set ymax [lindex [$canv cget -scrollregion] 3]
7143    set wnow [$canv yview]
7144    set wtop [expr {[lindex $wnow 0] * $ymax}]
7145    set newtop [expr {$wtop + $dir * $linespc}]
7146    if {$newtop < 0} {
7147        set newtop 0
7148    } elseif {$newtop > $ymax} {
7149        set newtop $ymax
7150    }
7151    allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7152}
7153
7154# add a list of tag or branch names at position pos
7155# returns the number of names inserted
7156proc appendrefs {pos ids var} {
7157    global ctext linknum curview $var maxrefs visiblerefs mainheadid
7158
7159    if {[catch {$ctext index $pos}]} {
7160        return 0
7161    }
7162    $ctext conf -state normal
7163    $ctext delete $pos "$pos lineend"
7164    set tags {}
7165    foreach id $ids {
7166        foreach tag [set $var\($id\)] {
7167            lappend tags [list $tag $id]
7168        }
7169    }
7170
7171    set sep {}
7172    set tags [lsort -index 0 -decreasing $tags]
7173    set nutags 0
7174
7175    if {[llength $tags] > $maxrefs} {
7176        # If we are displaying heads, and there are too many,
7177        # see if there are some important heads to display.
7178        # Currently that are the current head and heads listed in $visiblerefs option
7179        set itags {}
7180        if {$var eq "idheads"} {
7181            set utags {}
7182            foreach ti $tags {
7183                set hname [lindex $ti 0]
7184                set id [lindex $ti 1]
7185                if {([lsearch -exact $visiblerefs $hname] != -1 || $id eq $mainheadid) &&
7186                    [llength $itags] < $maxrefs} {
7187                    lappend itags $ti
7188                } else {
7189                    lappend utags $ti
7190                }
7191            }
7192            set tags $utags
7193        }
7194        if {$itags ne {}} {
7195            set str [mc "and many more"]
7196            set sep " "
7197        } else {
7198            set str [mc "many"]
7199        }
7200        $ctext insert $pos "$str ([llength $tags])"
7201        set nutags [llength $tags]
7202        set tags $itags
7203    }
7204
7205    foreach ti $tags {
7206        set id [lindex $ti 1]
7207        set lk link$linknum
7208        incr linknum
7209        $ctext tag delete $lk
7210        $ctext insert $pos $sep
7211        $ctext insert $pos [lindex $ti 0] $lk
7212        setlink $id $lk
7213        set sep ", "
7214    }
7215    $ctext tag add wwrap "$pos linestart" "$pos lineend"
7216    $ctext conf -state disabled
7217    return [expr {[llength $tags] + $nutags}]
7218}
7219
7220# called when we have finished computing the nearby tags
7221proc dispneartags {delay} {
7222    global selectedline currentid showneartags tagphase
7223
7224    if {$selectedline eq {} || !$showneartags} return
7225    after cancel dispnexttag
7226    if {$delay} {
7227        after 200 dispnexttag
7228        set tagphase -1
7229    } else {
7230        after idle dispnexttag
7231        set tagphase 0
7232    }
7233}
7234
7235proc dispnexttag {} {
7236    global selectedline currentid showneartags tagphase ctext
7237
7238    if {$selectedline eq {} || !$showneartags} return
7239    switch -- $tagphase {
7240        0 {
7241            set dtags [desctags $currentid]
7242            if {$dtags ne {}} {
7243                appendrefs precedes $dtags idtags
7244            }
7245        }
7246        1 {
7247            set atags [anctags $currentid]
7248            if {$atags ne {}} {
7249                appendrefs follows $atags idtags
7250            }
7251        }
7252        2 {
7253            set dheads [descheads $currentid]
7254            if {$dheads ne {}} {
7255                if {[appendrefs branch $dheads idheads] > 1
7256                    && [$ctext get "branch -3c"] eq "h"} {
7257                    # turn "Branch" into "Branches"
7258                    $ctext conf -state normal
7259                    $ctext insert "branch -2c" "es"
7260                    $ctext conf -state disabled
7261                }
7262            }
7263        }
7264    }
7265    if {[incr tagphase] <= 2} {
7266        after idle dispnexttag
7267    }
7268}
7269
7270proc make_secsel {id} {
7271    global linehtag linentag linedtag canv canv2 canv3
7272
7273    if {![info exists linehtag($id)]} return
7274    $canv delete secsel
7275    set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
7276               -tags secsel -fill [$canv cget -selectbackground]]
7277    $canv lower $t
7278    $canv2 delete secsel
7279    set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
7280               -tags secsel -fill [$canv2 cget -selectbackground]]
7281    $canv2 lower $t
7282    $canv3 delete secsel
7283    set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
7284               -tags secsel -fill [$canv3 cget -selectbackground]]
7285    $canv3 lower $t
7286}
7287
7288proc make_idmark {id} {
7289    global linehtag canv fgcolor
7290
7291    if {![info exists linehtag($id)]} return
7292    $canv delete markid
7293    set t [eval $canv create rect [$canv bbox $linehtag($id)] \
7294               -tags markid -outline $fgcolor]
7295    $canv raise $t
7296}
7297
7298proc selectline {l isnew {desired_loc {}} {switch_to_patch 0}} {
7299    global canv ctext commitinfo selectedline
7300    global canvy0 linespc parents children curview
7301    global currentid sha1entry
7302    global commentend idtags linknum
7303    global mergemax numcommits pending_select
7304    global cmitmode showneartags allcommits
7305    global targetrow targetid lastscrollrows
7306    global autoselect autosellen jump_to_here
7307    global vinlinediff
7308
7309    unset -nocomplain pending_select
7310    $canv delete hover
7311    normalline
7312    unsel_reflist
7313    stopfinding
7314    if {$l < 0 || $l >= $numcommits} return
7315    set id [commitonrow $l]
7316    set targetid $id
7317    set targetrow $l
7318    set selectedline $l
7319    set currentid $id
7320    if {$lastscrollrows < $numcommits} {
7321        setcanvscroll
7322    }
7323
7324    if {$cmitmode ne "patch" && $switch_to_patch} {
7325        set cmitmode "patch"
7326    }
7327
7328    set y [expr {$canvy0 + $l * $linespc}]
7329    set ymax [lindex [$canv cget -scrollregion] 3]
7330    set ytop [expr {$y - $linespc - 1}]
7331    set ybot [expr {$y + $linespc + 1}]
7332    set wnow [$canv yview]
7333    set wtop [expr {[lindex $wnow 0] * $ymax}]
7334    set wbot [expr {[lindex $wnow 1] * $ymax}]
7335    set wh [expr {$wbot - $wtop}]
7336    set newtop $wtop
7337    if {$ytop < $wtop} {
7338        if {$ybot < $wtop} {
7339            set newtop [expr {$y - $wh / 2.0}]
7340        } else {
7341            set newtop $ytop
7342            if {$newtop > $wtop - $linespc} {
7343                set newtop [expr {$wtop - $linespc}]
7344            }
7345        }
7346    } elseif {$ybot > $wbot} {
7347        if {$ytop > $wbot} {
7348            set newtop [expr {$y - $wh / 2.0}]
7349        } else {
7350            set newtop [expr {$ybot - $wh}]
7351            if {$newtop < $wtop + $linespc} {
7352                set newtop [expr {$wtop + $linespc}]
7353            }
7354        }
7355    }
7356    if {$newtop != $wtop} {
7357        if {$newtop < 0} {
7358            set newtop 0
7359        }
7360        allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7361        drawvisible
7362    }
7363
7364    make_secsel $id
7365
7366    if {$isnew} {
7367        addtohistory [list selbyid $id 0] savecmitpos
7368    }
7369
7370    $sha1entry delete 0 end
7371    $sha1entry insert 0 $id
7372    if {$autoselect} {
7373        $sha1entry selection range 0 $autosellen
7374    }
7375    rhighlight_sel $id
7376
7377    $ctext conf -state normal
7378    clear_ctext
7379    set linknum 0
7380    if {![info exists commitinfo($id)]} {
7381        getcommit $id
7382    }
7383    set info $commitinfo($id)
7384    set date [formatdate [lindex $info 2]]
7385    $ctext insert end "[mc "Author"]: [lindex $info 1]  $date\n"
7386    set date [formatdate [lindex $info 4]]
7387    $ctext insert end "[mc "Committer"]: [lindex $info 3]  $date\n"
7388    if {[info exists idtags($id)]} {
7389        $ctext insert end [mc "Tags:"]
7390        foreach tag $idtags($id) {
7391            $ctext insert end " $tag"
7392        }
7393        $ctext insert end "\n"
7394    }
7395
7396    set headers {}
7397    set olds $parents($curview,$id)
7398    if {[llength $olds] > 1} {
7399        set np 0
7400        foreach p $olds {
7401            if {$np >= $mergemax} {
7402                set tag mmax
7403            } else {
7404                set tag m$np
7405            }
7406            $ctext insert end "[mc "Parent"]: " $tag
7407            appendwithlinks [commit_descriptor $p] {}
7408            incr np
7409        }
7410    } else {
7411        foreach p $olds {
7412            append headers "[mc "Parent"]: [commit_descriptor $p]"
7413        }
7414    }
7415
7416    foreach c $children($curview,$id) {
7417        append headers "[mc "Child"]:  [commit_descriptor $c]"
7418    }
7419
7420    # make anything that looks like a SHA1 ID be a clickable link
7421    appendwithlinks $headers {}
7422    if {$showneartags} {
7423        if {![info exists allcommits]} {
7424            getallcommits
7425        }
7426        $ctext insert end "[mc "Branch"]: "
7427        $ctext mark set branch "end -1c"
7428        $ctext mark gravity branch left
7429        $ctext insert end "\n[mc "Follows"]: "
7430        $ctext mark set follows "end -1c"
7431        $ctext mark gravity follows left
7432        $ctext insert end "\n[mc "Precedes"]: "
7433        $ctext mark set precedes "end -1c"
7434        $ctext mark gravity precedes left
7435        $ctext insert end "\n"
7436        dispneartags 1
7437    }
7438    $ctext insert end "\n"
7439    set comment [lindex $info 5]
7440    if {[string first "\r" $comment] >= 0} {
7441        set comment [string map {"\r" "\n    "} $comment]
7442    }
7443    appendwithlinks $comment {comment}
7444
7445    $ctext tag remove found 1.0 end
7446    $ctext conf -state disabled
7447    set commentend [$ctext index "end - 1c"]
7448
7449    set jump_to_here $desired_loc
7450    init_flist [mc "Comments"]
7451    if {$cmitmode eq "tree"} {
7452        gettree $id
7453    } elseif {$vinlinediff($curview) == 1} {
7454        showinlinediff $id
7455    } elseif {[llength $olds] <= 1} {
7456        startdiff $id
7457    } else {
7458        mergediff $id
7459    }
7460}
7461
7462proc selfirstline {} {
7463    unmarkmatches
7464    selectline 0 1
7465}
7466
7467proc sellastline {} {
7468    global numcommits
7469    unmarkmatches
7470    set l [expr {$numcommits - 1}]
7471    selectline $l 1
7472}
7473
7474proc selnextline {dir} {
7475    global selectedline
7476    focus .
7477    if {$selectedline eq {}} return
7478    set l [expr {$selectedline + $dir}]
7479    unmarkmatches
7480    selectline $l 1
7481}
7482
7483proc selnextpage {dir} {
7484    global canv linespc selectedline numcommits
7485
7486    set lpp [expr {([winfo height $canv] - 2) / $linespc}]
7487    if {$lpp < 1} {
7488        set lpp 1
7489    }
7490    allcanvs yview scroll [expr {$dir * $lpp}] units
7491    drawvisible
7492    if {$selectedline eq {}} return
7493    set l [expr {$selectedline + $dir * $lpp}]
7494    if {$l < 0} {
7495        set l 0
7496    } elseif {$l >= $numcommits} {
7497        set l [expr $numcommits - 1]
7498    }
7499    unmarkmatches
7500    selectline $l 1
7501}
7502
7503proc unselectline {} {
7504    global selectedline currentid
7505
7506    set selectedline {}
7507    unset -nocomplain currentid
7508    allcanvs delete secsel
7509    rhighlight_none
7510}
7511
7512proc reselectline {} {
7513    global selectedline
7514
7515    if {$selectedline ne {}} {
7516        selectline $selectedline 0
7517    }
7518}
7519
7520proc addtohistory {cmd {saveproc {}}} {
7521    global history historyindex curview
7522
7523    unset_posvars
7524    save_position
7525    set elt [list $curview $cmd $saveproc {}]
7526    if {$historyindex > 0
7527        && [lindex $history [expr {$historyindex - 1}]] == $elt} {
7528        return
7529    }
7530
7531    if {$historyindex < [llength $history]} {
7532        set history [lreplace $history $historyindex end $elt]
7533    } else {
7534        lappend history $elt
7535    }
7536    incr historyindex
7537    if {$historyindex > 1} {
7538        .tf.bar.leftbut conf -state normal
7539    } else {
7540        .tf.bar.leftbut conf -state disabled
7541    }
7542    .tf.bar.rightbut conf -state disabled
7543}
7544
7545# save the scrolling position of the diff display pane
7546proc save_position {} {
7547    global historyindex history
7548
7549    if {$historyindex < 1} return
7550    set hi [expr {$historyindex - 1}]
7551    set fn [lindex $history $hi 2]
7552    if {$fn ne {}} {
7553        lset history $hi 3 [eval $fn]
7554    }
7555}
7556
7557proc unset_posvars {} {
7558    global last_posvars
7559
7560    if {[info exists last_posvars]} {
7561        foreach {var val} $last_posvars {
7562            global $var
7563            unset -nocomplain $var
7564        }
7565        unset last_posvars
7566    }
7567}
7568
7569proc godo {elt} {
7570    global curview last_posvars
7571
7572    set view [lindex $elt 0]
7573    set cmd [lindex $elt 1]
7574    set pv [lindex $elt 3]
7575    if {$curview != $view} {
7576        showview $view
7577    }
7578    unset_posvars
7579    foreach {var val} $pv {
7580        global $var
7581        set $var $val
7582    }
7583    set last_posvars $pv
7584    eval $cmd
7585}
7586
7587proc goback {} {
7588    global history historyindex
7589    focus .
7590
7591    if {$historyindex > 1} {
7592        save_position
7593        incr historyindex -1
7594        godo [lindex $history [expr {$historyindex - 1}]]
7595        .tf.bar.rightbut conf -state normal
7596    }
7597    if {$historyindex <= 1} {
7598        .tf.bar.leftbut conf -state disabled
7599    }
7600}
7601
7602proc goforw {} {
7603    global history historyindex
7604    focus .
7605
7606    if {$historyindex < [llength $history]} {
7607        save_position
7608        set cmd [lindex $history $historyindex]
7609        incr historyindex
7610        godo $cmd
7611        .tf.bar.leftbut conf -state normal
7612    }
7613    if {$historyindex >= [llength $history]} {
7614        .tf.bar.rightbut conf -state disabled
7615    }
7616}
7617
7618proc go_to_parent {i} {
7619    global parents curview targetid
7620    set ps $parents($curview,$targetid)
7621    if {[llength $ps] >= $i} {
7622        selbyid [lindex $ps [expr $i - 1]]
7623    }
7624}
7625
7626proc gettree {id} {
7627    global treefilelist treeidlist diffids diffmergeid treepending
7628    global nullid nullid2
7629
7630    set diffids $id
7631    unset -nocomplain diffmergeid
7632    if {![info exists treefilelist($id)]} {
7633        if {![info exists treepending]} {
7634            if {$id eq $nullid} {
7635                set cmd [list | git ls-files]
7636            } elseif {$id eq $nullid2} {
7637                set cmd [list | git ls-files --stage -t]
7638            } else {
7639                set cmd [list | git ls-tree -r $id]
7640            }
7641            if {[catch {set gtf [open $cmd r]}]} {
7642                return
7643            }
7644            set treepending $id
7645            set treefilelist($id) {}
7646            set treeidlist($id) {}
7647            fconfigure $gtf -blocking 0 -encoding binary
7648            filerun $gtf [list gettreeline $gtf $id]
7649        }
7650    } else {
7651        setfilelist $id
7652    }
7653}
7654
7655proc gettreeline {gtf id} {
7656    global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
7657
7658    set nl 0
7659    while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
7660        if {$diffids eq $nullid} {
7661            set fname $line
7662        } else {
7663            set i [string first "\t" $line]
7664            if {$i < 0} continue
7665            set fname [string range $line [expr {$i+1}] end]
7666            set line [string range $line 0 [expr {$i-1}]]
7667            if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7668            set sha1 [lindex $line 2]
7669            lappend treeidlist($id) $sha1
7670        }
7671        if {[string index $fname 0] eq "\""} {
7672            set fname [lindex $fname 0]
7673        }
7674        set fname [encoding convertfrom $fname]
7675        lappend treefilelist($id) $fname
7676    }
7677    if {![eof $gtf]} {
7678        return [expr {$nl >= 1000? 2: 1}]
7679    }
7680    close $gtf
7681    unset treepending
7682    if {$cmitmode ne "tree"} {
7683        if {![info exists diffmergeid]} {
7684            gettreediffs $diffids
7685        }
7686    } elseif {$id ne $diffids} {
7687        gettree $diffids
7688    } else {
7689        setfilelist $id
7690    }
7691    return 0
7692}
7693
7694proc showfile {f} {
7695    global treefilelist treeidlist diffids nullid nullid2
7696    global ctext_file_names ctext_file_lines
7697    global ctext commentend
7698
7699    set i [lsearch -exact $treefilelist($diffids) $f]
7700    if {$i < 0} {
7701        puts "oops, $f not in list for id $diffids"
7702        return
7703    }
7704    if {$diffids eq $nullid} {
7705        if {[catch {set bf [open $f r]} err]} {
7706            puts "oops, can't read $f: $err"
7707            return
7708        }
7709    } else {
7710        set blob [lindex $treeidlist($diffids) $i]
7711        if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7712            puts "oops, error reading blob $blob: $err"
7713            return
7714        }
7715    }
7716    fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7717    filerun $bf [list getblobline $bf $diffids]
7718    $ctext config -state normal
7719    clear_ctext $commentend
7720    lappend ctext_file_names $f
7721    lappend ctext_file_lines [lindex [split $commentend "."] 0]
7722    $ctext insert end "\n"
7723    $ctext insert end "$f\n" filesep
7724    $ctext config -state disabled
7725    $ctext yview $commentend
7726    settabs 0
7727}
7728
7729proc getblobline {bf id} {
7730    global diffids cmitmode ctext
7731
7732    if {$id ne $diffids || $cmitmode ne "tree"} {
7733        catch {close $bf}
7734        return 0
7735    }
7736    $ctext config -state normal
7737    set nl 0
7738    while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7739        $ctext insert end "$line\n"
7740    }
7741    if {[eof $bf]} {
7742        global jump_to_here ctext_file_names commentend
7743
7744        # delete last newline
7745        $ctext delete "end - 2c" "end - 1c"
7746        close $bf
7747        if {$jump_to_here ne {} &&
7748            [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7749            set lnum [expr {[lindex $jump_to_here 1] +
7750                            [lindex [split $commentend .] 0]}]
7751            mark_ctext_line $lnum
7752        }
7753        $ctext config -state disabled
7754        return 0
7755    }
7756    $ctext config -state disabled
7757    return [expr {$nl >= 1000? 2: 1}]
7758}
7759
7760proc mark_ctext_line {lnum} {
7761    global ctext markbgcolor
7762
7763    $ctext tag delete omark
7764    $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7765    $ctext tag conf omark -background $markbgcolor
7766    $ctext see $lnum.0
7767}
7768
7769proc mergediff {id} {
7770    global diffmergeid
7771    global diffids treediffs
7772    global parents curview
7773
7774    set diffmergeid $id
7775    set diffids $id
7776    set treediffs($id) {}
7777    set np [llength $parents($curview,$id)]
7778    settabs $np
7779    getblobdiffs $id
7780}
7781
7782proc startdiff {ids} {
7783    global treediffs diffids treepending diffmergeid nullid nullid2
7784
7785    settabs 1
7786    set diffids $ids
7787    unset -nocomplain diffmergeid
7788    if {![info exists treediffs($ids)] ||
7789        [lsearch -exact $ids $nullid] >= 0 ||
7790        [lsearch -exact $ids $nullid2] >= 0} {
7791        if {![info exists treepending]} {
7792            gettreediffs $ids
7793        }
7794    } else {
7795        addtocflist $ids
7796    }
7797}
7798
7799proc showinlinediff {ids} {
7800    global commitinfo commitdata ctext
7801    global treediffs
7802
7803    set info $commitinfo($ids)
7804    set diff [lindex $info 7]
7805    set difflines [split $diff "\n"]
7806
7807    initblobdiffvars
7808    set treediff {}
7809
7810    set inhdr 0
7811    foreach line $difflines {
7812        if {![string compare -length 5 "diff " $line]} {
7813            set inhdr 1
7814        } elseif {$inhdr && ![string compare -length 4 "+++ " $line]} {
7815            # offset also accounts for the b/ prefix
7816            lappend treediff [string range $line 6 end]
7817            set inhdr 0
7818        }
7819    }
7820
7821    set treediffs($ids) $treediff
7822    add_flist $treediff
7823
7824    $ctext conf -state normal
7825    foreach line $difflines {
7826        parseblobdiffline $ids $line
7827    }
7828    maybe_scroll_ctext 1
7829    $ctext conf -state disabled
7830}
7831
7832# If the filename (name) is under any of the passed filter paths
7833# then return true to include the file in the listing.
7834proc path_filter {filter name} {
7835    set worktree [gitworktree]
7836    foreach p $filter {
7837        set fq_p [file normalize $p]
7838        set fq_n [file normalize [file join $worktree $name]]
7839        if {[string match [file normalize $fq_p]* $fq_n]} {
7840            return 1
7841        }
7842    }
7843    return 0
7844}
7845
7846proc addtocflist {ids} {
7847    global treediffs
7848
7849    add_flist $treediffs($ids)
7850    getblobdiffs $ids
7851}
7852
7853proc diffcmd {ids flags} {
7854    global log_showroot nullid nullid2 git_version
7855
7856    set i [lsearch -exact $ids $nullid]
7857    set j [lsearch -exact $ids $nullid2]
7858    if {$i >= 0} {
7859        if {[llength $ids] > 1 && $j < 0} {
7860            # comparing working directory with some specific revision
7861            set cmd [concat | git diff-index $flags]
7862            if {$i == 0} {
7863                lappend cmd -R [lindex $ids 1]
7864            } else {
7865                lappend cmd [lindex $ids 0]
7866            }
7867        } else {
7868            # comparing working directory with index
7869            set cmd [concat | git diff-files $flags]
7870            if {$j == 1} {
7871                lappend cmd -R
7872            }
7873        }
7874    } elseif {$j >= 0} {
7875        if {[package vcompare $git_version "1.7.2"] >= 0} {
7876            set flags "$flags --ignore-submodules=dirty"
7877        }
7878        set cmd [concat | git diff-index --cached $flags]
7879        if {[llength $ids] > 1} {
7880            # comparing index with specific revision
7881            if {$j == 0} {
7882                lappend cmd -R [lindex $ids 1]
7883            } else {
7884                lappend cmd [lindex $ids 0]
7885            }
7886        } else {
7887            # comparing index with HEAD
7888            lappend cmd HEAD
7889        }
7890    } else {
7891        if {$log_showroot} {
7892            lappend flags --root
7893        }
7894        set cmd [concat | git diff-tree -r $flags $ids]
7895    }
7896    return $cmd
7897}
7898
7899proc gettreediffs {ids} {
7900    global treediff treepending limitdiffs vfilelimit curview
7901
7902    set cmd [diffcmd $ids {--no-commit-id}]
7903    if {$limitdiffs && $vfilelimit($curview) ne {}} {
7904            set cmd [concat $cmd -- $vfilelimit($curview)]
7905    }
7906    if {[catch {set gdtf [open $cmd r]}]} return
7907
7908    set treepending $ids
7909    set treediff {}
7910    fconfigure $gdtf -blocking 0 -encoding binary
7911    filerun $gdtf [list gettreediffline $gdtf $ids]
7912}
7913
7914proc gettreediffline {gdtf ids} {
7915    global treediff treediffs treepending diffids diffmergeid
7916    global cmitmode vfilelimit curview limitdiffs perfile_attrs
7917
7918    set nr 0
7919    set sublist {}
7920    set max 1000
7921    if {$perfile_attrs} {
7922        # cache_gitattr is slow, and even slower on win32 where we
7923        # have to invoke it for only about 30 paths at a time
7924        set max 500
7925        if {[tk windowingsystem] == "win32"} {
7926            set max 120
7927        }
7928    }
7929    while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7930        set i [string first "\t" $line]
7931        if {$i >= 0} {
7932            set file [string range $line [expr {$i+1}] end]
7933            if {[string index $file 0] eq "\""} {
7934                set file [lindex $file 0]
7935            }
7936            set file [encoding convertfrom $file]
7937            if {$file ne [lindex $treediff end]} {
7938                lappend treediff $file
7939                lappend sublist $file
7940            }
7941        }
7942    }
7943    if {$perfile_attrs} {
7944        cache_gitattr encoding $sublist
7945    }
7946    if {![eof $gdtf]} {
7947        return [expr {$nr >= $max? 2: 1}]
7948    }
7949    close $gdtf
7950    set treediffs($ids) $treediff
7951    unset treepending
7952    if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7953        gettree $diffids
7954    } elseif {$ids != $diffids} {
7955        if {![info exists diffmergeid]} {
7956            gettreediffs $diffids
7957        }
7958    } else {
7959        addtocflist $ids
7960    }
7961    return 0
7962}
7963
7964# empty string or positive integer
7965proc diffcontextvalidate {v} {
7966    return [regexp {^(|[1-9][0-9]*)$} $v]
7967}
7968
7969proc diffcontextchange {n1 n2 op} {
7970    global diffcontextstring diffcontext
7971
7972    if {[string is integer -strict $diffcontextstring]} {
7973        if {$diffcontextstring >= 0} {
7974            set diffcontext $diffcontextstring
7975            reselectline
7976        }
7977    }
7978}
7979
7980proc changeignorespace {} {
7981    reselectline
7982}
7983
7984proc changeworddiff {name ix op} {
7985    reselectline
7986}
7987
7988proc initblobdiffvars {} {
7989    global diffencoding targetline diffnparents
7990    global diffinhdr currdiffsubmod diffseehere
7991    set targetline {}
7992    set diffnparents 0
7993    set diffinhdr 0
7994    set diffencoding [get_path_encoding {}]
7995    set currdiffsubmod ""
7996    set diffseehere -1
7997}
7998
7999proc getblobdiffs {ids} {
8000    global blobdifffd diffids env
8001    global treediffs
8002    global diffcontext
8003    global ignorespace
8004    global worddiff
8005    global limitdiffs vfilelimit curview
8006    global git_version
8007
8008    set textconv {}
8009    if {[package vcompare $git_version "1.6.1"] >= 0} {
8010        set textconv "--textconv"
8011    }
8012    set submodule {}
8013    if {[package vcompare $git_version "1.6.6"] >= 0} {
8014        set submodule "--submodule"
8015    }
8016    set cmd [diffcmd $ids "-p $textconv $submodule  -C --cc --no-commit-id -U$diffcontext"]
8017    if {$ignorespace} {
8018        append cmd " -w"
8019    }
8020    if {$worddiff ne [mc "Line diff"]} {
8021        append cmd " --word-diff=porcelain"
8022    }
8023    if {$limitdiffs && $vfilelimit($curview) ne {}} {
8024        set cmd [concat $cmd -- $vfilelimit($curview)]
8025    }
8026    if {[catch {set bdf [open $cmd r]} err]} {
8027        error_popup [mc "Error getting diffs: %s" $err]
8028        return
8029    }
8030    fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
8031    set blobdifffd($ids) $bdf
8032    initblobdiffvars
8033    filerun $bdf [list getblobdiffline $bdf $diffids]
8034}
8035
8036proc savecmitpos {} {
8037    global ctext cmitmode
8038
8039    if {$cmitmode eq "tree"} {
8040        return {}
8041    }
8042    return [list target_scrollpos [$ctext index @0,0]]
8043}
8044
8045proc savectextpos {} {
8046    global ctext
8047
8048    return [list target_scrollpos [$ctext index @0,0]]
8049}
8050
8051proc maybe_scroll_ctext {ateof} {
8052    global ctext target_scrollpos
8053
8054    if {![info exists target_scrollpos]} return
8055    if {!$ateof} {
8056        set nlines [expr {[winfo height $ctext]
8057                          / [font metrics textfont -linespace]}]
8058        if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
8059    }
8060    $ctext yview $target_scrollpos
8061    unset target_scrollpos
8062}
8063
8064proc setinlist {var i val} {
8065    global $var
8066
8067    while {[llength [set $var]] < $i} {
8068        lappend $var {}
8069    }
8070    if {[llength [set $var]] == $i} {
8071        lappend $var $val
8072    } else {
8073        lset $var $i $val
8074    }
8075}
8076
8077proc makediffhdr {fname ids} {
8078    global ctext curdiffstart treediffs diffencoding
8079    global ctext_file_names jump_to_here targetline diffline
8080
8081    set fname [encoding convertfrom $fname]
8082    set diffencoding [get_path_encoding $fname]
8083    set i [lsearch -exact $treediffs($ids) $fname]
8084    if {$i >= 0} {
8085        setinlist difffilestart $i $curdiffstart
8086    }
8087    lset ctext_file_names end $fname
8088    set l [expr {(78 - [string length $fname]) / 2}]
8089    set pad [string range "----------------------------------------" 1 $l]
8090    $ctext insert $curdiffstart "$pad $fname $pad" filesep
8091    set targetline {}
8092    if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
8093        set targetline [lindex $jump_to_here 1]
8094    }
8095    set diffline 0
8096}
8097
8098proc blobdiffmaybeseehere {ateof} {
8099    global diffseehere
8100    if {$diffseehere >= 0} {
8101        mark_ctext_line [lindex [split $diffseehere .] 0]
8102    }
8103    maybe_scroll_ctext $ateof
8104}
8105
8106proc getblobdiffline {bdf ids} {
8107    global diffids blobdifffd
8108    global ctext
8109
8110    set nr 0
8111    $ctext conf -state normal
8112    while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
8113        if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
8114            # Older diff read. Abort it.
8115            catch {close $bdf}
8116            if {$ids != $diffids} {
8117                array unset blobdifffd $ids
8118            }
8119            return 0
8120        }
8121        parseblobdiffline $ids $line
8122    }
8123    $ctext conf -state disabled
8124    blobdiffmaybeseehere [eof $bdf]
8125    if {[eof $bdf]} {
8126        catch {close $bdf}
8127        array unset blobdifffd $ids
8128        return 0
8129    }
8130    return [expr {$nr >= 1000? 2: 1}]
8131}
8132
8133proc parseblobdiffline {ids line} {
8134    global ctext curdiffstart
8135    global diffnexthead diffnextnote difffilestart
8136    global ctext_file_names ctext_file_lines
8137    global diffinhdr treediffs mergemax diffnparents
8138    global diffencoding jump_to_here targetline diffline currdiffsubmod
8139    global worddiff diffseehere
8140
8141    if {![string compare -length 5 "diff " $line]} {
8142        if {![regexp {^diff (--cc|--git) } $line m type]} {
8143            set line [encoding convertfrom $line]
8144            $ctext insert end "$line\n" hunksep
8145            continue
8146        }
8147        # start of a new file
8148        set diffinhdr 1
8149        $ctext insert end "\n"
8150        set curdiffstart [$ctext index "end - 1c"]
8151        lappend ctext_file_names ""
8152        lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8153        $ctext insert end "\n" filesep
8154
8155        if {$type eq "--cc"} {
8156            # start of a new file in a merge diff
8157            set fname [string range $line 10 end]
8158            if {[lsearch -exact $treediffs($ids) $fname] < 0} {
8159                lappend treediffs($ids) $fname
8160                add_flist [list $fname]
8161            }
8162
8163        } else {
8164            set line [string range $line 11 end]
8165            # If the name hasn't changed the length will be odd,
8166            # the middle char will be a space, and the two bits either
8167            # side will be a/name and b/name, or "a/name" and "b/name".
8168            # If the name has changed we'll get "rename from" and
8169            # "rename to" or "copy from" and "copy to" lines following
8170            # this, and we'll use them to get the filenames.
8171            # This complexity is necessary because spaces in the
8172            # filename(s) don't get escaped.
8173            set l [string length $line]
8174            set i [expr {$l / 2}]
8175            if {!(($l & 1) && [string index $line $i] eq " " &&
8176                  [string range $line 2 [expr {$i - 1}]] eq \
8177                      [string range $line [expr {$i + 3}] end])} {
8178                return
8179            }
8180            # unescape if quoted and chop off the a/ from the front
8181            if {[string index $line 0] eq "\""} {
8182                set fname [string range [lindex $line 0] 2 end]
8183            } else {
8184                set fname [string range $line 2 [expr {$i - 1}]]
8185            }
8186        }
8187        makediffhdr $fname $ids
8188
8189    } elseif {![string compare -length 16 "* Unmerged path " $line]} {
8190        set fname [encoding convertfrom [string range $line 16 end]]
8191        $ctext insert end "\n"
8192        set curdiffstart [$ctext index "end - 1c"]
8193        lappend ctext_file_names $fname
8194        lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8195        $ctext insert end "$line\n" filesep
8196        set i [lsearch -exact $treediffs($ids) $fname]
8197        if {$i >= 0} {
8198            setinlist difffilestart $i $curdiffstart
8199        }
8200
8201    } elseif {![string compare -length 2 "@@" $line]} {
8202        regexp {^@@+} $line ats
8203        set line [encoding convertfrom $diffencoding $line]
8204        $ctext insert end "$line\n" hunksep
8205        if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
8206            set diffline $nl
8207        }
8208        set diffnparents [expr {[string length $ats] - 1}]
8209        set diffinhdr 0
8210
8211    } elseif {![string compare -length 10 "Submodule " $line]} {
8212        # start of a new submodule
8213        if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
8214            set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
8215        } else {
8216            set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
8217        }
8218        if {$currdiffsubmod != $fname} {
8219            $ctext insert end "\n";     # Add newline after commit message
8220        }
8221        set curdiffstart [$ctext index "end - 1c"]
8222        lappend ctext_file_names ""
8223        if {$currdiffsubmod != $fname} {
8224            lappend ctext_file_lines $fname
8225            makediffhdr $fname $ids
8226            set currdiffsubmod $fname
8227            $ctext insert end "\n$line\n" filesep
8228        } else {
8229            $ctext insert end "$line\n" filesep
8230        }
8231    } elseif {$currdiffsubmod != "" && ![string compare -length 3 "  >" $line]} {
8232        set $currdiffsubmod ""
8233        set line [encoding convertfrom $diffencoding $line]
8234        $ctext insert end "$line\n" dresult
8235    } elseif {$currdiffsubmod != "" && ![string compare -length 3 "  <" $line]} {
8236        set $currdiffsubmod ""
8237        set line [encoding convertfrom $diffencoding $line]
8238        $ctext insert end "$line\n" d0
8239    } elseif {$diffinhdr} {
8240        if {![string compare -length 12 "rename from " $line]} {
8241            set fname [string range $line [expr 6 + [string first " from " $line] ] end]
8242            if {[string index $fname 0] eq "\""} {
8243                set fname [lindex $fname 0]
8244            }
8245            set fname [encoding convertfrom $fname]
8246            set i [lsearch -exact $treediffs($ids) $fname]
8247            if {$i >= 0} {
8248                setinlist difffilestart $i $curdiffstart
8249            }
8250        } elseif {![string compare -length 10 $line "rename to "] ||
8251                  ![string compare -length 8 $line "copy to "]} {
8252            set fname [string range $line [expr 4 + [string first " to " $line] ] end]
8253            if {[string index $fname 0] eq "\""} {
8254                set fname [lindex $fname 0]
8255            }
8256            makediffhdr $fname $ids
8257        } elseif {[string compare -length 3 $line "---"] == 0} {
8258            # do nothing
8259            return
8260        } elseif {[string compare -length 3 $line "+++"] == 0} {
8261            set diffinhdr 0
8262            return
8263        }
8264        $ctext insert end "$line\n" filesep
8265
8266    } else {
8267        set line [string map {\x1A ^Z} \
8268                      [encoding convertfrom $diffencoding $line]]
8269        # parse the prefix - one ' ', '-' or '+' for each parent
8270        set prefix [string range $line 0 [expr {$diffnparents - 1}]]
8271        set tag [expr {$diffnparents > 1? "m": "d"}]
8272        set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
8273        set words_pre_markup ""
8274        set words_post_markup ""
8275        if {[string trim $prefix " -+"] eq {}} {
8276            # prefix only has " ", "-" and "+" in it: normal diff line
8277            set num [string first "-" $prefix]
8278            if {$dowords} {
8279                set line [string range $line 1 end]
8280            }
8281            if {$num >= 0} {
8282                # removed line, first parent with line is $num
8283                if {$num >= $mergemax} {
8284                    set num "max"
8285                }
8286                if {$dowords && $worddiff eq [mc "Markup words"]} {
8287                    $ctext insert end "\[-$line-\]" $tag$num
8288                } else {
8289                    $ctext insert end "$line" $tag$num
8290                }
8291                if {!$dowords} {
8292                    $ctext insert end "\n" $tag$num
8293                }
8294            } else {
8295                set tags {}
8296                if {[string first "+" $prefix] >= 0} {
8297                    # added line
8298                    lappend tags ${tag}result
8299                    if {$diffnparents > 1} {
8300                        set num [string first " " $prefix]
8301                        if {$num >= 0} {
8302                            if {$num >= $mergemax} {
8303                                set num "max"
8304                            }
8305                            lappend tags m$num
8306                        }
8307                    }
8308                    set words_pre_markup "{+"
8309                    set words_post_markup "+}"
8310                }
8311                if {$targetline ne {}} {
8312                    if {$diffline == $targetline} {
8313                        set diffseehere [$ctext index "end - 1 chars"]
8314                        set targetline {}
8315                    } else {
8316                        incr diffline
8317                    }
8318                }
8319                if {$dowords && $worddiff eq [mc "Markup words"]} {
8320                    $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
8321                } else {
8322                    $ctext insert end "$line" $tags
8323                }
8324                if {!$dowords} {
8325                    $ctext insert end "\n" $tags
8326                }
8327            }
8328        } elseif {$dowords && $prefix eq "~"} {
8329            $ctext insert end "\n" {}
8330        } else {
8331            # "\ No newline at end of file",
8332            # or something else we don't recognize
8333            $ctext insert end "$line\n" hunksep
8334        }
8335    }
8336}
8337
8338proc changediffdisp {} {
8339    global ctext diffelide
8340
8341    $ctext tag conf d0 -elide [lindex $diffelide 0]
8342    $ctext tag conf dresult -elide [lindex $diffelide 1]
8343}
8344
8345proc highlightfile {cline} {
8346    global cflist cflist_top
8347
8348    if {![info exists cflist_top]} return
8349
8350    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
8351    $cflist tag add highlight $cline.0 "$cline.0 lineend"
8352    $cflist see $cline.0
8353    set cflist_top $cline
8354}
8355
8356proc highlightfile_for_scrollpos {topidx} {
8357    global cmitmode difffilestart
8358
8359    if {$cmitmode eq "tree"} return
8360    if {![info exists difffilestart]} return
8361
8362    set top [lindex [split $topidx .] 0]
8363    if {$difffilestart eq {} || $top < [lindex $difffilestart 0]} {
8364        highlightfile 0
8365    } else {
8366        highlightfile [expr {[bsearch $difffilestart $top] + 2}]
8367    }
8368}
8369
8370proc prevfile {} {
8371    global difffilestart ctext cmitmode
8372
8373    if {$cmitmode eq "tree"} return
8374    set prev 0.0
8375    set here [$ctext index @0,0]
8376    foreach loc $difffilestart {
8377        if {[$ctext compare $loc >= $here]} {
8378            $ctext yview $prev
8379            return
8380        }
8381        set prev $loc
8382    }
8383    $ctext yview $prev
8384}
8385
8386proc nextfile {} {
8387    global difffilestart ctext cmitmode
8388
8389    if {$cmitmode eq "tree"} return
8390    set here [$ctext index @0,0]
8391    foreach loc $difffilestart {
8392        if {[$ctext compare $loc > $here]} {
8393            $ctext yview $loc
8394            return
8395        }
8396    }
8397}
8398
8399proc clear_ctext {{first 1.0}} {
8400    global ctext smarktop smarkbot
8401    global ctext_file_names ctext_file_lines
8402    global pendinglinks
8403
8404    set l [lindex [split $first .] 0]
8405    if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
8406        set smarktop $l
8407    }
8408    if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
8409        set smarkbot $l
8410    }
8411    $ctext delete $first end
8412    if {$first eq "1.0"} {
8413        unset -nocomplain pendinglinks
8414    }
8415    set ctext_file_names {}
8416    set ctext_file_lines {}
8417}
8418
8419proc settabs {{firstab {}}} {
8420    global firsttabstop tabstop ctext have_tk85
8421
8422    if {$firstab ne {} && $have_tk85} {
8423        set firsttabstop $firstab
8424    }
8425    set w [font measure textfont "0"]
8426    if {$firsttabstop != 0} {
8427        $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
8428                               [expr {($firsttabstop + 2 * $tabstop) * $w}]]
8429    } elseif {$have_tk85 || $tabstop != 8} {
8430        $ctext conf -tabs [expr {$tabstop * $w}]
8431    } else {
8432        $ctext conf -tabs {}
8433    }
8434}
8435
8436proc incrsearch {name ix op} {
8437    global ctext searchstring searchdirn
8438
8439    if {[catch {$ctext index anchor}]} {
8440        # no anchor set, use start of selection, or of visible area
8441        set sel [$ctext tag ranges sel]
8442        if {$sel ne {}} {
8443            $ctext mark set anchor [lindex $sel 0]
8444        } elseif {$searchdirn eq "-forwards"} {
8445            $ctext mark set anchor @0,0
8446        } else {
8447            $ctext mark set anchor @0,[winfo height $ctext]
8448        }
8449    }
8450    if {$searchstring ne {}} {
8451        set here [$ctext search -count mlen $searchdirn -- $searchstring anchor]
8452        if {$here ne {}} {
8453            $ctext see $here
8454            set mend "$here + $mlen c"
8455            $ctext tag remove sel 1.0 end
8456            $ctext tag add sel $here $mend
8457            suppress_highlighting_file_for_current_scrollpos
8458            highlightfile_for_scrollpos $here
8459        }
8460    }
8461    rehighlight_search_results
8462}
8463
8464proc dosearch {} {
8465    global sstring ctext searchstring searchdirn
8466
8467    focus $sstring
8468    $sstring icursor end
8469    set searchdirn -forwards
8470    if {$searchstring ne {}} {
8471        set sel [$ctext tag ranges sel]
8472        if {$sel ne {}} {
8473            set start "[lindex $sel 0] + 1c"
8474        } elseif {[catch {set start [$ctext index anchor]}]} {
8475            set start "@0,0"
8476        }
8477        set match [$ctext search -count mlen -- $searchstring $start]
8478        $ctext tag remove sel 1.0 end
8479        if {$match eq {}} {
8480            bell
8481            return
8482        }
8483        $ctext see $match
8484        suppress_highlighting_file_for_current_scrollpos
8485        highlightfile_for_scrollpos $match
8486        set mend "$match + $mlen c"
8487        $ctext tag add sel $match $mend
8488        $ctext mark unset anchor
8489        rehighlight_search_results
8490    }
8491}
8492
8493proc dosearchback {} {
8494    global sstring ctext searchstring searchdirn
8495
8496    focus $sstring
8497    $sstring icursor end
8498    set searchdirn -backwards
8499    if {$searchstring ne {}} {
8500        set sel [$ctext tag ranges sel]
8501        if {$sel ne {}} {
8502            set start [lindex $sel 0]
8503        } elseif {[catch {set start [$ctext index anchor]}]} {
8504            set start @0,[winfo height $ctext]
8505        }
8506        set match [$ctext search -backwards -count ml -- $searchstring $start]
8507        $ctext tag remove sel 1.0 end
8508        if {$match eq {}} {
8509            bell
8510            return
8511        }
8512        $ctext see $match
8513        suppress_highlighting_file_for_current_scrollpos
8514        highlightfile_for_scrollpos $match
8515        set mend "$match + $ml c"
8516        $ctext tag add sel $match $mend
8517        $ctext mark unset anchor
8518        rehighlight_search_results
8519    }
8520}
8521
8522proc rehighlight_search_results {} {
8523    global ctext searchstring
8524
8525    $ctext tag remove found 1.0 end
8526    $ctext tag remove currentsearchhit 1.0 end
8527
8528    if {$searchstring ne {}} {
8529        searchmarkvisible 1
8530    }
8531}
8532
8533proc searchmark {first last} {
8534    global ctext searchstring
8535
8536    set sel [$ctext tag ranges sel]
8537
8538    set mend $first.0
8539    while {1} {
8540        set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8541        if {$match eq {}} break
8542        set mend "$match + $mlen c"
8543        if {$sel ne {} && [$ctext compare $match == [lindex $sel 0]]} {
8544            $ctext tag add currentsearchhit $match $mend
8545        } else {
8546            $ctext tag add found $match $mend
8547        }
8548    }
8549}
8550
8551proc searchmarkvisible {doall} {
8552    global ctext smarktop smarkbot
8553
8554    set topline [lindex [split [$ctext index @0,0] .] 0]
8555    set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8556    if {$doall || $botline < $smarktop || $topline > $smarkbot} {
8557        # no overlap with previous
8558        searchmark $topline $botline
8559        set smarktop $topline
8560        set smarkbot $botline
8561    } else {
8562        if {$topline < $smarktop} {
8563            searchmark $topline [expr {$smarktop-1}]
8564            set smarktop $topline
8565        }
8566        if {$botline > $smarkbot} {
8567            searchmark [expr {$smarkbot+1}] $botline
8568            set smarkbot $botline
8569        }
8570    }
8571}
8572
8573proc suppress_highlighting_file_for_current_scrollpos {} {
8574    global ctext suppress_highlighting_file_for_this_scrollpos
8575
8576    set suppress_highlighting_file_for_this_scrollpos [$ctext index @0,0]
8577}
8578
8579proc scrolltext {f0 f1} {
8580    global searchstring cmitmode ctext
8581    global suppress_highlighting_file_for_this_scrollpos
8582
8583    set topidx [$ctext index @0,0]
8584    if {![info exists suppress_highlighting_file_for_this_scrollpos]
8585        || $topidx ne $suppress_highlighting_file_for_this_scrollpos} {
8586        highlightfile_for_scrollpos $topidx
8587    }
8588
8589    unset -nocomplain suppress_highlighting_file_for_this_scrollpos
8590
8591    .bleft.bottom.sb set $f0 $f1
8592    if {$searchstring ne {}} {
8593        searchmarkvisible 0
8594    }
8595}
8596
8597proc setcoords {} {
8598    global linespc charspc canvx0 canvy0
8599    global xspc1 xspc2 lthickness
8600
8601    set linespc [font metrics mainfont -linespace]
8602    set charspc [font measure mainfont "m"]
8603    set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8604    set canvx0 [expr {int(3 + 0.5 * $linespc)}]
8605    set lthickness [expr {int($linespc / 9) + 1}]
8606    set xspc1(0) $linespc
8607    set xspc2 $linespc
8608}
8609
8610proc redisplay {} {
8611    global canv
8612    global selectedline
8613
8614    set ymax [lindex [$canv cget -scrollregion] 3]
8615    if {$ymax eq {} || $ymax == 0} return
8616    set span [$canv yview]
8617    clear_display
8618    setcanvscroll
8619    allcanvs yview moveto [lindex $span 0]
8620    drawvisible
8621    if {$selectedline ne {}} {
8622        selectline $selectedline 0
8623        allcanvs yview moveto [lindex $span 0]
8624    }
8625}
8626
8627proc parsefont {f n} {
8628    global fontattr
8629
8630    set fontattr($f,family) [lindex $n 0]
8631    set s [lindex $n 1]
8632    if {$s eq {} || $s == 0} {
8633        set s 10
8634    } elseif {$s < 0} {
8635        set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
8636    }
8637    set fontattr($f,size) $s
8638    set fontattr($f,weight) normal
8639    set fontattr($f,slant) roman
8640    foreach style [lrange $n 2 end] {
8641        switch -- $style {
8642            "normal" -
8643            "bold"   {set fontattr($f,weight) $style}
8644            "roman" -
8645            "italic" {set fontattr($f,slant) $style}
8646        }
8647    }
8648}
8649
8650proc fontflags {f {isbold 0}} {
8651    global fontattr
8652
8653    return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8654                -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8655                -slant $fontattr($f,slant)]
8656}
8657
8658proc fontname {f} {
8659    global fontattr
8660
8661    set n [list $fontattr($f,family) $fontattr($f,size)]
8662    if {$fontattr($f,weight) eq "bold"} {
8663        lappend n "bold"
8664    }
8665    if {$fontattr($f,slant) eq "italic"} {
8666        lappend n "italic"
8667    }
8668    return $n
8669}
8670
8671proc incrfont {inc} {
8672    global mainfont textfont ctext canv cflist showrefstop
8673    global stopped entries fontattr
8674
8675    unmarkmatches
8676    set s $fontattr(mainfont,size)
8677    incr s $inc
8678    if {$s < 1} {
8679        set s 1
8680    }
8681    set fontattr(mainfont,size) $s
8682    font config mainfont -size $s
8683    font config mainfontbold -size $s
8684    set mainfont [fontname mainfont]
8685    set s $fontattr(textfont,size)
8686    incr s $inc
8687    if {$s < 1} {
8688        set s 1
8689    }
8690    set fontattr(textfont,size) $s
8691    font config textfont -size $s
8692    font config textfontbold -size $s
8693    set textfont [fontname textfont]
8694    setcoords
8695    settabs
8696    redisplay
8697}
8698
8699proc clearsha1 {} {
8700    global sha1entry sha1string
8701    if {[string length $sha1string] == 40} {
8702        $sha1entry delete 0 end
8703    }
8704}
8705
8706proc sha1change {n1 n2 op} {
8707    global sha1string currentid sha1but
8708    if {$sha1string == {}
8709        || ([info exists currentid] && $sha1string == $currentid)} {
8710        set state disabled
8711    } else {
8712        set state normal
8713    }
8714    if {[$sha1but cget -state] == $state} return
8715    if {$state == "normal"} {
8716        $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
8717    } else {
8718        $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
8719    }
8720}
8721
8722proc gotocommit {} {
8723    global sha1string tagids headids curview varcid
8724
8725    if {$sha1string == {}
8726        || ([info exists currentid] && $sha1string == $currentid)} return
8727    if {[info exists tagids($sha1string)]} {
8728        set id $tagids($sha1string)
8729    } elseif {[info exists headids($sha1string)]} {
8730        set id $headids($sha1string)
8731    } else {
8732        set id [string tolower $sha1string]
8733        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
8734            set matches [longid $id]
8735            if {$matches ne {}} {
8736                if {[llength $matches] > 1} {
8737                    error_popup [mc "Short SHA1 id %s is ambiguous" $id]
8738                    return
8739                }
8740                set id [lindex $matches 0]
8741            }
8742        } else {
8743            if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8744                error_popup [mc "Revision %s is not known" $sha1string]
8745                return
8746            }
8747        }
8748    }
8749    if {[commitinview $id $curview]} {
8750        selectline [rowofcommit $id] 1
8751        return
8752    }
8753    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
8754        set msg [mc "SHA1 id %s is not known" $sha1string]
8755    } else {
8756        set msg [mc "Revision %s is not in the current view" $sha1string]
8757    }
8758    error_popup $msg
8759}
8760
8761proc lineenter {x y id} {
8762    global hoverx hovery hoverid hovertimer
8763    global commitinfo canv
8764
8765    if {![info exists commitinfo($id)] && ![getcommit $id]} return
8766    set hoverx $x
8767    set hovery $y
8768    set hoverid $id
8769    if {[info exists hovertimer]} {
8770        after cancel $hovertimer
8771    }
8772    set hovertimer [after 500 linehover]
8773    $canv delete hover
8774}
8775
8776proc linemotion {x y id} {
8777    global hoverx hovery hoverid hovertimer
8778
8779    if {[info exists hoverid] && $id == $hoverid} {
8780        set hoverx $x
8781        set hovery $y
8782        if {[info exists hovertimer]} {
8783            after cancel $hovertimer
8784        }
8785        set hovertimer [after 500 linehover]
8786    }
8787}
8788
8789proc lineleave {id} {
8790    global hoverid hovertimer canv
8791
8792    if {[info exists hoverid] && $id == $hoverid} {
8793        $canv delete hover
8794        if {[info exists hovertimer]} {
8795            after cancel $hovertimer
8796            unset hovertimer
8797        }
8798        unset hoverid
8799    }
8800}
8801
8802proc linehover {} {
8803    global hoverx hovery hoverid hovertimer
8804    global canv linespc lthickness
8805    global linehoverbgcolor linehoverfgcolor linehoveroutlinecolor
8806
8807    global commitinfo
8808
8809    set text [lindex $commitinfo($hoverid) 0]
8810    set ymax [lindex [$canv cget -scrollregion] 3]
8811    if {$ymax == {}} return
8812    set yfrac [lindex [$canv yview] 0]
8813    set x [expr {$hoverx + 2 * $linespc}]
8814    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8815    set x0 [expr {$x - 2 * $lthickness}]
8816    set y0 [expr {$y - 2 * $lthickness}]
8817    set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
8818    set y1 [expr {$y + $linespc + 2 * $lthickness}]
8819    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8820               -fill $linehoverbgcolor -outline $linehoveroutlinecolor \
8821               -width 1 -tags hover]
8822    $canv raise $t
8823    set t [$canv create text $x $y -anchor nw -text $text -tags hover \
8824               -font mainfont -fill $linehoverfgcolor]
8825    $canv raise $t
8826}
8827
8828proc clickisonarrow {id y} {
8829    global lthickness
8830
8831    set ranges [rowranges $id]
8832    set thresh [expr {2 * $lthickness + 6}]
8833    set n [expr {[llength $ranges] - 1}]
8834    for {set i 1} {$i < $n} {incr i} {
8835        set row [lindex $ranges $i]
8836        if {abs([yc $row] - $y) < $thresh} {
8837            return $i
8838        }
8839    }
8840    return {}
8841}
8842
8843proc arrowjump {id n y} {
8844    global canv
8845
8846    # 1 <-> 2, 3 <-> 4, etc...
8847    set n [expr {(($n - 1) ^ 1) + 1}]
8848    set row [lindex [rowranges $id] $n]
8849    set yt [yc $row]
8850    set ymax [lindex [$canv cget -scrollregion] 3]
8851    if {$ymax eq {} || $ymax <= 0} return
8852    set view [$canv yview]
8853    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8854    set yfrac [expr {$yt / $ymax - $yspan / 2}]
8855    if {$yfrac < 0} {
8856        set yfrac 0
8857    }
8858    allcanvs yview moveto $yfrac
8859}
8860
8861proc lineclick {x y id isnew} {
8862    global ctext commitinfo children canv thickerline curview
8863
8864    if {![info exists commitinfo($id)] && ![getcommit $id]} return
8865    unmarkmatches
8866    unselectline
8867    normalline
8868    $canv delete hover
8869    # draw this line thicker than normal
8870    set thickerline $id
8871    drawlines $id
8872    if {$isnew} {
8873        set ymax [lindex [$canv cget -scrollregion] 3]
8874        if {$ymax eq {}} return
8875        set yfrac [lindex [$canv yview] 0]
8876        set y [expr {$y + $yfrac * $ymax}]
8877    }
8878    set dirn [clickisonarrow $id $y]
8879    if {$dirn ne {}} {
8880        arrowjump $id $dirn $y
8881        return
8882    }
8883
8884    if {$isnew} {
8885        addtohistory [list lineclick $x $y $id 0] savectextpos
8886    }
8887    # fill the details pane with info about this line
8888    $ctext conf -state normal
8889    clear_ctext
8890    settabs 0
8891    $ctext insert end "[mc "Parent"]:\t"
8892    $ctext insert end $id link0
8893    setlink $id link0
8894    set info $commitinfo($id)
8895    $ctext insert end "\n\t[lindex $info 0]\n"
8896    $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8897    set date [formatdate [lindex $info 2]]
8898    $ctext insert end "\t[mc "Date"]:\t$date\n"
8899    set kids $children($curview,$id)
8900    if {$kids ne {}} {
8901        $ctext insert end "\n[mc "Children"]:"
8902        set i 0
8903        foreach child $kids {
8904            incr i
8905            if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8906            set info $commitinfo($child)
8907            $ctext insert end "\n\t"
8908            $ctext insert end $child link$i
8909            setlink $child link$i
8910            $ctext insert end "\n\t[lindex $info 0]"
8911            $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8912            set date [formatdate [lindex $info 2]]
8913            $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8914        }
8915    }
8916    maybe_scroll_ctext 1
8917    $ctext conf -state disabled
8918    init_flist {}
8919}
8920
8921proc normalline {} {
8922    global thickerline
8923    if {[info exists thickerline]} {
8924        set id $thickerline
8925        unset thickerline
8926        drawlines $id
8927    }
8928}
8929
8930proc selbyid {id {isnew 1}} {
8931    global curview
8932    if {[commitinview $id $curview]} {
8933        selectline [rowofcommit $id] $isnew
8934    }
8935}
8936
8937proc mstime {} {
8938    global startmstime
8939    if {![info exists startmstime]} {
8940        set startmstime [clock clicks -milliseconds]
8941    }
8942    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8943}
8944
8945proc rowmenu {x y id} {
8946    global rowctxmenu selectedline rowmenuid curview
8947    global nullid nullid2 fakerowmenu mainhead markedid
8948
8949    stopfinding
8950    set rowmenuid $id
8951    if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8952        set state disabled
8953    } else {
8954        set state normal
8955    }
8956    if {[info exists markedid] && $markedid ne $id} {
8957        set mstate normal
8958    } else {
8959        set mstate disabled
8960    }
8961    if {$id ne $nullid && $id ne $nullid2} {
8962        set menu $rowctxmenu
8963        if {$mainhead ne {}} {
8964            $menu entryconfigure 8 -label [mc "Reset %s branch to here" $mainhead] -state normal
8965        } else {
8966            $menu entryconfigure 8 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8967        }
8968        $menu entryconfigure 10 -state $mstate
8969        $menu entryconfigure 11 -state $mstate
8970        $menu entryconfigure 12 -state $mstate
8971    } else {
8972        set menu $fakerowmenu
8973    }
8974    $menu entryconfigure [mca "Diff this -> selected"] -state $state
8975    $menu entryconfigure [mca "Diff selected -> this"] -state $state
8976    $menu entryconfigure [mca "Make patch"] -state $state
8977    $menu entryconfigure [mca "Diff this -> marked commit"] -state $mstate
8978    $menu entryconfigure [mca "Diff marked commit -> this"] -state $mstate
8979    tk_popup $menu $x $y
8980}
8981
8982proc markhere {} {
8983    global rowmenuid markedid canv
8984
8985    set markedid $rowmenuid
8986    make_idmark $markedid
8987}
8988
8989proc gotomark {} {
8990    global markedid
8991
8992    if {[info exists markedid]} {
8993        selbyid $markedid
8994    }
8995}
8996
8997proc replace_by_kids {l r} {
8998    global curview children
8999
9000    set id [commitonrow $r]
9001    set l [lreplace $l 0 0]
9002    foreach kid $children($curview,$id) {
9003        lappend l [rowofcommit $kid]
9004    }
9005    return [lsort -integer -decreasing -unique $l]
9006}
9007
9008proc find_common_desc {} {
9009    global markedid rowmenuid curview children
9010
9011    if {![info exists markedid]} return
9012    if {![commitinview $markedid $curview] ||
9013        ![commitinview $rowmenuid $curview]} return
9014    #set t1 [clock clicks -milliseconds]
9015    set l1 [list [rowofcommit $markedid]]
9016    set l2 [list [rowofcommit $rowmenuid]]
9017    while 1 {
9018        set r1 [lindex $l1 0]
9019        set r2 [lindex $l2 0]
9020        if {$r1 eq {} || $r2 eq {}} break
9021        if {$r1 == $r2} {
9022            selectline $r1 1
9023            break
9024        }
9025        if {$r1 > $r2} {
9026            set l1 [replace_by_kids $l1 $r1]
9027        } else {
9028            set l2 [replace_by_kids $l2 $r2]
9029        }
9030    }
9031    #set t2 [clock clicks -milliseconds]
9032    #puts "took [expr {$t2-$t1}]ms"
9033}
9034
9035proc compare_commits {} {
9036    global markedid rowmenuid curview children
9037
9038    if {![info exists markedid]} return
9039    if {![commitinview $markedid $curview]} return
9040    addtohistory [list do_cmp_commits $markedid $rowmenuid]
9041    do_cmp_commits $markedid $rowmenuid
9042}
9043
9044proc getpatchid {id} {
9045    global patchids
9046
9047    if {![info exists patchids($id)]} {
9048        set cmd [diffcmd [list $id] {-p --root}]
9049        # trim off the initial "|"
9050        set cmd [lrange $cmd 1 end]
9051        if {[catch {
9052            set x [eval exec $cmd | git patch-id]
9053            set patchids($id) [lindex $x 0]
9054        }]} {
9055            set patchids($id) "error"
9056        }
9057    }
9058    return $patchids($id)
9059}
9060
9061proc do_cmp_commits {a b} {
9062    global ctext curview parents children patchids commitinfo
9063
9064    $ctext conf -state normal
9065    clear_ctext
9066    init_flist {}
9067    for {set i 0} {$i < 100} {incr i} {
9068        set skipa 0
9069        set skipb 0
9070        if {[llength $parents($curview,$a)] > 1} {
9071            appendshortlink $a [mc "Skipping merge commit "] "\n"
9072            set skipa 1
9073        } else {
9074            set patcha [getpatchid $a]
9075        }
9076        if {[llength $parents($curview,$b)] > 1} {
9077            appendshortlink $b [mc "Skipping merge commit "] "\n"
9078            set skipb 1
9079        } else {
9080            set patchb [getpatchid $b]
9081        }
9082        if {!$skipa && !$skipb} {
9083            set heada [lindex $commitinfo($a) 0]
9084            set headb [lindex $commitinfo($b) 0]
9085            if {$patcha eq "error"} {
9086                appendshortlink $a [mc "Error getting patch ID for "] \
9087                    [mc " - stopping\n"]
9088                break
9089            }
9090            if {$patchb eq "error"} {
9091                appendshortlink $b [mc "Error getting patch ID for "] \
9092                    [mc " - stopping\n"]
9093                break
9094            }
9095            if {$patcha eq $patchb} {
9096                if {$heada eq $headb} {
9097                    appendshortlink $a [mc "Commit "]
9098                    appendshortlink $b " == " "  $heada\n"
9099                } else {
9100                    appendshortlink $a [mc "Commit "] "  $heada\n"
9101                    appendshortlink $b [mc " is the same patch as\n       "] \
9102                        "  $headb\n"
9103                }
9104                set skipa 1
9105                set skipb 1
9106            } else {
9107                $ctext insert end "\n"
9108                appendshortlink $a [mc "Commit "] "  $heada\n"
9109                appendshortlink $b [mc " differs from\n       "] \
9110                    "  $headb\n"
9111                $ctext insert end [mc "Diff of commits:\n\n"]
9112                $ctext conf -state disabled
9113                update
9114                diffcommits $a $b
9115                return
9116            }
9117        }
9118        if {$skipa} {
9119            set kids [real_children $curview,$a]
9120            if {[llength $kids] != 1} {
9121                $ctext insert end "\n"
9122                appendshortlink $a [mc "Commit "] \
9123                    [mc " has %s children - stopping\n" [llength $kids]]
9124                break
9125            }
9126            set a [lindex $kids 0]
9127        }
9128        if {$skipb} {
9129            set kids [real_children $curview,$b]
9130            if {[llength $kids] != 1} {
9131                appendshortlink $b [mc "Commit "] \
9132                    [mc " has %s children - stopping\n" [llength $kids]]
9133                break
9134            }
9135            set b [lindex $kids 0]
9136        }
9137    }
9138    $ctext conf -state disabled
9139}
9140
9141proc diffcommits {a b} {
9142    global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
9143
9144    set tmpdir [gitknewtmpdir]
9145    set fna [file join $tmpdir "commit-[string range $a 0 7]"]
9146    set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
9147    if {[catch {
9148        exec git diff-tree -p --pretty $a >$fna
9149        exec git diff-tree -p --pretty $b >$fnb
9150    } err]} {
9151        error_popup [mc "Error writing commit to file: %s" $err]
9152        return
9153    }
9154    if {[catch {
9155        set fd [open "| diff -U$diffcontext $fna $fnb" r]
9156    } err]} {
9157        error_popup [mc "Error diffing commits: %s" $err]
9158        return
9159    }
9160    set diffids [list commits $a $b]
9161    set blobdifffd($diffids) $fd
9162    set diffinhdr 0
9163    set currdiffsubmod ""
9164    filerun $fd [list getblobdiffline $fd $diffids]
9165}
9166
9167proc diffvssel {dirn} {
9168    global rowmenuid selectedline
9169
9170    if {$selectedline eq {}} return
9171    if {$dirn} {
9172        set oldid [commitonrow $selectedline]
9173        set newid $rowmenuid
9174    } else {
9175        set oldid $rowmenuid
9176        set newid [commitonrow $selectedline]
9177    }
9178    addtohistory [list doseldiff $oldid $newid] savectextpos
9179    doseldiff $oldid $newid
9180}
9181
9182proc diffvsmark {dirn} {
9183    global rowmenuid markedid
9184
9185    if {![info exists markedid]} return
9186    if {$dirn} {
9187        set oldid $markedid
9188        set newid $rowmenuid
9189    } else {
9190        set oldid $rowmenuid
9191        set newid $markedid
9192    }
9193    addtohistory [list doseldiff $oldid $newid] savectextpos
9194    doseldiff $oldid $newid
9195}
9196
9197proc doseldiff {oldid newid} {
9198    global ctext
9199    global commitinfo
9200
9201    $ctext conf -state normal
9202    clear_ctext
9203    init_flist [mc "Top"]
9204    $ctext insert end "[mc "From"] "
9205    $ctext insert end $oldid link0
9206    setlink $oldid link0
9207    $ctext insert end "\n     "
9208    $ctext insert end [lindex $commitinfo($oldid) 0]
9209    $ctext insert end "\n\n[mc "To"]   "
9210    $ctext insert end $newid link1
9211    setlink $newid link1
9212    $ctext insert end "\n     "
9213    $ctext insert end [lindex $commitinfo($newid) 0]
9214    $ctext insert end "\n"
9215    $ctext conf -state disabled
9216    $ctext tag remove found 1.0 end
9217    startdiff [list $oldid $newid]
9218}
9219
9220proc mkpatch {} {
9221    global rowmenuid currentid commitinfo patchtop patchnum NS
9222
9223    if {![info exists currentid]} return
9224    set oldid $currentid
9225    set oldhead [lindex $commitinfo($oldid) 0]
9226    set newid $rowmenuid
9227    set newhead [lindex $commitinfo($newid) 0]
9228    set top .patch
9229    set patchtop $top
9230    catch {destroy $top}
9231    ttk_toplevel $top
9232    make_transient $top .
9233    ${NS}::label $top.title -text [mc "Generate patch"]
9234    grid $top.title - -pady 10
9235    ${NS}::label $top.from -text [mc "From:"]
9236    ${NS}::entry $top.fromsha1 -width 40
9237    $top.fromsha1 insert 0 $oldid
9238    $top.fromsha1 conf -state readonly
9239    grid $top.from $top.fromsha1 -sticky w
9240    ${NS}::entry $top.fromhead -width 60
9241    $top.fromhead insert 0 $oldhead
9242    $top.fromhead conf -state readonly
9243    grid x $top.fromhead -sticky w
9244    ${NS}::label $top.to -text [mc "To:"]
9245    ${NS}::entry $top.tosha1 -width 40
9246    $top.tosha1 insert 0 $newid
9247    $top.tosha1 conf -state readonly
9248    grid $top.to $top.tosha1 -sticky w
9249    ${NS}::entry $top.tohead -width 60
9250    $top.tohead insert 0 $newhead
9251    $top.tohead conf -state readonly
9252    grid x $top.tohead -sticky w
9253    ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
9254    grid $top.rev x -pady 10 -padx 5
9255    ${NS}::label $top.flab -text [mc "Output file:"]
9256    ${NS}::entry $top.fname -width 60
9257    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
9258    incr patchnum
9259    grid $top.flab $top.fname -sticky w
9260    ${NS}::frame $top.buts
9261    ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
9262    ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
9263    bind $top <Key-Return> mkpatchgo
9264    bind $top <Key-Escape> mkpatchcan
9265    grid $top.buts.gen $top.buts.can
9266    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9267    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9268    grid $top.buts - -pady 10 -sticky ew
9269    focus $top.fname
9270}
9271
9272proc mkpatchrev {} {
9273    global patchtop
9274
9275    set oldid [$patchtop.fromsha1 get]
9276    set oldhead [$patchtop.fromhead get]
9277    set newid [$patchtop.tosha1 get]
9278    set newhead [$patchtop.tohead get]
9279    foreach e [list fromsha1 fromhead tosha1 tohead] \
9280            v [list $newid $newhead $oldid $oldhead] {
9281        $patchtop.$e conf -state normal
9282        $patchtop.$e delete 0 end
9283        $patchtop.$e insert 0 $v
9284        $patchtop.$e conf -state readonly
9285    }
9286}
9287
9288proc mkpatchgo {} {
9289    global patchtop nullid nullid2
9290
9291    set oldid [$patchtop.fromsha1 get]
9292    set newid [$patchtop.tosha1 get]
9293    set fname [$patchtop.fname get]
9294    set cmd [diffcmd [list $oldid $newid] -p]
9295    # trim off the initial "|"
9296    set cmd [lrange $cmd 1 end]
9297    lappend cmd >$fname &
9298    if {[catch {eval exec $cmd} err]} {
9299        error_popup "[mc "Error creating patch:"] $err" $patchtop
9300    }
9301    catch {destroy $patchtop}
9302    unset patchtop
9303}
9304
9305proc mkpatchcan {} {
9306    global patchtop
9307
9308    catch {destroy $patchtop}
9309    unset patchtop
9310}
9311
9312proc mktag {} {
9313    global rowmenuid mktagtop commitinfo NS
9314
9315    set top .maketag
9316    set mktagtop $top
9317    catch {destroy $top}
9318    ttk_toplevel $top
9319    make_transient $top .
9320    ${NS}::label $top.title -text [mc "Create tag"]
9321    grid $top.title - -pady 10
9322    ${NS}::label $top.id -text [mc "ID:"]
9323    ${NS}::entry $top.sha1 -width 40
9324    $top.sha1 insert 0 $rowmenuid
9325    $top.sha1 conf -state readonly
9326    grid $top.id $top.sha1 -sticky w
9327    ${NS}::entry $top.head -width 60
9328    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9329    $top.head conf -state readonly
9330    grid x $top.head -sticky w
9331    ${NS}::label $top.tlab -text [mc "Tag name:"]
9332    ${NS}::entry $top.tag -width 60
9333    grid $top.tlab $top.tag -sticky w
9334    ${NS}::label $top.op -text [mc "Tag message is optional"]
9335    grid $top.op -columnspan 2 -sticky we
9336    ${NS}::label $top.mlab -text [mc "Tag message:"]
9337    ${NS}::entry $top.msg -width 60
9338    grid $top.mlab $top.msg -sticky w
9339    ${NS}::frame $top.buts
9340    ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
9341    ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
9342    bind $top <Key-Return> mktaggo
9343    bind $top <Key-Escape> mktagcan
9344    grid $top.buts.gen $top.buts.can
9345    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9346    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9347    grid $top.buts - -pady 10 -sticky ew
9348    focus $top.tag
9349}
9350
9351proc domktag {} {
9352    global mktagtop env tagids idtags
9353
9354    set id [$mktagtop.sha1 get]
9355    set tag [$mktagtop.tag get]
9356    set msg [$mktagtop.msg get]
9357    if {$tag == {}} {
9358        error_popup [mc "No tag name specified"] $mktagtop
9359        return 0
9360    }
9361    if {[info exists tagids($tag)]} {
9362        error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
9363        return 0
9364    }
9365    if {[catch {
9366        if {$msg != {}} {
9367            exec git tag -a -m $msg $tag $id
9368        } else {
9369            exec git tag $tag $id
9370        }
9371    } err]} {
9372        error_popup "[mc "Error creating tag:"] $err" $mktagtop
9373        return 0
9374    }
9375
9376    set tagids($tag) $id
9377    lappend idtags($id) $tag
9378    redrawtags $id
9379    addedtag $id
9380    dispneartags 0
9381    run refill_reflist
9382    return 1
9383}
9384
9385proc redrawtags {id} {
9386    global canv linehtag idpos currentid curview cmitlisted markedid
9387    global canvxmax iddrawn circleitem mainheadid circlecolors
9388    global mainheadcirclecolor
9389
9390    if {![commitinview $id $curview]} return
9391    if {![info exists iddrawn($id)]} return
9392    set row [rowofcommit $id]
9393    if {$id eq $mainheadid} {
9394        set ofill $mainheadcirclecolor
9395    } else {
9396        set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
9397    }
9398    $canv itemconf $circleitem($row) -fill $ofill
9399    $canv delete tag.$id
9400    set xt [eval drawtags $id $idpos($id)]
9401    $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
9402    set text [$canv itemcget $linehtag($id) -text]
9403    set font [$canv itemcget $linehtag($id) -font]
9404    set xr [expr {$xt + [font measure $font $text]}]
9405    if {$xr > $canvxmax} {
9406        set canvxmax $xr
9407        setcanvscroll
9408    }
9409    if {[info exists currentid] && $currentid == $id} {
9410        make_secsel $id
9411    }
9412    if {[info exists markedid] && $markedid eq $id} {
9413        make_idmark $id
9414    }
9415}
9416
9417proc mktagcan {} {
9418    global mktagtop
9419
9420    catch {destroy $mktagtop}
9421    unset mktagtop
9422}
9423
9424proc mktaggo {} {
9425    if {![domktag]} return
9426    mktagcan
9427}
9428
9429proc copysummary {} {
9430    global rowmenuid autosellen
9431
9432    set format "%h (\"%s\", %ad)"
9433    set cmd [list git show -s --pretty=format:$format --date=short]
9434    if {$autosellen < 40} {
9435        lappend cmd --abbrev=$autosellen
9436    }
9437    set summary [eval exec $cmd $rowmenuid]
9438
9439    clipboard clear
9440    clipboard append $summary
9441}
9442
9443proc writecommit {} {
9444    global rowmenuid wrcomtop commitinfo wrcomcmd NS
9445
9446    set top .writecommit
9447    set wrcomtop $top
9448    catch {destroy $top}
9449    ttk_toplevel $top
9450    make_transient $top .
9451    ${NS}::label $top.title -text [mc "Write commit to file"]
9452    grid $top.title - -pady 10
9453    ${NS}::label $top.id -text [mc "ID:"]
9454    ${NS}::entry $top.sha1 -width 40
9455    $top.sha1 insert 0 $rowmenuid
9456    $top.sha1 conf -state readonly
9457    grid $top.id $top.sha1 -sticky w
9458    ${NS}::entry $top.head -width 60
9459    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9460    $top.head conf -state readonly
9461    grid x $top.head -sticky w
9462    ${NS}::label $top.clab -text [mc "Command:"]
9463    ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
9464    grid $top.clab $top.cmd -sticky w -pady 10
9465    ${NS}::label $top.flab -text [mc "Output file:"]
9466    ${NS}::entry $top.fname -width 60
9467    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
9468    grid $top.flab $top.fname -sticky w
9469    ${NS}::frame $top.buts
9470    ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
9471    ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
9472    bind $top <Key-Return> wrcomgo
9473    bind $top <Key-Escape> wrcomcan
9474    grid $top.buts.gen $top.buts.can
9475    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9476    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9477    grid $top.buts - -pady 10 -sticky ew
9478    focus $top.fname
9479}
9480
9481proc wrcomgo {} {
9482    global wrcomtop
9483
9484    set id [$wrcomtop.sha1 get]
9485    set cmd "echo $id | [$wrcomtop.cmd get]"
9486    set fname [$wrcomtop.fname get]
9487    if {[catch {exec sh -c $cmd >$fname &} err]} {
9488        error_popup "[mc "Error writing commit:"] $err" $wrcomtop
9489    }
9490    catch {destroy $wrcomtop}
9491    unset wrcomtop
9492}
9493
9494proc wrcomcan {} {
9495    global wrcomtop
9496
9497    catch {destroy $wrcomtop}
9498    unset wrcomtop
9499}
9500
9501proc mkbranch {} {
9502    global NS rowmenuid
9503
9504    set top .branchdialog
9505
9506    set val(name) ""
9507    set val(id) $rowmenuid
9508    set val(command) [list mkbrgo $top]
9509
9510    set ui(title) [mc "Create branch"]
9511    set ui(accept) [mc "Create"]
9512
9513    branchdia $top val ui
9514}
9515
9516proc mvbranch {} {
9517    global NS
9518    global headmenuid headmenuhead
9519
9520    set top .branchdialog
9521
9522    set val(name) $headmenuhead
9523    set val(id) $headmenuid
9524    set val(command) [list mvbrgo $top $headmenuhead]
9525
9526    set ui(title) [mc "Rename branch %s" $headmenuhead]
9527    set ui(accept) [mc "Rename"]
9528
9529    branchdia $top val ui
9530}
9531
9532proc branchdia {top valvar uivar} {
9533    global NS commitinfo
9534    upvar $valvar val $uivar ui
9535
9536    catch {destroy $top}
9537    ttk_toplevel $top
9538    make_transient $top .
9539    ${NS}::label $top.title -text $ui(title)
9540    grid $top.title - -pady 10
9541    ${NS}::label $top.id -text [mc "ID:"]
9542    ${NS}::entry $top.sha1 -width 40
9543    $top.sha1 insert 0 $val(id)
9544    $top.sha1 conf -state readonly
9545    grid $top.id $top.sha1 -sticky w
9546    ${NS}::entry $top.head -width 60
9547    $top.head insert 0 [lindex $commitinfo($val(id)) 0]
9548    $top.head conf -state readonly
9549    grid x $top.head -sticky ew
9550    grid columnconfigure $top 1 -weight 1
9551    ${NS}::label $top.nlab -text [mc "Name:"]
9552    ${NS}::entry $top.name -width 40
9553    $top.name insert 0 $val(name)
9554    grid $top.nlab $top.name -sticky w
9555    ${NS}::frame $top.buts
9556    ${NS}::button $top.buts.go -text $ui(accept) -command $val(command)
9557    ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
9558    bind $top <Key-Return> $val(command)
9559    bind $top <Key-Escape> "catch {destroy $top}"
9560    grid $top.buts.go $top.buts.can
9561    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9562    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9563    grid $top.buts - -pady 10 -sticky ew
9564    focus $top.name
9565}
9566
9567proc mkbrgo {top} {
9568    global headids idheads
9569
9570    set name [$top.name get]
9571    set id [$top.sha1 get]
9572    set cmdargs {}
9573    set old_id {}
9574    if {$name eq {}} {
9575        error_popup [mc "Please specify a name for the new branch"] $top
9576        return
9577    }
9578    if {[info exists headids($name)]} {
9579        if {![confirm_popup [mc \
9580                "Branch '%s' already exists. Overwrite?" $name] $top]} {
9581            return
9582        }
9583        set old_id $headids($name)
9584        lappend cmdargs -f
9585    }
9586    catch {destroy $top}
9587    lappend cmdargs $name $id
9588    nowbusy newbranch
9589    update
9590    if {[catch {
9591        eval exec git branch $cmdargs
9592    } err]} {
9593        notbusy newbranch
9594        error_popup $err
9595    } else {
9596        notbusy newbranch
9597        if {$old_id ne {}} {
9598            movehead $id $name
9599            movedhead $id $name
9600            redrawtags $old_id
9601            redrawtags $id
9602        } else {
9603            set headids($name) $id
9604            lappend idheads($id) $name
9605            addedhead $id $name
9606            redrawtags $id
9607        }
9608        dispneartags 0
9609        run refill_reflist
9610    }
9611}
9612
9613proc mvbrgo {top prevname} {
9614    global headids idheads mainhead mainheadid
9615
9616    set name [$top.name get]
9617    set id [$top.sha1 get]
9618    set cmdargs {}
9619    if {$name eq $prevname} {
9620        catch {destroy $top}
9621        return
9622    }
9623    if {$name eq {}} {
9624        error_popup [mc "Please specify a new name for the branch"] $top
9625        return
9626    }
9627    catch {destroy $top}
9628    lappend cmdargs -m $prevname $name
9629    nowbusy renamebranch
9630    update
9631    if {[catch {
9632        eval exec git branch $cmdargs
9633    } err]} {
9634        notbusy renamebranch
9635        error_popup $err
9636    } else {
9637        notbusy renamebranch
9638        removehead $id $prevname
9639        removedhead $id $prevname
9640        set headids($name) $id
9641        lappend idheads($id) $name
9642        addedhead $id $name
9643        if {$prevname eq $mainhead} {
9644            set mainhead $name
9645            set mainheadid $id
9646        }
9647        redrawtags $id
9648        dispneartags 0
9649        run refill_reflist
9650    }
9651}
9652
9653proc exec_citool {tool_args {baseid {}}} {
9654    global commitinfo env
9655
9656    set save_env [array get env GIT_AUTHOR_*]
9657
9658    if {$baseid ne {}} {
9659        if {![info exists commitinfo($baseid)]} {
9660            getcommit $baseid
9661        }
9662        set author [lindex $commitinfo($baseid) 1]
9663        set date [lindex $commitinfo($baseid) 2]
9664        if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9665                    $author author name email]
9666            && $date ne {}} {
9667            set env(GIT_AUTHOR_NAME) $name
9668            set env(GIT_AUTHOR_EMAIL) $email
9669            set env(GIT_AUTHOR_DATE) $date
9670        }
9671    }
9672
9673    eval exec git citool $tool_args &
9674
9675    array unset env GIT_AUTHOR_*
9676    array set env $save_env
9677}
9678
9679proc cherrypick {} {
9680    global rowmenuid curview
9681    global mainhead mainheadid
9682    global gitdir
9683
9684    set oldhead [exec git rev-parse HEAD]
9685    set dheads [descheads $rowmenuid]
9686    if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
9687        set ok [confirm_popup [mc "Commit %s is already\
9688                included in branch %s -- really re-apply it?" \
9689                                   [string range $rowmenuid 0 7] $mainhead]]
9690        if {!$ok} return
9691    }
9692    nowbusy cherrypick [mc "Cherry-picking"]
9693    update
9694    # Unfortunately git-cherry-pick writes stuff to stderr even when
9695    # no error occurs, and exec takes that as an indication of error...
9696    if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9697        notbusy cherrypick
9698        if {[regexp -line \
9699                 {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9700                 $err msg fname]} {
9701            error_popup [mc "Cherry-pick failed because of local changes\
9702                        to file '%s'.\nPlease commit, reset or stash\
9703                        your changes and try again." $fname]
9704        } elseif {[regexp -line \
9705                       {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
9706                       $err]} {
9707            if {[confirm_popup [mc "Cherry-pick failed because of merge\
9708                        conflict.\nDo you wish to run git citool to\
9709                        resolve it?"]]} {
9710                # Force citool to read MERGE_MSG
9711                file delete [file join $gitdir "GITGUI_MSG"]
9712                exec_citool {} $rowmenuid
9713            }
9714        } else {
9715            error_popup $err
9716        }
9717        run updatecommits
9718        return
9719    }
9720    set newhead [exec git rev-parse HEAD]
9721    if {$newhead eq $oldhead} {
9722        notbusy cherrypick
9723        error_popup [mc "No changes committed"]
9724        return
9725    }
9726    addnewchild $newhead $oldhead
9727    if {[commitinview $oldhead $curview]} {
9728        # XXX this isn't right if we have a path limit...
9729        insertrow $newhead $oldhead $curview
9730        if {$mainhead ne {}} {
9731            movehead $newhead $mainhead
9732            movedhead $newhead $mainhead
9733        }
9734        set mainheadid $newhead
9735        redrawtags $oldhead
9736        redrawtags $newhead
9737        selbyid $newhead
9738    }
9739    notbusy cherrypick
9740}
9741
9742proc revert {} {
9743    global rowmenuid curview
9744    global mainhead mainheadid
9745    global gitdir
9746
9747    set oldhead [exec git rev-parse HEAD]
9748    set dheads [descheads $rowmenuid]
9749    if { $dheads eq {} || [lsearch -exact $dheads $oldhead] == -1 } {
9750       set ok [confirm_popup [mc "Commit %s is not\
9751           included in branch %s -- really revert it?" \
9752                      [string range $rowmenuid 0 7] $mainhead]]
9753       if {!$ok} return
9754    }
9755    nowbusy revert [mc "Reverting"]
9756    update
9757
9758    if [catch {exec git revert --no-edit $rowmenuid} err] {
9759        notbusy revert
9760        if [regexp {files would be overwritten by merge:(\n(( |\t)+[^\n]+\n)+)}\
9761                $err match files] {
9762            regsub {\n( |\t)+} $files "\n" files
9763            error_popup [mc "Revert failed because of local changes to\
9764                the following files:%s Please commit, reset or stash \
9765                your changes and try again." $files]
9766        } elseif [regexp {error: could not revert} $err] {
9767            if [confirm_popup [mc "Revert failed because of merge conflict.\n\
9768                Do you wish to run git citool to resolve it?"]] {
9769                # Force citool to read MERGE_MSG
9770                file delete [file join $gitdir "GITGUI_MSG"]
9771                exec_citool {} $rowmenuid
9772            }
9773        } else { error_popup $err }
9774        run updatecommits
9775        return
9776    }
9777
9778    set newhead [exec git rev-parse HEAD]
9779    if { $newhead eq $oldhead } {
9780        notbusy revert
9781        error_popup [mc "No changes committed"]
9782        return
9783    }
9784
9785    addnewchild $newhead $oldhead
9786
9787    if [commitinview $oldhead $curview] {
9788        # XXX this isn't right if we have a path limit...
9789        insertrow $newhead $oldhead $curview
9790        if {$mainhead ne {}} {
9791            movehead $newhead $mainhead
9792            movedhead $newhead $mainhead
9793        }
9794        set mainheadid $newhead
9795        redrawtags $oldhead
9796        redrawtags $newhead
9797        selbyid $newhead
9798    }
9799
9800    notbusy revert
9801}
9802
9803proc resethead {} {
9804    global mainhead rowmenuid confirm_ok resettype NS
9805
9806    set confirm_ok 0
9807    set w ".confirmreset"
9808    ttk_toplevel $w
9809    make_transient $w .
9810    wm title $w [mc "Confirm reset"]
9811    ${NS}::label $w.m -text \
9812        [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
9813    pack $w.m -side top -fill x -padx 20 -pady 20
9814    ${NS}::labelframe $w.f -text [mc "Reset type:"]
9815    set resettype mixed
9816    ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
9817        -text [mc "Soft: Leave working tree and index untouched"]
9818    grid $w.f.soft -sticky w
9819    ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
9820        -text [mc "Mixed: Leave working tree untouched, reset index"]
9821    grid $w.f.mixed -sticky w
9822    ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
9823        -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
9824    grid $w.f.hard -sticky w
9825    pack $w.f -side top -fill x -padx 4
9826    ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
9827    pack $w.ok -side left -fill x -padx 20 -pady 20
9828    ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
9829    bind $w <Key-Escape> [list destroy $w]
9830    pack $w.cancel -side right -fill x -padx 20 -pady 20
9831    bind $w <Visibility> "grab $w; focus $w"
9832    tkwait window $w
9833    if {!$confirm_ok} return
9834    if {[catch {set fd [open \
9835            [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
9836        error_popup $err
9837    } else {
9838        dohidelocalchanges
9839        filerun $fd [list readresetstat $fd]
9840        nowbusy reset [mc "Resetting"]
9841        selbyid $rowmenuid
9842    }
9843}
9844
9845proc readresetstat {fd} {
9846    global mainhead mainheadid showlocalchanges rprogcoord
9847
9848    if {[gets $fd line] >= 0} {
9849        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9850            set rprogcoord [expr {1.0 * $m / $n}]
9851            adjustprogress
9852        }
9853        return 1
9854    }
9855    set rprogcoord 0
9856    adjustprogress
9857    notbusy reset
9858    if {[catch {close $fd} err]} {
9859        error_popup $err
9860    }
9861    set oldhead $mainheadid
9862    set newhead [exec git rev-parse HEAD]
9863    if {$newhead ne $oldhead} {
9864        movehead $newhead $mainhead
9865        movedhead $newhead $mainhead
9866        set mainheadid $newhead
9867        redrawtags $oldhead
9868        redrawtags $newhead
9869    }
9870    if {$showlocalchanges} {
9871        doshowlocalchanges
9872    }
9873    return 0
9874}
9875
9876# context menu for a head
9877proc headmenu {x y id head} {
9878    global headmenuid headmenuhead headctxmenu mainhead headids
9879
9880    stopfinding
9881    set headmenuid $id
9882    set headmenuhead $head
9883    array set state {0 normal 1 normal 2 normal}
9884    if {[string match "remotes/*" $head]} {
9885        set localhead [string range $head [expr [string last / $head] + 1] end]
9886        if {[info exists headids($localhead)]} {
9887            set state(0) disabled
9888        }
9889        array set state {1 disabled 2 disabled}
9890    }
9891    if {$head eq $mainhead} {
9892        array set state {0 disabled 2 disabled}
9893    }
9894    foreach i {0 1 2} {
9895        $headctxmenu entryconfigure $i -state $state($i)
9896    }
9897    tk_popup $headctxmenu $x $y
9898}
9899
9900proc cobranch {} {
9901    global headmenuid headmenuhead headids
9902    global showlocalchanges
9903
9904    # check the tree is clean first??
9905    set newhead $headmenuhead
9906    set command [list | git checkout]
9907    if {[string match "remotes/*" $newhead]} {
9908        set remote $newhead
9909        set newhead [string range $newhead [expr [string last / $newhead] + 1] end]
9910        # The following check is redundant - the menu option should
9911        # be disabled to begin with...
9912        if {[info exists headids($newhead)]} {
9913            error_popup [mc "A local branch named %s exists already" $newhead]
9914            return
9915        }
9916        lappend command -b $newhead --track $remote
9917    } else {
9918        lappend command $newhead
9919    }
9920    lappend command 2>@1
9921    nowbusy checkout [mc "Checking out"]
9922    update
9923    dohidelocalchanges
9924    if {[catch {
9925        set fd [open $command r]
9926    } err]} {
9927        notbusy checkout
9928        error_popup $err
9929        if {$showlocalchanges} {
9930            dodiffindex
9931        }
9932    } else {
9933        filerun $fd [list readcheckoutstat $fd $newhead $headmenuid]
9934    }
9935}
9936
9937proc readcheckoutstat {fd newhead newheadid} {
9938    global mainhead mainheadid headids idheads showlocalchanges progresscoords
9939    global viewmainheadid curview
9940
9941    if {[gets $fd line] >= 0} {
9942        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9943            set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9944            adjustprogress
9945        }
9946        return 1
9947    }
9948    set progresscoords {0 0}
9949    adjustprogress
9950    notbusy checkout
9951    if {[catch {close $fd} err]} {
9952        error_popup $err
9953        return
9954    }
9955    set oldmainid $mainheadid
9956    if {! [info exists headids($newhead)]} {
9957        set headids($newhead) $newheadid
9958        lappend idheads($newheadid) $newhead
9959        addedhead $newheadid $newhead
9960    }
9961    set mainhead $newhead
9962    set mainheadid $newheadid
9963    set viewmainheadid($curview) $newheadid
9964    redrawtags $oldmainid
9965    redrawtags $newheadid
9966    selbyid $newheadid
9967    if {$showlocalchanges} {
9968        dodiffindex
9969    }
9970}
9971
9972proc rmbranch {} {
9973    global headmenuid headmenuhead mainhead
9974    global idheads
9975
9976    set head $headmenuhead
9977    set id $headmenuid
9978    # this check shouldn't be needed any more...
9979    if {$head eq $mainhead} {
9980        error_popup [mc "Cannot delete the currently checked-out branch"]
9981        return
9982    }
9983    set dheads [descheads $id]
9984    if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
9985        # the stuff on this branch isn't on any other branch
9986        if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9987                        branch.\nReally delete branch %s?" $head $head]]} return
9988    }
9989    nowbusy rmbranch
9990    update
9991    if {[catch {exec git branch -D $head} err]} {
9992        notbusy rmbranch
9993        error_popup $err
9994        return
9995    }
9996    removehead $id $head
9997    removedhead $id $head
9998    redrawtags $id
9999    notbusy rmbranch
10000    dispneartags 0
10001    run refill_reflist
10002}
10003
10004# Display a list of tags and heads
10005proc showrefs {} {
10006    global showrefstop bgcolor fgcolor selectbgcolor NS
10007    global bglist fglist reflistfilter reflist maincursor
10008
10009    set top .showrefs
10010    set showrefstop $top
10011    if {[winfo exists $top]} {
10012        raise $top
10013        refill_reflist
10014        return
10015    }
10016    ttk_toplevel $top
10017    wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
10018    make_transient $top .
10019    text $top.list -background $bgcolor -foreground $fgcolor \
10020        -selectbackground $selectbgcolor -font mainfont \
10021        -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
10022        -width 30 -height 20 -cursor $maincursor \
10023        -spacing1 1 -spacing3 1 -state disabled
10024    $top.list tag configure highlight -background $selectbgcolor
10025    if {![lsearch -exact $bglist $top.list]} {
10026        lappend bglist $top.list
10027        lappend fglist $top.list
10028    }
10029    ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
10030    ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
10031    grid $top.list $top.ysb -sticky nsew
10032    grid $top.xsb x -sticky ew
10033    ${NS}::frame $top.f
10034    ${NS}::label $top.f.l -text "[mc "Filter"]: "
10035    ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
10036    set reflistfilter "*"
10037    trace add variable reflistfilter write reflistfilter_change
10038    pack $top.f.e -side right -fill x -expand 1
10039    pack $top.f.l -side left
10040    grid $top.f - -sticky ew -pady 2
10041    ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
10042    bind $top <Key-Escape> [list destroy $top]
10043    grid $top.close -
10044    grid columnconfigure $top 0 -weight 1
10045    grid rowconfigure $top 0 -weight 1
10046    bind $top.list <1> {break}
10047    bind $top.list <B1-Motion> {break}
10048    bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
10049    set reflist {}
10050    refill_reflist
10051}
10052
10053proc sel_reflist {w x y} {
10054    global showrefstop reflist headids tagids otherrefids
10055
10056    if {![winfo exists $showrefstop]} return
10057    set l [lindex [split [$w index "@$x,$y"] "."] 0]
10058    set ref [lindex $reflist [expr {$l-1}]]
10059    set n [lindex $ref 0]
10060    switch -- [lindex $ref 1] {
10061        "H" {selbyid $headids($n)}
10062        "R" {selbyid $headids($n)}
10063        "T" {selbyid $tagids($n)}
10064        "o" {selbyid $otherrefids($n)}
10065    }
10066    $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
10067}
10068
10069proc unsel_reflist {} {
10070    global showrefstop
10071
10072    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
10073    $showrefstop.list tag remove highlight 0.0 end
10074}
10075
10076proc reflistfilter_change {n1 n2 op} {
10077    global reflistfilter
10078
10079    after cancel refill_reflist
10080    after 200 refill_reflist
10081}
10082
10083proc refill_reflist {} {
10084    global reflist reflistfilter showrefstop headids tagids otherrefids
10085    global curview
10086
10087    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
10088    set refs {}
10089    foreach n [array names headids] {
10090        if {[string match $reflistfilter $n]} {
10091            if {[commitinview $headids($n) $curview]} {
10092                if {[string match "remotes/*" $n]} {
10093                    lappend refs [list $n R]
10094                } else {
10095                    lappend refs [list $n H]
10096                }
10097            } else {
10098                interestedin $headids($n) {run refill_reflist}
10099            }
10100        }
10101    }
10102    foreach n [array names tagids] {
10103        if {[string match $reflistfilter $n]} {
10104            if {[commitinview $tagids($n) $curview]} {
10105                lappend refs [list $n T]
10106            } else {
10107                interestedin $tagids($n) {run refill_reflist}
10108            }
10109        }
10110    }
10111    foreach n [array names otherrefids] {
10112        if {[string match $reflistfilter $n]} {
10113            if {[commitinview $otherrefids($n) $curview]} {
10114                lappend refs [list $n o]
10115            } else {
10116                interestedin $otherrefids($n) {run refill_reflist}
10117            }
10118        }
10119    }
10120    set refs [lsort -index 0 $refs]
10121    if {$refs eq $reflist} return
10122
10123    # Update the contents of $showrefstop.list according to the
10124    # differences between $reflist (old) and $refs (new)
10125    $showrefstop.list conf -state normal
10126    $showrefstop.list insert end "\n"
10127    set i 0
10128    set j 0
10129    while {$i < [llength $reflist] || $j < [llength $refs]} {
10130        if {$i < [llength $reflist]} {
10131            if {$j < [llength $refs]} {
10132                set cmp [string compare [lindex $reflist $i 0] \
10133                             [lindex $refs $j 0]]
10134                if {$cmp == 0} {
10135                    set cmp [string compare [lindex $reflist $i 1] \
10136                                 [lindex $refs $j 1]]
10137                }
10138            } else {
10139                set cmp -1
10140            }
10141        } else {
10142            set cmp 1
10143        }
10144        switch -- $cmp {
10145            -1 {
10146                $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
10147                incr i
10148            }
10149            0 {
10150                incr i
10151                incr j
10152            }
10153            1 {
10154                set l [expr {$j + 1}]
10155                $showrefstop.list image create $l.0 -align baseline \
10156                    -image reficon-[lindex $refs $j 1] -padx 2
10157                $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
10158                incr j
10159            }
10160        }
10161    }
10162    set reflist $refs
10163    # delete last newline
10164    $showrefstop.list delete end-2c end-1c
10165    $showrefstop.list conf -state disabled
10166}
10167
10168# Stuff for finding nearby tags
10169proc getallcommits {} {
10170    global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
10171    global idheads idtags idotherrefs allparents tagobjid
10172    global gitdir
10173
10174    if {![info exists allcommits]} {
10175        set nextarc 0
10176        set allcommits 0
10177        set seeds {}
10178        set allcwait 0
10179        set cachedarcs 0
10180        set allccache [file join $gitdir "gitk.cache"]
10181        if {![catch {
10182            set f [open $allccache r]
10183            set allcwait 1
10184            getcache $f
10185        }]} return
10186    }
10187
10188    if {$allcwait} {
10189        return
10190    }
10191    set cmd [list | git rev-list --parents]
10192    set allcupdate [expr {$seeds ne {}}]
10193    if {!$allcupdate} {
10194        set ids "--all"
10195    } else {
10196        set refs [concat [array names idheads] [array names idtags] \
10197                      [array names idotherrefs]]
10198        set ids {}
10199        set tagobjs {}
10200        foreach name [array names tagobjid] {
10201            lappend tagobjs $tagobjid($name)
10202        }
10203        foreach id [lsort -unique $refs] {
10204            if {![info exists allparents($id)] &&
10205                [lsearch -exact $tagobjs $id] < 0} {
10206                lappend ids $id
10207            }
10208        }
10209        if {$ids ne {}} {
10210            foreach id $seeds {
10211                lappend ids "^$id"
10212            }
10213        }
10214    }
10215    if {$ids ne {}} {
10216        set fd [open [concat $cmd $ids] r]
10217        fconfigure $fd -blocking 0
10218        incr allcommits
10219        nowbusy allcommits
10220        filerun $fd [list getallclines $fd]
10221    } else {
10222        dispneartags 0
10223    }
10224}
10225
10226# Since most commits have 1 parent and 1 child, we group strings of
10227# such commits into "arcs" joining branch/merge points (BMPs), which
10228# are commits that either don't have 1 parent or don't have 1 child.
10229#
10230# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
10231# arcout(id) - outgoing arcs for BMP
10232# arcids(a) - list of IDs on arc including end but not start
10233# arcstart(a) - BMP ID at start of arc
10234# arcend(a) - BMP ID at end of arc
10235# growing(a) - arc a is still growing
10236# arctags(a) - IDs out of arcids (excluding end) that have tags
10237# archeads(a) - IDs out of arcids (excluding end) that have heads
10238# The start of an arc is at the descendent end, so "incoming" means
10239# coming from descendents, and "outgoing" means going towards ancestors.
10240
10241proc getallclines {fd} {
10242    global allparents allchildren idtags idheads nextarc
10243    global arcnos arcids arctags arcout arcend arcstart archeads growing
10244    global seeds allcommits cachedarcs allcupdate
10245
10246    set nid 0
10247    while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
10248        set id [lindex $line 0]
10249        if {[info exists allparents($id)]} {
10250            # seen it already
10251            continue
10252        }
10253        set cachedarcs 0
10254        set olds [lrange $line 1 end]
10255        set allparents($id) $olds
10256        if {![info exists allchildren($id)]} {
10257            set allchildren($id) {}
10258            set arcnos($id) {}
10259            lappend seeds $id
10260        } else {
10261            set a $arcnos($id)
10262            if {[llength $olds] == 1 && [llength $a] == 1} {
10263                lappend arcids($a) $id
10264                if {[info exists idtags($id)]} {
10265                    lappend arctags($a) $id
10266                }
10267                if {[info exists idheads($id)]} {
10268                    lappend archeads($a) $id
10269                }
10270                if {[info exists allparents($olds)]} {
10271                    # seen parent already
10272                    if {![info exists arcout($olds)]} {
10273                        splitarc $olds
10274                    }
10275                    lappend arcids($a) $olds
10276                    set arcend($a) $olds
10277                    unset growing($a)
10278                }
10279                lappend allchildren($olds) $id
10280                lappend arcnos($olds) $a
10281                continue
10282            }
10283        }
10284        foreach a $arcnos($id) {
10285            lappend arcids($a) $id
10286            set arcend($a) $id
10287            unset growing($a)
10288        }
10289
10290        set ao {}
10291        foreach p $olds {
10292            lappend allchildren($p) $id
10293            set a [incr nextarc]
10294            set arcstart($a) $id
10295            set archeads($a) {}
10296            set arctags($a) {}
10297            set archeads($a) {}
10298            set arcids($a) {}
10299            lappend ao $a
10300            set growing($a) 1
10301            if {[info exists allparents($p)]} {
10302                # seen it already, may need to make a new branch
10303                if {![info exists arcout($p)]} {
10304                    splitarc $p
10305                }
10306                lappend arcids($a) $p
10307                set arcend($a) $p
10308                unset growing($a)
10309            }
10310            lappend arcnos($p) $a
10311        }
10312        set arcout($id) $ao
10313    }
10314    if {$nid > 0} {
10315        global cached_dheads cached_dtags cached_atags
10316        unset -nocomplain cached_dheads
10317        unset -nocomplain cached_dtags
10318        unset -nocomplain cached_atags
10319    }
10320    if {![eof $fd]} {
10321        return [expr {$nid >= 1000? 2: 1}]
10322    }
10323    set cacheok 1
10324    if {[catch {
10325        fconfigure $fd -blocking 1
10326        close $fd
10327    } err]} {
10328        # got an error reading the list of commits
10329        # if we were updating, try rereading the whole thing again
10330        if {$allcupdate} {
10331            incr allcommits -1
10332            dropcache $err
10333            return
10334        }
10335        error_popup "[mc "Error reading commit topology information;\
10336                branch and preceding/following tag information\
10337                will be incomplete."]\n($err)"
10338        set cacheok 0
10339    }
10340    if {[incr allcommits -1] == 0} {
10341        notbusy allcommits
10342        if {$cacheok} {
10343            run savecache
10344        }
10345    }
10346    dispneartags 0
10347    return 0
10348}
10349
10350proc recalcarc {a} {
10351    global arctags archeads arcids idtags idheads
10352
10353    set at {}
10354    set ah {}
10355    foreach id [lrange $arcids($a) 0 end-1] {
10356        if {[info exists idtags($id)]} {
10357            lappend at $id
10358        }
10359        if {[info exists idheads($id)]} {
10360            lappend ah $id
10361        }
10362    }
10363    set arctags($a) $at
10364    set archeads($a) $ah
10365}
10366
10367proc splitarc {p} {
10368    global arcnos arcids nextarc arctags archeads idtags idheads
10369    global arcstart arcend arcout allparents growing
10370
10371    set a $arcnos($p)
10372    if {[llength $a] != 1} {
10373        puts "oops splitarc called but [llength $a] arcs already"
10374        return
10375    }
10376    set a [lindex $a 0]
10377    set i [lsearch -exact $arcids($a) $p]
10378    if {$i < 0} {
10379        puts "oops splitarc $p not in arc $a"
10380        return
10381    }
10382    set na [incr nextarc]
10383    if {[info exists arcend($a)]} {
10384        set arcend($na) $arcend($a)
10385    } else {
10386        set l [lindex $allparents([lindex $arcids($a) end]) 0]
10387        set j [lsearch -exact $arcnos($l) $a]
10388        set arcnos($l) [lreplace $arcnos($l) $j $j $na]
10389    }
10390    set tail [lrange $arcids($a) [expr {$i+1}] end]
10391    set arcids($a) [lrange $arcids($a) 0 $i]
10392    set arcend($a) $p
10393    set arcstart($na) $p
10394    set arcout($p) $na
10395    set arcids($na) $tail
10396    if {[info exists growing($a)]} {
10397        set growing($na) 1
10398        unset growing($a)
10399    }
10400
10401    foreach id $tail {
10402        if {[llength $arcnos($id)] == 1} {
10403            set arcnos($id) $na
10404        } else {
10405            set j [lsearch -exact $arcnos($id) $a]
10406            set arcnos($id) [lreplace $arcnos($id) $j $j $na]
10407        }
10408    }
10409
10410    # reconstruct tags and heads lists
10411    if {$arctags($a) ne {} || $archeads($a) ne {}} {
10412        recalcarc $a
10413        recalcarc $na
10414    } else {
10415        set arctags($na) {}
10416        set archeads($na) {}
10417    }
10418}
10419
10420# Update things for a new commit added that is a child of one
10421# existing commit.  Used when cherry-picking.
10422proc addnewchild {id p} {
10423    global allparents allchildren idtags nextarc
10424    global arcnos arcids arctags arcout arcend arcstart archeads growing
10425    global seeds allcommits
10426
10427    if {![info exists allcommits] || ![info exists arcnos($p)]} return
10428    set allparents($id) [list $p]
10429    set allchildren($id) {}
10430    set arcnos($id) {}
10431    lappend seeds $id
10432    lappend allchildren($p) $id
10433    set a [incr nextarc]
10434    set arcstart($a) $id
10435    set archeads($a) {}
10436    set arctags($a) {}
10437    set arcids($a) [list $p]
10438    set arcend($a) $p
10439    if {![info exists arcout($p)]} {
10440        splitarc $p
10441    }
10442    lappend arcnos($p) $a
10443    set arcout($id) [list $a]
10444}
10445
10446# This implements a cache for the topology information.
10447# The cache saves, for each arc, the start and end of the arc,
10448# the ids on the arc, and the outgoing arcs from the end.
10449proc readcache {f} {
10450    global arcnos arcids arcout arcstart arcend arctags archeads nextarc
10451    global idtags idheads allparents cachedarcs possible_seeds seeds growing
10452    global allcwait
10453
10454    set a $nextarc
10455    set lim $cachedarcs
10456    if {$lim - $a > 500} {
10457        set lim [expr {$a + 500}]
10458    }
10459    if {[catch {
10460        if {$a == $lim} {
10461            # finish reading the cache and setting up arctags, etc.
10462            set line [gets $f]
10463            if {$line ne "1"} {error "bad final version"}
10464            close $f
10465            foreach id [array names idtags] {
10466                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10467                    [llength $allparents($id)] == 1} {
10468                    set a [lindex $arcnos($id) 0]
10469                    if {$arctags($a) eq {}} {
10470                        recalcarc $a
10471                    }
10472                }
10473            }
10474            foreach id [array names idheads] {
10475                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10476                    [llength $allparents($id)] == 1} {
10477                    set a [lindex $arcnos($id) 0]
10478                    if {$archeads($a) eq {}} {
10479                        recalcarc $a
10480                    }
10481                }
10482            }
10483            foreach id [lsort -unique $possible_seeds] {
10484                if {$arcnos($id) eq {}} {
10485                    lappend seeds $id
10486                }
10487            }
10488            set allcwait 0
10489        } else {
10490            while {[incr a] <= $lim} {
10491                set line [gets $f]
10492                if {[llength $line] != 3} {error "bad line"}
10493                set s [lindex $line 0]
10494                set arcstart($a) $s
10495                lappend arcout($s) $a
10496                if {![info exists arcnos($s)]} {
10497                    lappend possible_seeds $s
10498                    set arcnos($s) {}
10499                }
10500                set e [lindex $line 1]
10501                if {$e eq {}} {
10502                    set growing($a) 1
10503                } else {
10504                    set arcend($a) $e
10505                    if {![info exists arcout($e)]} {
10506                        set arcout($e) {}
10507                    }
10508                }
10509                set arcids($a) [lindex $line 2]
10510                foreach id $arcids($a) {
10511                    lappend allparents($s) $id
10512                    set s $id
10513                    lappend arcnos($id) $a
10514                }
10515                if {![info exists allparents($s)]} {
10516                    set allparents($s) {}
10517                }
10518                set arctags($a) {}
10519                set archeads($a) {}
10520            }
10521            set nextarc [expr {$a - 1}]
10522        }
10523    } err]} {
10524        dropcache $err
10525        return 0
10526    }
10527    if {!$allcwait} {
10528        getallcommits
10529    }
10530    return $allcwait
10531}
10532
10533proc getcache {f} {
10534    global nextarc cachedarcs possible_seeds
10535
10536    if {[catch {
10537        set line [gets $f]
10538        if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
10539        # make sure it's an integer
10540        set cachedarcs [expr {int([lindex $line 1])}]
10541        if {$cachedarcs < 0} {error "bad number of arcs"}
10542        set nextarc 0
10543        set possible_seeds {}
10544        run readcache $f
10545    } err]} {
10546        dropcache $err
10547    }
10548    return 0
10549}
10550
10551proc dropcache {err} {
10552    global allcwait nextarc cachedarcs seeds
10553
10554    #puts "dropping cache ($err)"
10555    foreach v {arcnos arcout arcids arcstart arcend growing \
10556                   arctags archeads allparents allchildren} {
10557        global $v
10558        unset -nocomplain $v
10559    }
10560    set allcwait 0
10561    set nextarc 0
10562    set cachedarcs 0
10563    set seeds {}
10564    getallcommits
10565}
10566
10567proc writecache {f} {
10568    global cachearc cachedarcs allccache
10569    global arcstart arcend arcnos arcids arcout
10570
10571    set a $cachearc
10572    set lim $cachedarcs
10573    if {$lim - $a > 1000} {
10574        set lim [expr {$a + 1000}]
10575    }
10576    if {[catch {
10577        while {[incr a] <= $lim} {
10578            if {[info exists arcend($a)]} {
10579                puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
10580            } else {
10581                puts $f [list $arcstart($a) {} $arcids($a)]
10582            }
10583        }
10584    } err]} {
10585        catch {close $f}
10586        catch {file delete $allccache}
10587        #puts "writing cache failed ($err)"
10588        return 0
10589    }
10590    set cachearc [expr {$a - 1}]
10591    if {$a > $cachedarcs} {
10592        puts $f "1"
10593        close $f
10594        return 0
10595    }
10596    return 1
10597}
10598
10599proc savecache {} {
10600    global nextarc cachedarcs cachearc allccache
10601
10602    if {$nextarc == $cachedarcs} return
10603    set cachearc 0
10604    set cachedarcs $nextarc
10605    catch {
10606        set f [open $allccache w]
10607        puts $f [list 1 $cachedarcs]
10608        run writecache $f
10609    }
10610}
10611
10612# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
10613# or 0 if neither is true.
10614proc anc_or_desc {a b} {
10615    global arcout arcstart arcend arcnos cached_isanc
10616
10617    if {$arcnos($a) eq $arcnos($b)} {
10618        # Both are on the same arc(s); either both are the same BMP,
10619        # or if one is not a BMP, the other is also not a BMP or is
10620        # the BMP at end of the arc (and it only has 1 incoming arc).
10621        # Or both can be BMPs with no incoming arcs.
10622        if {$a eq $b || $arcnos($a) eq {}} {
10623            return 0
10624        }
10625        # assert {[llength $arcnos($a)] == 1}
10626        set arc [lindex $arcnos($a) 0]
10627        set i [lsearch -exact $arcids($arc) $a]
10628        set j [lsearch -exact $arcids($arc) $b]
10629        if {$i < 0 || $i > $j} {
10630            return 1
10631        } else {
10632            return -1
10633        }
10634    }
10635
10636    if {![info exists arcout($a)]} {
10637        set arc [lindex $arcnos($a) 0]
10638        if {[info exists arcend($arc)]} {
10639            set aend $arcend($arc)
10640        } else {
10641            set aend {}
10642        }
10643        set a $arcstart($arc)
10644    } else {
10645        set aend $a
10646    }
10647    if {![info exists arcout($b)]} {
10648        set arc [lindex $arcnos($b) 0]
10649        if {[info exists arcend($arc)]} {
10650            set bend $arcend($arc)
10651        } else {
10652            set bend {}
10653        }
10654        set b $arcstart($arc)
10655    } else {
10656        set bend $b
10657    }
10658    if {$a eq $bend} {
10659        return 1
10660    }
10661    if {$b eq $aend} {
10662        return -1
10663    }
10664    if {[info exists cached_isanc($a,$bend)]} {
10665        if {$cached_isanc($a,$bend)} {
10666            return 1
10667        }
10668    }
10669    if {[info exists cached_isanc($b,$aend)]} {
10670        if {$cached_isanc($b,$aend)} {
10671            return -1
10672        }
10673        if {[info exists cached_isanc($a,$bend)]} {
10674            return 0
10675        }
10676    }
10677
10678    set todo [list $a $b]
10679    set anc($a) a
10680    set anc($b) b
10681    for {set i 0} {$i < [llength $todo]} {incr i} {
10682        set x [lindex $todo $i]
10683        if {$anc($x) eq {}} {
10684            continue
10685        }
10686        foreach arc $arcnos($x) {
10687            set xd $arcstart($arc)
10688            if {$xd eq $bend} {
10689                set cached_isanc($a,$bend) 1
10690                set cached_isanc($b,$aend) 0
10691                return 1
10692            } elseif {$xd eq $aend} {
10693                set cached_isanc($b,$aend) 1
10694                set cached_isanc($a,$bend) 0
10695                return -1
10696            }
10697            if {![info exists anc($xd)]} {
10698                set anc($xd) $anc($x)
10699                lappend todo $xd
10700            } elseif {$anc($xd) ne $anc($x)} {
10701                set anc($xd) {}
10702            }
10703        }
10704    }
10705    set cached_isanc($a,$bend) 0
10706    set cached_isanc($b,$aend) 0
10707    return 0
10708}
10709
10710# This identifies whether $desc has an ancestor that is
10711# a growing tip of the graph and which is not an ancestor of $anc
10712# and returns 0 if so and 1 if not.
10713# If we subsequently discover a tag on such a growing tip, and that
10714# turns out to be a descendent of $anc (which it could, since we
10715# don't necessarily see children before parents), then $desc
10716# isn't a good choice to display as a descendent tag of
10717# $anc (since it is the descendent of another tag which is
10718# a descendent of $anc).  Similarly, $anc isn't a good choice to
10719# display as a ancestor tag of $desc.
10720#
10721proc is_certain {desc anc} {
10722    global arcnos arcout arcstart arcend growing problems
10723
10724    set certain {}
10725    if {[llength $arcnos($anc)] == 1} {
10726        # tags on the same arc are certain
10727        if {$arcnos($desc) eq $arcnos($anc)} {
10728            return 1
10729        }
10730        if {![info exists arcout($anc)]} {
10731            # if $anc is partway along an arc, use the start of the arc instead
10732            set a [lindex $arcnos($anc) 0]
10733            set anc $arcstart($a)
10734        }
10735    }
10736    if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
10737        set x $desc
10738    } else {
10739        set a [lindex $arcnos($desc) 0]
10740        set x $arcend($a)
10741    }
10742    if {$x == $anc} {
10743        return 1
10744    }
10745    set anclist [list $x]
10746    set dl($x) 1
10747    set nnh 1
10748    set ngrowanc 0
10749    for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
10750        set x [lindex $anclist $i]
10751        if {$dl($x)} {
10752            incr nnh -1
10753        }
10754        set done($x) 1
10755        foreach a $arcout($x) {
10756            if {[info exists growing($a)]} {
10757                if {![info exists growanc($x)] && $dl($x)} {
10758                    set growanc($x) 1
10759                    incr ngrowanc
10760                }
10761            } else {
10762                set y $arcend($a)
10763                if {[info exists dl($y)]} {
10764                    if {$dl($y)} {
10765                        if {!$dl($x)} {
10766                            set dl($y) 0
10767                            if {![info exists done($y)]} {
10768                                incr nnh -1
10769                            }
10770                            if {[info exists growanc($x)]} {
10771                                incr ngrowanc -1
10772                            }
10773                            set xl [list $y]
10774                            for {set k 0} {$k < [llength $xl]} {incr k} {
10775                                set z [lindex $xl $k]
10776                                foreach c $arcout($z) {
10777                                    if {[info exists arcend($c)]} {
10778                                        set v $arcend($c)
10779                                        if {[info exists dl($v)] && $dl($v)} {
10780                                            set dl($v) 0
10781                                            if {![info exists done($v)]} {
10782                                                incr nnh -1
10783                                            }
10784                                            if {[info exists growanc($v)]} {
10785                                                incr ngrowanc -1
10786                                            }
10787                                            lappend xl $v
10788                                        }
10789                                    }
10790                                }
10791                            }
10792                        }
10793                    }
10794                } elseif {$y eq $anc || !$dl($x)} {
10795                    set dl($y) 0
10796                    lappend anclist $y
10797                } else {
10798                    set dl($y) 1
10799                    lappend anclist $y
10800                    incr nnh
10801                }
10802            }
10803        }
10804    }
10805    foreach x [array names growanc] {
10806        if {$dl($x)} {
10807            return 0
10808        }
10809        return 0
10810    }
10811    return 1
10812}
10813
10814proc validate_arctags {a} {
10815    global arctags idtags
10816
10817    set i -1
10818    set na $arctags($a)
10819    foreach id $arctags($a) {
10820        incr i
10821        if {![info exists idtags($id)]} {
10822            set na [lreplace $na $i $i]
10823            incr i -1
10824        }
10825    }
10826    set arctags($a) $na
10827}
10828
10829proc validate_archeads {a} {
10830    global archeads idheads
10831
10832    set i -1
10833    set na $archeads($a)
10834    foreach id $archeads($a) {
10835        incr i
10836        if {![info exists idheads($id)]} {
10837            set na [lreplace $na $i $i]
10838            incr i -1
10839        }
10840    }
10841    set archeads($a) $na
10842}
10843
10844# Return the list of IDs that have tags that are descendents of id,
10845# ignoring IDs that are descendents of IDs already reported.
10846proc desctags {id} {
10847    global arcnos arcstart arcids arctags idtags allparents
10848    global growing cached_dtags
10849
10850    if {![info exists allparents($id)]} {
10851        return {}
10852    }
10853    set t1 [clock clicks -milliseconds]
10854    set argid $id
10855    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10856        # part-way along an arc; check that arc first
10857        set a [lindex $arcnos($id) 0]
10858        if {$arctags($a) ne {}} {
10859            validate_arctags $a
10860            set i [lsearch -exact $arcids($a) $id]
10861            set tid {}
10862            foreach t $arctags($a) {
10863                set j [lsearch -exact $arcids($a) $t]
10864                if {$j >= $i} break
10865                set tid $t
10866            }
10867            if {$tid ne {}} {
10868                return $tid
10869            }
10870        }
10871        set id $arcstart($a)
10872        if {[info exists idtags($id)]} {
10873            return $id
10874        }
10875    }
10876    if {[info exists cached_dtags($id)]} {
10877        return $cached_dtags($id)
10878    }
10879
10880    set origid $id
10881    set todo [list $id]
10882    set queued($id) 1
10883    set nc 1
10884    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10885        set id [lindex $todo $i]
10886        set done($id) 1
10887        set ta [info exists hastaggedancestor($id)]
10888        if {!$ta} {
10889            incr nc -1
10890        }
10891        # ignore tags on starting node
10892        if {!$ta && $i > 0} {
10893            if {[info exists idtags($id)]} {
10894                set tagloc($id) $id
10895                set ta 1
10896            } elseif {[info exists cached_dtags($id)]} {
10897                set tagloc($id) $cached_dtags($id)
10898                set ta 1
10899            }
10900        }
10901        foreach a $arcnos($id) {
10902            set d $arcstart($a)
10903            if {!$ta && $arctags($a) ne {}} {
10904                validate_arctags $a
10905                if {$arctags($a) ne {}} {
10906                    lappend tagloc($id) [lindex $arctags($a) end]
10907                }
10908            }
10909            if {$ta || $arctags($a) ne {}} {
10910                set tomark [list $d]
10911                for {set j 0} {$j < [llength $tomark]} {incr j} {
10912                    set dd [lindex $tomark $j]
10913                    if {![info exists hastaggedancestor($dd)]} {
10914                        if {[info exists done($dd)]} {
10915                            foreach b $arcnos($dd) {
10916                                lappend tomark $arcstart($b)
10917                            }
10918                            if {[info exists tagloc($dd)]} {
10919                                unset tagloc($dd)
10920                            }
10921                        } elseif {[info exists queued($dd)]} {
10922                            incr nc -1
10923                        }
10924                        set hastaggedancestor($dd) 1
10925                    }
10926                }
10927            }
10928            if {![info exists queued($d)]} {
10929                lappend todo $d
10930                set queued($d) 1
10931                if {![info exists hastaggedancestor($d)]} {
10932                    incr nc
10933                }
10934            }
10935        }
10936    }
10937    set tags {}
10938    foreach id [array names tagloc] {
10939        if {![info exists hastaggedancestor($id)]} {
10940            foreach t $tagloc($id) {
10941                if {[lsearch -exact $tags $t] < 0} {
10942                    lappend tags $t
10943                }
10944            }
10945        }
10946    }
10947    set t2 [clock clicks -milliseconds]
10948    set loopix $i
10949
10950    # remove tags that are descendents of other tags
10951    for {set i 0} {$i < [llength $tags]} {incr i} {
10952        set a [lindex $tags $i]
10953        for {set j 0} {$j < $i} {incr j} {
10954            set b [lindex $tags $j]
10955            set r [anc_or_desc $a $b]
10956            if {$r == 1} {
10957                set tags [lreplace $tags $j $j]
10958                incr j -1
10959                incr i -1
10960            } elseif {$r == -1} {
10961                set tags [lreplace $tags $i $i]
10962                incr i -1
10963                break
10964            }
10965        }
10966    }
10967
10968    if {[array names growing] ne {}} {
10969        # graph isn't finished, need to check if any tag could get
10970        # eclipsed by another tag coming later.  Simply ignore any
10971        # tags that could later get eclipsed.
10972        set ctags {}
10973        foreach t $tags {
10974            if {[is_certain $t $origid]} {
10975                lappend ctags $t
10976            }
10977        }
10978        if {$tags eq $ctags} {
10979            set cached_dtags($origid) $tags
10980        } else {
10981            set tags $ctags
10982        }
10983    } else {
10984        set cached_dtags($origid) $tags
10985    }
10986    set t3 [clock clicks -milliseconds]
10987    if {0 && $t3 - $t1 >= 100} {
10988        puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10989            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10990    }
10991    return $tags
10992}
10993
10994proc anctags {id} {
10995    global arcnos arcids arcout arcend arctags idtags allparents
10996    global growing cached_atags
10997
10998    if {![info exists allparents($id)]} {
10999        return {}
11000    }
11001    set t1 [clock clicks -milliseconds]
11002    set argid $id
11003    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
11004        # part-way along an arc; check that arc first
11005        set a [lindex $arcnos($id) 0]
11006        if {$arctags($a) ne {}} {
11007            validate_arctags $a
11008            set i [lsearch -exact $arcids($a) $id]
11009            foreach t $arctags($a) {
11010                set j [lsearch -exact $arcids($a) $t]
11011                if {$j > $i} {
11012                    return $t
11013                }
11014            }
11015        }
11016        if {![info exists arcend($a)]} {
11017            return {}
11018        }
11019        set id $arcend($a)
11020        if {[info exists idtags($id)]} {
11021            return $id
11022        }
11023    }
11024    if {[info exists cached_atags($id)]} {
11025        return $cached_atags($id)
11026    }
11027
11028    set origid $id
11029    set todo [list $id]
11030    set queued($id) 1
11031    set taglist {}
11032    set nc 1
11033    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
11034        set id [lindex $todo $i]
11035        set done($id) 1
11036        set td [info exists hastaggeddescendent($id)]
11037        if {!$td} {
11038            incr nc -1
11039        }
11040        # ignore tags on starting node
11041        if {!$td && $i > 0} {
11042            if {[info exists idtags($id)]} {
11043                set tagloc($id) $id
11044                set td 1
11045            } elseif {[info exists cached_atags($id)]} {
11046                set tagloc($id) $cached_atags($id)
11047                set td 1
11048            }
11049        }
11050        foreach a $arcout($id) {
11051            if {!$td && $arctags($a) ne {}} {
11052                validate_arctags $a
11053                if {$arctags($a) ne {}} {
11054                    lappend tagloc($id) [lindex $arctags($a) 0]
11055                }
11056            }
11057            if {![info exists arcend($a)]} continue
11058            set d $arcend($a)
11059            if {$td || $arctags($a) ne {}} {
11060                set tomark [list $d]
11061                for {set j 0} {$j < [llength $tomark]} {incr j} {
11062                    set dd [lindex $tomark $j]
11063                    if {![info exists hastaggeddescendent($dd)]} {
11064                        if {[info exists done($dd)]} {
11065                            foreach b $arcout($dd) {
11066                                if {[info exists arcend($b)]} {
11067                                    lappend tomark $arcend($b)
11068                                }
11069                            }
11070                            if {[info exists tagloc($dd)]} {
11071                                unset tagloc($dd)
11072                            }
11073                        } elseif {[info exists queued($dd)]} {
11074                            incr nc -1
11075                        }
11076                        set hastaggeddescendent($dd) 1
11077                    }
11078                }
11079            }
11080            if {![info exists queued($d)]} {
11081                lappend todo $d
11082                set queued($d) 1
11083                if {![info exists hastaggeddescendent($d)]} {
11084                    incr nc
11085                }
11086            }
11087        }
11088    }
11089    set t2 [clock clicks -milliseconds]
11090    set loopix $i
11091    set tags {}
11092    foreach id [array names tagloc] {
11093        if {![info exists hastaggeddescendent($id)]} {
11094            foreach t $tagloc($id) {
11095                if {[lsearch -exact $tags $t] < 0} {
11096                    lappend tags $t
11097                }
11098            }
11099        }
11100    }
11101
11102    # remove tags that are ancestors of other tags
11103    for {set i 0} {$i < [llength $tags]} {incr i} {
11104        set a [lindex $tags $i]
11105        for {set j 0} {$j < $i} {incr j} {
11106            set b [lindex $tags $j]
11107            set r [anc_or_desc $a $b]
11108            if {$r == -1} {
11109                set tags [lreplace $tags $j $j]
11110                incr j -1
11111                incr i -1
11112            } elseif {$r == 1} {
11113                set tags [lreplace $tags $i $i]
11114                incr i -1
11115                break
11116            }
11117        }
11118    }
11119
11120    if {[array names growing] ne {}} {
11121        # graph isn't finished, need to check if any tag could get
11122        # eclipsed by another tag coming later.  Simply ignore any
11123        # tags that could later get eclipsed.
11124        set ctags {}
11125        foreach t $tags {
11126            if {[is_certain $origid $t]} {
11127                lappend ctags $t
11128            }
11129        }
11130        if {$tags eq $ctags} {
11131            set cached_atags($origid) $tags
11132        } else {
11133            set tags $ctags
11134        }
11135    } else {
11136        set cached_atags($origid) $tags
11137    }
11138    set t3 [clock clicks -milliseconds]
11139    if {0 && $t3 - $t1 >= 100} {
11140        puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
11141            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
11142    }
11143    return $tags
11144}
11145
11146# Return the list of IDs that have heads that are descendents of id,
11147# including id itself if it has a head.
11148proc descheads {id} {
11149    global arcnos arcstart arcids archeads idheads cached_dheads
11150    global allparents arcout
11151
11152    if {![info exists allparents($id)]} {
11153        return {}
11154    }
11155    set aret {}
11156    if {![info exists arcout($id)]} {
11157        # part-way along an arc; check it first
11158        set a [lindex $arcnos($id) 0]
11159        if {$archeads($a) ne {}} {
11160            validate_archeads $a
11161            set i [lsearch -exact $arcids($a) $id]
11162            foreach t $archeads($a) {
11163                set j [lsearch -exact $arcids($a) $t]
11164                if {$j > $i} break
11165                lappend aret $t
11166            }
11167        }
11168        set id $arcstart($a)
11169    }
11170    set origid $id
11171    set todo [list $id]
11172    set seen($id) 1
11173    set ret {}
11174    for {set i 0} {$i < [llength $todo]} {incr i} {
11175        set id [lindex $todo $i]
11176        if {[info exists cached_dheads($id)]} {
11177            set ret [concat $ret $cached_dheads($id)]
11178        } else {
11179            if {[info exists idheads($id)]} {
11180                lappend ret $id
11181            }
11182            foreach a $arcnos($id) {
11183                if {$archeads($a) ne {}} {
11184                    validate_archeads $a
11185                    if {$archeads($a) ne {}} {
11186                        set ret [concat $ret $archeads($a)]
11187                    }
11188                }
11189                set d $arcstart($a)
11190                if {![info exists seen($d)]} {
11191                    lappend todo $d
11192                    set seen($d) 1
11193                }
11194            }
11195        }
11196    }
11197    set ret [lsort -unique $ret]
11198    set cached_dheads($origid) $ret
11199    return [concat $ret $aret]
11200}
11201
11202proc addedtag {id} {
11203    global arcnos arcout cached_dtags cached_atags
11204
11205    if {![info exists arcnos($id)]} return
11206    if {![info exists arcout($id)]} {
11207        recalcarc [lindex $arcnos($id) 0]
11208    }
11209    unset -nocomplain cached_dtags
11210    unset -nocomplain cached_atags
11211}
11212
11213proc addedhead {hid head} {
11214    global arcnos arcout cached_dheads
11215
11216    if {![info exists arcnos($hid)]} return
11217    if {![info exists arcout($hid)]} {
11218        recalcarc [lindex $arcnos($hid) 0]
11219    }
11220    unset -nocomplain cached_dheads
11221}
11222
11223proc removedhead {hid head} {
11224    global cached_dheads
11225
11226    unset -nocomplain cached_dheads
11227}
11228
11229proc movedhead {hid head} {
11230    global arcnos arcout cached_dheads
11231
11232    if {![info exists arcnos($hid)]} return
11233    if {![info exists arcout($hid)]} {
11234        recalcarc [lindex $arcnos($hid) 0]
11235    }
11236    unset -nocomplain cached_dheads
11237}
11238
11239proc changedrefs {} {
11240    global cached_dheads cached_dtags cached_atags cached_tagcontent
11241    global arctags archeads arcnos arcout idheads idtags
11242
11243    foreach id [concat [array names idheads] [array names idtags]] {
11244        if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
11245            set a [lindex $arcnos($id) 0]
11246            if {![info exists donearc($a)]} {
11247                recalcarc $a
11248                set donearc($a) 1
11249            }
11250        }
11251    }
11252    unset -nocomplain cached_tagcontent
11253    unset -nocomplain cached_dtags
11254    unset -nocomplain cached_atags
11255    unset -nocomplain cached_dheads
11256}
11257
11258proc rereadrefs {} {
11259    global idtags idheads idotherrefs mainheadid
11260
11261    set refids [concat [array names idtags] \
11262                    [array names idheads] [array names idotherrefs]]
11263    foreach id $refids {
11264        if {![info exists ref($id)]} {
11265            set ref($id) [listrefs $id]
11266        }
11267    }
11268    set oldmainhead $mainheadid
11269    readrefs
11270    changedrefs
11271    set refids [lsort -unique [concat $refids [array names idtags] \
11272                        [array names idheads] [array names idotherrefs]]]
11273    foreach id $refids {
11274        set v [listrefs $id]
11275        if {![info exists ref($id)] || $ref($id) != $v} {
11276            redrawtags $id
11277        }
11278    }
11279    if {$oldmainhead ne $mainheadid} {
11280        redrawtags $oldmainhead
11281        redrawtags $mainheadid
11282    }
11283    run refill_reflist
11284}
11285
11286proc listrefs {id} {
11287    global idtags idheads idotherrefs
11288
11289    set x {}
11290    if {[info exists idtags($id)]} {
11291        set x $idtags($id)
11292    }
11293    set y {}
11294    if {[info exists idheads($id)]} {
11295        set y $idheads($id)
11296    }
11297    set z {}
11298    if {[info exists idotherrefs($id)]} {
11299        set z $idotherrefs($id)
11300    }
11301    return [list $x $y $z]
11302}
11303
11304proc add_tag_ctext {tag} {
11305    global ctext cached_tagcontent tagids
11306
11307    if {![info exists cached_tagcontent($tag)]} {
11308        catch {
11309            set cached_tagcontent($tag) [exec git cat-file -p $tag]
11310        }
11311    }
11312    $ctext insert end "[mc "Tag"]: $tag\n" bold
11313    if {[info exists cached_tagcontent($tag)]} {
11314        set text $cached_tagcontent($tag)
11315    } else {
11316        set text "[mc "Id"]:  $tagids($tag)"
11317    }
11318    appendwithlinks $text {}
11319}
11320
11321proc showtag {tag isnew} {
11322    global ctext cached_tagcontent tagids linknum tagobjid
11323
11324    if {$isnew} {
11325        addtohistory [list showtag $tag 0] savectextpos
11326    }
11327    $ctext conf -state normal
11328    clear_ctext
11329    settabs 0
11330    set linknum 0
11331    add_tag_ctext $tag
11332    maybe_scroll_ctext 1
11333    $ctext conf -state disabled
11334    init_flist {}
11335}
11336
11337proc showtags {id isnew} {
11338    global idtags ctext linknum
11339
11340    if {$isnew} {
11341        addtohistory [list showtags $id 0] savectextpos
11342    }
11343    $ctext conf -state normal
11344    clear_ctext
11345    settabs 0
11346    set linknum 0
11347    set sep {}
11348    foreach tag $idtags($id) {
11349        $ctext insert end $sep
11350        add_tag_ctext $tag
11351        set sep "\n\n"
11352    }
11353    maybe_scroll_ctext 1
11354    $ctext conf -state disabled
11355    init_flist {}
11356}
11357
11358proc doquit {} {
11359    global stopped
11360    global gitktmpdir
11361
11362    set stopped 100
11363    savestuff .
11364    destroy .
11365
11366    if {[info exists gitktmpdir]} {
11367        catch {file delete -force $gitktmpdir}
11368    }
11369}
11370
11371proc mkfontdisp {font top which} {
11372    global fontattr fontpref $font NS use_ttk
11373
11374    set fontpref($font) [set $font]
11375    ${NS}::button $top.${font}but -text $which \
11376        -command [list choosefont $font $which]
11377    ${NS}::label $top.$font -relief flat -font $font \
11378        -text $fontattr($font,family) -justify left
11379    grid x $top.${font}but $top.$font -sticky w
11380}
11381
11382proc choosefont {font which} {
11383    global fontparam fontlist fonttop fontattr
11384    global prefstop NS
11385
11386    set fontparam(which) $which
11387    set fontparam(font) $font
11388    set fontparam(family) [font actual $font -family]
11389    set fontparam(size) $fontattr($font,size)
11390    set fontparam(weight) $fontattr($font,weight)
11391    set fontparam(slant) $fontattr($font,slant)
11392    set top .gitkfont
11393    set fonttop $top
11394    if {![winfo exists $top]} {
11395        font create sample
11396        eval font config sample [font actual $font]
11397        ttk_toplevel $top
11398        make_transient $top $prefstop
11399        wm title $top [mc "Gitk font chooser"]
11400        ${NS}::label $top.l -textvariable fontparam(which)
11401        pack $top.l -side top
11402        set fontlist [lsort [font families]]
11403        ${NS}::frame $top.f
11404        listbox $top.f.fam -listvariable fontlist \
11405            -yscrollcommand [list $top.f.sb set]
11406        bind $top.f.fam <<ListboxSelect>> selfontfam
11407        ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
11408        pack $top.f.sb -side right -fill y
11409        pack $top.f.fam -side left -fill both -expand 1
11410        pack $top.f -side top -fill both -expand 1
11411        ${NS}::frame $top.g
11412        spinbox $top.g.size -from 4 -to 40 -width 4 \
11413            -textvariable fontparam(size) \
11414            -validatecommand {string is integer -strict %s}
11415        checkbutton $top.g.bold -padx 5 \
11416            -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
11417            -variable fontparam(weight) -onvalue bold -offvalue normal
11418        checkbutton $top.g.ital -padx 5 \
11419            -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
11420            -variable fontparam(slant) -onvalue italic -offvalue roman
11421        pack $top.g.size $top.g.bold $top.g.ital -side left
11422        pack $top.g -side top
11423        canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
11424            -background white
11425        $top.c create text 100 25 -anchor center -text $which -font sample \
11426            -fill black -tags text
11427        bind $top.c <Configure> [list centertext $top.c]
11428        pack $top.c -side top -fill x
11429        ${NS}::frame $top.buts
11430        ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
11431        ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
11432        bind $top <Key-Return> fontok
11433        bind $top <Key-Escape> fontcan
11434        grid $top.buts.ok $top.buts.can
11435        grid columnconfigure $top.buts 0 -weight 1 -uniform a
11436        grid columnconfigure $top.buts 1 -weight 1 -uniform a
11437        pack $top.buts -side bottom -fill x
11438        trace add variable fontparam write chg_fontparam
11439    } else {
11440        raise $top
11441        $top.c itemconf text -text $which
11442    }
11443    set i [lsearch -exact $fontlist $fontparam(family)]
11444    if {$i >= 0} {
11445        $top.f.fam selection set $i
11446        $top.f.fam see $i
11447    }
11448}
11449
11450proc centertext {w} {
11451    $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
11452}
11453
11454proc fontok {} {
11455    global fontparam fontpref prefstop
11456
11457    set f $fontparam(font)
11458    set fontpref($f) [list $fontparam(family) $fontparam(size)]
11459    if {$fontparam(weight) eq "bold"} {
11460        lappend fontpref($f) "bold"
11461    }
11462    if {$fontparam(slant) eq "italic"} {
11463        lappend fontpref($f) "italic"
11464    }
11465    set w $prefstop.notebook.fonts.$f
11466    $w conf -text $fontparam(family) -font $fontpref($f)
11467
11468    fontcan
11469}
11470
11471proc fontcan {} {
11472    global fonttop fontparam
11473
11474    if {[info exists fonttop]} {
11475        catch {destroy $fonttop}
11476        catch {font delete sample}
11477        unset fonttop
11478        unset fontparam
11479    }
11480}
11481
11482if {[package vsatisfies [package provide Tk] 8.6]} {
11483    # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
11484    # function to make use of it.
11485    proc choosefont {font which} {
11486        tk fontchooser configure -title $which -font $font \
11487            -command [list on_choosefont $font $which]
11488        tk fontchooser show
11489    }
11490    proc on_choosefont {font which newfont} {
11491        global fontparam
11492        puts stderr "$font $newfont"
11493        array set f [font actual $newfont]
11494        set fontparam(which) $which
11495        set fontparam(font) $font
11496        set fontparam(family) $f(-family)
11497        set fontparam(size) $f(-size)
11498        set fontparam(weight) $f(-weight)
11499        set fontparam(slant) $f(-slant)
11500        fontok
11501    }
11502}
11503
11504proc selfontfam {} {
11505    global fonttop fontparam
11506
11507    set i [$fonttop.f.fam curselection]
11508    if {$i ne {}} {
11509        set fontparam(family) [$fonttop.f.fam get $i]
11510    }
11511}
11512
11513proc chg_fontparam {v sub op} {
11514    global fontparam
11515
11516    font config sample -$sub $fontparam($sub)
11517}
11518
11519# Create a property sheet tab page
11520proc create_prefs_page {w} {
11521    global NS
11522    set parent [join [lrange [split $w .] 0 end-1] .]
11523    if {[winfo class $parent] eq "TNotebook"} {
11524        ${NS}::frame $w
11525    } else {
11526        ${NS}::labelframe $w
11527    }
11528}
11529
11530proc prefspage_general {notebook} {
11531    global NS maxwidth maxgraphpct showneartags showlocalchanges
11532    global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11533    global hideremotes want_ttk have_ttk maxrefs web_browser
11534
11535    set page [create_prefs_page $notebook.general]
11536
11537    ${NS}::label $page.ldisp -text [mc "Commit list display options"]
11538    grid $page.ldisp - -sticky w -pady 10
11539    ${NS}::label $page.spacer -text " "
11540    ${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
11541    spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
11542    grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w
11543                                         #xgettext:no-tcl-format
11544    ${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
11545    spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
11546    grid x $page.maxpctl $page.maxpct -sticky w
11547    ${NS}::checkbutton $page.showlocal -text [mc "Show local changes"] \
11548        -variable showlocalchanges
11549    grid x $page.showlocal -sticky w
11550    ${NS}::checkbutton $page.autoselect -text [mc "Auto-select SHA1 (length)"] \
11551        -variable autoselect
11552    spinbox $page.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
11553    grid x $page.autoselect $page.autosellen -sticky w
11554    ${NS}::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \
11555        -variable hideremotes
11556    grid x $page.hideremotes -sticky w
11557
11558    ${NS}::label $page.ddisp -text [mc "Diff display options"]
11559    grid $page.ddisp - -sticky w -pady 10
11560    ${NS}::label $page.tabstopl -text [mc "Tab spacing"]
11561    spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
11562    grid x $page.tabstopl $page.tabstop -sticky w
11563    ${NS}::checkbutton $page.ntag -text [mc "Display nearby tags/heads"] \
11564        -variable showneartags
11565    grid x $page.ntag -sticky w
11566    ${NS}::label $page.maxrefsl -text [mc "Maximum # tags/heads to show"]
11567    spinbox $page.maxrefs -from 1 -to 1000 -width 4 -textvariable maxrefs
11568    grid x $page.maxrefsl $page.maxrefs -sticky w
11569    ${NS}::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \
11570        -variable limitdiffs
11571    grid x $page.ldiff -sticky w
11572    ${NS}::checkbutton $page.lattr -text [mc "Support per-file encodings"] \
11573        -variable perfile_attrs
11574    grid x $page.lattr -sticky w
11575
11576    ${NS}::entry $page.extdifft -textvariable extdifftool
11577    ${NS}::frame $page.extdifff
11578    ${NS}::label $page.extdifff.l -text [mc "External diff tool" ]
11579    ${NS}::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff
11580    pack $page.extdifff.l $page.extdifff.b -side left
11581    pack configure $page.extdifff.l -padx 10
11582    grid x $page.extdifff $page.extdifft -sticky ew
11583
11584    ${NS}::entry $page.webbrowser -textvariable web_browser
11585    ${NS}::frame $page.webbrowserf
11586    ${NS}::label $page.webbrowserf.l -text [mc "Web browser" ]
11587    pack $page.webbrowserf.l -side left
11588    pack configure $page.webbrowserf.l -padx 10
11589    grid x $page.webbrowserf $page.webbrowser -sticky ew
11590
11591    ${NS}::label $page.lgen -text [mc "General options"]
11592    grid $page.lgen - -sticky w -pady 10
11593    ${NS}::checkbutton $page.want_ttk -variable want_ttk \
11594        -text [mc "Use themed widgets"]
11595    if {$have_ttk} {
11596        ${NS}::label $page.ttk_note -text [mc "(change requires restart)"]
11597    } else {
11598        ${NS}::label $page.ttk_note -text [mc "(currently unavailable)"]
11599    }
11600    grid x $page.want_ttk $page.ttk_note -sticky w
11601    return $page
11602}
11603
11604proc prefspage_colors {notebook} {
11605    global NS uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11606
11607    set page [create_prefs_page $notebook.colors]
11608
11609    ${NS}::label $page.cdisp -text [mc "Colors: press to choose"]
11610    grid $page.cdisp - -sticky w -pady 10
11611    label $page.ui -padx 40 -relief sunk -background $uicolor
11612    ${NS}::button $page.uibut -text [mc "Interface"] \
11613       -command [list choosecolor uicolor {} $page.ui [mc "interface"] setui]
11614    grid x $page.uibut $page.ui -sticky w
11615    label $page.bg -padx 40 -relief sunk -background $bgcolor
11616    ${NS}::button $page.bgbut -text [mc "Background"] \
11617        -command [list choosecolor bgcolor {} $page.bg [mc "background"] setbg]
11618    grid x $page.bgbut $page.bg -sticky w
11619    label $page.fg -padx 40 -relief sunk -background $fgcolor
11620    ${NS}::button $page.fgbut -text [mc "Foreground"] \
11621        -command [list choosecolor fgcolor {} $page.fg [mc "foreground"] setfg]
11622    grid x $page.fgbut $page.fg -sticky w
11623    label $page.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
11624    ${NS}::button $page.diffoldbut -text [mc "Diff: old lines"] \
11625        -command [list choosecolor diffcolors 0 $page.diffold [mc "diff old lines"] \
11626                      [list $ctext tag conf d0 -foreground]]
11627    grid x $page.diffoldbut $page.diffold -sticky w
11628    label $page.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
11629    ${NS}::button $page.diffnewbut -text [mc "Diff: new lines"] \
11630        -command [list choosecolor diffcolors 1 $page.diffnew [mc "diff new lines"] \
11631                      [list $ctext tag conf dresult -foreground]]
11632    grid x $page.diffnewbut $page.diffnew -sticky w
11633    label $page.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
11634    ${NS}::button $page.hunksepbut -text [mc "Diff: hunk header"] \
11635        -command [list choosecolor diffcolors 2 $page.hunksep \
11636                      [mc "diff hunk header"] \
11637                      [list $ctext tag conf hunksep -foreground]]
11638    grid x $page.hunksepbut $page.hunksep -sticky w
11639    label $page.markbgsep -padx 40 -relief sunk -background $markbgcolor
11640    ${NS}::button $page.markbgbut -text [mc "Marked line bg"] \
11641        -command [list choosecolor markbgcolor {} $page.markbgsep \
11642                      [mc "marked line background"] \
11643                      [list $ctext tag conf omark -background]]
11644    grid x $page.markbgbut $page.markbgsep -sticky w
11645    label $page.selbgsep -padx 40 -relief sunk -background $selectbgcolor
11646    ${NS}::button $page.selbgbut -text [mc "Select bg"] \
11647        -command [list choosecolor selectbgcolor {} $page.selbgsep [mc "background"] setselbg]
11648    grid x $page.selbgbut $page.selbgsep -sticky w
11649    return $page
11650}
11651
11652proc prefspage_fonts {notebook} {
11653    global NS
11654    set page [create_prefs_page $notebook.fonts]
11655    ${NS}::label $page.cfont -text [mc "Fonts: press to choose"]
11656    grid $page.cfont - -sticky w -pady 10
11657    mkfontdisp mainfont $page [mc "Main font"]
11658    mkfontdisp textfont $page [mc "Diff display font"]
11659    mkfontdisp uifont $page [mc "User interface font"]
11660    return $page
11661}
11662
11663proc doprefs {} {
11664    global maxwidth maxgraphpct use_ttk NS
11665    global oldprefs prefstop showneartags showlocalchanges
11666    global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11667    global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11668    global hideremotes want_ttk have_ttk
11669
11670    set top .gitkprefs
11671    set prefstop $top
11672    if {[winfo exists $top]} {
11673        raise $top
11674        return
11675    }
11676    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11677                   limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11678        set oldprefs($v) [set $v]
11679    }
11680    ttk_toplevel $top
11681    wm title $top [mc "Gitk preferences"]
11682    make_transient $top .
11683
11684    if {[set use_notebook [expr {$use_ttk && [info command ::ttk::notebook] ne ""}]]} {
11685        set notebook [ttk::notebook $top.notebook]
11686    } else {
11687        set notebook [${NS}::frame $top.notebook -borderwidth 0 -relief flat]
11688    }
11689
11690    lappend pages [prefspage_general $notebook] [mc "General"]
11691    lappend pages [prefspage_colors $notebook] [mc "Colors"]
11692    lappend pages [prefspage_fonts $notebook] [mc "Fonts"]
11693    set col 0
11694    foreach {page title} $pages {
11695        if {$use_notebook} {
11696            $notebook add $page -text $title
11697        } else {
11698            set btn [${NS}::button $notebook.b_[string map {. X} $page] \
11699                         -text $title -command [list raise $page]]
11700            $page configure -text $title
11701            grid $btn -row 0 -column [incr col] -sticky w
11702            grid $page -row 1 -column 0 -sticky news -columnspan 100
11703        }
11704    }
11705
11706    if {!$use_notebook} {
11707        grid columnconfigure $notebook 0 -weight 1
11708        grid rowconfigure $notebook 1 -weight 1
11709        raise [lindex $pages 0]
11710    }
11711
11712    grid $notebook -sticky news -padx 2 -pady 2
11713    grid rowconfigure $top 0 -weight 1
11714    grid columnconfigure $top 0 -weight 1
11715
11716    ${NS}::frame $top.buts
11717    ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
11718    ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
11719    bind $top <Key-Return> prefsok
11720    bind $top <Key-Escape> prefscan
11721    grid $top.buts.ok $top.buts.can
11722    grid columnconfigure $top.buts 0 -weight 1 -uniform a
11723    grid columnconfigure $top.buts 1 -weight 1 -uniform a
11724    grid $top.buts - - -pady 10 -sticky ew
11725    grid columnconfigure $top 2 -weight 1
11726    bind $top <Visibility> [list focus $top.buts.ok]
11727}
11728
11729proc choose_extdiff {} {
11730    global extdifftool
11731
11732    set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
11733    if {$prog ne {}} {
11734        set extdifftool $prog
11735    }
11736}
11737
11738proc choosecolor {v vi w x cmd} {
11739    global $v
11740
11741    set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
11742               -title [mc "Gitk: choose color for %s" $x]]
11743    if {$c eq {}} return
11744    $w conf -background $c
11745    lset $v $vi $c
11746    eval $cmd $c
11747}
11748
11749proc setselbg {c} {
11750    global bglist cflist
11751    foreach w $bglist {
11752        if {[winfo exists $w]} {
11753            $w configure -selectbackground $c
11754        }
11755    }
11756    $cflist tag configure highlight \
11757        -background [$cflist cget -selectbackground]
11758    allcanvs itemconf secsel -fill $c
11759}
11760
11761# This sets the background color and the color scheme for the whole UI.
11762# For some reason, tk_setPalette chooses a nasty dark red for selectColor
11763# if we don't specify one ourselves, which makes the checkbuttons and
11764# radiobuttons look bad.  This chooses white for selectColor if the
11765# background color is light, or black if it is dark.
11766proc setui {c} {
11767    if {[tk windowingsystem] eq "win32"} { return }
11768    set bg [winfo rgb . $c]
11769    set selc black
11770    if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
11771        set selc white
11772    }
11773    tk_setPalette background $c selectColor $selc
11774}
11775
11776proc setbg {c} {
11777    global bglist
11778
11779    foreach w $bglist {
11780        if {[winfo exists $w]} {
11781            $w conf -background $c
11782        }
11783    }
11784}
11785
11786proc setfg {c} {
11787    global fglist canv
11788
11789    foreach w $fglist {
11790        if {[winfo exists $w]} {
11791            $w conf -foreground $c
11792        }
11793    }
11794    allcanvs itemconf text -fill $c
11795    $canv itemconf circle -outline $c
11796    $canv itemconf markid -outline $c
11797}
11798
11799proc prefscan {} {
11800    global oldprefs prefstop
11801
11802    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11803                   limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11804        global $v
11805        set $v $oldprefs($v)
11806    }
11807    catch {destroy $prefstop}
11808    unset prefstop
11809    fontcan
11810}
11811
11812proc prefsok {} {
11813    global maxwidth maxgraphpct
11814    global oldprefs prefstop showneartags showlocalchanges
11815    global fontpref mainfont textfont uifont
11816    global limitdiffs treediffs perfile_attrs
11817    global hideremotes
11818
11819    catch {destroy $prefstop}
11820    unset prefstop
11821    fontcan
11822    set fontchanged 0
11823    if {$mainfont ne $fontpref(mainfont)} {
11824        set mainfont $fontpref(mainfont)
11825        parsefont mainfont $mainfont
11826        eval font configure mainfont [fontflags mainfont]
11827        eval font configure mainfontbold [fontflags mainfont 1]
11828        setcoords
11829        set fontchanged 1
11830    }
11831    if {$textfont ne $fontpref(textfont)} {
11832        set textfont $fontpref(textfont)
11833        parsefont textfont $textfont
11834        eval font configure textfont [fontflags textfont]
11835        eval font configure textfontbold [fontflags textfont 1]
11836    }
11837    if {$uifont ne $fontpref(uifont)} {
11838        set uifont $fontpref(uifont)
11839        parsefont uifont $uifont
11840        eval font configure uifont [fontflags uifont]
11841    }
11842    settabs
11843    if {$showlocalchanges != $oldprefs(showlocalchanges)} {
11844        if {$showlocalchanges} {
11845            doshowlocalchanges
11846        } else {
11847            dohidelocalchanges
11848        }
11849    }
11850    if {$limitdiffs != $oldprefs(limitdiffs) ||
11851        ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11852        # treediffs elements are limited by path;
11853        # won't have encodings cached if perfile_attrs was just turned on
11854        unset -nocomplain treediffs
11855    }
11856    if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
11857        || $maxgraphpct != $oldprefs(maxgraphpct)} {
11858        redisplay
11859    } elseif {$showneartags != $oldprefs(showneartags) ||
11860          $limitdiffs != $oldprefs(limitdiffs)} {
11861        reselectline
11862    }
11863    if {$hideremotes != $oldprefs(hideremotes)} {
11864        rereadrefs
11865    }
11866}
11867
11868proc formatdate {d} {
11869    global datetimeformat
11870    if {$d ne {}} {
11871        # If $datetimeformat includes a timezone, display in the
11872        # timezone of the argument.  Otherwise, display in local time.
11873        if {[string match {*%[zZ]*} $datetimeformat]} {
11874            if {[catch {set d [clock format [lindex $d 0] -timezone [lindex $d 1] -format $datetimeformat]}]} {
11875                # Tcl < 8.5 does not support -timezone.  Emulate it by
11876                # setting TZ (e.g. TZ=<-0430>+04:30).
11877                global env
11878                if {[info exists env(TZ)]} {
11879                    set savedTZ $env(TZ)
11880                }
11881                set zone [lindex $d 1]
11882                set sign [string map {+ - - +} [string index $zone 0]]
11883                set env(TZ) <$zone>$sign[string range $zone 1 2]:[string range $zone 3 4]
11884                set d [clock format [lindex $d 0] -format $datetimeformat]
11885                if {[info exists savedTZ]} {
11886                    set env(TZ) $savedTZ
11887                } else {
11888                    unset env(TZ)
11889                }
11890            }
11891        } else {
11892            set d [clock format [lindex $d 0] -format $datetimeformat]
11893        }
11894    }
11895    return $d
11896}
11897
11898# This list of encoding names and aliases is distilled from
11899# http://www.iana.org/assignments/character-sets.
11900# Not all of them are supported by Tcl.
11901set encoding_aliases {
11902    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11903      ISO646-US US-ASCII us IBM367 cp367 csASCII }
11904    { ISO-10646-UTF-1 csISO10646UTF1 }
11905    { ISO_646.basic:1983 ref csISO646basic1983 }
11906    { INVARIANT csINVARIANT }
11907    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11908    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11909    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11910    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11911    { NATS-DANO iso-ir-9-1 csNATSDANO }
11912    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11913    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11914    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11915    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11916    { ISO-2022-KR csISO2022KR }
11917    { EUC-KR csEUCKR }
11918    { ISO-2022-JP csISO2022JP }
11919    { ISO-2022-JP-2 csISO2022JP2 }
11920    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11921      csISO13JISC6220jp }
11922    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11923    { IT iso-ir-15 ISO646-IT csISO15Italian }
11924    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11925    { ES iso-ir-17 ISO646-ES csISO17Spanish }
11926    { greek7-old iso-ir-18 csISO18Greek7Old }
11927    { latin-greek iso-ir-19 csISO19LatinGreek }
11928    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11929    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11930    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11931    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11932    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11933    { BS_viewdata iso-ir-47 csISO47BSViewdata }
11934    { INIS iso-ir-49 csISO49INIS }
11935    { INIS-8 iso-ir-50 csISO50INIS8 }
11936    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11937    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11938    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11939    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11940    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11941    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11942      csISO60Norwegian1 }
11943    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11944    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11945    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11946    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11947    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11948    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11949    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11950    { greek7 iso-ir-88 csISO88Greek7 }
11951    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11952    { iso-ir-90 csISO90 }
11953    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11954    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11955      csISO92JISC62991984b }
11956    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11957    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11958    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11959      csISO95JIS62291984handadd }
11960    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11961    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11962    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11963    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11964      CP819 csISOLatin1 }
11965    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11966    { T.61-7bit iso-ir-102 csISO102T617bit }
11967    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11968    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
11969    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
11970    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
11971    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
11972    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
11973    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
11974    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
11975      arabic csISOLatinArabic }
11976    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
11977    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
11978    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
11979      greek greek8 csISOLatinGreek }
11980    { T.101-G2 iso-ir-128 csISO128T101G2 }
11981    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
11982      csISOLatinHebrew }
11983    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
11984    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
11985    { CSN_369103 iso-ir-139 csISO139CSN369103 }
11986    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
11987    { ISO_6937-2-add iso-ir-142 csISOTextComm }
11988    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
11989    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
11990      csISOLatinCyrillic }
11991    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
11992    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
11993    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
11994    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
11995    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
11996    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
11997    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
11998    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
11999    { ISO_10367-box iso-ir-155 csISO10367Box }
12000    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
12001    { latin-lap lap iso-ir-158 csISO158Lap }
12002    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
12003    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
12004    { us-dk csUSDK }
12005    { dk-us csDKUS }
12006    { JIS_X0201 X0201 csHalfWidthKatakana }
12007    { KSC5636 ISO646-KR csKSC5636 }
12008    { ISO-10646-UCS-2 csUnicode }
12009    { ISO-10646-UCS-4 csUCS4 }
12010    { DEC-MCS dec csDECMCS }
12011    { hp-roman8 roman8 r8 csHPRoman8 }
12012    { macintosh mac csMacintosh }
12013    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
12014      csIBM037 }
12015    { IBM038 EBCDIC-INT cp038 csIBM038 }
12016    { IBM273 CP273 csIBM273 }
12017    { IBM274 EBCDIC-BE CP274 csIBM274 }
12018    { IBM275 EBCDIC-BR cp275 csIBM275 }
12019    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
12020    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
12021    { IBM280 CP280 ebcdic-cp-it csIBM280 }
12022    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
12023    { IBM284 CP284 ebcdic-cp-es csIBM284 }
12024    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
12025    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
12026    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
12027    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
12028    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
12029    { IBM424 cp424 ebcdic-cp-he csIBM424 }
12030    { IBM437 cp437 437 csPC8CodePage437 }
12031    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
12032    { IBM775 cp775 csPC775Baltic }
12033    { IBM850 cp850 850 csPC850Multilingual }
12034    { IBM851 cp851 851 csIBM851 }
12035    { IBM852 cp852 852 csPCp852 }
12036    { IBM855 cp855 855 csIBM855 }
12037    { IBM857 cp857 857 csIBM857 }
12038    { IBM860 cp860 860 csIBM860 }
12039    { IBM861 cp861 861 cp-is csIBM861 }
12040    { IBM862 cp862 862 csPC862LatinHebrew }
12041    { IBM863 cp863 863 csIBM863 }
12042    { IBM864 cp864 csIBM864 }
12043    { IBM865 cp865 865 csIBM865 }
12044    { IBM866 cp866 866 csIBM866 }
12045    { IBM868 CP868 cp-ar csIBM868 }
12046    { IBM869 cp869 869 cp-gr csIBM869 }
12047    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
12048    { IBM871 CP871 ebcdic-cp-is csIBM871 }
12049    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
12050    { IBM891 cp891 csIBM891 }
12051    { IBM903 cp903 csIBM903 }
12052    { IBM904 cp904 904 csIBBM904 }
12053    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
12054    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
12055    { IBM1026 CP1026 csIBM1026 }
12056    { EBCDIC-AT-DE csIBMEBCDICATDE }
12057    { EBCDIC-AT-DE-A csEBCDICATDEA }
12058    { EBCDIC-CA-FR csEBCDICCAFR }
12059    { EBCDIC-DK-NO csEBCDICDKNO }
12060    { EBCDIC-DK-NO-A csEBCDICDKNOA }
12061    { EBCDIC-FI-SE csEBCDICFISE }
12062    { EBCDIC-FI-SE-A csEBCDICFISEA }
12063    { EBCDIC-FR csEBCDICFR }
12064    { EBCDIC-IT csEBCDICIT }
12065    { EBCDIC-PT csEBCDICPT }
12066    { EBCDIC-ES csEBCDICES }
12067    { EBCDIC-ES-A csEBCDICESA }
12068    { EBCDIC-ES-S csEBCDICESS }
12069    { EBCDIC-UK csEBCDICUK }
12070    { EBCDIC-US csEBCDICUS }
12071    { UNKNOWN-8BIT csUnknown8BiT }
12072    { MNEMONIC csMnemonic }
12073    { MNEM csMnem }
12074    { VISCII csVISCII }
12075    { VIQR csVIQR }
12076    { KOI8-R csKOI8R }
12077    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
12078    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
12079    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
12080    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
12081    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
12082    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
12083    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
12084    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
12085    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
12086    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
12087    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
12088    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
12089    { IBM1047 IBM-1047 }
12090    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
12091    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
12092    { UNICODE-1-1 csUnicode11 }
12093    { CESU-8 csCESU-8 }
12094    { BOCU-1 csBOCU-1 }
12095    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
12096    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
12097      l8 }
12098    { ISO-8859-15 ISO_8859-15 Latin-9 }
12099    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
12100    { GBK CP936 MS936 windows-936 }
12101    { JIS_Encoding csJISEncoding }
12102    { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
12103    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
12104      EUC-JP }
12105    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
12106    { ISO-10646-UCS-Basic csUnicodeASCII }
12107    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
12108    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
12109    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
12110    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
12111    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
12112    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
12113    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
12114    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
12115    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
12116    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
12117    { Adobe-Standard-Encoding csAdobeStandardEncoding }
12118    { Ventura-US csVenturaUS }
12119    { Ventura-International csVenturaInternational }
12120    { PC8-Danish-Norwegian csPC8DanishNorwegian }
12121    { PC8-Turkish csPC8Turkish }
12122    { IBM-Symbols csIBMSymbols }
12123    { IBM-Thai csIBMThai }
12124    { HP-Legal csHPLegal }
12125    { HP-Pi-font csHPPiFont }
12126    { HP-Math8 csHPMath8 }
12127    { Adobe-Symbol-Encoding csHPPSMath }
12128    { HP-DeskTop csHPDesktop }
12129    { Ventura-Math csVenturaMath }
12130    { Microsoft-Publishing csMicrosoftPublishing }
12131    { Windows-31J csWindows31J }
12132    { GB2312 csGB2312 }
12133    { Big5 csBig5 }
12134}
12135
12136proc tcl_encoding {enc} {
12137    global encoding_aliases tcl_encoding_cache
12138    if {[info exists tcl_encoding_cache($enc)]} {
12139        return $tcl_encoding_cache($enc)
12140    }
12141    set names [encoding names]
12142    set lcnames [string tolower $names]
12143    set enc [string tolower $enc]
12144    set i [lsearch -exact $lcnames $enc]
12145    if {$i < 0} {
12146        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
12147        if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
12148            set i [lsearch -exact $lcnames $encx]
12149        }
12150    }
12151    if {$i < 0} {
12152        foreach l $encoding_aliases {
12153            set ll [string tolower $l]
12154            if {[lsearch -exact $ll $enc] < 0} continue
12155            # look through the aliases for one that tcl knows about
12156            foreach e $ll {
12157                set i [lsearch -exact $lcnames $e]
12158                if {$i < 0} {
12159                    if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
12160                        set i [lsearch -exact $lcnames $ex]
12161                    }
12162                }
12163                if {$i >= 0} break
12164            }
12165            break
12166        }
12167    }
12168    set tclenc {}
12169    if {$i >= 0} {
12170        set tclenc [lindex $names $i]
12171    }
12172    set tcl_encoding_cache($enc) $tclenc
12173    return $tclenc
12174}
12175
12176proc gitattr {path attr default} {
12177    global path_attr_cache
12178    if {[info exists path_attr_cache($attr,$path)]} {
12179        set r $path_attr_cache($attr,$path)
12180    } else {
12181        set r "unspecified"
12182        if {![catch {set line [exec git check-attr $attr -- $path]}]} {
12183            regexp "(.*): $attr: (.*)" $line m f r
12184        }
12185        set path_attr_cache($attr,$path) $r
12186    }
12187    if {$r eq "unspecified"} {
12188        return $default
12189    }
12190    return $r
12191}
12192
12193proc cache_gitattr {attr pathlist} {
12194    global path_attr_cache
12195    set newlist {}
12196    foreach path $pathlist {
12197        if {![info exists path_attr_cache($attr,$path)]} {
12198            lappend newlist $path
12199        }
12200    }
12201    set lim 1000
12202    if {[tk windowingsystem] == "win32"} {
12203        # windows has a 32k limit on the arguments to a command...
12204        set lim 30
12205    }
12206    while {$newlist ne {}} {
12207        set head [lrange $newlist 0 [expr {$lim - 1}]]
12208        set newlist [lrange $newlist $lim end]
12209        if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
12210            foreach row [split $rlist "\n"] {
12211                if {[regexp "(.*): $attr: (.*)" $row m path value]} {
12212                    if {[string index $path 0] eq "\""} {
12213                        set path [encoding convertfrom [lindex $path 0]]
12214                    }
12215                    set path_attr_cache($attr,$path) $value
12216                }
12217            }
12218        }
12219    }
12220}
12221
12222proc get_path_encoding {path} {
12223    global gui_encoding perfile_attrs
12224    set tcl_enc $gui_encoding
12225    if {$path ne {} && $perfile_attrs} {
12226        set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
12227        if {$enc2 ne {}} {
12228            set tcl_enc $enc2
12229        }
12230    }
12231    return $tcl_enc
12232}
12233
12234## For msgcat loading, first locate the installation location.
12235if { [info exists ::env(GITK_MSGSDIR)] } {
12236    ## Msgsdir was manually set in the environment.
12237    set gitk_msgsdir $::env(GITK_MSGSDIR)
12238} else {
12239    ## Let's guess the prefix from argv0.
12240    set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
12241    set gitk_libdir [file join $gitk_prefix share gitk lib]
12242    set gitk_msgsdir [file join $gitk_libdir msgs]
12243    unset gitk_prefix
12244}
12245
12246## Internationalization (i18n) through msgcat and gettext. See
12247## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
12248package require msgcat
12249namespace import ::msgcat::mc
12250## And eventually load the actual message catalog
12251::msgcat::mcload $gitk_msgsdir
12252
12253# First check that Tcl/Tk is recent enough
12254if {[catch {package require Tk 8.4} err]} {
12255    show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
12256                         Gitk requires at least Tcl/Tk 8.4."]
12257    exit 1
12258}
12259
12260# on OSX bring the current Wish process window to front
12261if {[tk windowingsystem] eq "aqua"} {
12262    exec osascript -e [format {
12263        tell application "System Events"
12264            set frontmost of processes whose unix id is %d to true
12265        end tell
12266    } [pid] ]
12267}
12268
12269# Unset GIT_TRACE var if set
12270if { [info exists ::env(GIT_TRACE)] } {
12271    unset ::env(GIT_TRACE)
12272}
12273
12274# defaults...
12275set wrcomcmd "git diff-tree --stdin -p --pretty=email"
12276
12277set gitencoding {}
12278catch {
12279    set gitencoding [exec git config --get i18n.commitencoding]
12280}
12281catch {
12282    set gitencoding [exec git config --get i18n.logoutputencoding]
12283}
12284if {$gitencoding == ""} {
12285    set gitencoding "utf-8"
12286}
12287set tclencoding [tcl_encoding $gitencoding]
12288if {$tclencoding == {}} {
12289    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
12290}
12291
12292set gui_encoding [encoding system]
12293catch {
12294    set enc [exec git config --get gui.encoding]
12295    if {$enc ne {}} {
12296        set tclenc [tcl_encoding $enc]
12297        if {$tclenc ne {}} {
12298            set gui_encoding $tclenc
12299        } else {
12300            puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
12301        }
12302    }
12303}
12304
12305set log_showroot true
12306catch {
12307    set log_showroot [exec git config --bool --get log.showroot]
12308}
12309
12310if {[tk windowingsystem] eq "aqua"} {
12311    set mainfont {{Lucida Grande} 9}
12312    set textfont {Monaco 9}
12313    set uifont {{Lucida Grande} 9 bold}
12314} elseif {![catch {::tk::pkgconfig get fontsystem} xft] && $xft eq "xft"} {
12315    # fontconfig!
12316    set mainfont {sans 9}
12317    set textfont {monospace 9}
12318    set uifont {sans 9 bold}
12319} else {
12320    set mainfont {Helvetica 9}
12321    set textfont {Courier 9}
12322    set uifont {Helvetica 9 bold}
12323}
12324set tabstop 8
12325set findmergefiles 0
12326set maxgraphpct 50
12327set maxwidth 16
12328set revlistorder 0
12329set fastdate 0
12330set uparrowlen 5
12331set downarrowlen 5
12332set mingaplen 100
12333set cmitmode "patch"
12334set wrapcomment "none"
12335set showneartags 1
12336set hideremotes 0
12337set maxrefs 20
12338set visiblerefs {"master"}
12339set maxlinelen 200
12340set showlocalchanges 1
12341set limitdiffs 1
12342set datetimeformat "%Y-%m-%d %H:%M:%S"
12343set autoselect 1
12344set autosellen 40
12345set perfile_attrs 0
12346set want_ttk 1
12347
12348if {[tk windowingsystem] eq "aqua"} {
12349    set extdifftool "opendiff"
12350} else {
12351    set extdifftool "meld"
12352}
12353
12354set colors {"#00ff00" red blue magenta darkgrey brown orange}
12355if {[tk windowingsystem] eq "win32"} {
12356    set uicolor SystemButtonFace
12357    set uifgcolor SystemButtonText
12358    set uifgdisabledcolor SystemDisabledText
12359    set bgcolor SystemWindow
12360    set fgcolor SystemWindowText
12361    set selectbgcolor SystemHighlight
12362    set web_browser "cmd /c start"
12363} else {
12364    set uicolor grey85
12365    set uifgcolor black
12366    set uifgdisabledcolor "#999"
12367    set bgcolor white
12368    set fgcolor black
12369    set selectbgcolor gray85
12370    if {[tk windowingsystem] eq "aqua"} {
12371        set web_browser "open"
12372    } else {
12373        set web_browser "xdg-open"
12374    }
12375}
12376set diffcolors {red "#00a000" blue}
12377set diffcontext 3
12378set mergecolors {red blue "#00ff00" purple brown "#009090" magenta "#808000" "#009000" "#ff0080" cyan "#b07070" "#70b0f0" "#70f0b0" "#f0b070" "#ff70b0"}
12379set ignorespace 0
12380set worddiff ""
12381set markbgcolor "#e0e0ff"
12382
12383set headbgcolor "#00ff00"
12384set headfgcolor black
12385set headoutlinecolor black
12386set remotebgcolor #ffddaa
12387set tagbgcolor yellow
12388set tagfgcolor black
12389set tagoutlinecolor black
12390set reflinecolor black
12391set filesepbgcolor #aaaaaa
12392set filesepfgcolor black
12393set linehoverbgcolor #ffff80
12394set linehoverfgcolor black
12395set linehoveroutlinecolor black
12396set mainheadcirclecolor yellow
12397set workingfilescirclecolor red
12398set indexcirclecolor "#00ff00"
12399set circlecolors {white blue gray blue blue}
12400set linkfgcolor blue
12401set circleoutlinecolor $fgcolor
12402set foundbgcolor yellow
12403set currentsearchhitbgcolor orange
12404
12405# button for popping up context menus
12406if {[tk windowingsystem] eq "aqua"} {
12407    set ctxbut <Button-2>
12408} else {
12409    set ctxbut <Button-3>
12410}
12411
12412catch {
12413    # follow the XDG base directory specification by default. See
12414    # http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html
12415    if {[info exists env(XDG_CONFIG_HOME)] && $env(XDG_CONFIG_HOME) ne ""} {
12416        # XDG_CONFIG_HOME environment variable is set
12417        set config_file [file join $env(XDG_CONFIG_HOME) git gitk]
12418        set config_file_tmp [file join $env(XDG_CONFIG_HOME) git gitk-tmp]
12419    } else {
12420        # default XDG_CONFIG_HOME
12421        set config_file "~/.config/git/gitk"
12422        set config_file_tmp "~/.config/git/gitk-tmp"
12423    }
12424    if {![file exists $config_file]} {
12425        # for backward compatibility use the old config file if it exists
12426        if {[file exists "~/.gitk"]} {
12427            set config_file "~/.gitk"
12428            set config_file_tmp "~/.gitk-tmp"
12429        } elseif {![file exists [file dirname $config_file]]} {
12430            file mkdir [file dirname $config_file]
12431        }
12432    }
12433    source $config_file
12434}
12435config_check_tmp_exists 50
12436
12437set config_variables {
12438    mainfont textfont uifont tabstop findmergefiles maxgraphpct maxwidth
12439    cmitmode wrapcomment autoselect autosellen showneartags maxrefs visiblerefs
12440    hideremotes showlocalchanges datetimeformat limitdiffs uicolor want_ttk
12441    bgcolor fgcolor uifgcolor uifgdisabledcolor colors diffcolors mergecolors
12442    markbgcolor diffcontext selectbgcolor foundbgcolor currentsearchhitbgcolor
12443    extdifftool perfile_attrs headbgcolor headfgcolor headoutlinecolor
12444    remotebgcolor tagbgcolor tagfgcolor tagoutlinecolor reflinecolor
12445    filesepbgcolor filesepfgcolor linehoverbgcolor linehoverfgcolor
12446    linehoveroutlinecolor mainheadcirclecolor workingfilescirclecolor
12447    indexcirclecolor circlecolors linkfgcolor circleoutlinecolor
12448    web_browser
12449}
12450foreach var $config_variables {
12451    config_init_trace $var
12452    trace add variable $var write config_variable_change_cb
12453}
12454
12455parsefont mainfont $mainfont
12456eval font create mainfont [fontflags mainfont]
12457eval font create mainfontbold [fontflags mainfont 1]
12458
12459parsefont textfont $textfont
12460eval font create textfont [fontflags textfont]
12461eval font create textfontbold [fontflags textfont 1]
12462
12463parsefont uifont $uifont
12464eval font create uifont [fontflags uifont]
12465
12466setui $uicolor
12467
12468setoptions
12469
12470# check that we can find a .git directory somewhere...
12471if {[catch {set gitdir [exec git rev-parse --git-dir]}]} {
12472    show_error {} . [mc "Cannot find a git repository here."]
12473    exit 1
12474}
12475
12476set selecthead {}
12477set selectheadid {}
12478
12479set revtreeargs {}
12480set cmdline_files {}
12481set i 0
12482set revtreeargscmd {}
12483foreach arg $argv {
12484    switch -glob -- $arg {
12485        "" { }
12486        "--" {
12487            set cmdline_files [lrange $argv [expr {$i + 1}] end]
12488            break
12489        }
12490        "--select-commit=*" {
12491            set selecthead [string range $arg 16 end]
12492        }
12493        "--argscmd=*" {
12494            set revtreeargscmd [string range $arg 10 end]
12495        }
12496        default {
12497            lappend revtreeargs $arg
12498        }
12499    }
12500    incr i
12501}
12502
12503if {$selecthead eq "HEAD"} {
12504    set selecthead {}
12505}
12506
12507if {$i >= [llength $argv] && $revtreeargs ne {}} {
12508    # no -- on command line, but some arguments (other than --argscmd)
12509    if {[catch {
12510        set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
12511        set cmdline_files [split $f "\n"]
12512        set n [llength $cmdline_files]
12513        set revtreeargs [lrange $revtreeargs 0 end-$n]
12514        # Unfortunately git rev-parse doesn't produce an error when
12515        # something is both a revision and a filename.  To be consistent
12516        # with git log and git rev-list, check revtreeargs for filenames.
12517        foreach arg $revtreeargs {
12518            if {[file exists $arg]} {
12519                show_error {} . [mc "Ambiguous argument '%s': both revision\
12520                                 and filename" $arg]
12521                exit 1
12522            }
12523        }
12524    } err]} {
12525        # unfortunately we get both stdout and stderr in $err,
12526        # so look for "fatal:".
12527        set i [string first "fatal:" $err]
12528        if {$i > 0} {
12529            set err [string range $err [expr {$i + 6}] end]
12530        }
12531        show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
12532        exit 1
12533    }
12534}
12535
12536set nullid "0000000000000000000000000000000000000000"
12537set nullid2 "0000000000000000000000000000000000000001"
12538set nullfile "/dev/null"
12539
12540set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
12541if {![info exists have_ttk]} {
12542    set have_ttk [llength [info commands ::ttk::style]]
12543}
12544set use_ttk [expr {$have_ttk && $want_ttk}]
12545set NS [expr {$use_ttk ? "ttk" : ""}]
12546
12547if {$use_ttk} {
12548    setttkstyle
12549}
12550
12551regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
12552
12553set show_notes {}
12554if {[package vcompare $git_version "1.6.6.2"] >= 0} {
12555    set show_notes "--show-notes"
12556}
12557
12558set appname "gitk"
12559
12560set runq {}
12561set history {}
12562set historyindex 0
12563set fh_serial 0
12564set nhl_names {}
12565set highlight_paths {}
12566set findpattern {}
12567set searchdirn -forwards
12568set boldids {}
12569set boldnameids {}
12570set diffelide {0 0}
12571set markingmatches 0
12572set linkentercount 0
12573set need_redisplay 0
12574set nrows_drawn 0
12575set firsttabstop 0
12576
12577set nextviewnum 1
12578set curview 0
12579set selectedview 0
12580set selectedhlview [mc "None"]
12581set highlight_related [mc "None"]
12582set highlight_files {}
12583set viewfiles(0) {}
12584set viewperm(0) 0
12585set viewchanged(0) 0
12586set viewargs(0) {}
12587set viewargscmd(0) {}
12588
12589set selectedline {}
12590set numcommits 0
12591set loginstance 0
12592set cmdlineok 0
12593set stopped 0
12594set stuffsaved 0
12595set patchnum 0
12596set lserial 0
12597set hasworktree [hasworktree]
12598set cdup {}
12599if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} {
12600    set cdup [exec git rev-parse --show-cdup]
12601}
12602set worktree [exec git rev-parse --show-toplevel]
12603setcoords
12604makewindow
12605catch {
12606    image create photo gitlogo      -width 16 -height 16
12607
12608    image create photo gitlogominus -width  4 -height  2
12609    gitlogominus put #C00000 -to 0 0 4 2
12610    gitlogo copy gitlogominus -to  1 5
12611    gitlogo copy gitlogominus -to  6 5
12612    gitlogo copy gitlogominus -to 11 5
12613    image delete gitlogominus
12614
12615    image create photo gitlogoplus  -width  4 -height  4
12616    gitlogoplus  put #008000 -to 1 0 3 4
12617    gitlogoplus  put #008000 -to 0 1 4 3
12618    gitlogo copy gitlogoplus  -to  1 9
12619    gitlogo copy gitlogoplus  -to  6 9
12620    gitlogo copy gitlogoplus  -to 11 9
12621    image delete gitlogoplus
12622
12623    image create photo gitlogo32    -width 32 -height 32
12624    gitlogo32 copy gitlogo -zoom 2 2
12625
12626    wm iconphoto . -default gitlogo gitlogo32
12627}
12628# wait for the window to become visible
12629tkwait visibility .
12630set_window_title
12631update
12632readrefs
12633
12634if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
12635    # create a view for the files/dirs specified on the command line
12636    set curview 1
12637    set selectedview 1
12638    set nextviewnum 2
12639    set viewname(1) [mc "Command line"]
12640    set viewfiles(1) $cmdline_files
12641    set viewargs(1) $revtreeargs
12642    set viewargscmd(1) $revtreeargscmd
12643    set viewperm(1) 0
12644    set viewchanged(1) 0
12645    set vdatemode(1) 0
12646    addviewmenu 1
12647    .bar.view entryconf [mca "&Edit view..."] -state normal
12648    .bar.view entryconf [mca "&Delete view"] -state normal
12649}
12650
12651if {[info exists permviews]} {
12652    foreach v $permviews {
12653        set n $nextviewnum
12654        incr nextviewnum
12655        set viewname($n) [lindex $v 0]
12656        set viewfiles($n) [lindex $v 1]
12657        set viewargs($n) [lindex $v 2]
12658        set viewargscmd($n) [lindex $v 3]
12659        set viewperm($n) 1
12660        set viewchanged($n) 0
12661        addviewmenu $n
12662    }
12663}
12664
12665if {[tk windowingsystem] eq "win32"} {
12666    focus -force .
12667}
12668
12669getcommits {}
12670
12671# Local variables:
12672# mode: tcl
12673# indent-tabs-mode: t
12674# tab-width: 8
12675# End: