gitk-git / gitkon commit Merge branch 'master' of git://github.com/git-l10n/git-po (c65da26)
   1#!/bin/sh
   2# Tcl ignores the next line -*- tcl -*- \
   3exec wish "$0" -- "$@"
   4
   5# Copyright © 2005-2014 Paul Mackerras.  All rights reserved.
   6# This program is free software; it may be used, copied, modified
   7# and distributed under the terms of the GNU General Public Licence,
   8# either version 2, or (at your option) any later version.
   9
  10package require Tk
  11
  12proc hasworktree {} {
  13    return [expr {[exec git rev-parse --is-bare-repository] == "false" &&
  14                  [exec git rev-parse --is-inside-git-dir] == "false"}]
  15}
  16
  17proc reponame {} {
  18    global gitdir
  19    set n [file normalize $gitdir]
  20    if {[string match "*/.git" $n]} {
  21        set n [string range $n 0 end-5]
  22    }
  23    return [file tail $n]
  24}
  25
  26proc gitworktree {} {
  27    variable _gitworktree
  28    if {[info exists _gitworktree]} {
  29        return $_gitworktree
  30    }
  31    # v1.7.0 introduced --show-toplevel to return the canonical work-tree
  32    if {[catch {set _gitworktree [exec git rev-parse --show-toplevel]}]} {
  33        # try to set work tree from environment, core.worktree or use
  34        # cdup to obtain a relative path to the top of the worktree. If
  35        # run from the top, the ./ prefix ensures normalize expands pwd.
  36        if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
  37            catch {set _gitworktree [exec git config --get core.worktree]}
  38            if {$_gitworktree eq ""} {
  39                set _gitworktree [file normalize ./[exec git rev-parse --show-cdup]]
  40            }
  41        }
  42    }
  43    return $_gitworktree
  44}
  45
  46# A simple scheduler for compute-intensive stuff.
  47# The aim is to make sure that event handlers for GUI actions can
  48# run at least every 50-100 ms.  Unfortunately fileevent handlers are
  49# run before X event handlers, so reading from a fast source can
  50# make the GUI completely unresponsive.
  51proc run args {
  52    global isonrunq runq currunq
  53
  54    set script $args
  55    if {[info exists isonrunq($script)]} return
  56    if {$runq eq {} && ![info exists currunq]} {
  57        after idle dorunq
  58    }
  59    lappend runq [list {} $script]
  60    set isonrunq($script) 1
  61}
  62
  63proc filerun {fd script} {
  64    fileevent $fd readable [list filereadable $fd $script]
  65}
  66
  67proc filereadable {fd script} {
  68    global runq currunq
  69
  70    fileevent $fd readable {}
  71    if {$runq eq {} && ![info exists currunq]} {
  72        after idle dorunq
  73    }
  74    lappend runq [list $fd $script]
  75}
  76
  77proc nukefile {fd} {
  78    global runq
  79
  80    for {set i 0} {$i < [llength $runq]} {} {
  81        if {[lindex $runq $i 0] eq $fd} {
  82            set runq [lreplace $runq $i $i]
  83        } else {
  84            incr i
  85        }
  86    }
  87}
  88
  89proc dorunq {} {
  90    global isonrunq runq currunq
  91
  92    set tstart [clock clicks -milliseconds]
  93    set t0 $tstart
  94    while {[llength $runq] > 0} {
  95        set fd [lindex $runq 0 0]
  96        set script [lindex $runq 0 1]
  97        set currunq [lindex $runq 0]
  98        set runq [lrange $runq 1 end]
  99        set repeat [eval $script]
 100        unset currunq
 101        set t1 [clock clicks -milliseconds]
 102        set t [expr {$t1 - $t0}]
 103        if {$repeat ne {} && $repeat} {
 104            if {$fd eq {} || $repeat == 2} {
 105                # script returns 1 if it wants to be readded
 106                # file readers return 2 if they could do more straight away
 107                lappend runq [list $fd $script]
 108            } else {
 109                fileevent $fd readable [list filereadable $fd $script]
 110            }
 111        } elseif {$fd eq {}} {
 112            unset isonrunq($script)
 113        }
 114        set t0 $t1
 115        if {$t1 - $tstart >= 80} break
 116    }
 117    if {$runq ne {}} {
 118        after idle dorunq
 119    }
 120}
 121
 122proc reg_instance {fd} {
 123    global commfd leftover loginstance
 124
 125    set i [incr loginstance]
 126    set commfd($i) $fd
 127    set leftover($i) {}
 128    return $i
 129}
 130
 131proc unmerged_files {files} {
 132    global nr_unmerged
 133
 134    # find the list of unmerged files
 135    set mlist {}
 136    set nr_unmerged 0
 137    if {[catch {
 138        set fd [open "| git ls-files -u" r]
 139    } err]} {
 140        show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
 141        exit 1
 142    }
 143    while {[gets $fd line] >= 0} {
 144        set i [string first "\t" $line]
 145        if {$i < 0} continue
 146        set fname [string range $line [expr {$i+1}] end]
 147        if {[lsearch -exact $mlist $fname] >= 0} continue
 148        incr nr_unmerged
 149        if {$files eq {} || [path_filter $files $fname]} {
 150            lappend mlist $fname
 151        }
 152    }
 153    catch {close $fd}
 154    return $mlist
 155}
 156
 157proc parseviewargs {n arglist} {
 158    global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs env
 159    global vinlinediff
 160    global worddiff git_version
 161
 162    set vdatemode($n) 0
 163    set vmergeonly($n) 0
 164    set vinlinediff($n) 0
 165    set glflags {}
 166    set diffargs {}
 167    set nextisval 0
 168    set revargs {}
 169    set origargs $arglist
 170    set allknown 1
 171    set filtered 0
 172    set i -1
 173    foreach arg $arglist {
 174        incr i
 175        if {$nextisval} {
 176            lappend glflags $arg
 177            set nextisval 0
 178            continue
 179        }
 180        switch -glob -- $arg {
 181            "-d" -
 182            "--date-order" {
 183                set vdatemode($n) 1
 184                # remove from origargs in case we hit an unknown option
 185                set origargs [lreplace $origargs $i $i]
 186                incr i -1
 187            }
 188            "-[puabwcrRBMC]" -
 189            "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
 190            "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
 191            "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
 192            "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
 193            "--ignore-space-change" - "-U*" - "--unified=*" {
 194                # These request or affect diff output, which we don't want.
 195                # Some could be used to set our defaults for diff display.
 196                lappend diffargs $arg
 197            }
 198            "--raw" - "--patch-with-raw" - "--patch-with-stat" -
 199            "--name-only" - "--name-status" - "--color" -
 200            "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
 201            "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
 202            "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
 203            "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
 204            "--objects" - "--objects-edge" - "--reverse" {
 205                # These cause our parsing of git log's output to fail, or else
 206                # they're options we want to set ourselves, so ignore them.
 207            }
 208            "--color-words*" - "--word-diff=color" {
 209                # These trigger a word diff in the console interface,
 210                # so help the user by enabling our own support
 211                if {[package vcompare $git_version "1.7.2"] >= 0} {
 212                    set worddiff [mc "Color words"]
 213                }
 214            }
 215            "--word-diff*" {
 216                if {[package vcompare $git_version "1.7.2"] >= 0} {
 217                    set worddiff [mc "Markup words"]
 218                }
 219            }
 220            "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
 221            "--check" - "--exit-code" - "--quiet" - "--topo-order" -
 222            "--full-history" - "--dense" - "--sparse" -
 223            "--follow" - "--left-right" - "--encoding=*" {
 224                # These are harmless, and some are even useful
 225                lappend glflags $arg
 226            }
 227            "--diff-filter=*" - "--no-merges" - "--unpacked" -
 228            "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
 229            "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
 230            "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
 231            "--remove-empty" - "--first-parent" - "--cherry-pick" -
 232            "-S*" - "-G*" - "--pickaxe-all" - "--pickaxe-regex" -
 233            "--simplify-by-decoration" {
 234                # These mean that we get a subset of the commits
 235                set filtered 1
 236                lappend glflags $arg
 237            }
 238            "-L*" {
 239                # Line-log with 'stuck' argument (unstuck form is
 240                # not supported)
 241                set filtered 1
 242                set vinlinediff($n) 1
 243                set allknown 0
 244                lappend glflags $arg
 245            }
 246            "-n" {
 247                # This appears to be the only one that has a value as a
 248                # separate word following it
 249                set filtered 1
 250                set nextisval 1
 251                lappend glflags $arg
 252            }
 253            "--not" - "--all" {
 254                lappend revargs $arg
 255            }
 256            "--merge" {
 257                set vmergeonly($n) 1
 258                # git rev-parse doesn't understand --merge
 259                lappend revargs --gitk-symmetric-diff-marker MERGE_HEAD...HEAD
 260            }
 261            "--no-replace-objects" {
 262                set env(GIT_NO_REPLACE_OBJECTS) "1"
 263            }
 264            "-*" {
 265                # Other flag arguments including -<n>
 266                if {[string is digit -strict [string range $arg 1 end]]} {
 267                    set filtered 1
 268                } else {
 269                    # a flag argument that we don't recognize;
 270                    # that means we can't optimize
 271                    set allknown 0
 272                }
 273                lappend glflags $arg
 274            }
 275            default {
 276                # Non-flag arguments specify commits or ranges of commits
 277                if {[string match "*...*" $arg]} {
 278                    lappend revargs --gitk-symmetric-diff-marker
 279                }
 280                lappend revargs $arg
 281            }
 282        }
 283    }
 284    set vdflags($n) $diffargs
 285    set vflags($n) $glflags
 286    set vrevs($n) $revargs
 287    set vfiltered($n) $filtered
 288    set vorigargs($n) $origargs
 289    return $allknown
 290}
 291
 292proc parseviewrevs {view revs} {
 293    global vposids vnegids
 294
 295    if {$revs eq {}} {
 296        set revs HEAD
 297    } elseif {[lsearch -exact $revs --all] >= 0} {
 298        lappend revs HEAD
 299    }
 300    if {[catch {set ids [eval exec git rev-parse $revs]} err]} {
 301        # we get stdout followed by stderr in $err
 302        # for an unknown rev, git rev-parse echoes it and then errors out
 303        set errlines [split $err "\n"]
 304        set badrev {}
 305        for {set l 0} {$l < [llength $errlines]} {incr l} {
 306            set line [lindex $errlines $l]
 307            if {!([string length $line] == 40 && [string is xdigit $line])} {
 308                if {[string match "fatal:*" $line]} {
 309                    if {[string match "fatal: ambiguous argument*" $line]
 310                        && $badrev ne {}} {
 311                        if {[llength $badrev] == 1} {
 312                            set err "unknown revision $badrev"
 313                        } else {
 314                            set err "unknown revisions: [join $badrev ", "]"
 315                        }
 316                    } else {
 317                        set err [join [lrange $errlines $l end] "\n"]
 318                    }
 319                    break
 320                }
 321                lappend badrev $line
 322            }
 323        }
 324        error_popup "[mc "Error parsing revisions:"] $err"
 325        return {}
 326    }
 327    set ret {}
 328    set pos {}
 329    set neg {}
 330    set sdm 0
 331    foreach id [split $ids "\n"] {
 332        if {$id eq "--gitk-symmetric-diff-marker"} {
 333            set sdm 4
 334        } elseif {[string match "^*" $id]} {
 335            if {$sdm != 1} {
 336                lappend ret $id
 337                if {$sdm == 3} {
 338                    set sdm 0
 339                }
 340            }
 341            lappend neg [string range $id 1 end]
 342        } else {
 343            if {$sdm != 2} {
 344                lappend ret $id
 345            } else {
 346                lset ret end $id...[lindex $ret end]
 347            }
 348            lappend pos $id
 349        }
 350        incr sdm -1
 351    }
 352    set vposids($view) $pos
 353    set vnegids($view) $neg
 354    return $ret
 355}
 356
 357# Start off a git log process and arrange to read its output
 358proc start_rev_list {view} {
 359    global startmsecs commitidx viewcomplete curview
 360    global tclencoding
 361    global viewargs viewargscmd viewfiles vfilelimit
 362    global showlocalchanges
 363    global viewactive viewinstances vmergeonly
 364    global mainheadid viewmainheadid viewmainheadid_orig
 365    global vcanopt vflags vrevs vorigargs
 366    global show_notes
 367
 368    set startmsecs [clock clicks -milliseconds]
 369    set commitidx($view) 0
 370    # these are set this way for the error exits
 371    set viewcomplete($view) 1
 372    set viewactive($view) 0
 373    varcinit $view
 374
 375    set args $viewargs($view)
 376    if {$viewargscmd($view) ne {}} {
 377        if {[catch {
 378            set str [exec sh -c $viewargscmd($view)]
 379        } err]} {
 380            error_popup "[mc "Error executing --argscmd command:"] $err"
 381            return 0
 382        }
 383        set args [concat $args [split $str "\n"]]
 384    }
 385    set vcanopt($view) [parseviewargs $view $args]
 386
 387    set files $viewfiles($view)
 388    if {$vmergeonly($view)} {
 389        set files [unmerged_files $files]
 390        if {$files eq {}} {
 391            global nr_unmerged
 392            if {$nr_unmerged == 0} {
 393                error_popup [mc "No files selected: --merge specified but\
 394                             no files are unmerged."]
 395            } else {
 396                error_popup [mc "No files selected: --merge specified but\
 397                             no unmerged files are within file limit."]
 398            }
 399            return 0
 400        }
 401    }
 402    set vfilelimit($view) $files
 403
 404    if {$vcanopt($view)} {
 405        set revs [parseviewrevs $view $vrevs($view)]
 406        if {$revs eq {}} {
 407            return 0
 408        }
 409        set args [concat $vflags($view) $revs]
 410    } else {
 411        set args $vorigargs($view)
 412    }
 413
 414    if {[catch {
 415        set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
 416                        --parents --boundary $args "--" $files] r]
 417    } err]} {
 418        error_popup "[mc "Error executing git log:"] $err"
 419        return 0
 420    }
 421    set i [reg_instance $fd]
 422    set viewinstances($view) [list $i]
 423    set viewmainheadid($view) $mainheadid
 424    set viewmainheadid_orig($view) $mainheadid
 425    if {$files ne {} && $mainheadid ne {}} {
 426        get_viewmainhead $view
 427    }
 428    if {$showlocalchanges && $viewmainheadid($view) ne {}} {
 429        interestedin $viewmainheadid($view) dodiffindex
 430    }
 431    fconfigure $fd -blocking 0 -translation lf -eofchar {}
 432    if {$tclencoding != {}} {
 433        fconfigure $fd -encoding $tclencoding
 434    }
 435    filerun $fd [list getcommitlines $fd $i $view 0]
 436    nowbusy $view [mc "Reading"]
 437    set viewcomplete($view) 0
 438    set viewactive($view) 1
 439    return 1
 440}
 441
 442proc stop_instance {inst} {
 443    global commfd leftover
 444
 445    set fd $commfd($inst)
 446    catch {
 447        set pid [pid $fd]
 448
 449        if {$::tcl_platform(platform) eq {windows}} {
 450            exec taskkill /pid $pid
 451        } else {
 452            exec kill $pid
 453        }
 454    }
 455    catch {close $fd}
 456    nukefile $fd
 457    unset commfd($inst)
 458    unset leftover($inst)
 459}
 460
 461proc stop_backends {} {
 462    global commfd
 463
 464    foreach inst [array names commfd] {
 465        stop_instance $inst
 466    }
 467}
 468
 469proc stop_rev_list {view} {
 470    global viewinstances
 471
 472    foreach inst $viewinstances($view) {
 473        stop_instance $inst
 474    }
 475    set viewinstances($view) {}
 476}
 477
 478proc reset_pending_select {selid} {
 479    global pending_select mainheadid selectheadid
 480
 481    if {$selid ne {}} {
 482        set pending_select $selid
 483    } elseif {$selectheadid ne {}} {
 484        set pending_select $selectheadid
 485    } else {
 486        set pending_select $mainheadid
 487    }
 488}
 489
 490proc getcommits {selid} {
 491    global canv curview need_redisplay viewactive
 492
 493    initlayout
 494    if {[start_rev_list $curview]} {
 495        reset_pending_select $selid
 496        show_status [mc "Reading commits..."]
 497        set need_redisplay 1
 498    } else {
 499        show_status [mc "No commits selected"]
 500    }
 501}
 502
 503proc updatecommits {} {
 504    global curview vcanopt vorigargs vfilelimit viewinstances
 505    global viewactive viewcomplete tclencoding
 506    global startmsecs showneartags showlocalchanges
 507    global mainheadid viewmainheadid viewmainheadid_orig pending_select
 508    global hasworktree
 509    global varcid vposids vnegids vflags vrevs
 510    global show_notes
 511
 512    set hasworktree [hasworktree]
 513    rereadrefs
 514    set view $curview
 515    if {$mainheadid ne $viewmainheadid_orig($view)} {
 516        if {$showlocalchanges} {
 517            dohidelocalchanges
 518        }
 519        set viewmainheadid($view) $mainheadid
 520        set viewmainheadid_orig($view) $mainheadid
 521        if {$vfilelimit($view) ne {}} {
 522            get_viewmainhead $view
 523        }
 524    }
 525    if {$showlocalchanges} {
 526        doshowlocalchanges
 527    }
 528    if {$vcanopt($view)} {
 529        set oldpos $vposids($view)
 530        set oldneg $vnegids($view)
 531        set revs [parseviewrevs $view $vrevs($view)]
 532        if {$revs eq {}} {
 533            return
 534        }
 535        # note: getting the delta when negative refs change is hard,
 536        # and could require multiple git log invocations, so in that
 537        # case we ask git log for all the commits (not just the delta)
 538        if {$oldneg eq $vnegids($view)} {
 539            set newrevs {}
 540            set npos 0
 541            # take out positive refs that we asked for before or
 542            # that we have already seen
 543            foreach rev $revs {
 544                if {[string length $rev] == 40} {
 545                    if {[lsearch -exact $oldpos $rev] < 0
 546                        && ![info exists varcid($view,$rev)]} {
 547                        lappend newrevs $rev
 548                        incr npos
 549                    }
 550                } else {
 551                    lappend $newrevs $rev
 552                }
 553            }
 554            if {$npos == 0} return
 555            set revs $newrevs
 556            set vposids($view) [lsort -unique [concat $oldpos $vposids($view)]]
 557        }
 558        set args [concat $vflags($view) $revs --not $oldpos]
 559    } else {
 560        set args $vorigargs($view)
 561    }
 562    if {[catch {
 563        set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
 564                        --parents --boundary $args "--" $vfilelimit($view)] r]
 565    } err]} {
 566        error_popup "[mc "Error executing git log:"] $err"
 567        return
 568    }
 569    if {$viewactive($view) == 0} {
 570        set startmsecs [clock clicks -milliseconds]
 571    }
 572    set i [reg_instance $fd]
 573    lappend viewinstances($view) $i
 574    fconfigure $fd -blocking 0 -translation lf -eofchar {}
 575    if {$tclencoding != {}} {
 576        fconfigure $fd -encoding $tclencoding
 577    }
 578    filerun $fd [list getcommitlines $fd $i $view 1]
 579    incr viewactive($view)
 580    set viewcomplete($view) 0
 581    reset_pending_select {}
 582    nowbusy $view [mc "Reading"]
 583    if {$showneartags} {
 584        getallcommits
 585    }
 586}
 587
 588proc reloadcommits {} {
 589    global curview viewcomplete selectedline currentid thickerline
 590    global showneartags treediffs commitinterest cached_commitrow
 591    global targetid
 592
 593    set selid {}
 594    if {$selectedline ne {}} {
 595        set selid $currentid
 596    }
 597
 598    if {!$viewcomplete($curview)} {
 599        stop_rev_list $curview
 600    }
 601    resetvarcs $curview
 602    set selectedline {}
 603    unset -nocomplain currentid
 604    unset -nocomplain thickerline
 605    unset -nocomplain treediffs
 606    readrefs
 607    changedrefs
 608    if {$showneartags} {
 609        getallcommits
 610    }
 611    clear_display
 612    unset -nocomplain commitinterest
 613    unset -nocomplain cached_commitrow
 614    unset -nocomplain targetid
 615    setcanvscroll
 616    getcommits $selid
 617    return 0
 618}
 619
 620# This makes a string representation of a positive integer which
 621# sorts as a string in numerical order
 622proc strrep {n} {
 623    if {$n < 16} {
 624        return [format "%x" $n]
 625    } elseif {$n < 256} {
 626        return [format "x%.2x" $n]
 627    } elseif {$n < 65536} {
 628        return [format "y%.4x" $n]
 629    }
 630    return [format "z%.8x" $n]
 631}
 632
 633# Procedures used in reordering commits from git log (without
 634# --topo-order) into the order for display.
 635
 636proc varcinit {view} {
 637    global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
 638    global vtokmod varcmod vrowmod varcix vlastins
 639
 640    set varcstart($view) {{}}
 641    set vupptr($view) {0}
 642    set vdownptr($view) {0}
 643    set vleftptr($view) {0}
 644    set vbackptr($view) {0}
 645    set varctok($view) {{}}
 646    set varcrow($view) {{}}
 647    set vtokmod($view) {}
 648    set varcmod($view) 0
 649    set vrowmod($view) 0
 650    set varcix($view) {{}}
 651    set vlastins($view) {0}
 652}
 653
 654proc resetvarcs {view} {
 655    global varcid varccommits parents children vseedcount ordertok
 656    global vshortids
 657
 658    foreach vid [array names varcid $view,*] {
 659        unset varcid($vid)
 660        unset children($vid)
 661        unset parents($vid)
 662    }
 663    foreach vid [array names vshortids $view,*] {
 664        unset vshortids($vid)
 665    }
 666    # some commits might have children but haven't been seen yet
 667    foreach vid [array names children $view,*] {
 668        unset children($vid)
 669    }
 670    foreach va [array names varccommits $view,*] {
 671        unset varccommits($va)
 672    }
 673    foreach vd [array names vseedcount $view,*] {
 674        unset vseedcount($vd)
 675    }
 676    unset -nocomplain ordertok
 677}
 678
 679# returns a list of the commits with no children
 680proc seeds {v} {
 681    global vdownptr vleftptr varcstart
 682
 683    set ret {}
 684    set a [lindex $vdownptr($v) 0]
 685    while {$a != 0} {
 686        lappend ret [lindex $varcstart($v) $a]
 687        set a [lindex $vleftptr($v) $a]
 688    }
 689    return $ret
 690}
 691
 692proc newvarc {view id} {
 693    global varcid varctok parents children vdatemode
 694    global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
 695    global commitdata commitinfo vseedcount varccommits vlastins
 696
 697    set a [llength $varctok($view)]
 698    set vid $view,$id
 699    if {[llength $children($vid)] == 0 || $vdatemode($view)} {
 700        if {![info exists commitinfo($id)]} {
 701            parsecommit $id $commitdata($id) 1
 702        }
 703        set cdate [lindex [lindex $commitinfo($id) 4] 0]
 704        if {![string is integer -strict $cdate]} {
 705            set cdate 0
 706        }
 707        if {![info exists vseedcount($view,$cdate)]} {
 708            set vseedcount($view,$cdate) -1
 709        }
 710        set c [incr vseedcount($view,$cdate)]
 711        set cdate [expr {$cdate ^ 0xffffffff}]
 712        set tok "s[strrep $cdate][strrep $c]"
 713    } else {
 714        set tok {}
 715    }
 716    set ka 0
 717    if {[llength $children($vid)] > 0} {
 718        set kid [lindex $children($vid) end]
 719        set k $varcid($view,$kid)
 720        if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
 721            set ki $kid
 722            set ka $k
 723            set tok [lindex $varctok($view) $k]
 724        }
 725    }
 726    if {$ka != 0} {
 727        set i [lsearch -exact $parents($view,$ki) $id]
 728        set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
 729        append tok [strrep $j]
 730    }
 731    set c [lindex $vlastins($view) $ka]
 732    if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
 733        set c $ka
 734        set b [lindex $vdownptr($view) $ka]
 735    } else {
 736        set b [lindex $vleftptr($view) $c]
 737    }
 738    while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
 739        set c $b
 740        set b [lindex $vleftptr($view) $c]
 741    }
 742    if {$c == $ka} {
 743        lset vdownptr($view) $ka $a
 744        lappend vbackptr($view) 0
 745    } else {
 746        lset vleftptr($view) $c $a
 747        lappend vbackptr($view) $c
 748    }
 749    lset vlastins($view) $ka $a
 750    lappend vupptr($view) $ka
 751    lappend vleftptr($view) $b
 752    if {$b != 0} {
 753        lset vbackptr($view) $b $a
 754    }
 755    lappend varctok($view) $tok
 756    lappend varcstart($view) $id
 757    lappend vdownptr($view) 0
 758    lappend varcrow($view) {}
 759    lappend varcix($view) {}
 760    set varccommits($view,$a) {}
 761    lappend vlastins($view) 0
 762    return $a
 763}
 764
 765proc splitvarc {p v} {
 766    global varcid varcstart varccommits varctok vtokmod
 767    global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
 768
 769    set oa $varcid($v,$p)
 770    set otok [lindex $varctok($v) $oa]
 771    set ac $varccommits($v,$oa)
 772    set i [lsearch -exact $varccommits($v,$oa) $p]
 773    if {$i <= 0} return
 774    set na [llength $varctok($v)]
 775    # "%" sorts before "0"...
 776    set tok "$otok%[strrep $i]"
 777    lappend varctok($v) $tok
 778    lappend varcrow($v) {}
 779    lappend varcix($v) {}
 780    set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
 781    set varccommits($v,$na) [lrange $ac $i end]
 782    lappend varcstart($v) $p
 783    foreach id $varccommits($v,$na) {
 784        set varcid($v,$id) $na
 785    }
 786    lappend vdownptr($v) [lindex $vdownptr($v) $oa]
 787    lappend vlastins($v) [lindex $vlastins($v) $oa]
 788    lset vdownptr($v) $oa $na
 789    lset vlastins($v) $oa 0
 790    lappend vupptr($v) $oa
 791    lappend vleftptr($v) 0
 792    lappend vbackptr($v) 0
 793    for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
 794        lset vupptr($v) $b $na
 795    }
 796    if {[string compare $otok $vtokmod($v)] <= 0} {
 797        modify_arc $v $oa
 798    }
 799}
 800
 801proc renumbervarc {a v} {
 802    global parents children varctok varcstart varccommits
 803    global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
 804
 805    set t1 [clock clicks -milliseconds]
 806    set todo {}
 807    set isrelated($a) 1
 808    set kidchanged($a) 1
 809    set ntot 0
 810    while {$a != 0} {
 811        if {[info exists isrelated($a)]} {
 812            lappend todo $a
 813            set id [lindex $varccommits($v,$a) end]
 814            foreach p $parents($v,$id) {
 815                if {[info exists varcid($v,$p)]} {
 816                    set isrelated($varcid($v,$p)) 1
 817                }
 818            }
 819        }
 820        incr ntot
 821        set b [lindex $vdownptr($v) $a]
 822        if {$b == 0} {
 823            while {$a != 0} {
 824                set b [lindex $vleftptr($v) $a]
 825                if {$b != 0} break
 826                set a [lindex $vupptr($v) $a]
 827            }
 828        }
 829        set a $b
 830    }
 831    foreach a $todo {
 832        if {![info exists kidchanged($a)]} continue
 833        set id [lindex $varcstart($v) $a]
 834        if {[llength $children($v,$id)] > 1} {
 835            set children($v,$id) [lsort -command [list vtokcmp $v] \
 836                                      $children($v,$id)]
 837        }
 838        set oldtok [lindex $varctok($v) $a]
 839        if {!$vdatemode($v)} {
 840            set tok {}
 841        } else {
 842            set tok $oldtok
 843        }
 844        set ka 0
 845        set kid [last_real_child $v,$id]
 846        if {$kid ne {}} {
 847            set k $varcid($v,$kid)
 848            if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
 849                set ki $kid
 850                set ka $k
 851                set tok [lindex $varctok($v) $k]
 852            }
 853        }
 854        if {$ka != 0} {
 855            set i [lsearch -exact $parents($v,$ki) $id]
 856            set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
 857            append tok [strrep $j]
 858        }
 859        if {$tok eq $oldtok} {
 860            continue
 861        }
 862        set id [lindex $varccommits($v,$a) end]
 863        foreach p $parents($v,$id) {
 864            if {[info exists varcid($v,$p)]} {
 865                set kidchanged($varcid($v,$p)) 1
 866            } else {
 867                set sortkids($p) 1
 868            }
 869        }
 870        lset varctok($v) $a $tok
 871        set b [lindex $vupptr($v) $a]
 872        if {$b != $ka} {
 873            if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
 874                modify_arc $v $ka
 875            }
 876            if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
 877                modify_arc $v $b
 878            }
 879            set c [lindex $vbackptr($v) $a]
 880            set d [lindex $vleftptr($v) $a]
 881            if {$c == 0} {
 882                lset vdownptr($v) $b $d
 883            } else {
 884                lset vleftptr($v) $c $d
 885            }
 886            if {$d != 0} {
 887                lset vbackptr($v) $d $c
 888            }
 889            if {[lindex $vlastins($v) $b] == $a} {
 890                lset vlastins($v) $b $c
 891            }
 892            lset vupptr($v) $a $ka
 893            set c [lindex $vlastins($v) $ka]
 894            if {$c == 0 || \
 895                    [string compare $tok [lindex $varctok($v) $c]] < 0} {
 896                set c $ka
 897                set b [lindex $vdownptr($v) $ka]
 898            } else {
 899                set b [lindex $vleftptr($v) $c]
 900            }
 901            while {$b != 0 && \
 902                      [string compare $tok [lindex $varctok($v) $b]] >= 0} {
 903                set c $b
 904                set b [lindex $vleftptr($v) $c]
 905            }
 906            if {$c == $ka} {
 907                lset vdownptr($v) $ka $a
 908                lset vbackptr($v) $a 0
 909            } else {
 910                lset vleftptr($v) $c $a
 911                lset vbackptr($v) $a $c
 912            }
 913            lset vleftptr($v) $a $b
 914            if {$b != 0} {
 915                lset vbackptr($v) $b $a
 916            }
 917            lset vlastins($v) $ka $a
 918        }
 919    }
 920    foreach id [array names sortkids] {
 921        if {[llength $children($v,$id)] > 1} {
 922            set children($v,$id) [lsort -command [list vtokcmp $v] \
 923                                      $children($v,$id)]
 924        }
 925    }
 926    set t2 [clock clicks -milliseconds]
 927    #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
 928}
 929
 930# Fix up the graph after we have found out that in view $v,
 931# $p (a commit that we have already seen) is actually the parent
 932# of the last commit in arc $a.
 933proc fix_reversal {p a v} {
 934    global varcid varcstart varctok vupptr
 935
 936    set pa $varcid($v,$p)
 937    if {$p ne [lindex $varcstart($v) $pa]} {
 938        splitvarc $p $v
 939        set pa $varcid($v,$p)
 940    }
 941    # seeds always need to be renumbered
 942    if {[lindex $vupptr($v) $pa] == 0 ||
 943        [string compare [lindex $varctok($v) $a] \
 944             [lindex $varctok($v) $pa]] > 0} {
 945        renumbervarc $pa $v
 946    }
 947}
 948
 949proc insertrow {id p v} {
 950    global cmitlisted children parents varcid varctok vtokmod
 951    global varccommits ordertok commitidx numcommits curview
 952    global targetid targetrow vshortids
 953
 954    readcommit $id
 955    set vid $v,$id
 956    set cmitlisted($vid) 1
 957    set children($vid) {}
 958    set parents($vid) [list $p]
 959    set a [newvarc $v $id]
 960    set varcid($vid) $a
 961    lappend vshortids($v,[string range $id 0 3]) $id
 962    if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
 963        modify_arc $v $a
 964    }
 965    lappend varccommits($v,$a) $id
 966    set vp $v,$p
 967    if {[llength [lappend children($vp) $id]] > 1} {
 968        set children($vp) [lsort -command [list vtokcmp $v] $children($vp)]
 969        unset -nocomplain ordertok
 970    }
 971    fix_reversal $p $a $v
 972    incr commitidx($v)
 973    if {$v == $curview} {
 974        set numcommits $commitidx($v)
 975        setcanvscroll
 976        if {[info exists targetid]} {
 977            if {![comes_before $targetid $p]} {
 978                incr targetrow
 979            }
 980        }
 981    }
 982}
 983
 984proc insertfakerow {id p} {
 985    global varcid varccommits parents children cmitlisted
 986    global commitidx varctok vtokmod targetid targetrow curview numcommits
 987
 988    set v $curview
 989    set a $varcid($v,$p)
 990    set i [lsearch -exact $varccommits($v,$a) $p]
 991    if {$i < 0} {
 992        puts "oops: insertfakerow can't find [shortids $p] on arc $a"
 993        return
 994    }
 995    set children($v,$id) {}
 996    set parents($v,$id) [list $p]
 997    set varcid($v,$id) $a
 998    lappend children($v,$p) $id
 999    set cmitlisted($v,$id) 1
1000    set numcommits [incr commitidx($v)]
1001    # note we deliberately don't update varcstart($v) even if $i == 0
1002    set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
1003    modify_arc $v $a $i
1004    if {[info exists targetid]} {
1005        if {![comes_before $targetid $p]} {
1006            incr targetrow
1007        }
1008    }
1009    setcanvscroll
1010    drawvisible
1011}
1012
1013proc removefakerow {id} {
1014    global varcid varccommits parents children commitidx
1015    global varctok vtokmod cmitlisted currentid selectedline
1016    global targetid curview numcommits
1017
1018    set v $curview
1019    if {[llength $parents($v,$id)] != 1} {
1020        puts "oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
1021        return
1022    }
1023    set p [lindex $parents($v,$id) 0]
1024    set a $varcid($v,$id)
1025    set i [lsearch -exact $varccommits($v,$a) $id]
1026    if {$i < 0} {
1027        puts "oops: removefakerow can't find [shortids $id] on arc $a"
1028        return
1029    }
1030    unset varcid($v,$id)
1031    set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
1032    unset parents($v,$id)
1033    unset children($v,$id)
1034    unset cmitlisted($v,$id)
1035    set numcommits [incr commitidx($v) -1]
1036    set j [lsearch -exact $children($v,$p) $id]
1037    if {$j >= 0} {
1038        set children($v,$p) [lreplace $children($v,$p) $j $j]
1039    }
1040    modify_arc $v $a $i
1041    if {[info exist currentid] && $id eq $currentid} {
1042        unset currentid
1043        set selectedline {}
1044    }
1045    if {[info exists targetid] && $targetid eq $id} {
1046        set targetid $p
1047    }
1048    setcanvscroll
1049    drawvisible
1050}
1051
1052proc real_children {vp} {
1053    global children nullid nullid2
1054
1055    set kids {}
1056    foreach id $children($vp) {
1057        if {$id ne $nullid && $id ne $nullid2} {
1058            lappend kids $id
1059        }
1060    }
1061    return $kids
1062}
1063
1064proc first_real_child {vp} {
1065    global children nullid nullid2
1066
1067    foreach id $children($vp) {
1068        if {$id ne $nullid && $id ne $nullid2} {
1069            return $id
1070        }
1071    }
1072    return {}
1073}
1074
1075proc last_real_child {vp} {
1076    global children nullid nullid2
1077
1078    set kids $children($vp)
1079    for {set i [llength $kids]} {[incr i -1] >= 0} {} {
1080        set id [lindex $kids $i]
1081        if {$id ne $nullid && $id ne $nullid2} {
1082            return $id
1083        }
1084    }
1085    return {}
1086}
1087
1088proc vtokcmp {v a b} {
1089    global varctok varcid
1090
1091    return [string compare [lindex $varctok($v) $varcid($v,$a)] \
1092                [lindex $varctok($v) $varcid($v,$b)]]
1093}
1094
1095# This assumes that if lim is not given, the caller has checked that
1096# arc a's token is less than $vtokmod($v)
1097proc modify_arc {v a {lim {}}} {
1098    global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
1099
1100    if {$lim ne {}} {
1101        set c [string compare [lindex $varctok($v) $a] $vtokmod($v)]
1102        if {$c > 0} return
1103        if {$c == 0} {
1104            set r [lindex $varcrow($v) $a]
1105            if {$r ne {} && $vrowmod($v) <= $r + $lim} return
1106        }
1107    }
1108    set vtokmod($v) [lindex $varctok($v) $a]
1109    set varcmod($v) $a
1110    if {$v == $curview} {
1111        while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
1112            set a [lindex $vupptr($v) $a]
1113            set lim {}
1114        }
1115        set r 0
1116        if {$a != 0} {
1117            if {$lim eq {}} {
1118                set lim [llength $varccommits($v,$a)]
1119            }
1120            set r [expr {[lindex $varcrow($v) $a] + $lim}]
1121        }
1122        set vrowmod($v) $r
1123        undolayout $r
1124    }
1125}
1126
1127proc update_arcrows {v} {
1128    global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
1129    global varcid vrownum varcorder varcix varccommits
1130    global vupptr vdownptr vleftptr varctok
1131    global displayorder parentlist curview cached_commitrow
1132
1133    if {$vrowmod($v) == $commitidx($v)} return
1134    if {$v == $curview} {
1135        if {[llength $displayorder] > $vrowmod($v)} {
1136            set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
1137            set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
1138        }
1139        unset -nocomplain cached_commitrow
1140    }
1141    set narctot [expr {[llength $varctok($v)] - 1}]
1142    set a $varcmod($v)
1143    while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
1144        # go up the tree until we find something that has a row number,
1145        # or we get to a seed
1146        set a [lindex $vupptr($v) $a]
1147    }
1148    if {$a == 0} {
1149        set a [lindex $vdownptr($v) 0]
1150        if {$a == 0} return
1151        set vrownum($v) {0}
1152        set varcorder($v) [list $a]
1153        lset varcix($v) $a 0
1154        lset varcrow($v) $a 0
1155        set arcn 0
1156        set row 0
1157    } else {
1158        set arcn [lindex $varcix($v) $a]
1159        if {[llength $vrownum($v)] > $arcn + 1} {
1160            set vrownum($v) [lrange $vrownum($v) 0 $arcn]
1161            set varcorder($v) [lrange $varcorder($v) 0 $arcn]
1162        }
1163        set row [lindex $varcrow($v) $a]
1164    }
1165    while {1} {
1166        set p $a
1167        incr row [llength $varccommits($v,$a)]
1168        # go down if possible
1169        set b [lindex $vdownptr($v) $a]
1170        if {$b == 0} {
1171            # if not, go left, or go up until we can go left
1172            while {$a != 0} {
1173                set b [lindex $vleftptr($v) $a]
1174                if {$b != 0} break
1175                set a [lindex $vupptr($v) $a]
1176            }
1177            if {$a == 0} break
1178        }
1179        set a $b
1180        incr arcn
1181        lappend vrownum($v) $row
1182        lappend varcorder($v) $a
1183        lset varcix($v) $a $arcn
1184        lset varcrow($v) $a $row
1185    }
1186    set vtokmod($v) [lindex $varctok($v) $p]
1187    set varcmod($v) $p
1188    set vrowmod($v) $row
1189    if {[info exists currentid]} {
1190        set selectedline [rowofcommit $currentid]
1191    }
1192}
1193
1194# Test whether view $v contains commit $id
1195proc commitinview {id v} {
1196    global varcid
1197
1198    return [info exists varcid($v,$id)]
1199}
1200
1201# Return the row number for commit $id in the current view
1202proc rowofcommit {id} {
1203    global varcid varccommits varcrow curview cached_commitrow
1204    global varctok vtokmod
1205
1206    set v $curview
1207    if {![info exists varcid($v,$id)]} {
1208        puts "oops rowofcommit no arc for [shortids $id]"
1209        return {}
1210    }
1211    set a $varcid($v,$id)
1212    if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
1213        update_arcrows $v
1214    }
1215    if {[info exists cached_commitrow($id)]} {
1216        return $cached_commitrow($id)
1217    }
1218    set i [lsearch -exact $varccommits($v,$a) $id]
1219    if {$i < 0} {
1220        puts "oops didn't find commit [shortids $id] in arc $a"
1221        return {}
1222    }
1223    incr i [lindex $varcrow($v) $a]
1224    set cached_commitrow($id) $i
1225    return $i
1226}
1227
1228# Returns 1 if a is on an earlier row than b, otherwise 0
1229proc comes_before {a b} {
1230    global varcid varctok curview
1231
1232    set v $curview
1233    if {$a eq $b || ![info exists varcid($v,$a)] || \
1234            ![info exists varcid($v,$b)]} {
1235        return 0
1236    }
1237    if {$varcid($v,$a) != $varcid($v,$b)} {
1238        return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
1239                           [lindex $varctok($v) $varcid($v,$b)]] < 0}]
1240    }
1241    return [expr {[rowofcommit $a] < [rowofcommit $b]}]
1242}
1243
1244proc bsearch {l elt} {
1245    if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
1246        return 0
1247    }
1248    set lo 0
1249    set hi [llength $l]
1250    while {$hi - $lo > 1} {
1251        set mid [expr {int(($lo + $hi) / 2)}]
1252        set t [lindex $l $mid]
1253        if {$elt < $t} {
1254            set hi $mid
1255        } elseif {$elt > $t} {
1256            set lo $mid
1257        } else {
1258            return $mid
1259        }
1260    }
1261    return $lo
1262}
1263
1264# Make sure rows $start..$end-1 are valid in displayorder and parentlist
1265proc make_disporder {start end} {
1266    global vrownum curview commitidx displayorder parentlist
1267    global varccommits varcorder parents vrowmod varcrow
1268    global d_valid_start d_valid_end
1269
1270    if {$end > $vrowmod($curview)} {
1271        update_arcrows $curview
1272    }
1273    set ai [bsearch $vrownum($curview) $start]
1274    set start [lindex $vrownum($curview) $ai]
1275    set narc [llength $vrownum($curview)]
1276    for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
1277        set a [lindex $varcorder($curview) $ai]
1278        set l [llength $displayorder]
1279        set al [llength $varccommits($curview,$a)]
1280        if {$l < $r + $al} {
1281            if {$l < $r} {
1282                set pad [ntimes [expr {$r - $l}] {}]
1283                set displayorder [concat $displayorder $pad]
1284                set parentlist [concat $parentlist $pad]
1285            } elseif {$l > $r} {
1286                set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
1287                set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
1288            }
1289            foreach id $varccommits($curview,$a) {
1290                lappend displayorder $id
1291                lappend parentlist $parents($curview,$id)
1292            }
1293        } elseif {[lindex $displayorder [expr {$r + $al - 1}]] eq {}} {
1294            set i $r
1295            foreach id $varccommits($curview,$a) {
1296                lset displayorder $i $id
1297                lset parentlist $i $parents($curview,$id)
1298                incr i
1299            }
1300        }
1301        incr r $al
1302    }
1303}
1304
1305proc commitonrow {row} {
1306    global displayorder
1307
1308    set id [lindex $displayorder $row]
1309    if {$id eq {}} {
1310        make_disporder $row [expr {$row + 1}]
1311        set id [lindex $displayorder $row]
1312    }
1313    return $id
1314}
1315
1316proc closevarcs {v} {
1317    global varctok varccommits varcid parents children
1318    global cmitlisted commitidx vtokmod
1319
1320    set missing_parents 0
1321    set scripts {}
1322    set narcs [llength $varctok($v)]
1323    for {set a 1} {$a < $narcs} {incr a} {
1324        set id [lindex $varccommits($v,$a) end]
1325        foreach p $parents($v,$id) {
1326            if {[info exists varcid($v,$p)]} continue
1327            # add p as a new commit
1328            incr missing_parents
1329            set cmitlisted($v,$p) 0
1330            set parents($v,$p) {}
1331            if {[llength $children($v,$p)] == 1 &&
1332                [llength $parents($v,$id)] == 1} {
1333                set b $a
1334            } else {
1335                set b [newvarc $v $p]
1336            }
1337            set varcid($v,$p) $b
1338            if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
1339                modify_arc $v $b
1340            }
1341            lappend varccommits($v,$b) $p
1342            incr commitidx($v)
1343            set scripts [check_interest $p $scripts]
1344        }
1345    }
1346    if {$missing_parents > 0} {
1347        foreach s $scripts {
1348            eval $s
1349        }
1350    }
1351}
1352
1353# Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1354# Assumes we already have an arc for $rwid.
1355proc rewrite_commit {v id rwid} {
1356    global children parents varcid varctok vtokmod varccommits
1357
1358    foreach ch $children($v,$id) {
1359        # make $rwid be $ch's parent in place of $id
1360        set i [lsearch -exact $parents($v,$ch) $id]
1361        if {$i < 0} {
1362            puts "oops rewrite_commit didn't find $id in parent list for $ch"
1363        }
1364        set parents($v,$ch) [lreplace $parents($v,$ch) $i $i $rwid]
1365        # add $ch to $rwid's children and sort the list if necessary
1366        if {[llength [lappend children($v,$rwid) $ch]] > 1} {
1367            set children($v,$rwid) [lsort -command [list vtokcmp $v] \
1368                                        $children($v,$rwid)]
1369        }
1370        # fix the graph after joining $id to $rwid
1371        set a $varcid($v,$ch)
1372        fix_reversal $rwid $a $v
1373        # parentlist is wrong for the last element of arc $a
1374        # even if displayorder is right, hence the 3rd arg here
1375        modify_arc $v $a [expr {[llength $varccommits($v,$a)] - 1}]
1376    }
1377}
1378
1379# Mechanism for registering a command to be executed when we come
1380# across a particular commit.  To handle the case when only the
1381# prefix of the commit is known, the commitinterest array is now
1382# indexed by the first 4 characters of the ID.  Each element is a
1383# list of id, cmd pairs.
1384proc interestedin {id cmd} {
1385    global commitinterest
1386
1387    lappend commitinterest([string range $id 0 3]) $id $cmd
1388}
1389
1390proc check_interest {id scripts} {
1391    global commitinterest
1392
1393    set prefix [string range $id 0 3]
1394    if {[info exists commitinterest($prefix)]} {
1395        set newlist {}
1396        foreach {i script} $commitinterest($prefix) {
1397            if {[string match "$i*" $id]} {
1398                lappend scripts [string map [list "%I" $id "%P" $i] $script]
1399            } else {
1400                lappend newlist $i $script
1401            }
1402        }
1403        if {$newlist ne {}} {
1404            set commitinterest($prefix) $newlist
1405        } else {
1406            unset commitinterest($prefix)
1407        }
1408    }
1409    return $scripts
1410}
1411
1412proc getcommitlines {fd inst view updating}  {
1413    global cmitlisted leftover
1414    global commitidx commitdata vdatemode
1415    global parents children curview hlview
1416    global idpending ordertok
1417    global varccommits varcid varctok vtokmod vfilelimit vshortids
1418
1419    set stuff [read $fd 500000]
1420    # git log doesn't terminate the last commit with a null...
1421    if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
1422        set stuff "\0"
1423    }
1424    if {$stuff == {}} {
1425        if {![eof $fd]} {
1426            return 1
1427        }
1428        global commfd viewcomplete viewactive viewname
1429        global viewinstances
1430        unset commfd($inst)
1431        set i [lsearch -exact $viewinstances($view) $inst]
1432        if {$i >= 0} {
1433            set viewinstances($view) [lreplace $viewinstances($view) $i $i]
1434        }
1435        # set it blocking so we wait for the process to terminate
1436        fconfigure $fd -blocking 1
1437        if {[catch {close $fd} err]} {
1438            set fv {}
1439            if {$view != $curview} {
1440                set fv " for the \"$viewname($view)\" view"
1441            }
1442            if {[string range $err 0 4] == "usage"} {
1443                set err "Gitk: error reading commits$fv:\
1444                        bad arguments to git log."
1445                if {$viewname($view) eq [mc "Command line"]} {
1446                    append err \
1447                        "  (Note: arguments to gitk are passed to git log\
1448                         to allow selection of commits to be displayed.)"
1449                }
1450            } else {
1451                set err "Error reading commits$fv: $err"
1452            }
1453            error_popup $err
1454        }
1455        if {[incr viewactive($view) -1] <= 0} {
1456            set viewcomplete($view) 1
1457            # Check if we have seen any ids listed as parents that haven't
1458            # appeared in the list
1459            closevarcs $view
1460            notbusy $view
1461        }
1462        if {$view == $curview} {
1463            run chewcommits
1464        }
1465        return 0
1466    }
1467    set start 0
1468    set gotsome 0
1469    set scripts {}
1470    while 1 {
1471        set i [string first "\0" $stuff $start]
1472        if {$i < 0} {
1473            append leftover($inst) [string range $stuff $start end]
1474            break
1475        }
1476        if {$start == 0} {
1477            set cmit $leftover($inst)
1478            append cmit [string range $stuff 0 [expr {$i - 1}]]
1479            set leftover($inst) {}
1480        } else {
1481            set cmit [string range $stuff $start [expr {$i - 1}]]
1482        }
1483        set start [expr {$i + 1}]
1484        set j [string first "\n" $cmit]
1485        set ok 0
1486        set listed 1
1487        if {$j >= 0 && [string match "commit *" $cmit]} {
1488            set ids [string range $cmit 7 [expr {$j - 1}]]
1489            if {[string match {[-^<>]*} $ids]} {
1490                switch -- [string index $ids 0] {
1491                    "-" {set listed 0}
1492                    "^" {set listed 2}
1493                    "<" {set listed 3}
1494                    ">" {set listed 4}
1495                }
1496                set ids [string range $ids 1 end]
1497            }
1498            set ok 1
1499            foreach id $ids {
1500                if {[string length $id] != 40} {
1501                    set ok 0
1502                    break
1503                }
1504            }
1505        }
1506        if {!$ok} {
1507            set shortcmit $cmit
1508            if {[string length $shortcmit] > 80} {
1509                set shortcmit "[string range $shortcmit 0 80]..."
1510            }
1511            error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
1512            exit 1
1513        }
1514        set id [lindex $ids 0]
1515        set vid $view,$id
1516
1517        lappend vshortids($view,[string range $id 0 3]) $id
1518
1519        if {!$listed && $updating && ![info exists varcid($vid)] &&
1520            $vfilelimit($view) ne {}} {
1521            # git log doesn't rewrite parents for unlisted commits
1522            # when doing path limiting, so work around that here
1523            # by working out the rewritten parent with git rev-list
1524            # and if we already know about it, using the rewritten
1525            # parent as a substitute parent for $id's children.
1526            if {![catch {
1527                set rwid [exec git rev-list --first-parent --max-count=1 \
1528                              $id -- $vfilelimit($view)]
1529            }]} {
1530                if {$rwid ne {} && [info exists varcid($view,$rwid)]} {
1531                    # use $rwid in place of $id
1532                    rewrite_commit $view $id $rwid
1533                    continue
1534                }
1535            }
1536        }
1537
1538        set a 0
1539        if {[info exists varcid($vid)]} {
1540            if {$cmitlisted($vid) || !$listed} continue
1541            set a $varcid($vid)
1542        }
1543        if {$listed} {
1544            set olds [lrange $ids 1 end]
1545        } else {
1546            set olds {}
1547        }
1548        set commitdata($id) [string range $cmit [expr {$j + 1}] end]
1549        set cmitlisted($vid) $listed
1550        set parents($vid) $olds
1551        if {![info exists children($vid)]} {
1552            set children($vid) {}
1553        } elseif {$a == 0 && [llength $children($vid)] == 1} {
1554            set k [lindex $children($vid) 0]
1555            if {[llength $parents($view,$k)] == 1 &&
1556                (!$vdatemode($view) ||
1557                 $varcid($view,$k) == [llength $varctok($view)] - 1)} {
1558                set a $varcid($view,$k)
1559            }
1560        }
1561        if {$a == 0} {
1562            # new arc
1563            set a [newvarc $view $id]
1564        }
1565        if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
1566            modify_arc $view $a
1567        }
1568        if {![info exists varcid($vid)]} {
1569            set varcid($vid) $a
1570            lappend varccommits($view,$a) $id
1571            incr commitidx($view)
1572        }
1573
1574        set i 0
1575        foreach p $olds {
1576            if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
1577                set vp $view,$p
1578                if {[llength [lappend children($vp) $id]] > 1 &&
1579                    [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
1580                    set children($vp) [lsort -command [list vtokcmp $view] \
1581                                           $children($vp)]
1582                    unset -nocomplain ordertok
1583                }
1584                if {[info exists varcid($view,$p)]} {
1585                    fix_reversal $p $a $view
1586                }
1587            }
1588            incr i
1589        }
1590
1591        set scripts [check_interest $id $scripts]
1592        set gotsome 1
1593    }
1594    if {$gotsome} {
1595        global numcommits hlview
1596
1597        if {$view == $curview} {
1598            set numcommits $commitidx($view)
1599            run chewcommits
1600        }
1601        if {[info exists hlview] && $view == $hlview} {
1602            # we never actually get here...
1603            run vhighlightmore
1604        }
1605        foreach s $scripts {
1606            eval $s
1607        }
1608    }
1609    return 2
1610}
1611
1612proc chewcommits {} {
1613    global curview hlview viewcomplete
1614    global pending_select
1615
1616    layoutmore
1617    if {$viewcomplete($curview)} {
1618        global commitidx varctok
1619        global numcommits startmsecs
1620
1621        if {[info exists pending_select]} {
1622            update
1623            reset_pending_select {}
1624
1625            if {[commitinview $pending_select $curview]} {
1626                selectline [rowofcommit $pending_select] 1
1627            } else {
1628                set row [first_real_row]
1629                selectline $row 1
1630            }
1631        }
1632        if {$commitidx($curview) > 0} {
1633            #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1634            #puts "overall $ms ms for $numcommits commits"
1635            #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1636        } else {
1637            show_status [mc "No commits selected"]
1638        }
1639        notbusy layout
1640    }
1641    return 0
1642}
1643
1644proc do_readcommit {id} {
1645    global tclencoding
1646
1647    # Invoke git-log to handle automatic encoding conversion
1648    set fd [open [concat | git log --no-color --pretty=raw -1 $id] r]
1649    # Read the results using i18n.logoutputencoding
1650    fconfigure $fd -translation lf -eofchar {}
1651    if {$tclencoding != {}} {
1652        fconfigure $fd -encoding $tclencoding
1653    }
1654    set contents [read $fd]
1655    close $fd
1656    # Remove the heading line
1657    regsub {^commit [0-9a-f]+\n} $contents {} contents
1658
1659    return $contents
1660}
1661
1662proc readcommit {id} {
1663    if {[catch {set contents [do_readcommit $id]}]} return
1664    parsecommit $id $contents 1
1665}
1666
1667proc parsecommit {id contents listed} {
1668    global commitinfo
1669
1670    set inhdr 1
1671    set comment {}
1672    set headline {}
1673    set auname {}
1674    set audate {}
1675    set comname {}
1676    set comdate {}
1677    set hdrend [string first "\n\n" $contents]
1678    if {$hdrend < 0} {
1679        # should never happen...
1680        set hdrend [string length $contents]
1681    }
1682    set header [string range $contents 0 [expr {$hdrend - 1}]]
1683    set comment [string range $contents [expr {$hdrend + 2}] end]
1684    foreach line [split $header "\n"] {
1685        set line [split $line " "]
1686        set tag [lindex $line 0]
1687        if {$tag == "author"} {
1688            set audate [lrange $line end-1 end]
1689            set auname [join [lrange $line 1 end-2] " "]
1690        } elseif {$tag == "committer"} {
1691            set comdate [lrange $line end-1 end]
1692            set comname [join [lrange $line 1 end-2] " "]
1693        }
1694    }
1695    set headline {}
1696    # take the first non-blank line of the comment as the headline
1697    set headline [string trimleft $comment]
1698    set i [string first "\n" $headline]
1699    if {$i >= 0} {
1700        set headline [string range $headline 0 $i]
1701    }
1702    set headline [string trimright $headline]
1703    set i [string first "\r" $headline]
1704    if {$i >= 0} {
1705        set headline [string trimright [string range $headline 0 $i]]
1706    }
1707    if {!$listed} {
1708        # git log indents the comment by 4 spaces;
1709        # if we got this via git cat-file, add the indentation
1710        set newcomment {}
1711        foreach line [split $comment "\n"] {
1712            append newcomment "    "
1713            append newcomment $line
1714            append newcomment "\n"
1715        }
1716        set comment $newcomment
1717    }
1718    set hasnote [string first "\nNotes:\n" $contents]
1719    set diff ""
1720    # If there is diff output shown in the git-log stream, split it
1721    # out.  But get rid of the empty line that always precedes the
1722    # diff.
1723    set i [string first "\n\ndiff" $comment]
1724    if {$i >= 0} {
1725        set diff [string range $comment $i+1 end]
1726        set comment [string range $comment 0 $i-1]
1727    }
1728    set commitinfo($id) [list $headline $auname $audate \
1729                             $comname $comdate $comment $hasnote $diff]
1730}
1731
1732proc getcommit {id} {
1733    global commitdata commitinfo
1734
1735    if {[info exists commitdata($id)]} {
1736        parsecommit $id $commitdata($id) 1
1737    } else {
1738        readcommit $id
1739        if {![info exists commitinfo($id)]} {
1740            set commitinfo($id) [list [mc "No commit information available"]]
1741        }
1742    }
1743    return 1
1744}
1745
1746# Expand an abbreviated commit ID to a list of full 40-char IDs that match
1747# and are present in the current view.
1748# This is fairly slow...
1749proc longid {prefix} {
1750    global varcid curview vshortids
1751
1752    set ids {}
1753    if {[string length $prefix] >= 4} {
1754        set vshortid $curview,[string range $prefix 0 3]
1755        if {[info exists vshortids($vshortid)]} {
1756            foreach id $vshortids($vshortid) {
1757                if {[string match "$prefix*" $id]} {
1758                    if {[lsearch -exact $ids $id] < 0} {
1759                        lappend ids $id
1760                        if {[llength $ids] >= 2} break
1761                    }
1762                }
1763            }
1764        }
1765    } else {
1766        foreach match [array names varcid "$curview,$prefix*"] {
1767            lappend ids [lindex [split $match ","] 1]
1768            if {[llength $ids] >= 2} break
1769        }
1770    }
1771    return $ids
1772}
1773
1774proc readrefs {} {
1775    global tagids idtags headids idheads tagobjid
1776    global otherrefids idotherrefs mainhead mainheadid
1777    global selecthead selectheadid
1778    global hideremotes
1779
1780    foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
1781        unset -nocomplain $v
1782    }
1783    set refd [open [list | git show-ref -d] r]
1784    while {[gets $refd line] >= 0} {
1785        if {[string index $line 40] ne " "} continue
1786        set id [string range $line 0 39]
1787        set ref [string range $line 41 end]
1788        if {![string match "refs/*" $ref]} continue
1789        set name [string range $ref 5 end]
1790        if {[string match "remotes/*" $name]} {
1791            if {![string match "*/HEAD" $name] && !$hideremotes} {
1792                set headids($name) $id
1793                lappend idheads($id) $name
1794            }
1795        } elseif {[string match "heads/*" $name]} {
1796            set name [string range $name 6 end]
1797            set headids($name) $id
1798            lappend idheads($id) $name
1799        } elseif {[string match "tags/*" $name]} {
1800            # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1801            # which is what we want since the former is the commit ID
1802            set name [string range $name 5 end]
1803            if {[string match "*^{}" $name]} {
1804                set name [string range $name 0 end-3]
1805            } else {
1806                set tagobjid($name) $id
1807            }
1808            set tagids($name) $id
1809            lappend idtags($id) $name
1810        } else {
1811            set otherrefids($name) $id
1812            lappend idotherrefs($id) $name
1813        }
1814    }
1815    catch {close $refd}
1816    set mainhead {}
1817    set mainheadid {}
1818    catch {
1819        set mainheadid [exec git rev-parse HEAD]
1820        set thehead [exec git symbolic-ref HEAD]
1821        if {[string match "refs/heads/*" $thehead]} {
1822            set mainhead [string range $thehead 11 end]
1823        }
1824    }
1825    set selectheadid {}
1826    if {$selecthead ne {}} {
1827        catch {
1828            set selectheadid [exec git rev-parse --verify $selecthead]
1829        }
1830    }
1831}
1832
1833# skip over fake commits
1834proc first_real_row {} {
1835    global nullid nullid2 numcommits
1836
1837    for {set row 0} {$row < $numcommits} {incr row} {
1838        set id [commitonrow $row]
1839        if {$id ne $nullid && $id ne $nullid2} {
1840            break
1841        }
1842    }
1843    return $row
1844}
1845
1846# update things for a head moved to a child of its previous location
1847proc movehead {id name} {
1848    global headids idheads
1849
1850    removehead $headids($name) $name
1851    set headids($name) $id
1852    lappend idheads($id) $name
1853}
1854
1855# update things when a head has been removed
1856proc removehead {id name} {
1857    global headids idheads
1858
1859    if {$idheads($id) eq $name} {
1860        unset idheads($id)
1861    } else {
1862        set i [lsearch -exact $idheads($id) $name]
1863        if {$i >= 0} {
1864            set idheads($id) [lreplace $idheads($id) $i $i]
1865        }
1866    }
1867    unset headids($name)
1868}
1869
1870proc ttk_toplevel {w args} {
1871    global use_ttk
1872    eval [linsert $args 0 ::toplevel $w]
1873    if {$use_ttk} {
1874        place [ttk::frame $w._toplevel_background] -x 0 -y 0 -relwidth 1 -relheight 1
1875    }
1876    return $w
1877}
1878
1879proc make_transient {window origin} {
1880    global have_tk85
1881
1882    # In MacOS Tk 8.4 transient appears to work by setting
1883    # overrideredirect, which is utterly useless, since the
1884    # windows get no border, and are not even kept above
1885    # the parent.
1886    if {!$have_tk85 && [tk windowingsystem] eq {aqua}} return
1887
1888    wm transient $window $origin
1889
1890    # Windows fails to place transient windows normally, so
1891    # schedule a callback to center them on the parent.
1892    if {[tk windowingsystem] eq {win32}} {
1893        after idle [list tk::PlaceWindow $window widget $origin]
1894    }
1895}
1896
1897proc show_error {w top msg} {
1898    global NS
1899    if {![info exists NS]} {set NS ""}
1900    if {[wm state $top] eq "withdrawn"} { wm deiconify $top }
1901    message $w.m -text $msg -justify center -aspect 400
1902    pack $w.m -side top -fill x -padx 20 -pady 20
1903    ${NS}::button $w.ok -default active -text [mc OK] -command "destroy $top"
1904    pack $w.ok -side bottom -fill x
1905    bind $top <Visibility> "grab $top; focus $top"
1906    bind $top <Key-Return> "destroy $top"
1907    bind $top <Key-space>  "destroy $top"
1908    bind $top <Key-Escape> "destroy $top"
1909    tkwait window $top
1910}
1911
1912proc error_popup {msg {owner .}} {
1913    if {[tk windowingsystem] eq "win32"} {
1914        tk_messageBox -icon error -type ok -title [wm title .] \
1915            -parent $owner -message $msg
1916    } else {
1917        set w .error
1918        ttk_toplevel $w
1919        make_transient $w $owner
1920        show_error $w $w $msg
1921    }
1922}
1923
1924proc confirm_popup {msg {owner .}} {
1925    global confirm_ok NS
1926    set confirm_ok 0
1927    set w .confirm
1928    ttk_toplevel $w
1929    make_transient $w $owner
1930    message $w.m -text $msg -justify center -aspect 400
1931    pack $w.m -side top -fill x -padx 20 -pady 20
1932    ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
1933    pack $w.ok -side left -fill x
1934    ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
1935    pack $w.cancel -side right -fill x
1936    bind $w <Visibility> "grab $w; focus $w"
1937    bind $w <Key-Return> "set confirm_ok 1; destroy $w"
1938    bind $w <Key-space>  "set confirm_ok 1; destroy $w"
1939    bind $w <Key-Escape> "destroy $w"
1940    tk::PlaceWindow $w widget $owner
1941    tkwait window $w
1942    return $confirm_ok
1943}
1944
1945proc setoptions {} {
1946    if {[tk windowingsystem] ne "win32"} {
1947        option add *Panedwindow.showHandle 1 startupFile
1948        option add *Panedwindow.sashRelief raised startupFile
1949        if {[tk windowingsystem] ne "aqua"} {
1950            option add *Menu.font uifont startupFile
1951        }
1952    } else {
1953        option add *Menu.TearOff 0 startupFile
1954    }
1955    option add *Button.font uifont startupFile
1956    option add *Checkbutton.font uifont startupFile
1957    option add *Radiobutton.font uifont startupFile
1958    option add *Menubutton.font uifont startupFile
1959    option add *Label.font uifont startupFile
1960    option add *Message.font uifont startupFile
1961    option add *Entry.font textfont startupFile
1962    option add *Text.font textfont startupFile
1963    option add *Labelframe.font uifont startupFile
1964    option add *Spinbox.font textfont startupFile
1965    option add *Listbox.font mainfont startupFile
1966}
1967
1968# Make a menu and submenus.
1969# m is the window name for the menu, items is the list of menu items to add.
1970# Each item is a list {mc label type description options...}
1971# mc is ignored; it's so we can put mc there to alert xgettext
1972# label is the string that appears in the menu
1973# type is cascade, command or radiobutton (should add checkbutton)
1974# description depends on type; it's the sublist for cascade, the
1975# command to invoke for command, or {variable value} for radiobutton
1976proc makemenu {m items} {
1977    menu $m
1978    if {[tk windowingsystem] eq {aqua}} {
1979        set Meta1 Cmd
1980    } else {
1981        set Meta1 Ctrl
1982    }
1983    foreach i $items {
1984        set name [mc [lindex $i 1]]
1985        set type [lindex $i 2]
1986        set thing [lindex $i 3]
1987        set params [list $type]
1988        if {$name ne {}} {
1989            set u [string first "&" [string map {&& x} $name]]
1990            lappend params -label [string map {&& & & {}} $name]
1991            if {$u >= 0} {
1992                lappend params -underline $u
1993            }
1994        }
1995        switch -- $type {
1996            "cascade" {
1997                set submenu [string tolower [string map {& ""} [lindex $i 1]]]
1998                lappend params -menu $m.$submenu
1999            }
2000            "command" {
2001                lappend params -command $thing
2002            }
2003            "radiobutton" {
2004                lappend params -variable [lindex $thing 0] \
2005                    -value [lindex $thing 1]
2006            }
2007        }
2008        set tail [lrange $i 4 end]
2009        regsub -all {\yMeta1\y} $tail $Meta1 tail
2010        eval $m add $params $tail
2011        if {$type eq "cascade"} {
2012            makemenu $m.$submenu $thing
2013        }
2014    }
2015}
2016
2017# translate string and remove ampersands
2018proc mca {str} {
2019    return [string map {&& & & {}} [mc $str]]
2020}
2021
2022proc cleardropsel {w} {
2023    $w selection clear
2024}
2025proc makedroplist {w varname args} {
2026    global use_ttk
2027    if {$use_ttk} {
2028        set width 0
2029        foreach label $args {
2030            set cx [string length $label]
2031            if {$cx > $width} {set width $cx}
2032        }
2033        set gm [ttk::combobox $w -width $width -state readonly\
2034                    -textvariable $varname -values $args \
2035                    -exportselection false]
2036        bind $gm <<ComboboxSelected>> [list $gm selection clear]
2037    } else {
2038        set gm [eval [linsert $args 0 tk_optionMenu $w $varname]]
2039    }
2040    return $gm
2041}
2042
2043proc makewindow {} {
2044    global canv canv2 canv3 linespc charspc ctext cflist cscroll
2045    global tabstop
2046    global findtype findtypemenu findloc findstring fstring geometry
2047    global entries sha1entry sha1string sha1but
2048    global diffcontextstring diffcontext
2049    global ignorespace
2050    global maincursor textcursor curtextcursor
2051    global rowctxmenu fakerowmenu mergemax wrapcomment
2052    global highlight_files gdttype
2053    global searchstring sstring
2054    global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
2055    global uifgcolor uifgdisabledcolor
2056    global filesepbgcolor filesepfgcolor
2057    global mergecolors foundbgcolor currentsearchhitbgcolor
2058    global headctxmenu progresscanv progressitem progresscoords statusw
2059    global fprogitem fprogcoord lastprogupdate progupdatepending
2060    global rprogitem rprogcoord rownumsel numcommits
2061    global have_tk85 use_ttk NS
2062    global git_version
2063    global worddiff
2064
2065    # The "mc" arguments here are purely so that xgettext
2066    # sees the following string as needing to be translated
2067    set file {
2068        mc "&File" cascade {
2069            {mc "&Update" command updatecommits -accelerator F5}
2070            {mc "&Reload" command reloadcommits -accelerator Shift-F5}
2071            {mc "Reread re&ferences" command rereadrefs}
2072            {mc "&List references" command showrefs -accelerator F2}
2073            {xx "" separator}
2074            {mc "Start git &gui" command {exec git gui &}}
2075            {xx "" separator}
2076            {mc "&Quit" command doquit -accelerator Meta1-Q}
2077        }}
2078    set edit {
2079        mc "&Edit" cascade {
2080            {mc "&Preferences" command doprefs}
2081        }}
2082    set view {
2083        mc "&View" cascade {
2084            {mc "&New view..." command {newview 0} -accelerator Shift-F4}
2085            {mc "&Edit view..." command editview -state disabled -accelerator F4}
2086            {mc "&Delete view" command delview -state disabled}
2087            {xx "" separator}
2088            {mc "&All files" radiobutton {selectedview 0} -command {showview 0}}
2089        }}
2090    if {[tk windowingsystem] ne "aqua"} {
2091        set help {
2092        mc "&Help" cascade {
2093            {mc "&About gitk" command about}
2094            {mc "&Key bindings" command keys}
2095        }}
2096        set bar [list $file $edit $view $help]
2097    } else {
2098        proc ::tk::mac::ShowPreferences {} {doprefs}
2099        proc ::tk::mac::Quit {} {doquit}
2100        lset file end [lreplace [lindex $file end] end-1 end]
2101        set apple {
2102        xx "&Apple" cascade {
2103            {mc "&About gitk" command about}
2104            {xx "" separator}
2105        }}
2106        set help {
2107        mc "&Help" cascade {
2108            {mc "&Key bindings" command keys}
2109        }}
2110        set bar [list $apple $file $view $help]
2111    }
2112    makemenu .bar $bar
2113    . configure -menu .bar
2114
2115    if {$use_ttk} {
2116        # cover the non-themed toplevel with a themed frame.
2117        place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1
2118    }
2119
2120    # the gui has upper and lower half, parts of a paned window.
2121    ${NS}::panedwindow .ctop -orient vertical
2122
2123    # possibly use assumed geometry
2124    if {![info exists geometry(pwsash0)]} {
2125        set geometry(topheight) [expr {15 * $linespc}]
2126        set geometry(topwidth) [expr {80 * $charspc}]
2127        set geometry(botheight) [expr {15 * $linespc}]
2128        set geometry(botwidth) [expr {50 * $charspc}]
2129        set geometry(pwsash0) [list [expr {40 * $charspc}] 2]
2130        set geometry(pwsash1) [list [expr {60 * $charspc}] 2]
2131    }
2132
2133    # the upper half will have a paned window, a scroll bar to the right, and some stuff below
2134    ${NS}::frame .tf -height $geometry(topheight) -width $geometry(topwidth)
2135    ${NS}::frame .tf.histframe
2136    ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal
2137    if {!$use_ttk} {
2138        .tf.histframe.pwclist configure -sashpad 0 -handlesize 4
2139    }
2140
2141    # create three canvases
2142    set cscroll .tf.histframe.csb
2143    set canv .tf.histframe.pwclist.canv
2144    canvas $canv \
2145        -selectbackground $selectbgcolor \
2146        -background $bgcolor -bd 0 \
2147        -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
2148    .tf.histframe.pwclist add $canv
2149    set canv2 .tf.histframe.pwclist.canv2
2150    canvas $canv2 \
2151        -selectbackground $selectbgcolor \
2152        -background $bgcolor -bd 0 -yscrollincr $linespc
2153    .tf.histframe.pwclist add $canv2
2154    set canv3 .tf.histframe.pwclist.canv3
2155    canvas $canv3 \
2156        -selectbackground $selectbgcolor \
2157        -background $bgcolor -bd 0 -yscrollincr $linespc
2158    .tf.histframe.pwclist add $canv3
2159    if {$use_ttk} {
2160        bind .tf.histframe.pwclist <Map> {
2161            bind %W <Map> {}
2162            .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0]
2163            .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0]
2164        }
2165    } else {
2166        eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
2167        eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
2168    }
2169
2170    # a scroll bar to rule them
2171    ${NS}::scrollbar $cscroll -command {allcanvs yview}
2172    if {!$use_ttk} {$cscroll configure -highlightthickness 0}
2173    pack $cscroll -side right -fill y
2174    bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
2175    lappend bglist $canv $canv2 $canv3
2176    pack .tf.histframe.pwclist -fill both -expand 1 -side left
2177
2178    # we have two button bars at bottom of top frame. Bar 1
2179    ${NS}::frame .tf.bar
2180    ${NS}::frame .tf.lbar -height 15
2181
2182    set sha1entry .tf.bar.sha1
2183    set entries $sha1entry
2184    set sha1but .tf.bar.sha1label
2185    button $sha1but -text "[mc "SHA1 ID:"] " -state disabled -relief flat \
2186        -command gotocommit -width 8
2187    $sha1but conf -disabledforeground [$sha1but cget -foreground]
2188    pack .tf.bar.sha1label -side left
2189    ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string
2190    trace add variable sha1string write sha1change
2191    pack $sha1entry -side left -pady 2
2192
2193    set bm_left_data {
2194        #define left_width 16
2195        #define left_height 16
2196        static unsigned char left_bits[] = {
2197        0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
2198        0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
2199        0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
2200    }
2201    set bm_right_data {
2202        #define right_width 16
2203        #define right_height 16
2204        static unsigned char right_bits[] = {
2205        0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
2206        0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
2207        0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
2208    }
2209    image create bitmap bm-left -data $bm_left_data -foreground $uifgcolor
2210    image create bitmap bm-left-gray -data $bm_left_data -foreground $uifgdisabledcolor
2211    image create bitmap bm-right -data $bm_right_data -foreground $uifgcolor
2212    image create bitmap bm-right-gray -data $bm_right_data -foreground $uifgdisabledcolor
2213
2214    ${NS}::button .tf.bar.leftbut -command goback -state disabled -width 26
2215    if {$use_ttk} {
2216        .tf.bar.leftbut configure -image [list bm-left disabled bm-left-gray]
2217    } else {
2218        .tf.bar.leftbut configure -image bm-left
2219    }
2220    pack .tf.bar.leftbut -side left -fill y
2221    ${NS}::button .tf.bar.rightbut -command goforw -state disabled -width 26
2222    if {$use_ttk} {
2223        .tf.bar.rightbut configure -image [list bm-right disabled bm-right-gray]
2224    } else {
2225        .tf.bar.rightbut configure -image bm-right
2226    }
2227    pack .tf.bar.rightbut -side left -fill y
2228
2229    ${NS}::label .tf.bar.rowlabel -text [mc "Row"]
2230    set rownumsel {}
2231    ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \
2232        -relief sunken -anchor e
2233    ${NS}::label .tf.bar.rowlabel2 -text "/"
2234    ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \
2235        -relief sunken -anchor e
2236    pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
2237        -side left
2238    if {!$use_ttk} {
2239        foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont}
2240    }
2241    global selectedline
2242    trace add variable selectedline write selectedline_change
2243
2244    # Status label and progress bar
2245    set statusw .tf.bar.status
2246    ${NS}::label $statusw -width 15 -relief sunken
2247    pack $statusw -side left -padx 5
2248    if {$use_ttk} {
2249        set progresscanv [ttk::progressbar .tf.bar.progress]
2250    } else {
2251        set h [expr {[font metrics uifont -linespace] + 2}]
2252        set progresscanv .tf.bar.progress
2253        canvas $progresscanv -relief sunken -height $h -borderwidth 2
2254        set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
2255        set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
2256        set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
2257    }
2258    pack $progresscanv -side right -expand 1 -fill x -padx {0 2}
2259    set progresscoords {0 0}
2260    set fprogcoord 0
2261    set rprogcoord 0
2262    bind $progresscanv <Configure> adjustprogress
2263    set lastprogupdate [clock clicks -milliseconds]
2264    set progupdatepending 0
2265
2266    # build up the bottom bar of upper window
2267    ${NS}::label .tf.lbar.flabel -text "[mc "Find"] "
2268
2269    set bm_down_data {
2270        #define down_width 16
2271        #define down_height 16
2272        static unsigned char down_bits[] = {
2273        0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2274        0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2275        0x87, 0xe1, 0x8e, 0x71, 0x9c, 0x39, 0xb8, 0x1d,
2276        0xf0, 0x0f, 0xe0, 0x07, 0xc0, 0x03, 0x80, 0x01};
2277    }
2278    image create bitmap bm-down -data $bm_down_data -foreground $uifgcolor
2279    ${NS}::button .tf.lbar.fnext -width 26 -command {dofind 1 1}
2280    .tf.lbar.fnext configure -image bm-down
2281
2282    set bm_up_data {
2283        #define up_width 16
2284        #define up_height 16
2285        static unsigned char up_bits[] = {
2286        0x80, 0x01, 0xc0, 0x03, 0xe0, 0x07, 0xf0, 0x0f,
2287        0xb8, 0x1d, 0x9c, 0x39, 0x8e, 0x71, 0x87, 0xe1,
2288        0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2289        0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01};
2290    }
2291    image create bitmap bm-up -data $bm_up_data -foreground $uifgcolor
2292    ${NS}::button .tf.lbar.fprev -width 26 -command {dofind -1 1}
2293    .tf.lbar.fprev configure -image bm-up
2294
2295    ${NS}::label .tf.lbar.flab2 -text " [mc "commit"] "
2296
2297    pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
2298        -side left -fill y
2299    set gdttype [mc "containing:"]
2300    set gm [makedroplist .tf.lbar.gdttype gdttype \
2301                [mc "containing:"] \
2302                [mc "touching paths:"] \
2303                [mc "adding/removing string:"] \
2304                [mc "changing lines matching:"]]
2305    trace add variable gdttype write gdttype_change
2306    pack .tf.lbar.gdttype -side left -fill y
2307
2308    set findstring {}
2309    set fstring .tf.lbar.findstring
2310    lappend entries $fstring
2311    ${NS}::entry $fstring -width 30 -textvariable findstring
2312    trace add variable findstring write find_change
2313    set findtype [mc "Exact"]
2314    set findtypemenu [makedroplist .tf.lbar.findtype \
2315                          findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
2316    trace add variable findtype write findcom_change
2317    set findloc [mc "All fields"]
2318    makedroplist .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
2319        [mc "Comments"] [mc "Author"] [mc "Committer"]
2320    trace add variable findloc write find_change
2321    pack .tf.lbar.findloc -side right
2322    pack .tf.lbar.findtype -side right
2323    pack $fstring -side left -expand 1 -fill x
2324
2325    # Finish putting the upper half of the viewer together
2326    pack .tf.lbar -in .tf -side bottom -fill x
2327    pack .tf.bar -in .tf -side bottom -fill x
2328    pack .tf.histframe -fill both -side top -expand 1
2329    .ctop add .tf
2330    if {!$use_ttk} {
2331        .ctop paneconfigure .tf -height $geometry(topheight)
2332        .ctop paneconfigure .tf -width $geometry(topwidth)
2333    }
2334
2335    # now build up the bottom
2336    ${NS}::panedwindow .pwbottom -orient horizontal
2337
2338    # lower left, a text box over search bar, scroll bar to the right
2339    # if we know window height, then that will set the lower text height, otherwise
2340    # we set lower text height which will drive window height
2341    if {[info exists geometry(main)]} {
2342        ${NS}::frame .bleft -width $geometry(botwidth)
2343    } else {
2344        ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
2345    }
2346    ${NS}::frame .bleft.top
2347    ${NS}::frame .bleft.mid
2348    ${NS}::frame .bleft.bottom
2349
2350    ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch
2351    pack .bleft.top.search -side left -padx 5
2352    set sstring .bleft.top.sstring
2353    set searchstring ""
2354    ${NS}::entry $sstring -width 20 -textvariable searchstring
2355    lappend entries $sstring
2356    trace add variable searchstring write incrsearch
2357    pack $sstring -side left -expand 1 -fill x
2358    ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \
2359        -command changediffdisp -variable diffelide -value {0 0}
2360    ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \
2361        -command changediffdisp -variable diffelide -value {0 1}
2362    ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \
2363        -command changediffdisp -variable diffelide -value {1 0}
2364    ${NS}::label .bleft.mid.labeldiffcontext -text "      [mc "Lines of context"]: "
2365    pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
2366    spinbox .bleft.mid.diffcontext -width 5 \
2367        -from 0 -increment 1 -to 10000000 \
2368        -validate all -validatecommand "diffcontextvalidate %P" \
2369        -textvariable diffcontextstring
2370    .bleft.mid.diffcontext set $diffcontext
2371    trace add variable diffcontextstring write diffcontextchange
2372    lappend entries .bleft.mid.diffcontext
2373    pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
2374    ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
2375        -command changeignorespace -variable ignorespace
2376    pack .bleft.mid.ignspace -side left -padx 5
2377
2378    set worddiff [mc "Line diff"]
2379    if {[package vcompare $git_version "1.7.2"] >= 0} {
2380        makedroplist .bleft.mid.worddiff worddiff [mc "Line diff"] \
2381            [mc "Markup words"] [mc "Color words"]
2382        trace add variable worddiff write changeworddiff
2383        pack .bleft.mid.worddiff -side left -padx 5
2384    }
2385
2386    set ctext .bleft.bottom.ctext
2387    text $ctext -background $bgcolor -foreground $fgcolor \
2388        -state disabled -font textfont \
2389        -yscrollcommand scrolltext -wrap none \
2390        -xscrollcommand ".bleft.bottom.sbhorizontal set"
2391    if {$have_tk85} {
2392        $ctext conf -tabstyle wordprocessor
2393    }
2394    ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview"
2395    ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h
2396    pack .bleft.top -side top -fill x
2397    pack .bleft.mid -side top -fill x
2398    grid $ctext .bleft.bottom.sb -sticky nsew
2399    grid .bleft.bottom.sbhorizontal -sticky ew
2400    grid columnconfigure .bleft.bottom 0 -weight 1
2401    grid rowconfigure .bleft.bottom 0 -weight 1
2402    grid rowconfigure .bleft.bottom 1 -weight 0
2403    pack .bleft.bottom -side top -fill both -expand 1
2404    lappend bglist $ctext
2405    lappend fglist $ctext
2406
2407    $ctext tag conf comment -wrap $wrapcomment
2408    $ctext tag conf filesep -font textfontbold -fore $filesepfgcolor -back $filesepbgcolor
2409    $ctext tag conf hunksep -fore [lindex $diffcolors 2]
2410    $ctext tag conf d0 -fore [lindex $diffcolors 0]
2411    $ctext tag conf dresult -fore [lindex $diffcolors 1]
2412    $ctext tag conf m0 -fore [lindex $mergecolors 0]
2413    $ctext tag conf m1 -fore [lindex $mergecolors 1]
2414    $ctext tag conf m2 -fore [lindex $mergecolors 2]
2415    $ctext tag conf m3 -fore [lindex $mergecolors 3]
2416    $ctext tag conf m4 -fore [lindex $mergecolors 4]
2417    $ctext tag conf m5 -fore [lindex $mergecolors 5]
2418    $ctext tag conf m6 -fore [lindex $mergecolors 6]
2419    $ctext tag conf m7 -fore [lindex $mergecolors 7]
2420    $ctext tag conf m8 -fore [lindex $mergecolors 8]
2421    $ctext tag conf m9 -fore [lindex $mergecolors 9]
2422    $ctext tag conf m10 -fore [lindex $mergecolors 10]
2423    $ctext tag conf m11 -fore [lindex $mergecolors 11]
2424    $ctext tag conf m12 -fore [lindex $mergecolors 12]
2425    $ctext tag conf m13 -fore [lindex $mergecolors 13]
2426    $ctext tag conf m14 -fore [lindex $mergecolors 14]
2427    $ctext tag conf m15 -fore [lindex $mergecolors 15]
2428    $ctext tag conf mmax -fore darkgrey
2429    set mergemax 16
2430    $ctext tag conf mresult -font textfontbold
2431    $ctext tag conf msep -font textfontbold
2432    $ctext tag conf found -back $foundbgcolor
2433    $ctext tag conf currentsearchhit -back $currentsearchhitbgcolor
2434    $ctext tag conf wwrap -wrap word -lmargin2 1c
2435    $ctext tag conf bold -font textfontbold
2436
2437    .pwbottom add .bleft
2438    if {!$use_ttk} {
2439        .pwbottom paneconfigure .bleft -width $geometry(botwidth)
2440    }
2441
2442    # lower right
2443    ${NS}::frame .bright
2444    ${NS}::frame .bright.mode
2445    ${NS}::radiobutton .bright.mode.patch -text [mc "Patch"] \
2446        -command reselectline -variable cmitmode -value "patch"
2447    ${NS}::radiobutton .bright.mode.tree -text [mc "Tree"] \
2448        -command reselectline -variable cmitmode -value "tree"
2449    grid .bright.mode.patch .bright.mode.tree -sticky ew
2450    pack .bright.mode -side top -fill x
2451    set cflist .bright.cfiles
2452    set indent [font measure mainfont "nn"]
2453    text $cflist \
2454        -selectbackground $selectbgcolor \
2455        -background $bgcolor -foreground $fgcolor \
2456        -font mainfont \
2457        -tabs [list $indent [expr {2 * $indent}]] \
2458        -yscrollcommand ".bright.sb set" \
2459        -cursor [. cget -cursor] \
2460        -spacing1 1 -spacing3 1
2461    lappend bglist $cflist
2462    lappend fglist $cflist
2463    ${NS}::scrollbar .bright.sb -command "$cflist yview"
2464    pack .bright.sb -side right -fill y
2465    pack $cflist -side left -fill both -expand 1
2466    $cflist tag configure highlight \
2467        -background [$cflist cget -selectbackground]
2468    $cflist tag configure bold -font mainfontbold
2469
2470    .pwbottom add .bright
2471    .ctop add .pwbottom
2472
2473    # restore window width & height if known
2474    if {[info exists geometry(main)]} {
2475        if {[scan $geometry(main) "%dx%d" w h] >= 2} {
2476            if {$w > [winfo screenwidth .]} {
2477                set w [winfo screenwidth .]
2478            }
2479            if {$h > [winfo screenheight .]} {
2480                set h [winfo screenheight .]
2481            }
2482            wm geometry . "${w}x$h"
2483        }
2484    }
2485
2486    if {[info exists geometry(state)] && $geometry(state) eq "zoomed"} {
2487        wm state . $geometry(state)
2488    }
2489
2490    if {[tk windowingsystem] eq {aqua}} {
2491        set M1B M1
2492        set ::BM "3"
2493    } else {
2494        set M1B Control
2495        set ::BM "2"
2496    }
2497
2498    if {$use_ttk} {
2499        bind .ctop <Map> {
2500            bind %W <Map> {}
2501            %W sashpos 0 $::geometry(topheight)
2502        }
2503        bind .pwbottom <Map> {
2504            bind %W <Map> {}
2505            %W sashpos 0 $::geometry(botwidth)
2506        }
2507    }
2508
2509    bind .pwbottom <Configure> {resizecdetpanes %W %w}
2510    pack .ctop -fill both -expand 1
2511    bindall <1> {selcanvline %W %x %y}
2512    #bindall <B1-Motion> {selcanvline %W %x %y}
2513    if {[tk windowingsystem] == "win32"} {
2514        bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
2515        bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
2516    } else {
2517        bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
2518        bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
2519        bind $ctext <Button> {
2520            if {"%b" eq 6} {
2521                $ctext xview scroll -5 units
2522            } elseif {"%b" eq 7} {
2523                $ctext xview scroll 5 units
2524            }
2525        }
2526        if {[tk windowingsystem] eq "aqua"} {
2527            bindall <MouseWheel> {
2528                set delta [expr {- (%D)}]
2529                allcanvs yview scroll $delta units
2530            }
2531            bindall <Shift-MouseWheel> {
2532                set delta [expr {- (%D)}]
2533                $canv xview scroll $delta units
2534            }
2535        }
2536    }
2537    bindall <$::BM> "canvscan mark %W %x %y"
2538    bindall <B$::BM-Motion> "canvscan dragto %W %x %y"
2539    bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2540    bind . <$M1B-Key-w> doquit
2541    bindkey <Home> selfirstline
2542    bindkey <End> sellastline
2543    bind . <Key-Up> "selnextline -1"
2544    bind . <Key-Down> "selnextline 1"
2545    bind . <Shift-Key-Up> "dofind -1 0"
2546    bind . <Shift-Key-Down> "dofind 1 0"
2547    bindkey <Key-Right> "goforw"
2548    bindkey <Key-Left> "goback"
2549    bind . <Key-Prior> "selnextpage -1"
2550    bind . <Key-Next> "selnextpage 1"
2551    bind . <$M1B-Home> "allcanvs yview moveto 0.0"
2552    bind . <$M1B-End> "allcanvs yview moveto 1.0"
2553    bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
2554    bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
2555    bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2556    bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
2557    bindkey <Key-Delete> "$ctext yview scroll -1 pages"
2558    bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
2559    bindkey <Key-space> "$ctext yview scroll 1 pages"
2560    bindkey p "selnextline -1"
2561    bindkey n "selnextline 1"
2562    bindkey z "goback"
2563    bindkey x "goforw"
2564    bindkey k "selnextline -1"
2565    bindkey j "selnextline 1"
2566    bindkey h "goback"
2567    bindkey l "goforw"
2568    bindkey b prevfile
2569    bindkey d "$ctext yview scroll 18 units"
2570    bindkey u "$ctext yview scroll -18 units"
2571    bindkey g {$sha1entry delete 0 end; focus $sha1entry}
2572    bindkey / {focus $fstring}
2573    bindkey <Key-KP_Divide> {focus $fstring}
2574    bindkey <Key-Return> {dofind 1 1}
2575    bindkey ? {dofind -1 1}
2576    bindkey f nextfile
2577    bind . <F5> updatecommits
2578    bindmodfunctionkey Shift 5 reloadcommits
2579    bind . <F2> showrefs
2580    bindmodfunctionkey Shift 4 {newview 0}
2581    bind . <F4> edit_or_newview
2582    bind . <$M1B-q> doquit
2583    bind . <$M1B-f> {dofind 1 1}
2584    bind . <$M1B-g> {dofind 1 0}
2585    bind . <$M1B-r> dosearchback
2586    bind . <$M1B-s> dosearch
2587    bind . <$M1B-equal> {incrfont 1}
2588    bind . <$M1B-plus> {incrfont 1}
2589    bind . <$M1B-KP_Add> {incrfont 1}
2590    bind . <$M1B-minus> {incrfont -1}
2591    bind . <$M1B-KP_Subtract> {incrfont -1}
2592    wm protocol . WM_DELETE_WINDOW doquit
2593    bind . <Destroy> {stop_backends}
2594    bind . <Button-1> "click %W"
2595    bind $fstring <Key-Return> {dofind 1 1}
2596    bind $sha1entry <Key-Return> {gotocommit; break}
2597    bind $sha1entry <<PasteSelection>> clearsha1
2598    bind $sha1entry <<Paste>> clearsha1
2599    bind $cflist <1> {sel_flist %W %x %y; break}
2600    bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
2601    bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
2602    global ctxbut
2603    bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
2604    bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
2605    bind $ctext <Button-1> {focus %W}
2606    bind $ctext <<Selection>> rehighlight_search_results
2607    for {set i 1} {$i < 10} {incr i} {
2608        bind . <$M1B-Key-$i> [list go_to_parent $i]
2609    }
2610
2611    set maincursor [. cget -cursor]
2612    set textcursor [$ctext cget -cursor]
2613    set curtextcursor $textcursor
2614
2615    set rowctxmenu .rowctxmenu
2616    makemenu $rowctxmenu {
2617        {mc "Diff this -> selected" command {diffvssel 0}}
2618        {mc "Diff selected -> this" command {diffvssel 1}}
2619        {mc "Make patch" command mkpatch}
2620        {mc "Create tag" command mktag}
2621        {mc "Copy commit summary" command copysummary}
2622        {mc "Write commit to file" command writecommit}
2623        {mc "Create new branch" command mkbranch}
2624        {mc "Cherry-pick this commit" command cherrypick}
2625        {mc "Reset HEAD branch to here" command resethead}
2626        {mc "Mark this commit" command markhere}
2627        {mc "Return to mark" command gotomark}
2628        {mc "Find descendant of this and mark" command find_common_desc}
2629        {mc "Compare with marked commit" command compare_commits}
2630        {mc "Diff this -> marked commit" command {diffvsmark 0}}
2631        {mc "Diff marked commit -> this" command {diffvsmark 1}}
2632        {mc "Revert this commit" command revert}
2633    }
2634    $rowctxmenu configure -tearoff 0
2635
2636    set fakerowmenu .fakerowmenu
2637    makemenu $fakerowmenu {
2638        {mc "Diff this -> selected" command {diffvssel 0}}
2639        {mc "Diff selected -> this" command {diffvssel 1}}
2640        {mc "Make patch" command mkpatch}
2641        {mc "Diff this -> marked commit" command {diffvsmark 0}}
2642        {mc "Diff marked commit -> this" command {diffvsmark 1}}
2643    }
2644    $fakerowmenu configure -tearoff 0
2645
2646    set headctxmenu .headctxmenu
2647    makemenu $headctxmenu {
2648        {mc "Check out this branch" command cobranch}
2649        {mc "Remove this branch" command rmbranch}
2650        {mc "Copy branch name" command {clipboard clear; clipboard append $headmenuhead}}
2651    }
2652    $headctxmenu configure -tearoff 0
2653
2654    global flist_menu
2655    set flist_menu .flistctxmenu
2656    makemenu $flist_menu {
2657        {mc "Highlight this too" command {flist_hl 0}}
2658        {mc "Highlight this only" command {flist_hl 1}}
2659        {mc "External diff" command {external_diff}}
2660        {mc "Blame parent commit" command {external_blame 1}}
2661        {mc "Copy path" command {clipboard clear; clipboard append $flist_menu_file}}
2662    }
2663    $flist_menu configure -tearoff 0
2664
2665    global diff_menu
2666    set diff_menu .diffctxmenu
2667    makemenu $diff_menu {
2668        {mc "Show origin of this line" command show_line_source}
2669        {mc "Run git gui blame on this line" command {external_blame_diff}}
2670    }
2671    $diff_menu configure -tearoff 0
2672}
2673
2674# Windows sends all mouse wheel events to the current focused window, not
2675# the one where the mouse hovers, so bind those events here and redirect
2676# to the correct window
2677proc windows_mousewheel_redirector {W X Y D} {
2678    global canv canv2 canv3
2679    set w [winfo containing -displayof $W $X $Y]
2680    if {$w ne ""} {
2681        set u [expr {$D < 0 ? 5 : -5}]
2682        if {$w == $canv || $w == $canv2 || $w == $canv3} {
2683            allcanvs yview scroll $u units
2684        } else {
2685            catch {
2686                $w yview scroll $u units
2687            }
2688        }
2689    }
2690}
2691
2692# Update row number label when selectedline changes
2693proc selectedline_change {n1 n2 op} {
2694    global selectedline rownumsel
2695
2696    if {$selectedline eq {}} {
2697        set rownumsel {}
2698    } else {
2699        set rownumsel [expr {$selectedline + 1}]
2700    }
2701}
2702
2703# mouse-2 makes all windows scan vertically, but only the one
2704# the cursor is in scans horizontally
2705proc canvscan {op w x y} {
2706    global canv canv2 canv3
2707    foreach c [list $canv $canv2 $canv3] {
2708        if {$c == $w} {
2709            $c scan $op $x $y
2710        } else {
2711            $c scan $op 0 $y
2712        }
2713    }
2714}
2715
2716proc scrollcanv {cscroll f0 f1} {
2717    $cscroll set $f0 $f1
2718    drawvisible
2719    flushhighlights
2720}
2721
2722# when we make a key binding for the toplevel, make sure
2723# it doesn't get triggered when that key is pressed in the
2724# find string entry widget.
2725proc bindkey {ev script} {
2726    global entries
2727    bind . $ev $script
2728    set escript [bind Entry $ev]
2729    if {$escript == {}} {
2730        set escript [bind Entry <Key>]
2731    }
2732    foreach e $entries {
2733        bind $e $ev "$escript; break"
2734    }
2735}
2736
2737proc bindmodfunctionkey {mod n script} {
2738    bind . <$mod-F$n> $script
2739    catch { bind . <$mod-XF86_Switch_VT_$n> $script }
2740}
2741
2742# set the focus back to the toplevel for any click outside
2743# the entry widgets
2744proc click {w} {
2745    global ctext entries
2746    foreach e [concat $entries $ctext] {
2747        if {$w == $e} return
2748    }
2749    focus .
2750}
2751
2752# Adjust the progress bar for a change in requested extent or canvas size
2753proc adjustprogress {} {
2754    global progresscanv progressitem progresscoords
2755    global fprogitem fprogcoord lastprogupdate progupdatepending
2756    global rprogitem rprogcoord use_ttk
2757
2758    if {$use_ttk} {
2759        $progresscanv configure -value [expr {int($fprogcoord * 100)}]
2760        return
2761    }
2762
2763    set w [expr {[winfo width $progresscanv] - 4}]
2764    set x0 [expr {$w * [lindex $progresscoords 0]}]
2765    set x1 [expr {$w * [lindex $progresscoords 1]}]
2766    set h [winfo height $progresscanv]
2767    $progresscanv coords $progressitem $x0 0 $x1 $h
2768    $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2769    $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2770    set now [clock clicks -milliseconds]
2771    if {$now >= $lastprogupdate + 100} {
2772        set progupdatepending 0
2773        update
2774    } elseif {!$progupdatepending} {
2775        set progupdatepending 1
2776        after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2777    }
2778}
2779
2780proc doprogupdate {} {
2781    global lastprogupdate progupdatepending
2782
2783    if {$progupdatepending} {
2784        set progupdatepending 0
2785        set lastprogupdate [clock clicks -milliseconds]
2786        update
2787    }
2788}
2789
2790proc config_check_tmp_exists {tries_left} {
2791    global config_file_tmp
2792
2793    if {[file exists $config_file_tmp]} {
2794        incr tries_left -1
2795        if {$tries_left > 0} {
2796            after 100 [list config_check_tmp_exists $tries_left]
2797        } else {
2798            error_popup "There appears to be a stale $config_file_tmp\
2799 file, which will prevent gitk from saving its configuration on exit.\
2800 Please remove it if it is not being used by any existing gitk process."
2801        }
2802    }
2803}
2804
2805proc config_init_trace {name} {
2806    global config_variable_changed config_variable_original
2807
2808    upvar #0 $name var
2809    set config_variable_changed($name) 0
2810    set config_variable_original($name) $var
2811}
2812
2813proc config_variable_change_cb {name name2 op} {
2814    global config_variable_changed config_variable_original
2815
2816    upvar #0 $name var
2817    if {$op eq "write" &&
2818        (![info exists config_variable_original($name)] ||
2819         $config_variable_original($name) ne $var)} {
2820        set config_variable_changed($name) 1
2821    }
2822}
2823
2824proc savestuff {w} {
2825    global stuffsaved
2826    global config_file config_file_tmp
2827    global config_variables config_variable_changed
2828    global viewchanged
2829
2830    upvar #0 viewname current_viewname
2831    upvar #0 viewfiles current_viewfiles
2832    upvar #0 viewargs current_viewargs
2833    upvar #0 viewargscmd current_viewargscmd
2834    upvar #0 viewperm current_viewperm
2835    upvar #0 nextviewnum current_nextviewnum
2836    upvar #0 use_ttk current_use_ttk
2837
2838    if {$stuffsaved} return
2839    if {![winfo viewable .]} return
2840    set remove_tmp 0
2841    if {[catch {
2842        set try_count 0
2843        while {[catch {set f [open $config_file_tmp {WRONLY CREAT EXCL}]}]} {
2844            if {[incr try_count] > 50} {
2845                error "Unable to write config file: $config_file_tmp exists"
2846            }
2847            after 100
2848        }
2849        set remove_tmp 1
2850        if {$::tcl_platform(platform) eq {windows}} {
2851            file attributes $config_file_tmp -hidden true
2852        }
2853        if {[file exists $config_file]} {
2854            source $config_file
2855        }
2856        foreach var_name $config_variables {
2857            upvar #0 $var_name var
2858            upvar 0 $var_name old_var
2859            if {!$config_variable_changed($var_name) && [info exists old_var]} {
2860                puts $f [list set $var_name $old_var]
2861            } else {
2862                puts $f [list set $var_name $var]
2863            }
2864        }
2865
2866        puts $f "set geometry(main) [wm geometry .]"
2867        puts $f "set geometry(state) [wm state .]"
2868        puts $f "set geometry(topwidth) [winfo width .tf]"
2869        puts $f "set geometry(topheight) [winfo height .tf]"
2870        if {$current_use_ttk} {
2871            puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
2872            puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
2873        } else {
2874            puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2875            puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2876        }
2877        puts $f "set geometry(botwidth) [winfo width .bleft]"
2878        puts $f "set geometry(botheight) [winfo height .bleft]"
2879
2880        array set view_save {}
2881        array set views {}
2882        if {![info exists permviews]} { set permviews {} }
2883        foreach view $permviews {
2884            set view_save([lindex $view 0]) 1
2885            set views([lindex $view 0]) $view
2886        }
2887        puts -nonewline $f "set permviews {"
2888        for {set v 1} {$v < $current_nextviewnum} {incr v} {
2889            if {$viewchanged($v)} {
2890                if {$current_viewperm($v)} {
2891                    set views($current_viewname($v)) [list $current_viewname($v) $current_viewfiles($v) $current_viewargs($v) $current_viewargscmd($v)]
2892                } else {
2893                    set view_save($current_viewname($v)) 0
2894                }
2895            }
2896        }
2897        # write old and updated view to their places and append remaining to the end
2898        foreach view $permviews {
2899            set view_name [lindex $view 0]
2900            if {$view_save($view_name)} {
2901                puts $f "{$views($view_name)}"
2902            }
2903            unset views($view_name)
2904        }
2905        foreach view_name [array names views] {
2906            puts $f "{$views($view_name)}"
2907        }
2908        puts $f "}"
2909        close $f
2910        file rename -force $config_file_tmp $config_file
2911        set remove_tmp 0
2912    } err]} {
2913        puts "Error saving config: $err"
2914    }
2915    if {$remove_tmp} {
2916        file delete -force $config_file_tmp
2917    }
2918    set stuffsaved 1
2919}
2920
2921proc resizeclistpanes {win w} {
2922    global oldwidth use_ttk
2923    if {[info exists oldwidth($win)]} {
2924        if {$use_ttk} {
2925            set s0 [$win sashpos 0]
2926            set s1 [$win sashpos 1]
2927        } else {
2928            set s0 [$win sash coord 0]
2929            set s1 [$win sash coord 1]
2930        }
2931        if {$w < 60} {
2932            set sash0 [expr {int($w/2 - 2)}]
2933            set sash1 [expr {int($w*5/6 - 2)}]
2934        } else {
2935            set factor [expr {1.0 * $w / $oldwidth($win)}]
2936            set sash0 [expr {int($factor * [lindex $s0 0])}]
2937            set sash1 [expr {int($factor * [lindex $s1 0])}]
2938            if {$sash0 < 30} {
2939                set sash0 30
2940            }
2941            if {$sash1 < $sash0 + 20} {
2942                set sash1 [expr {$sash0 + 20}]
2943            }
2944            if {$sash1 > $w - 10} {
2945                set sash1 [expr {$w - 10}]
2946                if {$sash0 > $sash1 - 20} {
2947                    set sash0 [expr {$sash1 - 20}]
2948                }
2949            }
2950        }
2951        if {$use_ttk} {
2952            $win sashpos 0 $sash0
2953            $win sashpos 1 $sash1
2954        } else {
2955            $win sash place 0 $sash0 [lindex $s0 1]
2956            $win sash place 1 $sash1 [lindex $s1 1]
2957        }
2958    }
2959    set oldwidth($win) $w
2960}
2961
2962proc resizecdetpanes {win w} {
2963    global oldwidth use_ttk
2964    if {[info exists oldwidth($win)]} {
2965        if {$use_ttk} {
2966            set s0 [$win sashpos 0]
2967        } else {
2968            set s0 [$win sash coord 0]
2969        }
2970        if {$w < 60} {
2971            set sash0 [expr {int($w*3/4 - 2)}]
2972        } else {
2973            set factor [expr {1.0 * $w / $oldwidth($win)}]
2974            set sash0 [expr {int($factor * [lindex $s0 0])}]
2975            if {$sash0 < 45} {
2976                set sash0 45
2977            }
2978            if {$sash0 > $w - 15} {
2979                set sash0 [expr {$w - 15}]
2980            }
2981        }
2982        if {$use_ttk} {
2983            $win sashpos 0 $sash0
2984        } else {
2985            $win sash place 0 $sash0 [lindex $s0 1]
2986        }
2987    }
2988    set oldwidth($win) $w
2989}
2990
2991proc allcanvs args {
2992    global canv canv2 canv3
2993    eval $canv $args
2994    eval $canv2 $args
2995    eval $canv3 $args
2996}
2997
2998proc bindall {event action} {
2999    global canv canv2 canv3
3000    bind $canv $event $action
3001    bind $canv2 $event $action
3002    bind $canv3 $event $action
3003}
3004
3005proc about {} {
3006    global uifont NS
3007    set w .about
3008    if {[winfo exists $w]} {
3009        raise $w
3010        return
3011    }
3012    ttk_toplevel $w
3013    wm title $w [mc "About gitk"]
3014    make_transient $w .
3015    message $w.m -text [mc "
3016Gitk - a commit viewer for git
3017
3018Copyright \u00a9 2005-2014 Paul Mackerras
3019
3020Use and redistribute under the terms of the GNU General Public License"] \
3021            -justify center -aspect 400 -border 2 -bg white -relief groove
3022    pack $w.m -side top -fill x -padx 2 -pady 2
3023    ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
3024    pack $w.ok -side bottom
3025    bind $w <Visibility> "focus $w.ok"
3026    bind $w <Key-Escape> "destroy $w"
3027    bind $w <Key-Return> "destroy $w"
3028    tk::PlaceWindow $w widget .
3029}
3030
3031proc keys {} {
3032    global NS
3033    set w .keys
3034    if {[winfo exists $w]} {
3035        raise $w
3036        return
3037    }
3038    if {[tk windowingsystem] eq {aqua}} {
3039        set M1T Cmd
3040    } else {
3041        set M1T Ctrl
3042    }
3043    ttk_toplevel $w
3044    wm title $w [mc "Gitk key bindings"]
3045    make_transient $w .
3046    message $w.m -text "
3047[mc "Gitk key bindings:"]
3048
3049[mc "<%s-Q>             Quit" $M1T]
3050[mc "<%s-W>             Close window" $M1T]
3051[mc "<Home>             Move to first commit"]
3052[mc "<End>              Move to last commit"]
3053[mc "<Up>, p, k Move up one commit"]
3054[mc "<Down>, n, j       Move down one commit"]
3055[mc "<Left>, z, h       Go back in history list"]
3056[mc "<Right>, x, l      Go forward in history list"]
3057[mc "<%s-n>     Go to n-th parent of current commit in history list" $M1T]
3058[mc "<PageUp>   Move up one page in commit list"]
3059[mc "<PageDown> Move down one page in commit list"]
3060[mc "<%s-Home>  Scroll to top of commit list" $M1T]
3061[mc "<%s-End>   Scroll to bottom of commit list" $M1T]
3062[mc "<%s-Up>    Scroll commit list up one line" $M1T]
3063[mc "<%s-Down>  Scroll commit list down one line" $M1T]
3064[mc "<%s-PageUp>        Scroll commit list up one page" $M1T]
3065[mc "<%s-PageDown>      Scroll commit list down one page" $M1T]
3066[mc "<Shift-Up> Find backwards (upwards, later commits)"]
3067[mc "<Shift-Down>       Find forwards (downwards, earlier commits)"]
3068[mc "<Delete>, b        Scroll diff view up one page"]
3069[mc "<Backspace>        Scroll diff view up one page"]
3070[mc "<Space>            Scroll diff view down one page"]
3071[mc "u          Scroll diff view up 18 lines"]
3072[mc "d          Scroll diff view down 18 lines"]
3073[mc "<%s-F>             Find" $M1T]
3074[mc "<%s-G>             Move to next find hit" $M1T]
3075[mc "<Return>   Move to next find hit"]
3076[mc "g          Go to commit"]
3077[mc "/          Focus the search box"]
3078[mc "?          Move to previous find hit"]
3079[mc "f          Scroll diff view to next file"]
3080[mc "<%s-S>             Search for next hit in diff view" $M1T]
3081[mc "<%s-R>             Search for previous hit in diff view" $M1T]
3082[mc "<%s-KP+>   Increase font size" $M1T]
3083[mc "<%s-plus>  Increase font size" $M1T]
3084[mc "<%s-KP->   Decrease font size" $M1T]
3085[mc "<%s-minus> Decrease font size" $M1T]
3086[mc "<F5>               Update"]
3087" \
3088            -justify left -bg white -border 2 -relief groove
3089    pack $w.m -side top -fill both -padx 2 -pady 2
3090    ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
3091    bind $w <Key-Escape> [list destroy $w]
3092    pack $w.ok -side bottom
3093    bind $w <Visibility> "focus $w.ok"
3094    bind $w <Key-Escape> "destroy $w"
3095    bind $w <Key-Return> "destroy $w"
3096}
3097
3098# Procedures for manipulating the file list window at the
3099# bottom right of the overall window.
3100
3101proc treeview {w l openlevs} {
3102    global treecontents treediropen treeheight treeparent treeindex
3103
3104    set ix 0
3105    set treeindex() 0
3106    set lev 0
3107    set prefix {}
3108    set prefixend -1
3109    set prefendstack {}
3110    set htstack {}
3111    set ht 0
3112    set treecontents() {}
3113    $w conf -state normal
3114    foreach f $l {
3115        while {[string range $f 0 $prefixend] ne $prefix} {
3116            if {$lev <= $openlevs} {
3117                $w mark set e:$treeindex($prefix) "end -1c"
3118                $w mark gravity e:$treeindex($prefix) left
3119            }
3120            set treeheight($prefix) $ht
3121            incr ht [lindex $htstack end]
3122            set htstack [lreplace $htstack end end]
3123            set prefixend [lindex $prefendstack end]
3124            set prefendstack [lreplace $prefendstack end end]
3125            set prefix [string range $prefix 0 $prefixend]
3126            incr lev -1
3127        }
3128        set tail [string range $f [expr {$prefixend+1}] end]
3129        while {[set slash [string first "/" $tail]] >= 0} {
3130            lappend htstack $ht
3131            set ht 0
3132            lappend prefendstack $prefixend
3133            incr prefixend [expr {$slash + 1}]
3134            set d [string range $tail 0 $slash]
3135            lappend treecontents($prefix) $d
3136            set oldprefix $prefix
3137            append prefix $d
3138            set treecontents($prefix) {}
3139            set treeindex($prefix) [incr ix]
3140            set treeparent($prefix) $oldprefix
3141            set tail [string range $tail [expr {$slash+1}] end]
3142            if {$lev <= $openlevs} {
3143                set ht 1
3144                set treediropen($prefix) [expr {$lev < $openlevs}]
3145                set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
3146                $w mark set d:$ix "end -1c"
3147                $w mark gravity d:$ix left
3148                set str "\n"
3149                for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3150                $w insert end $str
3151                $w image create end -align center -image $bm -padx 1 \
3152                    -name a:$ix
3153                $w insert end $d [highlight_tag $prefix]
3154                $w mark set s:$ix "end -1c"
3155                $w mark gravity s:$ix left
3156            }
3157            incr lev
3158        }
3159        if {$tail ne {}} {
3160            if {$lev <= $openlevs} {
3161                incr ht
3162                set str "\n"
3163                for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3164                $w insert end $str
3165                $w insert end $tail [highlight_tag $f]
3166            }
3167            lappend treecontents($prefix) $tail
3168        }
3169    }
3170    while {$htstack ne {}} {
3171        set treeheight($prefix) $ht
3172        incr ht [lindex $htstack end]
3173        set htstack [lreplace $htstack end end]
3174        set prefixend [lindex $prefendstack end]
3175        set prefendstack [lreplace $prefendstack end end]
3176        set prefix [string range $prefix 0 $prefixend]
3177    }
3178    $w conf -state disabled
3179}
3180
3181proc linetoelt {l} {
3182    global treeheight treecontents
3183
3184    set y 2
3185    set prefix {}
3186    while {1} {
3187        foreach e $treecontents($prefix) {
3188            if {$y == $l} {
3189                return "$prefix$e"
3190            }
3191            set n 1
3192            if {[string index $e end] eq "/"} {
3193                set n $treeheight($prefix$e)
3194                if {$y + $n > $l} {
3195                    append prefix $e
3196                    incr y
3197                    break
3198                }
3199            }
3200            incr y $n
3201        }
3202    }
3203}
3204
3205proc highlight_tree {y prefix} {
3206    global treeheight treecontents cflist
3207
3208    foreach e $treecontents($prefix) {
3209        set path $prefix$e
3210        if {[highlight_tag $path] ne {}} {
3211            $cflist tag add bold $y.0 "$y.0 lineend"
3212        }
3213        incr y
3214        if {[string index $e end] eq "/" && $treeheight($path) > 1} {
3215            set y [highlight_tree $y $path]
3216        }
3217    }
3218    return $y
3219}
3220
3221proc treeclosedir {w dir} {
3222    global treediropen treeheight treeparent treeindex
3223
3224    set ix $treeindex($dir)
3225    $w conf -state normal
3226    $w delete s:$ix e:$ix
3227    set treediropen($dir) 0
3228    $w image configure a:$ix -image tri-rt
3229    $w conf -state disabled
3230    set n [expr {1 - $treeheight($dir)}]
3231    while {$dir ne {}} {
3232        incr treeheight($dir) $n
3233        set dir $treeparent($dir)
3234    }
3235}
3236
3237proc treeopendir {w dir} {
3238    global treediropen treeheight treeparent treecontents treeindex
3239
3240    set ix $treeindex($dir)
3241    $w conf -state normal
3242    $w image configure a:$ix -image tri-dn
3243    $w mark set e:$ix s:$ix
3244    $w mark gravity e:$ix right
3245    set lev 0
3246    set str "\n"
3247    set n [llength $treecontents($dir)]
3248    for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
3249        incr lev
3250        append str "\t"
3251        incr treeheight($x) $n
3252    }
3253    foreach e $treecontents($dir) {
3254        set de $dir$e
3255        if {[string index $e end] eq "/"} {
3256            set iy $treeindex($de)
3257            $w mark set d:$iy e:$ix
3258            $w mark gravity d:$iy left
3259            $w insert e:$ix $str
3260            set treediropen($de) 0
3261            $w image create e:$ix -align center -image tri-rt -padx 1 \
3262                -name a:$iy
3263            $w insert e:$ix $e [highlight_tag $de]
3264            $w mark set s:$iy e:$ix
3265            $w mark gravity s:$iy left
3266            set treeheight($de) 1
3267        } else {
3268            $w insert e:$ix $str
3269            $w insert e:$ix $e [highlight_tag $de]
3270        }
3271    }
3272    $w mark gravity e:$ix right
3273    $w conf -state disabled
3274    set treediropen($dir) 1
3275    set top [lindex [split [$w index @0,0] .] 0]
3276    set ht [$w cget -height]
3277    set l [lindex [split [$w index s:$ix] .] 0]
3278    if {$l < $top} {
3279        $w yview $l.0
3280    } elseif {$l + $n + 1 > $top + $ht} {
3281        set top [expr {$l + $n + 2 - $ht}]
3282        if {$l < $top} {
3283            set top $l
3284        }
3285        $w yview $top.0
3286    }
3287}
3288
3289proc treeclick {w x y} {
3290    global treediropen cmitmode ctext cflist cflist_top
3291
3292    if {$cmitmode ne "tree"} return
3293    if {![info exists cflist_top]} return
3294    set l [lindex [split [$w index "@$x,$y"] "."] 0]
3295    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3296    $cflist tag add highlight $l.0 "$l.0 lineend"
3297    set cflist_top $l
3298    if {$l == 1} {
3299        $ctext yview 1.0
3300        return
3301    }
3302    set e [linetoelt $l]
3303    if {[string index $e end] ne "/"} {
3304        showfile $e
3305    } elseif {$treediropen($e)} {
3306        treeclosedir $w $e
3307    } else {
3308        treeopendir $w $e
3309    }
3310}
3311
3312proc setfilelist {id} {
3313    global treefilelist cflist jump_to_here
3314
3315    treeview $cflist $treefilelist($id) 0
3316    if {$jump_to_here ne {}} {
3317        set f [lindex $jump_to_here 0]
3318        if {[lsearch -exact $treefilelist($id) $f] >= 0} {
3319            showfile $f
3320        }
3321    }
3322}
3323
3324image create bitmap tri-rt -background black -foreground blue -data {
3325    #define tri-rt_width 13
3326    #define tri-rt_height 13
3327    static unsigned char tri-rt_bits[] = {
3328       0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
3329       0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
3330       0x00, 0x00};
3331} -maskdata {
3332    #define tri-rt-mask_width 13
3333    #define tri-rt-mask_height 13
3334    static unsigned char tri-rt-mask_bits[] = {
3335       0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
3336       0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
3337       0x08, 0x00};
3338}
3339image create bitmap tri-dn -background black -foreground blue -data {
3340    #define tri-dn_width 13
3341    #define tri-dn_height 13
3342    static unsigned char tri-dn_bits[] = {
3343       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
3344       0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3345       0x00, 0x00};
3346} -maskdata {
3347    #define tri-dn-mask_width 13
3348    #define tri-dn-mask_height 13
3349    static unsigned char tri-dn-mask_bits[] = {
3350       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
3351       0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
3352       0x00, 0x00};
3353}
3354
3355image create bitmap reficon-T -background black -foreground yellow -data {
3356    #define tagicon_width 13
3357    #define tagicon_height 9
3358    static unsigned char tagicon_bits[] = {
3359       0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
3360       0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
3361} -maskdata {
3362    #define tagicon-mask_width 13
3363    #define tagicon-mask_height 9
3364    static unsigned char tagicon-mask_bits[] = {
3365       0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
3366       0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
3367}
3368set rectdata {
3369    #define headicon_width 13
3370    #define headicon_height 9
3371    static unsigned char headicon_bits[] = {
3372       0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3373       0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3374}
3375set rectmask {
3376    #define headicon-mask_width 13
3377    #define headicon-mask_height 9
3378    static unsigned char headicon-mask_bits[] = {
3379       0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3380       0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3381}
3382image create bitmap reficon-H -background black -foreground green \
3383    -data $rectdata -maskdata $rectmask
3384image create bitmap reficon-o -background black -foreground "#ddddff" \
3385    -data $rectdata -maskdata $rectmask
3386
3387proc init_flist {first} {
3388    global cflist cflist_top difffilestart
3389
3390    $cflist conf -state normal
3391    $cflist delete 0.0 end
3392    if {$first ne {}} {
3393        $cflist insert end $first
3394        set cflist_top 1
3395        $cflist tag add highlight 1.0 "1.0 lineend"
3396    } else {
3397        unset -nocomplain cflist_top
3398    }
3399    $cflist conf -state disabled
3400    set difffilestart {}
3401}
3402
3403proc highlight_tag {f} {
3404    global highlight_paths
3405
3406    foreach p $highlight_paths {
3407        if {[string match $p $f]} {
3408            return "bold"
3409        }
3410    }
3411    return {}
3412}
3413
3414proc highlight_filelist {} {
3415    global cmitmode cflist
3416
3417    $cflist conf -state normal
3418    if {$cmitmode ne "tree"} {
3419        set end [lindex [split [$cflist index end] .] 0]
3420        for {set l 2} {$l < $end} {incr l} {
3421            set line [$cflist get $l.0 "$l.0 lineend"]
3422            if {[highlight_tag $line] ne {}} {
3423                $cflist tag add bold $l.0 "$l.0 lineend"
3424            }
3425        }
3426    } else {
3427        highlight_tree 2 {}
3428    }
3429    $cflist conf -state disabled
3430}
3431
3432proc unhighlight_filelist {} {
3433    global cflist
3434
3435    $cflist conf -state normal
3436    $cflist tag remove bold 1.0 end
3437    $cflist conf -state disabled
3438}
3439
3440proc add_flist {fl} {
3441    global cflist
3442
3443    $cflist conf -state normal
3444    foreach f $fl {
3445        $cflist insert end "\n"
3446        $cflist insert end $f [highlight_tag $f]
3447    }
3448    $cflist conf -state disabled
3449}
3450
3451proc sel_flist {w x y} {
3452    global ctext difffilestart cflist cflist_top cmitmode
3453
3454    if {$cmitmode eq "tree"} return
3455    if {![info exists cflist_top]} return
3456    set l [lindex [split [$w index "@$x,$y"] "."] 0]
3457    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3458    $cflist tag add highlight $l.0 "$l.0 lineend"
3459    set cflist_top $l
3460    if {$l == 1} {
3461        $ctext yview 1.0
3462    } else {
3463        catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
3464    }
3465    suppress_highlighting_file_for_current_scrollpos
3466}
3467
3468proc pop_flist_menu {w X Y x y} {
3469    global ctext cflist cmitmode flist_menu flist_menu_file
3470    global treediffs diffids
3471
3472    stopfinding
3473    set l [lindex [split [$w index "@$x,$y"] "."] 0]
3474    if {$l <= 1} return
3475    if {$cmitmode eq "tree"} {
3476        set e [linetoelt $l]
3477        if {[string index $e end] eq "/"} return
3478    } else {
3479        set e [lindex $treediffs($diffids) [expr {$l-2}]]
3480    }
3481    set flist_menu_file $e
3482    set xdiffstate "normal"
3483    if {$cmitmode eq "tree"} {
3484        set xdiffstate "disabled"
3485    }
3486    # Disable "External diff" item in tree mode
3487    $flist_menu entryconf 2 -state $xdiffstate
3488    tk_popup $flist_menu $X $Y
3489}
3490
3491proc find_ctext_fileinfo {line} {
3492    global ctext_file_names ctext_file_lines
3493
3494    set ok [bsearch $ctext_file_lines $line]
3495    set tline [lindex $ctext_file_lines $ok]
3496
3497    if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3498        return {}
3499    } else {
3500        return [list [lindex $ctext_file_names $ok] $tline]
3501    }
3502}
3503
3504proc pop_diff_menu {w X Y x y} {
3505    global ctext diff_menu flist_menu_file
3506    global diff_menu_txtpos diff_menu_line
3507    global diff_menu_filebase
3508
3509    set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3510    set diff_menu_line [lindex $diff_menu_txtpos 0]
3511    # don't pop up the menu on hunk-separator or file-separator lines
3512    if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3513        return
3514    }
3515    stopfinding
3516    set f [find_ctext_fileinfo $diff_menu_line]
3517    if {$f eq {}} return
3518    set flist_menu_file [lindex $f 0]
3519    set diff_menu_filebase [lindex $f 1]
3520    tk_popup $diff_menu $X $Y
3521}
3522
3523proc flist_hl {only} {
3524    global flist_menu_file findstring gdttype
3525
3526    set x [shellquote $flist_menu_file]
3527    if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
3528        set findstring $x
3529    } else {
3530        append findstring " " $x
3531    }
3532    set gdttype [mc "touching paths:"]
3533}
3534
3535proc gitknewtmpdir {} {
3536    global diffnum gitktmpdir gitdir env
3537
3538    if {![info exists gitktmpdir]} {
3539        if {[info exists env(GITK_TMPDIR)]} {
3540            set tmpdir $env(GITK_TMPDIR)
3541        } elseif {[info exists env(TMPDIR)]} {
3542            set tmpdir $env(TMPDIR)
3543        } else {
3544            set tmpdir $gitdir
3545        }
3546        set gitktmpformat [file join $tmpdir ".gitk-tmp.XXXXXX"]
3547        if {[catch {set gitktmpdir [exec mktemp -d $gitktmpformat]}]} {
3548            set gitktmpdir [file join $gitdir [format ".gitk-tmp.%s" [pid]]]
3549        }
3550        if {[catch {file mkdir $gitktmpdir} err]} {
3551            error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3552            unset gitktmpdir
3553            return {}
3554        }
3555        set diffnum 0
3556    }
3557    incr diffnum
3558    set diffdir [file join $gitktmpdir $diffnum]
3559    if {[catch {file mkdir $diffdir} err]} {
3560        error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3561        return {}
3562    }
3563    return $diffdir
3564}
3565
3566proc save_file_from_commit {filename output what} {
3567    global nullfile
3568
3569    if {[catch {exec git show $filename -- > $output} err]} {
3570        if {[string match "fatal: bad revision *" $err]} {
3571            return $nullfile
3572        }
3573        error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
3574        return {}
3575    }
3576    return $output
3577}
3578
3579proc external_diff_get_one_file {diffid filename diffdir} {
3580    global nullid nullid2 nullfile
3581    global worktree
3582
3583    if {$diffid == $nullid} {
3584        set difffile [file join $worktree $filename]
3585        if {[file exists $difffile]} {
3586            return $difffile
3587        }
3588        return $nullfile
3589    }
3590    if {$diffid == $nullid2} {
3591        set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3592        return [save_file_from_commit :$filename $difffile index]
3593    }
3594    set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3595    return [save_file_from_commit $diffid:$filename $difffile \
3596               "revision $diffid"]
3597}
3598
3599proc external_diff {} {
3600    global nullid nullid2
3601    global flist_menu_file
3602    global diffids
3603    global extdifftool
3604
3605    if {[llength $diffids] == 1} {
3606        # no reference commit given
3607        set diffidto [lindex $diffids 0]
3608        if {$diffidto eq $nullid} {
3609            # diffing working copy with index
3610            set diffidfrom $nullid2
3611        } elseif {$diffidto eq $nullid2} {
3612            # diffing index with HEAD
3613            set diffidfrom "HEAD"
3614        } else {
3615            # use first parent commit
3616            global parentlist selectedline
3617            set diffidfrom [lindex $parentlist $selectedline 0]
3618        }
3619    } else {
3620        set diffidfrom [lindex $diffids 0]
3621        set diffidto [lindex $diffids 1]
3622    }
3623
3624    # make sure that several diffs wont collide
3625    set diffdir [gitknewtmpdir]
3626    if {$diffdir eq {}} return
3627
3628    # gather files to diff
3629    set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3630    set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3631
3632    if {$difffromfile ne {} && $difftofile ne {}} {
3633        set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
3634        if {[catch {set fl [open |$cmd r]} err]} {
3635            file delete -force $diffdir
3636            error_popup "$extdifftool: [mc "command failed:"] $err"
3637        } else {
3638            fconfigure $fl -blocking 0
3639            filerun $fl [list delete_at_eof $fl $diffdir]
3640        }
3641    }
3642}
3643
3644proc find_hunk_blamespec {base line} {
3645    global ctext
3646
3647    # Find and parse the hunk header
3648    set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3649    if {$s_lix eq {}} return
3650
3651    set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3652    if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3653            s_line old_specs osz osz1 new_line nsz]} {
3654        return
3655    }
3656
3657    # base lines for the parents
3658    set base_lines [list $new_line]
3659    foreach old_spec [lrange [split $old_specs " "] 1 end] {
3660        if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3661                old_spec old_line osz]} {
3662            return
3663        }
3664        lappend base_lines $old_line
3665    }
3666
3667    # Now scan the lines to determine offset within the hunk
3668    set max_parent [expr {[llength $base_lines]-2}]
3669    set dline 0
3670    set s_lno [lindex [split $s_lix "."] 0]
3671
3672    # Determine if the line is removed
3673    set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3674    if {[string match {[-+ ]*} $chunk]} {
3675        set removed_idx [string first "-" $chunk]
3676        # Choose a parent index
3677        if {$removed_idx >= 0} {
3678            set parent $removed_idx
3679        } else {
3680            set unchanged_idx [string first " " $chunk]
3681            if {$unchanged_idx >= 0} {
3682                set parent $unchanged_idx
3683            } else {
3684                # blame the current commit
3685                set parent -1
3686            }
3687        }
3688        # then count other lines that belong to it
3689        for {set i $line} {[incr i -1] > $s_lno} {} {
3690            set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3691            # Determine if the line is removed
3692            set removed_idx [string first "-" $chunk]
3693            if {$parent >= 0} {
3694                set code [string index $chunk $parent]
3695                if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3696                    incr dline
3697                }
3698            } else {
3699                if {$removed_idx < 0} {
3700                    incr dline
3701                }
3702            }
3703        }
3704        incr parent
3705    } else {
3706        set parent 0
3707    }
3708
3709    incr dline [lindex $base_lines $parent]
3710    return [list $parent $dline]
3711}
3712
3713proc external_blame_diff {} {
3714    global currentid cmitmode
3715    global diff_menu_txtpos diff_menu_line
3716    global diff_menu_filebase flist_menu_file
3717
3718    if {$cmitmode eq "tree"} {
3719        set parent_idx 0
3720        set line [expr {$diff_menu_line - $diff_menu_filebase}]
3721    } else {
3722        set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3723        if {$hinfo ne {}} {
3724            set parent_idx [lindex $hinfo 0]
3725            set line [lindex $hinfo 1]
3726        } else {
3727            set parent_idx 0
3728            set line 0
3729        }
3730    }
3731
3732    external_blame $parent_idx $line
3733}
3734
3735# Find the SHA1 ID of the blob for file $fname in the index
3736# at stage 0 or 2
3737proc index_sha1 {fname} {
3738    set f [open [list | git ls-files -s $fname] r]
3739    while {[gets $f line] >= 0} {
3740        set info [lindex [split $line "\t"] 0]
3741        set stage [lindex $info 2]
3742        if {$stage eq "0" || $stage eq "2"} {
3743            close $f
3744            return [lindex $info 1]
3745        }
3746    }
3747    close $f
3748    return {}
3749}
3750
3751# Turn an absolute path into one relative to the current directory
3752proc make_relative {f} {
3753    if {[file pathtype $f] eq "relative"} {
3754        return $f
3755    }
3756    set elts [file split $f]
3757    set here [file split [pwd]]
3758    set ei 0
3759    set hi 0
3760    set res {}
3761    foreach d $here {
3762        if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3763            lappend res ".."
3764        } else {
3765            incr ei
3766        }
3767        incr hi
3768    }
3769    set elts [concat $res [lrange $elts $ei end]]
3770    return [eval file join $elts]
3771}
3772
3773proc external_blame {parent_idx {line {}}} {
3774    global flist_menu_file cdup
3775    global nullid nullid2
3776    global parentlist selectedline currentid
3777
3778    if {$parent_idx > 0} {
3779        set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3780    } else {
3781        set base_commit $currentid
3782    }
3783
3784    if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3785        error_popup [mc "No such commit"]
3786        return
3787    }
3788
3789    set cmdline [list git gui blame]
3790    if {$line ne {} && $line > 1} {
3791        lappend cmdline "--line=$line"
3792    }
3793    set f [file join $cdup $flist_menu_file]
3794    # Unfortunately it seems git gui blame doesn't like
3795    # being given an absolute path...
3796    set f [make_relative $f]
3797    lappend cmdline $base_commit $f
3798    if {[catch {eval exec $cmdline &} err]} {
3799        error_popup "[mc "git gui blame: command failed:"] $err"
3800    }
3801}
3802
3803proc show_line_source {} {
3804    global cmitmode currentid parents curview blamestuff blameinst
3805    global diff_menu_line diff_menu_filebase flist_menu_file
3806    global nullid nullid2 gitdir cdup
3807
3808    set from_index {}
3809    if {$cmitmode eq "tree"} {
3810        set id $currentid
3811        set line [expr {$diff_menu_line - $diff_menu_filebase}]
3812    } else {
3813        set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3814        if {$h eq {}} return
3815        set pi [lindex $h 0]
3816        if {$pi == 0} {
3817            mark_ctext_line $diff_menu_line
3818            return
3819        }
3820        incr pi -1
3821        if {$currentid eq $nullid} {
3822            if {$pi > 0} {
3823                # must be a merge in progress...
3824                if {[catch {
3825                    # get the last line from .git/MERGE_HEAD
3826                    set f [open [file join $gitdir MERGE_HEAD] r]
3827                    set id [lindex [split [read $f] "\n"] end-1]
3828                    close $f
3829                } err]} {
3830                    error_popup [mc "Couldn't read merge head: %s" $err]
3831                    return
3832                }
3833            } elseif {$parents($curview,$currentid) eq $nullid2} {
3834                # need to do the blame from the index
3835                if {[catch {
3836                    set from_index [index_sha1 $flist_menu_file]
3837                } err]} {
3838                    error_popup [mc "Error reading index: %s" $err]
3839                    return
3840                }
3841            } else {
3842                set id $parents($curview,$currentid)
3843            }
3844        } else {
3845            set id [lindex $parents($curview,$currentid) $pi]
3846        }
3847        set line [lindex $h 1]
3848    }
3849    set blameargs {}
3850    if {$from_index ne {}} {
3851        lappend blameargs | git cat-file blob $from_index
3852    }
3853    lappend blameargs | git blame -p -L$line,+1
3854    if {$from_index ne {}} {
3855        lappend blameargs --contents -
3856    } else {
3857        lappend blameargs $id
3858    }
3859    lappend blameargs -- [file join $cdup $flist_menu_file]
3860    if {[catch {
3861        set f [open $blameargs r]
3862    } err]} {
3863        error_popup [mc "Couldn't start git blame: %s" $err]
3864        return
3865    }
3866    nowbusy blaming [mc "Searching"]
3867    fconfigure $f -blocking 0
3868    set i [reg_instance $f]
3869    set blamestuff($i) {}
3870    set blameinst $i
3871    filerun $f [list read_line_source $f $i]
3872}
3873
3874proc stopblaming {} {
3875    global blameinst
3876
3877    if {[info exists blameinst]} {
3878        stop_instance $blameinst
3879        unset blameinst
3880        notbusy blaming
3881    }
3882}
3883
3884proc read_line_source {fd inst} {
3885    global blamestuff curview commfd blameinst nullid nullid2
3886
3887    while {[gets $fd line] >= 0} {
3888        lappend blamestuff($inst) $line
3889    }
3890    if {![eof $fd]} {
3891        return 1
3892    }
3893    unset commfd($inst)
3894    unset blameinst
3895    notbusy blaming
3896    fconfigure $fd -blocking 1
3897    if {[catch {close $fd} err]} {
3898        error_popup [mc "Error running git blame: %s" $err]
3899        return 0
3900    }
3901
3902    set fname {}
3903    set line [split [lindex $blamestuff($inst) 0] " "]
3904    set id [lindex $line 0]
3905    set lnum [lindex $line 1]
3906    if {[string length $id] == 40 && [string is xdigit $id] &&
3907        [string is digit -strict $lnum]} {
3908        # look for "filename" line
3909        foreach l $blamestuff($inst) {
3910            if {[string match "filename *" $l]} {
3911                set fname [string range $l 9 end]
3912                break
3913            }
3914        }
3915    }
3916    if {$fname ne {}} {
3917        # all looks good, select it
3918        if {$id eq $nullid} {
3919            # blame uses all-zeroes to mean not committed,
3920            # which would mean a change in the index
3921            set id $nullid2
3922        }
3923        if {[commitinview $id $curview]} {
3924            selectline [rowofcommit $id] 1 [list $fname $lnum] 1
3925        } else {
3926            error_popup [mc "That line comes from commit %s, \
3927                             which is not in this view" [shortids $id]]
3928        }
3929    } else {
3930        puts "oops couldn't parse git blame output"
3931    }
3932    return 0
3933}
3934
3935# delete $dir when we see eof on $f (presumably because the child has exited)
3936proc delete_at_eof {f dir} {
3937    while {[gets $f line] >= 0} {}
3938    if {[eof $f]} {
3939        if {[catch {close $f} err]} {
3940            error_popup "[mc "External diff viewer failed:"] $err"
3941        }
3942        file delete -force $dir
3943        return 0
3944    }
3945    return 1
3946}
3947
3948# Functions for adding and removing shell-type quoting
3949
3950proc shellquote {str} {
3951    if {![string match "*\['\"\\ \t]*" $str]} {
3952        return $str
3953    }
3954    if {![string match "*\['\"\\]*" $str]} {
3955        return "\"$str\""
3956    }
3957    if {![string match "*'*" $str]} {
3958        return "'$str'"
3959    }
3960    return "\"[string map {\" \\\" \\ \\\\} $str]\""
3961}
3962
3963proc shellarglist {l} {
3964    set str {}
3965    foreach a $l {
3966        if {$str ne {}} {
3967            append str " "
3968        }
3969        append str [shellquote $a]
3970    }
3971    return $str
3972}
3973
3974proc shelldequote {str} {
3975    set ret {}
3976    set used -1
3977    while {1} {
3978        incr used
3979        if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
3980            append ret [string range $str $used end]
3981            set used [string length $str]
3982            break
3983        }
3984        set first [lindex $first 0]
3985        set ch [string index $str $first]
3986        if {$first > $used} {
3987            append ret [string range $str $used [expr {$first - 1}]]
3988            set used $first
3989        }
3990        if {$ch eq " " || $ch eq "\t"} break
3991        incr used
3992        if {$ch eq "'"} {
3993            set first [string first "'" $str $used]
3994            if {$first < 0} {
3995                error "unmatched single-quote"
3996            }
3997            append ret [string range $str $used [expr {$first - 1}]]
3998            set used $first
3999            continue
4000        }
4001        if {$ch eq "\\"} {
4002            if {$used >= [string length $str]} {
4003                error "trailing backslash"
4004            }
4005            append ret [string index $str $used]
4006            continue
4007        }
4008        # here ch == "\""
4009        while {1} {
4010            if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
4011                error "unmatched double-quote"
4012            }
4013            set first [lindex $first 0]
4014            set ch [string index $str $first]
4015            if {$first > $used} {
4016                append ret [string range $str $used [expr {$first - 1}]]
4017                set used $first
4018            }
4019            if {$ch eq "\""} break
4020            incr used
4021            append ret [string index $str $used]
4022            incr used
4023        }
4024    }
4025    return [list $used $ret]
4026}
4027
4028proc shellsplit {str} {
4029    set l {}
4030    while {1} {
4031        set str [string trimleft $str]
4032        if {$str eq {}} break
4033        set dq [shelldequote $str]
4034        set n [lindex $dq 0]
4035        set word [lindex $dq 1]
4036        set str [string range $str $n end]
4037        lappend l $word
4038    }
4039    return $l
4040}
4041
4042proc set_window_title {} {
4043    global appname curview viewname vrevs
4044    set rev [mc "All files"]
4045    if {$curview ne 0} {
4046        if {$viewname($curview) eq [mc "Command line"]} {
4047            set rev [string map {"--gitk-symmetric-diff-marker" "--merge"} $vrevs($curview)]
4048        } else {
4049            set rev $viewname($curview)
4050        }
4051    }
4052    wm title . "[reponame]: $rev - $appname"
4053}
4054
4055# Code to implement multiple views
4056
4057proc newview {ishighlight} {
4058    global nextviewnum newviewname newishighlight
4059    global revtreeargs viewargscmd newviewopts curview
4060
4061    set newishighlight $ishighlight
4062    set top .gitkview
4063    if {[winfo exists $top]} {
4064        raise $top
4065        return
4066    }
4067    decode_view_opts $nextviewnum $revtreeargs
4068    set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
4069    set newviewopts($nextviewnum,perm) 0
4070    set newviewopts($nextviewnum,cmd)  $viewargscmd($curview)
4071    vieweditor $top $nextviewnum [mc "Gitk view definition"]
4072}
4073
4074set known_view_options {
4075    {perm      b    .  {}               {mc "Remember this view"}}
4076    {reflabel  l    +  {}               {mc "References (space separated list):"}}
4077    {refs      t15  .. {}               {mc "Branches & tags:"}}
4078    {allrefs   b    *. "--all"          {mc "All refs"}}
4079    {branches  b    .  "--branches"     {mc "All (local) branches"}}
4080    {tags      b    .  "--tags"         {mc "All tags"}}
4081    {remotes   b    .  "--remotes"      {mc "All remote-tracking branches"}}
4082    {commitlbl l    +  {}               {mc "Commit Info (regular expressions):"}}
4083    {author    t15  .. "--author=*"     {mc "Author:"}}
4084    {committer t15  .  "--committer=*"  {mc "Committer:"}}
4085    {loginfo   t15  .. "--grep=*"       {mc "Commit Message:"}}
4086    {allmatch  b    .. "--all-match"    {mc "Matches all Commit Info criteria"}}
4087    {igrep     b    .. "--invert-grep"  {mc "Matches no Commit Info criteria"}}
4088    {changes_l l    +  {}               {mc "Changes to Files:"}}
4089    {pickaxe_s r0   .  {}               {mc "Fixed String"}}
4090    {pickaxe_t r1   .  "--pickaxe-regex"  {mc "Regular Expression"}}
4091    {pickaxe   t15  .. "-S*"            {mc "Search string:"}}
4092    {datelabel l    +  {}               {mc "Commit Dates (\"2 weeks ago\", \"2009-03-17 15:27:38\", \"March 17, 2009 15:27:38\"):"}}
4093    {since     t15  ..  {"--since=*" "--after=*"}  {mc "Since:"}}
4094    {until     t15  .   {"--until=*" "--before=*"} {mc "Until:"}}
4095    {limit_lbl l    +  {}               {mc "Limit and/or skip a number of revisions (positive integer):"}}
4096    {limit     t10  *. "--max-count=*"  {mc "Number to show:"}}
4097    {skip      t10  .  "--skip=*"       {mc "Number to skip:"}}
4098    {misc_lbl  l    +  {}               {mc "Miscellaneous options:"}}
4099    {dorder    b    *. {"--date-order" "-d"}      {mc "Strictly sort by date"}}
4100    {lright    b    .  "--left-right"   {mc "Mark branch sides"}}
4101    {first     b    .  "--first-parent" {mc "Limit to first parent"}}
4102    {smplhst   b    .  "--simplify-by-decoration"   {mc "Simple history"}}
4103    {args      t50  *. {}               {mc "Additional arguments to git log:"}}
4104    {allpaths  path +  {}               {mc "Enter files and directories to include, one per line:"}}
4105    {cmd       t50= +  {}               {mc "Command to generate more commits to include:"}}
4106    }
4107
4108# Convert $newviewopts($n, ...) into args for git log.
4109proc encode_view_opts {n} {
4110    global known_view_options newviewopts
4111
4112    set rargs [list]
4113    foreach opt $known_view_options {
4114        set patterns [lindex $opt 3]
4115        if {$patterns eq {}} continue
4116        set pattern [lindex $patterns 0]
4117
4118        if {[lindex $opt 1] eq "b"} {
4119            set val $newviewopts($n,[lindex $opt 0])
4120            if {$val} {
4121                lappend rargs $pattern
4122            }
4123        } elseif {[regexp {^r(\d+)$} [lindex $opt 1] type value]} {
4124            regexp {^(.*_)} [lindex $opt 0] uselessvar button_id
4125            set val $newviewopts($n,$button_id)
4126            if {$val eq $value} {
4127                lappend rargs $pattern
4128            }
4129        } else {
4130            set val $newviewopts($n,[lindex $opt 0])
4131            set val [string trim $val]
4132            if {$val ne {}} {
4133                set pfix [string range $pattern 0 end-1]
4134                lappend rargs $pfix$val
4135            }
4136        }
4137    }
4138    set rargs [concat $rargs [shellsplit $newviewopts($n,refs)]]
4139    return [concat $rargs [shellsplit $newviewopts($n,args)]]
4140}
4141
4142# Fill $newviewopts($n, ...) based on args for git log.
4143proc decode_view_opts {n view_args} {
4144    global known_view_options newviewopts
4145
4146    foreach opt $known_view_options {
4147        set id [lindex $opt 0]
4148        if {[lindex $opt 1] eq "b"} {
4149            # Checkboxes
4150            set val 0
4151        } elseif {[regexp {^r(\d+)$} [lindex $opt 1]]} {
4152            # Radiobuttons
4153            regexp {^(.*_)} $id uselessvar id
4154            set val 0
4155        } else {
4156            # Text fields
4157            set val {}
4158        }
4159        set newviewopts($n,$id) $val
4160    }
4161    set oargs [list]
4162    set refargs [list]
4163    foreach arg $view_args {
4164        if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
4165            && ![info exists found(limit)]} {
4166            set newviewopts($n,limit) $cnt
4167            set found(limit) 1
4168            continue
4169        }
4170        catch { unset val }
4171        foreach opt $known_view_options {
4172            set id [lindex $opt 0]
4173            if {[info exists found($id)]} continue
4174            foreach pattern [lindex $opt 3] {
4175                if {![string match $pattern $arg]} continue
4176                if {[lindex $opt 1] eq "b"} {
4177                    # Check buttons
4178                    set val 1
4179                } elseif {[regexp {^r(\d+)$} [lindex $opt 1] match num]} {
4180                    # Radio buttons
4181                    regexp {^(.*_)} $id uselessvar id
4182                    set val $num
4183                } else {
4184                    # Text input fields
4185                    set size [string length $pattern]
4186                    set val [string range $arg [expr {$size-1}] end]
4187                }
4188                set newviewopts($n,$id) $val
4189                set found($id) 1
4190                break
4191            }
4192            if {[info exists val]} break
4193        }
4194        if {[info exists val]} continue
4195        if {[regexp {^-} $arg]} {
4196            lappend oargs $arg
4197        } else {
4198            lappend refargs $arg
4199        }
4200    }
4201    set newviewopts($n,refs) [shellarglist $refargs]
4202    set newviewopts($n,args) [shellarglist $oargs]
4203}
4204
4205proc edit_or_newview {} {
4206    global curview
4207
4208    if {$curview > 0} {
4209        editview
4210    } else {
4211        newview 0
4212    }
4213}
4214
4215proc editview {} {
4216    global curview
4217    global viewname viewperm newviewname newviewopts
4218    global viewargs viewargscmd
4219
4220    set top .gitkvedit-$curview
4221    if {[winfo exists $top]} {
4222        raise $top
4223        return
4224    }
4225    decode_view_opts $curview $viewargs($curview)
4226    set newviewname($curview)      $viewname($curview)
4227    set newviewopts($curview,perm) $viewperm($curview)
4228    set newviewopts($curview,cmd)  $viewargscmd($curview)
4229    vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
4230}
4231
4232proc vieweditor {top n title} {
4233    global newviewname newviewopts viewfiles bgcolor
4234    global known_view_options NS
4235
4236    ttk_toplevel $top
4237    wm title $top [concat $title [mc "-- criteria for selecting revisions"]]
4238    make_transient $top .
4239
4240    # View name
4241    ${NS}::frame $top.nfr
4242    ${NS}::label $top.nl -text [mc "View Name"]
4243    ${NS}::entry $top.name -width 20 -textvariable newviewname($n)
4244    pack $top.nfr -in $top -fill x -pady 5 -padx 3
4245    pack $top.nl -in $top.nfr -side left -padx {0 5}
4246    pack $top.name -in $top.nfr -side left -padx {0 25}
4247
4248    # View options
4249    set cframe $top.nfr
4250    set cexpand 0
4251    set cnt 0
4252    foreach opt $known_view_options {
4253        set id [lindex $opt 0]
4254        set type [lindex $opt 1]
4255        set flags [lindex $opt 2]
4256        set title [eval [lindex $opt 4]]
4257        set lxpad 0
4258
4259        if {$flags eq "+" || $flags eq "*"} {
4260            set cframe $top.fr$cnt
4261            incr cnt
4262            ${NS}::frame $cframe
4263            pack $cframe -in $top -fill x -pady 3 -padx 3
4264            set cexpand [expr {$flags eq "*"}]
4265        } elseif {$flags eq ".." || $flags eq "*."} {
4266            set cframe $top.fr$cnt
4267            incr cnt
4268            ${NS}::frame $cframe
4269            pack $cframe -in $top -fill x -pady 3 -padx [list 15 3]
4270            set cexpand [expr {$flags eq "*."}]
4271        } else {
4272            set lxpad 5
4273        }
4274
4275        if {$type eq "l"} {
4276            ${NS}::label $cframe.l_$id -text $title
4277            pack $cframe.l_$id -in $cframe -side left -pady [list 3 0] -anchor w
4278        } elseif {$type eq "b"} {
4279            ${NS}::checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
4280            pack $cframe.c_$id -in $cframe -side left \
4281                -padx [list $lxpad 0] -expand $cexpand -anchor w
4282        } elseif {[regexp {^r(\d+)$} $type type sz]} {
4283            regexp {^(.*_)} $id uselessvar button_id
4284            ${NS}::radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz
4285            pack $cframe.c_$id -in $cframe -side left \
4286                -padx [list $lxpad 0] -expand $cexpand -anchor w
4287        } elseif {[regexp {^t(\d+)$} $type type sz]} {
4288            ${NS}::label $cframe.l_$id -text $title
4289            ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4290                -textvariable newviewopts($n,$id)
4291            pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
4292            pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
4293        } elseif {[regexp {^t(\d+)=$} $type type sz]} {
4294            ${NS}::label $cframe.l_$id -text $title
4295            ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4296                -textvariable newviewopts($n,$id)
4297            pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
4298            pack $cframe.e_$id -in $cframe -side top -fill x
4299        } elseif {$type eq "path"} {
4300            ${NS}::label $top.l -text $title
4301            pack $top.l -in $top -side top -pady [list 3 0] -anchor w -padx 3
4302            text $top.t -width 40 -height 5 -background $bgcolor
4303            if {[info exists viewfiles($n)]} {
4304                foreach f $viewfiles($n) {
4305                    $top.t insert end $f
4306                    $top.t insert end "\n"
4307                }
4308                $top.t delete {end - 1c} end
4309                $top.t mark set insert 0.0
4310            }
4311            pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
4312        }
4313    }
4314
4315    ${NS}::frame $top.buts
4316    ${NS}::button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
4317    ${NS}::button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
4318    ${NS}::button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
4319    bind $top <Control-Return> [list newviewok $top $n]
4320    bind $top <F5> [list newviewok $top $n 1]
4321    bind $top <Escape> [list destroy $top]
4322    grid $top.buts.ok $top.buts.apply $top.buts.can
4323    grid columnconfigure $top.buts 0 -weight 1 -uniform a
4324    grid columnconfigure $top.buts 1 -weight 1 -uniform a
4325    grid columnconfigure $top.buts 2 -weight 1 -uniform a
4326    pack $top.buts -in $top -side top -fill x
4327    focus $top.t
4328}
4329
4330proc doviewmenu {m first cmd op argv} {
4331    set nmenu [$m index end]
4332    for {set i $first} {$i <= $nmenu} {incr i} {
4333        if {[$m entrycget $i -command] eq $cmd} {
4334            eval $m $op $i $argv
4335            break
4336        }
4337    }
4338}
4339
4340proc allviewmenus {n op args} {
4341    # global viewhlmenu
4342
4343    doviewmenu .bar.view 5 [list showview $n] $op $args
4344    # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
4345}
4346
4347proc newviewok {top n {apply 0}} {
4348    global nextviewnum newviewperm newviewname newishighlight
4349    global viewname viewfiles viewperm viewchanged selectedview curview
4350    global viewargs viewargscmd newviewopts viewhlmenu
4351
4352    if {[catch {
4353        set newargs [encode_view_opts $n]
4354    } err]} {
4355        error_popup "[mc "Error in commit selection arguments:"] $err" $top
4356        return
4357    }
4358    set files {}
4359    foreach f [split [$top.t get 0.0 end] "\n"] {
4360        set ft [string trim $f]
4361        if {$ft ne {}} {
4362            lappend files $ft
4363        }
4364    }
4365    if {![info exists viewfiles($n)]} {
4366        # creating a new view
4367        incr nextviewnum
4368        set viewname($n) $newviewname($n)
4369        set viewperm($n) $newviewopts($n,perm)
4370        set viewchanged($n) 1
4371        set viewfiles($n) $files
4372        set viewargs($n) $newargs
4373        set viewargscmd($n) $newviewopts($n,cmd)
4374        addviewmenu $n
4375        if {!$newishighlight} {
4376            run showview $n
4377        } else {
4378            run addvhighlight $n
4379        }
4380    } else {
4381        # editing an existing view
4382        set viewperm($n) $newviewopts($n,perm)
4383        set viewchanged($n) 1
4384        if {$newviewname($n) ne $viewname($n)} {
4385            set viewname($n) $newviewname($n)
4386            doviewmenu .bar.view 5 [list showview $n] \
4387                entryconf [list -label $viewname($n)]
4388            # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
4389                # entryconf [list -label $viewname($n) -value $viewname($n)]
4390        }
4391        if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
4392                $newviewopts($n,cmd) ne $viewargscmd($n)} {
4393            set viewfiles($n) $files
4394            set viewargs($n) $newargs
4395            set viewargscmd($n) $newviewopts($n,cmd)
4396            if {$curview == $n} {
4397                run reloadcommits
4398            }
4399        }
4400    }
4401    if {$apply} return
4402    catch {destroy $top}
4403}
4404
4405proc delview {} {
4406    global curview viewperm hlview selectedhlview viewchanged
4407
4408    if {$curview == 0} return
4409    if {[info exists hlview] && $hlview == $curview} {
4410        set selectedhlview [mc "None"]
4411        unset hlview
4412    }
4413    allviewmenus $curview delete
4414    set viewperm($curview) 0
4415    set viewchanged($curview) 1
4416    showview 0
4417}
4418
4419proc addviewmenu {n} {
4420    global viewname viewhlmenu
4421
4422    .bar.view add radiobutton -label $viewname($n) \
4423        -command [list showview $n] -variable selectedview -value $n
4424    #$viewhlmenu add radiobutton -label $viewname($n) \
4425    #   -command [list addvhighlight $n] -variable selectedhlview
4426}
4427
4428proc showview {n} {
4429    global curview cached_commitrow ordertok
4430    global displayorder parentlist rowidlist rowisopt rowfinal
4431    global colormap rowtextx nextcolor canvxmax
4432    global numcommits viewcomplete
4433    global selectedline currentid canv canvy0
4434    global treediffs
4435    global pending_select mainheadid
4436    global commitidx
4437    global selectedview
4438    global hlview selectedhlview commitinterest
4439
4440    if {$n == $curview} return
4441    set selid {}
4442    set ymax [lindex [$canv cget -scrollregion] 3]
4443    set span [$canv yview]
4444    set ytop [expr {[lindex $span 0] * $ymax}]
4445    set ybot [expr {[lindex $span 1] * $ymax}]
4446    set yscreen [expr {($ybot - $ytop) / 2}]
4447    if {$selectedline ne {}} {
4448        set selid $currentid
4449        set y [yc $selectedline]
4450        if {$ytop < $y && $y < $ybot} {
4451            set yscreen [expr {$y - $ytop}]
4452        }
4453    } elseif {[info exists pending_select]} {
4454        set selid $pending_select
4455        unset pending_select
4456    }
4457    unselectline
4458    normalline
4459    unset -nocomplain treediffs
4460    clear_display
4461    if {[info exists hlview] && $hlview == $n} {
4462        unset hlview
4463        set selectedhlview [mc "None"]
4464    }
4465    unset -nocomplain commitinterest
4466    unset -nocomplain cached_commitrow
4467    unset -nocomplain ordertok
4468
4469    set curview $n
4470    set selectedview $n
4471    .bar.view entryconf [mca "&Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
4472    .bar.view entryconf [mca "&Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
4473
4474    run refill_reflist
4475    if {![info exists viewcomplete($n)]} {
4476        getcommits $selid
4477        return
4478    }
4479
4480    set displayorder {}
4481    set parentlist {}
4482    set rowidlist {}
4483    set rowisopt {}
4484    set rowfinal {}
4485    set numcommits $commitidx($n)
4486
4487    unset -nocomplain colormap
4488    unset -nocomplain rowtextx
4489    set nextcolor 0
4490    set canvxmax [$canv cget -width]
4491    set curview $n
4492    set row 0
4493    setcanvscroll
4494    set yf 0
4495    set row {}
4496    if {$selid ne {} && [commitinview $selid $n]} {
4497        set row [rowofcommit $selid]
4498        # try to get the selected row in the same position on the screen
4499        set ymax [lindex [$canv cget -scrollregion] 3]
4500        set ytop [expr {[yc $row] - $yscreen}]
4501        if {$ytop < 0} {
4502            set ytop 0
4503        }
4504        set yf [expr {$ytop * 1.0 / $ymax}]
4505    }
4506    allcanvs yview moveto $yf
4507    drawvisible
4508    if {$row ne {}} {
4509        selectline $row 0
4510    } elseif {!$viewcomplete($n)} {
4511        reset_pending_select $selid
4512    } else {
4513        reset_pending_select {}
4514
4515        if {[commitinview $pending_select $curview]} {
4516            selectline [rowofcommit $pending_select] 1
4517        } else {
4518            set row [first_real_row]
4519            if {$row < $numcommits} {
4520                selectline $row 0
4521            }
4522        }
4523    }
4524    if {!$viewcomplete($n)} {
4525        if {$numcommits == 0} {
4526            show_status [mc "Reading commits..."]
4527        }
4528    } elseif {$numcommits == 0} {
4529        show_status [mc "No commits selected"]
4530    }
4531    set_window_title
4532}
4533
4534# Stuff relating to the highlighting facility
4535
4536proc ishighlighted {id} {
4537    global vhighlights fhighlights nhighlights rhighlights
4538
4539    if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
4540        return $nhighlights($id)
4541    }
4542    if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
4543        return $vhighlights($id)
4544    }
4545    if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
4546        return $fhighlights($id)
4547    }
4548    if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4549        return $rhighlights($id)
4550    }
4551    return 0
4552}
4553
4554proc bolden {id font} {
4555    global canv linehtag currentid boldids need_redisplay markedid
4556
4557    # need_redisplay = 1 means the display is stale and about to be redrawn
4558    if {$need_redisplay} return
4559    lappend boldids $id
4560    $canv itemconf $linehtag($id) -font $font
4561    if {[info exists currentid] && $id eq $currentid} {
4562        $canv delete secsel
4563        set t [eval $canv create rect [$canv bbox $linehtag($id)] \
4564                   -outline {{}} -tags secsel \
4565                   -fill [$canv cget -selectbackground]]
4566        $canv lower $t
4567    }
4568    if {[info exists markedid] && $id eq $markedid} {
4569        make_idmark $id
4570    }
4571}
4572
4573proc bolden_name {id font} {
4574    global canv2 linentag currentid boldnameids need_redisplay
4575
4576    if {$need_redisplay} return
4577    lappend boldnameids $id
4578    $canv2 itemconf $linentag($id) -font $font
4579    if {[info exists currentid] && $id eq $currentid} {
4580        $canv2 delete secsel
4581        set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
4582                   -outline {{}} -tags secsel \
4583                   -fill [$canv2 cget -selectbackground]]
4584        $canv2 lower $t
4585    }
4586}
4587
4588proc unbolden {} {
4589    global boldids
4590
4591    set stillbold {}
4592    foreach id $boldids {
4593        if {![ishighlighted $id]} {
4594            bolden $id mainfont
4595        } else {
4596            lappend stillbold $id
4597        }
4598    }
4599    set boldids $stillbold
4600}
4601
4602proc addvhighlight {n} {
4603    global hlview viewcomplete curview vhl_done commitidx
4604
4605    if {[info exists hlview]} {
4606        delvhighlight
4607    }
4608    set hlview $n
4609    if {$n != $curview && ![info exists viewcomplete($n)]} {
4610        start_rev_list $n
4611    }
4612    set vhl_done $commitidx($hlview)
4613    if {$vhl_done > 0} {
4614        drawvisible
4615    }
4616}
4617
4618proc delvhighlight {} {
4619    global hlview vhighlights
4620
4621    if {![info exists hlview]} return
4622    unset hlview
4623    unset -nocomplain vhighlights
4624    unbolden
4625}
4626
4627proc vhighlightmore {} {
4628    global hlview vhl_done commitidx vhighlights curview
4629
4630    set max $commitidx($hlview)
4631    set vr [visiblerows]
4632    set r0 [lindex $vr 0]
4633    set r1 [lindex $vr 1]
4634    for {set i $vhl_done} {$i < $max} {incr i} {
4635        set id [commitonrow $i $hlview]
4636        if {[commitinview $id $curview]} {
4637            set row [rowofcommit $id]
4638            if {$r0 <= $row && $row <= $r1} {
4639                if {![highlighted $row]} {
4640                    bolden $id mainfontbold
4641                }
4642                set vhighlights($id) 1
4643            }
4644        }
4645    }
4646    set vhl_done $max
4647    return 0
4648}
4649
4650proc askvhighlight {row id} {
4651    global hlview vhighlights iddrawn
4652
4653    if {[commitinview $id $hlview]} {
4654        if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
4655            bolden $id mainfontbold
4656        }
4657        set vhighlights($id) 1
4658    } else {
4659        set vhighlights($id) 0
4660    }
4661}
4662
4663proc hfiles_change {} {
4664    global highlight_files filehighlight fhighlights fh_serial
4665    global highlight_paths
4666
4667    if {[info exists filehighlight]} {
4668        # delete previous highlights
4669        catch {close $filehighlight}
4670        unset filehighlight
4671        unset -nocomplain fhighlights
4672        unbolden
4673        unhighlight_filelist
4674    }
4675    set highlight_paths {}
4676    after cancel do_file_hl $fh_serial
4677    incr fh_serial
4678    if {$highlight_files ne {}} {
4679        after 300 do_file_hl $fh_serial
4680    }
4681}
4682
4683proc gdttype_change {name ix op} {
4684    global gdttype highlight_files findstring findpattern
4685
4686    stopfinding
4687    if {$findstring ne {}} {
4688        if {$gdttype eq [mc "containing:"]} {
4689            if {$highlight_files ne {}} {
4690                set highlight_files {}
4691                hfiles_change
4692            }
4693            findcom_change
4694        } else {
4695            if {$findpattern ne {}} {
4696                set findpattern {}
4697                findcom_change
4698            }
4699            set highlight_files $findstring
4700            hfiles_change
4701        }
4702        drawvisible
4703    }
4704    # enable/disable findtype/findloc menus too
4705}
4706
4707proc find_change {name ix op} {
4708    global gdttype findstring highlight_files
4709
4710    stopfinding
4711    if {$gdttype eq [mc "containing:"]} {
4712        findcom_change
4713    } else {
4714        if {$highlight_files ne $findstring} {
4715            set highlight_files $findstring
4716            hfiles_change
4717        }
4718    }
4719    drawvisible
4720}
4721
4722proc findcom_change args {
4723    global nhighlights boldnameids
4724    global findpattern findtype findstring gdttype
4725
4726    stopfinding
4727    # delete previous highlights, if any
4728    foreach id $boldnameids {
4729        bolden_name $id mainfont
4730    }
4731    set boldnameids {}
4732    unset -nocomplain nhighlights
4733    unbolden
4734    unmarkmatches
4735    if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
4736        set findpattern {}
4737    } elseif {$findtype eq [mc "Regexp"]} {
4738        set findpattern $findstring
4739    } else {
4740        set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4741                   $findstring]
4742        set findpattern "*$e*"
4743    }
4744}
4745
4746proc makepatterns {l} {
4747    set ret {}
4748    foreach e $l {
4749        set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4750        if {[string index $ee end] eq "/"} {
4751            lappend ret "$ee*"
4752        } else {
4753            lappend ret $ee
4754            lappend ret "$ee/*"
4755        }
4756    }
4757    return $ret
4758}
4759
4760proc do_file_hl {serial} {
4761    global highlight_files filehighlight highlight_paths gdttype fhl_list
4762    global cdup findtype
4763
4764    if {$gdttype eq [mc "touching paths:"]} {
4765        # If "exact" match then convert backslashes to forward slashes.
4766        # Most useful to support Windows-flavoured file paths.
4767        if {$findtype eq [mc "Exact"]} {
4768            set highlight_files [string map {"\\" "/"} $highlight_files]
4769        }
4770        if {[catch {set paths [shellsplit $highlight_files]}]} return
4771        set highlight_paths [makepatterns $paths]
4772        highlight_filelist
4773        set relative_paths {}
4774        foreach path $paths {
4775            lappend relative_paths [file join $cdup $path]
4776        }
4777        set gdtargs [concat -- $relative_paths]
4778    } elseif {$gdttype eq [mc "adding/removing string:"]} {
4779        set gdtargs [list "-S$highlight_files"]
4780    } elseif {$gdttype eq [mc "changing lines matching:"]} {
4781        set gdtargs [list "-G$highlight_files"]
4782    } else {
4783        # must be "containing:", i.e. we're searching commit info
4784        return
4785    }
4786    set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
4787    set filehighlight [open $cmd r+]
4788    fconfigure $filehighlight -blocking 0
4789    filerun $filehighlight readfhighlight
4790    set fhl_list {}
4791    drawvisible
4792    flushhighlights
4793}
4794
4795proc flushhighlights {} {
4796    global filehighlight fhl_list
4797
4798    if {[info exists filehighlight]} {
4799        lappend fhl_list {}
4800        puts $filehighlight ""
4801        flush $filehighlight
4802    }
4803}
4804
4805proc askfilehighlight {row id} {
4806    global filehighlight fhighlights fhl_list
4807
4808    lappend fhl_list $id
4809    set fhighlights($id) -1
4810    puts $filehighlight $id
4811}
4812
4813proc readfhighlight {} {
4814    global filehighlight fhighlights curview iddrawn
4815    global fhl_list find_dirn
4816
4817    if {![info exists filehighlight]} {
4818        return 0
4819    }
4820    set nr 0
4821    while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4822        set line [string trim $line]
4823        set i [lsearch -exact $fhl_list $line]
4824        if {$i < 0} continue
4825        for {set j 0} {$j < $i} {incr j} {
4826            set id [lindex $fhl_list $j]
4827            set fhighlights($id) 0
4828        }
4829        set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4830        if {$line eq {}} continue
4831        if {![commitinview $line $curview]} continue
4832        if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4833            bolden $line mainfontbold
4834        }
4835        set fhighlights($line) 1
4836    }
4837    if {[eof $filehighlight]} {
4838        # strange...
4839        puts "oops, git diff-tree died"
4840        catch {close $filehighlight}
4841        unset filehighlight
4842        return 0
4843    }
4844    if {[info exists find_dirn]} {
4845        run findmore
4846    }
4847    return 1
4848}
4849
4850proc doesmatch {f} {
4851    global findtype findpattern
4852
4853    if {$findtype eq [mc "Regexp"]} {
4854        return [regexp $findpattern $f]
4855    } elseif {$findtype eq [mc "IgnCase"]} {
4856        return [string match -nocase $findpattern $f]
4857    } else {
4858        return [string match $findpattern $f]
4859    }
4860}
4861
4862proc askfindhighlight {row id} {
4863    global nhighlights commitinfo iddrawn
4864    global findloc
4865    global markingmatches
4866
4867    if {![info exists commitinfo($id)]} {
4868        getcommit $id
4869    }
4870    set info $commitinfo($id)
4871    set isbold 0
4872    set fldtypes [list [mc Headline] [mc Author] "" [mc Committer] "" [mc Comments]]
4873    foreach f $info ty $fldtypes {
4874        if {$ty eq ""} continue
4875        if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4876            [doesmatch $f]} {
4877            if {$ty eq [mc "Author"]} {
4878                set isbold 2
4879                break
4880            }
4881            set isbold 1
4882        }
4883    }
4884    if {$isbold && [info exists iddrawn($id)]} {
4885        if {![ishighlighted $id]} {
4886            bolden $id mainfontbold
4887            if {$isbold > 1} {
4888                bolden_name $id mainfontbold
4889            }
4890        }
4891        if {$markingmatches} {
4892            markrowmatches $row $id
4893        }
4894    }
4895    set nhighlights($id) $isbold
4896}
4897
4898proc markrowmatches {row id} {
4899    global canv canv2 linehtag linentag commitinfo findloc
4900
4901    set headline [lindex $commitinfo($id) 0]
4902    set author [lindex $commitinfo($id) 1]
4903    $canv delete match$row
4904    $canv2 delete match$row
4905    if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4906        set m [findmatches $headline]
4907        if {$m ne {}} {
4908            markmatches $canv $row $headline $linehtag($id) $m \
4909                [$canv itemcget $linehtag($id) -font] $row
4910        }
4911    }
4912    if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4913        set m [findmatches $author]
4914        if {$m ne {}} {
4915            markmatches $canv2 $row $author $linentag($id) $m \
4916                [$canv2 itemcget $linentag($id) -font] $row
4917        }
4918    }
4919}
4920
4921proc vrel_change {name ix op} {
4922    global highlight_related
4923
4924    rhighlight_none
4925    if {$highlight_related ne [mc "None"]} {
4926        run drawvisible
4927    }
4928}
4929
4930# prepare for testing whether commits are descendents or ancestors of a
4931proc rhighlight_sel {a} {
4932    global descendent desc_todo ancestor anc_todo
4933    global highlight_related
4934
4935    unset -nocomplain descendent
4936    set desc_todo [list $a]
4937    unset -nocomplain ancestor
4938    set anc_todo [list $a]
4939    if {$highlight_related ne [mc "None"]} {
4940        rhighlight_none
4941        run drawvisible
4942    }
4943}
4944
4945proc rhighlight_none {} {
4946    global rhighlights
4947
4948    unset -nocomplain rhighlights
4949    unbolden
4950}
4951
4952proc is_descendent {a} {
4953    global curview children descendent desc_todo
4954
4955    set v $curview
4956    set la [rowofcommit $a]
4957    set todo $desc_todo
4958    set leftover {}
4959    set done 0
4960    for {set i 0} {$i < [llength $todo]} {incr i} {
4961        set do [lindex $todo $i]
4962        if {[rowofcommit $do] < $la} {
4963            lappend leftover $do
4964            continue
4965        }
4966        foreach nk $children($v,$do) {
4967            if {![info exists descendent($nk)]} {
4968                set descendent($nk) 1
4969                lappend todo $nk
4970                if {$nk eq $a} {
4971                    set done 1
4972                }
4973            }
4974        }
4975        if {$done} {
4976            set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4977            return
4978        }
4979    }
4980    set descendent($a) 0
4981    set desc_todo $leftover
4982}
4983
4984proc is_ancestor {a} {
4985    global curview parents ancestor anc_todo
4986
4987    set v $curview
4988    set la [rowofcommit $a]
4989    set todo $anc_todo
4990    set leftover {}
4991    set done 0
4992    for {set i 0} {$i < [llength $todo]} {incr i} {
4993        set do [lindex $todo $i]
4994        if {![commitinview $do $v] || [rowofcommit $do] > $la} {
4995            lappend leftover $do
4996            continue
4997        }
4998        foreach np $parents($v,$do) {
4999            if {![info exists ancestor($np)]} {
5000                set ancestor($np) 1
5001                lappend todo $np
5002                if {$np eq $a} {
5003                    set done 1
5004                }
5005            }
5006        }
5007        if {$done} {
5008            set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
5009            return
5010        }
5011    }
5012    set ancestor($a) 0
5013    set anc_todo $leftover
5014}
5015
5016proc askrelhighlight {row id} {
5017    global descendent highlight_related iddrawn rhighlights
5018    global selectedline ancestor
5019
5020    if {$selectedline eq {}} return
5021    set isbold 0
5022    if {$highlight_related eq [mc "Descendant"] ||
5023        $highlight_related eq [mc "Not descendant"]} {
5024        if {![info exists descendent($id)]} {
5025            is_descendent $id
5026        }
5027        if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
5028            set isbold 1
5029        }
5030    } elseif {$highlight_related eq [mc "Ancestor"] ||
5031              $highlight_related eq [mc "Not ancestor"]} {
5032        if {![info exists ancestor($id)]} {
5033            is_ancestor $id
5034        }
5035        if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
5036            set isbold 1
5037        }
5038    }
5039    if {[info exists iddrawn($id)]} {
5040        if {$isbold && ![ishighlighted $id]} {
5041            bolden $id mainfontbold
5042        }
5043    }
5044    set rhighlights($id) $isbold
5045}
5046
5047# Graph layout functions
5048
5049proc shortids {ids} {
5050    set res {}
5051    foreach id $ids {
5052        if {[llength $id] > 1} {
5053            lappend res [shortids $id]
5054        } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
5055            lappend res [string range $id 0 7]
5056        } else {
5057            lappend res $id
5058        }
5059    }
5060    return $res
5061}
5062
5063proc ntimes {n o} {
5064    set ret {}
5065    set o [list $o]
5066    for {set mask 1} {$mask <= $n} {incr mask $mask} {
5067        if {($n & $mask) != 0} {
5068            set ret [concat $ret $o]
5069        }
5070        set o [concat $o $o]
5071    }
5072    return $ret
5073}
5074
5075proc ordertoken {id} {
5076    global ordertok curview varcid varcstart varctok curview parents children
5077    global nullid nullid2
5078
5079    if {[info exists ordertok($id)]} {
5080        return $ordertok($id)
5081    }
5082    set origid $id
5083    set todo {}
5084    while {1} {
5085        if {[info exists varcid($curview,$id)]} {
5086            set a $varcid($curview,$id)
5087            set p [lindex $varcstart($curview) $a]
5088        } else {
5089            set p [lindex $children($curview,$id) 0]
5090        }
5091        if {[info exists ordertok($p)]} {
5092            set tok $ordertok($p)
5093            break
5094        }
5095        set id [first_real_child $curview,$p]
5096        if {$id eq {}} {
5097            # it's a root
5098            set tok [lindex $varctok($curview) $varcid($curview,$p)]
5099            break
5100        }
5101        if {[llength $parents($curview,$id)] == 1} {
5102            lappend todo [list $p {}]
5103        } else {
5104            set j [lsearch -exact $parents($curview,$id) $p]
5105            if {$j < 0} {
5106                puts "oops didn't find [shortids $p] in parents of [shortids $id]"
5107            }
5108            lappend todo [list $p [strrep $j]]
5109        }
5110    }
5111    for {set i [llength $todo]} {[incr i -1] >= 0} {} {
5112        set p [lindex $todo $i 0]
5113        append tok [lindex $todo $i 1]
5114        set ordertok($p) $tok
5115    }
5116    set ordertok($origid) $tok
5117    return $tok
5118}
5119
5120# Work out where id should go in idlist so that order-token
5121# values increase from left to right
5122proc idcol {idlist id {i 0}} {
5123    set t [ordertoken $id]
5124    if {$i < 0} {
5125        set i 0
5126    }
5127    if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
5128        if {$i > [llength $idlist]} {
5129            set i [llength $idlist]
5130        }
5131        while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
5132        incr i
5133    } else {
5134        if {$t > [ordertoken [lindex $idlist $i]]} {
5135            while {[incr i] < [llength $idlist] &&
5136                   $t >= [ordertoken [lindex $idlist $i]]} {}
5137        }
5138    }
5139    return $i
5140}
5141
5142proc initlayout {} {
5143    global rowidlist rowisopt rowfinal displayorder parentlist
5144    global numcommits canvxmax canv
5145    global nextcolor
5146    global colormap rowtextx
5147
5148    set numcommits 0
5149    set displayorder {}
5150    set parentlist {}
5151    set nextcolor 0
5152    set rowidlist {}
5153    set rowisopt {}
5154    set rowfinal {}
5155    set canvxmax [$canv cget -width]
5156    unset -nocomplain colormap
5157    unset -nocomplain rowtextx
5158    setcanvscroll
5159}
5160
5161proc setcanvscroll {} {
5162    global canv canv2 canv3 numcommits linespc canvxmax canvy0
5163    global lastscrollset lastscrollrows
5164
5165    set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
5166    $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
5167    $canv2 conf -scrollregion [list 0 0 0 $ymax]
5168    $canv3 conf -scrollregion [list 0 0 0 $ymax]
5169    set lastscrollset [clock clicks -milliseconds]
5170    set lastscrollrows $numcommits
5171}
5172
5173proc visiblerows {} {
5174    global canv numcommits linespc
5175
5176    set ymax [lindex [$canv cget -scrollregion] 3]
5177    if {$ymax eq {} || $ymax == 0} return
5178    set f [$canv yview]
5179    set y0 [expr {int([lindex $f 0] * $ymax)}]
5180    set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
5181    if {$r0 < 0} {
5182        set r0 0
5183    }
5184    set y1 [expr {int([lindex $f 1] * $ymax)}]
5185    set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
5186    if {$r1 >= $numcommits} {
5187        set r1 [expr {$numcommits - 1}]
5188    }
5189    return [list $r0 $r1]
5190}
5191
5192proc layoutmore {} {
5193    global commitidx viewcomplete curview
5194    global numcommits pending_select curview
5195    global lastscrollset lastscrollrows
5196
5197    if {$lastscrollrows < 100 || $viewcomplete($curview) ||
5198        [clock clicks -milliseconds] - $lastscrollset > 500} {
5199        setcanvscroll
5200    }
5201    if {[info exists pending_select] &&
5202        [commitinview $pending_select $curview]} {
5203        update
5204        selectline [rowofcommit $pending_select] 1
5205    }
5206    drawvisible
5207}
5208
5209# With path limiting, we mightn't get the actual HEAD commit,
5210# so ask git rev-list what is the first ancestor of HEAD that
5211# touches a file in the path limit.
5212proc get_viewmainhead {view} {
5213    global viewmainheadid vfilelimit viewinstances mainheadid
5214
5215    catch {
5216        set rfd [open [concat | git rev-list -1 $mainheadid \
5217                           -- $vfilelimit($view)] r]
5218        set j [reg_instance $rfd]
5219        lappend viewinstances($view) $j
5220        fconfigure $rfd -blocking 0
5221        filerun $rfd [list getviewhead $rfd $j $view]
5222        set viewmainheadid($curview) {}
5223    }
5224}
5225
5226# git rev-list should give us just 1 line to use as viewmainheadid($view)
5227proc getviewhead {fd inst view} {
5228    global viewmainheadid commfd curview viewinstances showlocalchanges
5229
5230    set id {}
5231    if {[gets $fd line] < 0} {
5232        if {![eof $fd]} {
5233            return 1
5234        }
5235    } elseif {[string length $line] == 40 && [string is xdigit $line]} {
5236        set id $line
5237    }
5238    set viewmainheadid($view) $id
5239    close $fd
5240    unset commfd($inst)
5241    set i [lsearch -exact $viewinstances($view) $inst]
5242    if {$i >= 0} {
5243        set viewinstances($view) [lreplace $viewinstances($view) $i $i]
5244    }
5245    if {$showlocalchanges && $id ne {} && $view == $curview} {
5246        doshowlocalchanges
5247    }
5248    return 0
5249}
5250
5251proc doshowlocalchanges {} {
5252    global curview viewmainheadid
5253
5254    if {$viewmainheadid($curview) eq {}} return
5255    if {[commitinview $viewmainheadid($curview) $curview]} {
5256        dodiffindex
5257    } else {
5258        interestedin $viewmainheadid($curview) dodiffindex
5259    }
5260}
5261
5262proc dohidelocalchanges {} {
5263    global nullid nullid2 lserial curview
5264
5265    if {[commitinview $nullid $curview]} {
5266        removefakerow $nullid
5267    }
5268    if {[commitinview $nullid2 $curview]} {
5269        removefakerow $nullid2
5270    }
5271    incr lserial
5272}
5273
5274# spawn off a process to do git diff-index --cached HEAD
5275proc dodiffindex {} {
5276    global lserial showlocalchanges vfilelimit curview
5277    global hasworktree git_version
5278
5279    if {!$showlocalchanges || !$hasworktree} return
5280    incr lserial
5281    if {[package vcompare $git_version "1.7.2"] >= 0} {
5282        set cmd "|git diff-index --cached --ignore-submodules=dirty HEAD"
5283    } else {
5284        set cmd "|git diff-index --cached HEAD"
5285    }
5286    if {$vfilelimit($curview) ne {}} {
5287        set cmd [concat $cmd -- $vfilelimit($curview)]
5288    }
5289    set fd [open $cmd r]
5290    fconfigure $fd -blocking 0
5291    set i [reg_instance $fd]
5292    filerun $fd [list readdiffindex $fd $lserial $i]
5293}
5294
5295proc readdiffindex {fd serial inst} {
5296    global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
5297    global vfilelimit
5298
5299    set isdiff 1
5300    if {[gets $fd line] < 0} {
5301        if {![eof $fd]} {
5302            return 1
5303        }
5304        set isdiff 0
5305    }
5306    # we only need to see one line and we don't really care what it says...
5307    stop_instance $inst
5308
5309    if {$serial != $lserial} {
5310        return 0
5311    }
5312
5313    # now see if there are any local changes not checked in to the index
5314    set cmd "|git diff-files"
5315    if {$vfilelimit($curview) ne {}} {
5316        set cmd [concat $cmd -- $vfilelimit($curview)]
5317    }
5318    set fd [open $cmd r]
5319    fconfigure $fd -blocking 0
5320    set i [reg_instance $fd]
5321    filerun $fd [list readdifffiles $fd $serial $i]
5322
5323    if {$isdiff && ![commitinview $nullid2 $curview]} {
5324        # add the line for the changes in the index to the graph
5325        set hl [mc "Local changes checked in to index but not committed"]
5326        set commitinfo($nullid2) [list  $hl {} {} {} {} "    $hl\n"]
5327        set commitdata($nullid2) "\n    $hl\n"
5328        if {[commitinview $nullid $curview]} {
5329            removefakerow $nullid
5330        }
5331        insertfakerow $nullid2 $viewmainheadid($curview)
5332    } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
5333        if {[commitinview $nullid $curview]} {
5334            removefakerow $nullid
5335        }
5336        removefakerow $nullid2
5337    }
5338    return 0
5339}
5340
5341proc readdifffiles {fd serial inst} {
5342    global viewmainheadid nullid nullid2 curview
5343    global commitinfo commitdata lserial
5344
5345    set isdiff 1
5346    if {[gets $fd line] < 0} {
5347        if {![eof $fd]} {
5348            return 1
5349        }
5350        set isdiff 0
5351    }
5352    # we only need to see one line and we don't really care what it says...
5353    stop_instance $inst
5354
5355    if {$serial != $lserial} {
5356        return 0
5357    }
5358
5359    if {$isdiff && ![commitinview $nullid $curview]} {
5360        # add the line for the local diff to the graph
5361        set hl [mc "Local uncommitted changes, not checked in to index"]
5362        set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
5363        set commitdata($nullid) "\n    $hl\n"
5364        if {[commitinview $nullid2 $curview]} {
5365            set p $nullid2
5366        } else {
5367            set p $viewmainheadid($curview)
5368        }
5369        insertfakerow $nullid $p
5370    } elseif {!$isdiff && [commitinview $nullid $curview]} {
5371        removefakerow $nullid
5372    }
5373    return 0
5374}
5375
5376proc nextuse {id row} {
5377    global curview children
5378
5379    if {[info exists children($curview,$id)]} {
5380        foreach kid $children($curview,$id) {
5381            if {![commitinview $kid $curview]} {
5382                return -1
5383            }
5384            if {[rowofcommit $kid] > $row} {
5385                return [rowofcommit $kid]
5386            }
5387        }
5388    }
5389    if {[commitinview $id $curview]} {
5390        return [rowofcommit $id]
5391    }
5392    return -1
5393}
5394
5395proc prevuse {id row} {
5396    global curview children
5397
5398    set ret -1
5399    if {[info exists children($curview,$id)]} {
5400        foreach kid $children($curview,$id) {
5401            if {![commitinview $kid $curview]} break
5402            if {[rowofcommit $kid] < $row} {
5403                set ret [rowofcommit $kid]
5404            }
5405        }
5406    }
5407    return $ret
5408}
5409
5410proc make_idlist {row} {
5411    global displayorder parentlist uparrowlen downarrowlen mingaplen
5412    global commitidx curview children
5413
5414    set r [expr {$row - $mingaplen - $downarrowlen - 1}]
5415    if {$r < 0} {
5416        set r 0
5417    }
5418    set ra [expr {$row - $downarrowlen}]
5419    if {$ra < 0} {
5420        set ra 0
5421    }
5422    set rb [expr {$row + $uparrowlen}]
5423    if {$rb > $commitidx($curview)} {
5424        set rb $commitidx($curview)
5425    }
5426    make_disporder $r [expr {$rb + 1}]
5427    set ids {}
5428    for {} {$r < $ra} {incr r} {
5429        set nextid [lindex $displayorder [expr {$r + 1}]]
5430        foreach p [lindex $parentlist $r] {
5431            if {$p eq $nextid} continue
5432            set rn [nextuse $p $r]
5433            if {$rn >= $row &&
5434                $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
5435                lappend ids [list [ordertoken $p] $p]
5436            }
5437        }
5438    }
5439    for {} {$r < $row} {incr r} {
5440        set nextid [lindex $displayorder [expr {$r + 1}]]
5441        foreach p [lindex $parentlist $r] {
5442            if {$p eq $nextid} continue
5443            set rn [nextuse $p $r]
5444            if {$rn < 0 || $rn >= $row} {
5445                lappend ids [list [ordertoken $p] $p]
5446            }
5447        }
5448    }
5449    set id [lindex $displayorder $row]
5450    lappend ids [list [ordertoken $id] $id]
5451    while {$r < $rb} {
5452        foreach p [lindex $parentlist $r] {
5453            set firstkid [lindex $children($curview,$p) 0]
5454            if {[rowofcommit $firstkid] < $row} {
5455                lappend ids [list [ordertoken $p] $p]
5456            }
5457        }
5458        incr r
5459        set id [lindex $displayorder $r]
5460        if {$id ne {}} {
5461            set firstkid [lindex $children($curview,$id) 0]
5462            if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
5463                lappend ids [list [ordertoken $id] $id]
5464            }
5465        }
5466    }
5467    set idlist {}
5468    foreach idx [lsort -unique $ids] {
5469        lappend idlist [lindex $idx 1]
5470    }
5471    return $idlist
5472}
5473
5474proc rowsequal {a b} {
5475    while {[set i [lsearch -exact $a {}]] >= 0} {
5476        set a [lreplace $a $i $i]
5477    }
5478    while {[set i [lsearch -exact $b {}]] >= 0} {
5479        set b [lreplace $b $i $i]
5480    }
5481    return [expr {$a eq $b}]
5482}
5483
5484proc makeupline {id row rend col} {
5485    global rowidlist uparrowlen downarrowlen mingaplen
5486
5487    for {set r $rend} {1} {set r $rstart} {
5488        set rstart [prevuse $id $r]
5489        if {$rstart < 0} return
5490        if {$rstart < $row} break
5491    }
5492    if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5493        set rstart [expr {$rend - $uparrowlen - 1}]
5494    }
5495    for {set r $rstart} {[incr r] <= $row} {} {
5496        set idlist [lindex $rowidlist $r]
5497        if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5498            set col [idcol $idlist $id $col]
5499            lset rowidlist $r [linsert $idlist $col $id]
5500            changedrow $r
5501        }
5502    }
5503}
5504
5505proc layoutrows {row endrow} {
5506    global rowidlist rowisopt rowfinal displayorder
5507    global uparrowlen downarrowlen maxwidth mingaplen
5508    global children parentlist
5509    global commitidx viewcomplete curview
5510
5511    make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
5512    set idlist {}
5513    if {$row > 0} {
5514        set rm1 [expr {$row - 1}]
5515        foreach id [lindex $rowidlist $rm1] {
5516            if {$id ne {}} {
5517                lappend idlist $id
5518            }
5519        }
5520        set final [lindex $rowfinal $rm1]
5521    }
5522    for {} {$row < $endrow} {incr row} {
5523        set rm1 [expr {$row - 1}]
5524        if {$rm1 < 0 || $idlist eq {}} {
5525            set idlist [make_idlist $row]
5526            set final 1
5527        } else {
5528            set id [lindex $displayorder $rm1]
5529            set col [lsearch -exact $idlist $id]
5530            set idlist [lreplace $idlist $col $col]
5531            foreach p [lindex $parentlist $rm1] {
5532                if {[lsearch -exact $idlist $p] < 0} {
5533                    set col [idcol $idlist $p $col]
5534                    set idlist [linsert $idlist $col $p]
5535                    # if not the first child, we have to insert a line going up
5536                    if {$id ne [lindex $children($curview,$p) 0]} {
5537                        makeupline $p $rm1 $row $col
5538                    }
5539                }
5540            }
5541            set id [lindex $displayorder $row]
5542            if {$row > $downarrowlen} {
5543                set termrow [expr {$row - $downarrowlen - 1}]
5544                foreach p [lindex $parentlist $termrow] {
5545                    set i [lsearch -exact $idlist $p]
5546                    if {$i < 0} continue
5547                    set nr [nextuse $p $termrow]
5548                    if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5549                        set idlist [lreplace $idlist $i $i]
5550                    }
5551                }
5552            }
5553            set col [lsearch -exact $idlist $id]
5554            if {$col < 0} {
5555                set col [idcol $idlist $id]
5556                set idlist [linsert $idlist $col $id]
5557                if {$children($curview,$id) ne {}} {
5558                    makeupline $id $rm1 $row $col
5559                }
5560            }
5561            set r [expr {$row + $uparrowlen - 1}]
5562            if {$r < $commitidx($curview)} {
5563                set x $col
5564                foreach p [lindex $parentlist $r] {
5565                    if {[lsearch -exact $idlist $p] >= 0} continue
5566                    set fk [lindex $children($curview,$p) 0]
5567                    if {[rowofcommit $fk] < $row} {
5568                        set x [idcol $idlist $p $x]
5569                        set idlist [linsert $idlist $x $p]
5570                    }
5571                }
5572                if {[incr r] < $commitidx($curview)} {
5573                    set p [lindex $displayorder $r]
5574                    if {[lsearch -exact $idlist $p] < 0} {
5575                        set fk [lindex $children($curview,$p) 0]
5576                        if {$fk ne {} && [rowofcommit $fk] < $row} {
5577                            set x [idcol $idlist $p $x]
5578                            set idlist [linsert $idlist $x $p]
5579                        }
5580                    }
5581                }
5582            }
5583        }
5584        if {$final && !$viewcomplete($curview) &&
5585            $row + $uparrowlen + $mingaplen + $downarrowlen
5586                >= $commitidx($curview)} {
5587            set final 0
5588        }
5589        set l [llength $rowidlist]
5590        if {$row == $l} {
5591            lappend rowidlist $idlist
5592            lappend rowisopt 0
5593            lappend rowfinal $final
5594        } elseif {$row < $l} {
5595            if {![rowsequal $idlist [lindex $rowidlist $row]]} {
5596                lset rowidlist $row $idlist
5597                changedrow $row
5598            }
5599            lset rowfinal $row $final
5600        } else {
5601            set pad [ntimes [expr {$row - $l}] {}]
5602            set rowidlist [concat $rowidlist $pad]
5603            lappend rowidlist $idlist
5604            set rowfinal [concat $rowfinal $pad]
5605            lappend rowfinal $final
5606            set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5607        }
5608    }
5609    return $row
5610}
5611
5612proc changedrow {row} {
5613    global displayorder iddrawn rowisopt need_redisplay
5614
5615    set l [llength $rowisopt]
5616    if {$row < $l} {
5617        lset rowisopt $row 0
5618        if {$row + 1 < $l} {
5619            lset rowisopt [expr {$row + 1}] 0
5620            if {$row + 2 < $l} {
5621                lset rowisopt [expr {$row + 2}] 0
5622            }
5623        }
5624    }
5625    set id [lindex $displayorder $row]
5626    if {[info exists iddrawn($id)]} {
5627        set need_redisplay 1
5628    }
5629}
5630
5631proc insert_pad {row col npad} {
5632    global rowidlist
5633
5634    set pad [ntimes $npad {}]
5635    set idlist [lindex $rowidlist $row]
5636    set bef [lrange $idlist 0 [expr {$col - 1}]]
5637    set aft [lrange $idlist $col end]
5638    set i [lsearch -exact $aft {}]
5639    if {$i > 0} {
5640        set aft [lreplace $aft $i $i]
5641    }
5642    lset rowidlist $row [concat $bef $pad $aft]
5643    changedrow $row
5644}
5645
5646proc optimize_rows {row col endrow} {
5647    global rowidlist rowisopt displayorder curview children
5648
5649    if {$row < 1} {
5650        set row 1
5651    }
5652    for {} {$row < $endrow} {incr row; set col 0} {
5653        if {[lindex $rowisopt $row]} continue
5654        set haspad 0
5655        set y0 [expr {$row - 1}]
5656        set ym [expr {$row - 2}]
5657        set idlist [lindex $rowidlist $row]
5658        set previdlist [lindex $rowidlist $y0]
5659        if {$idlist eq {} || $previdlist eq {}} continue
5660        if {$ym >= 0} {
5661            set pprevidlist [lindex $rowidlist $ym]
5662            if {$pprevidlist eq {}} continue
5663        } else {
5664            set pprevidlist {}
5665        }
5666        set x0 -1
5667        set xm -1
5668        for {} {$col < [llength $idlist]} {incr col} {
5669            set id [lindex $idlist $col]
5670            if {[lindex $previdlist $col] eq $id} continue
5671            if {$id eq {}} {
5672                set haspad 1
5673                continue
5674            }
5675            set x0 [lsearch -exact $previdlist $id]
5676            if {$x0 < 0} continue
5677            set z [expr {$x0 - $col}]
5678            set isarrow 0
5679            set z0 {}
5680            if {$ym >= 0} {
5681                set xm [lsearch -exact $pprevidlist $id]
5682                if {$xm >= 0} {
5683                    set z0 [expr {$xm - $x0}]
5684                }
5685            }
5686            if {$z0 eq {}} {
5687                # if row y0 is the first child of $id then it's not an arrow
5688                if {[lindex $children($curview,$id) 0] ne
5689                    [lindex $displayorder $y0]} {
5690                    set isarrow 1
5691                }
5692            }
5693            if {!$isarrow && $id ne [lindex $displayorder $row] &&
5694                [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5695                set isarrow 1
5696            }
5697            # Looking at lines from this row to the previous row,
5698            # make them go straight up if they end in an arrow on
5699            # the previous row; otherwise make them go straight up
5700            # or at 45 degrees.
5701            if {$z < -1 || ($z < 0 && $isarrow)} {
5702                # Line currently goes left too much;
5703                # insert pads in the previous row, then optimize it
5704                set npad [expr {-1 - $z + $isarrow}]
5705                insert_pad $y0 $x0 $npad
5706                if {$y0 > 0} {
5707                    optimize_rows $y0 $x0 $row
5708                }
5709                set previdlist [lindex $rowidlist $y0]
5710                set x0 [lsearch -exact $previdlist $id]
5711                set z [expr {$x0 - $col}]
5712                if {$z0 ne {}} {
5713                    set pprevidlist [lindex $rowidlist $ym]
5714                    set xm [lsearch -exact $pprevidlist $id]
5715                    set z0 [expr {$xm - $x0}]
5716                }
5717            } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5718                # Line currently goes right too much;
5719                # insert pads in this line
5720                set npad [expr {$z - 1 + $isarrow}]
5721                insert_pad $row $col $npad
5722                set idlist [lindex $rowidlist $row]
5723                incr col $npad
5724                set z [expr {$x0 - $col}]
5725                set haspad 1
5726            }
5727            if {$z0 eq {} && !$isarrow && $ym >= 0} {
5728                # this line links to its first child on row $row-2
5729                set id [lindex $displayorder $ym]
5730                set xc [lsearch -exact $pprevidlist $id]
5731                if {$xc >= 0} {
5732                    set z0 [expr {$xc - $x0}]
5733                }
5734            }
5735            # avoid lines jigging left then immediately right
5736            if {$z0 ne {} && $z < 0 && $z0 > 0} {
5737                insert_pad $y0 $x0 1
5738                incr x0
5739                optimize_rows $y0 $x0 $row
5740                set previdlist [lindex $rowidlist $y0]
5741            }
5742        }
5743        if {!$haspad} {
5744            # Find the first column that doesn't have a line going right
5745            for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5746                set id [lindex $idlist $col]
5747                if {$id eq {}} break
5748                set x0 [lsearch -exact $previdlist $id]
5749                if {$x0 < 0} {
5750                    # check if this is the link to the first child
5751                    set kid [lindex $displayorder $y0]
5752                    if {[lindex $children($curview,$id) 0] eq $kid} {
5753                        # it is, work out offset to child
5754                        set x0 [lsearch -exact $previdlist $kid]
5755                    }
5756                }
5757                if {$x0 <= $col} break
5758            }
5759            # Insert a pad at that column as long as it has a line and
5760            # isn't the last column
5761            if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5762                set idlist [linsert $idlist $col {}]
5763                lset rowidlist $row $idlist
5764                changedrow $row
5765            }
5766        }
5767    }
5768}
5769
5770proc xc {row col} {
5771    global canvx0 linespc
5772    return [expr {$canvx0 + $col * $linespc}]
5773}
5774
5775proc yc {row} {
5776    global canvy0 linespc
5777    return [expr {$canvy0 + $row * $linespc}]
5778}
5779
5780proc linewidth {id} {
5781    global thickerline lthickness
5782
5783    set wid $lthickness
5784    if {[info exists thickerline] && $id eq $thickerline} {
5785        set wid [expr {2 * $lthickness}]
5786    }
5787    return $wid
5788}
5789
5790proc rowranges {id} {
5791    global curview children uparrowlen downarrowlen
5792    global rowidlist
5793
5794    set kids $children($curview,$id)
5795    if {$kids eq {}} {
5796        return {}
5797    }
5798    set ret {}
5799    lappend kids $id
5800    foreach child $kids {
5801        if {![commitinview $child $curview]} break
5802        set row [rowofcommit $child]
5803        if {![info exists prev]} {
5804            lappend ret [expr {$row + 1}]
5805        } else {
5806            if {$row <= $prevrow} {
5807                puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5808            }
5809            # see if the line extends the whole way from prevrow to row
5810            if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5811                [lsearch -exact [lindex $rowidlist \
5812                            [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5813                # it doesn't, see where it ends
5814                set r [expr {$prevrow + $downarrowlen}]
5815                if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5816                    while {[incr r -1] > $prevrow &&
5817                           [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5818                } else {
5819                    while {[incr r] <= $row &&
5820                           [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5821                    incr r -1
5822                }
5823                lappend ret $r
5824                # see where it starts up again
5825                set r [expr {$row - $uparrowlen}]
5826                if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5827                    while {[incr r] < $row &&
5828                           [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5829                } else {
5830                    while {[incr r -1] >= $prevrow &&
5831                           [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5832                    incr r
5833                }
5834                lappend ret $r
5835            }
5836        }
5837        if {$child eq $id} {
5838            lappend ret $row
5839        }
5840        set prev $child
5841        set prevrow $row
5842    }
5843    return $ret
5844}
5845
5846proc drawlineseg {id row endrow arrowlow} {
5847    global rowidlist displayorder iddrawn linesegs
5848    global canv colormap linespc curview maxlinelen parentlist
5849
5850    set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5851    set le [expr {$row + 1}]
5852    set arrowhigh 1
5853    while {1} {
5854        set c [lsearch -exact [lindex $rowidlist $le] $id]
5855        if {$c < 0} {
5856            incr le -1
5857            break
5858        }
5859        lappend cols $c
5860        set x [lindex $displayorder $le]
5861        if {$x eq $id} {
5862            set arrowhigh 0
5863            break
5864        }
5865        if {[info exists iddrawn($x)] || $le == $endrow} {
5866            set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5867            if {$c >= 0} {
5868                lappend cols $c
5869                set arrowhigh 0
5870            }
5871            break
5872        }
5873        incr le
5874    }
5875    if {$le <= $row} {
5876        return $row
5877    }
5878
5879    set lines {}
5880    set i 0
5881    set joinhigh 0
5882    if {[info exists linesegs($id)]} {
5883        set lines $linesegs($id)
5884        foreach li $lines {
5885            set r0 [lindex $li 0]
5886            if {$r0 > $row} {
5887                if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5888                    set joinhigh 1
5889                }
5890                break
5891            }
5892            incr i
5893        }
5894    }
5895    set joinlow 0
5896    if {$i > 0} {
5897        set li [lindex $lines [expr {$i-1}]]
5898        set r1 [lindex $li 1]
5899        if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5900            set joinlow 1
5901        }
5902    }
5903
5904    set x [lindex $cols [expr {$le - $row}]]
5905    set xp [lindex $cols [expr {$le - 1 - $row}]]
5906    set dir [expr {$xp - $x}]
5907    if {$joinhigh} {
5908        set ith [lindex $lines $i 2]
5909        set coords [$canv coords $ith]
5910        set ah [$canv itemcget $ith -arrow]
5911        set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5912        set x2 [lindex $cols [expr {$le + 1 - $row}]]
5913        if {$x2 ne {} && $x - $x2 == $dir} {
5914            set coords [lrange $coords 0 end-2]
5915        }
5916    } else {
5917        set coords [list [xc $le $x] [yc $le]]
5918    }
5919    if {$joinlow} {
5920        set itl [lindex $lines [expr {$i-1}] 2]
5921        set al [$canv itemcget $itl -arrow]
5922        set arrowlow [expr {$al eq "last" || $al eq "both"}]
5923    } elseif {$arrowlow} {
5924        if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5925            [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5926            set arrowlow 0
5927        }
5928    }
5929    set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5930    for {set y $le} {[incr y -1] > $row} {} {
5931        set x $xp
5932        set xp [lindex $cols [expr {$y - 1 - $row}]]
5933        set ndir [expr {$xp - $x}]
5934        if {$dir != $ndir || $xp < 0} {
5935            lappend coords [xc $y $x] [yc $y]
5936        }
5937        set dir $ndir
5938    }
5939    if {!$joinlow} {
5940        if {$xp < 0} {
5941            # join parent line to first child
5942            set ch [lindex $displayorder $row]
5943            set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5944            if {$xc < 0} {
5945                puts "oops: drawlineseg: child $ch not on row $row"
5946            } elseif {$xc != $x} {
5947                if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5948                    set d [expr {int(0.5 * $linespc)}]
5949                    set x1 [xc $row $x]
5950                    if {$xc < $x} {
5951                        set x2 [expr {$x1 - $d}]
5952                    } else {
5953                        set x2 [expr {$x1 + $d}]
5954                    }
5955                    set y2 [yc $row]
5956                    set y1 [expr {$y2 + $d}]
5957                    lappend coords $x1 $y1 $x2 $y2
5958                } elseif {$xc < $x - 1} {
5959                    lappend coords [xc $row [expr {$x-1}]] [yc $row]
5960                } elseif {$xc > $x + 1} {
5961                    lappend coords [xc $row [expr {$x+1}]] [yc $row]
5962                }
5963                set x $xc
5964            }
5965            lappend coords [xc $row $x] [yc $row]
5966        } else {
5967            set xn [xc $row $xp]
5968            set yn [yc $row]
5969            lappend coords $xn $yn
5970        }
5971        if {!$joinhigh} {
5972            assigncolor $id
5973            set t [$canv create line $coords -width [linewidth $id] \
5974                       -fill $colormap($id) -tags lines.$id -arrow $arrow]
5975            $canv lower $t
5976            bindline $t $id
5977            set lines [linsert $lines $i [list $row $le $t]]
5978        } else {
5979            $canv coords $ith $coords
5980            if {$arrow ne $ah} {
5981                $canv itemconf $ith -arrow $arrow
5982            }
5983            lset lines $i 0 $row
5984        }
5985    } else {
5986        set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
5987        set ndir [expr {$xo - $xp}]
5988        set clow [$canv coords $itl]
5989        if {$dir == $ndir} {
5990            set clow [lrange $clow 2 end]
5991        }
5992        set coords [concat $coords $clow]
5993        if {!$joinhigh} {
5994            lset lines [expr {$i-1}] 1 $le
5995        } else {
5996            # coalesce two pieces
5997            $canv delete $ith
5998            set b [lindex $lines [expr {$i-1}] 0]
5999            set e [lindex $lines $i 1]
6000            set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
6001        }
6002        $canv coords $itl $coords
6003        if {$arrow ne $al} {
6004            $canv itemconf $itl -arrow $arrow
6005        }
6006    }
6007
6008    set linesegs($id) $lines
6009    return $le
6010}
6011
6012proc drawparentlinks {id row} {
6013    global rowidlist canv colormap curview parentlist
6014    global idpos linespc
6015
6016    set rowids [lindex $rowidlist $row]
6017    set col [lsearch -exact $rowids $id]
6018    if {$col < 0} return
6019    set olds [lindex $parentlist $row]
6020    set row2 [expr {$row + 1}]
6021    set x [xc $row $col]
6022    set y [yc $row]
6023    set y2 [yc $row2]
6024    set d [expr {int(0.5 * $linespc)}]
6025    set ymid [expr {$y + $d}]
6026    set ids [lindex $rowidlist $row2]
6027    # rmx = right-most X coord used
6028    set rmx 0
6029    foreach p $olds {
6030        set i [lsearch -exact $ids $p]
6031        if {$i < 0} {
6032            puts "oops, parent $p of $id not in list"
6033            continue
6034        }
6035        set x2 [xc $row2 $i]
6036        if {$x2 > $rmx} {
6037            set rmx $x2
6038        }
6039        set j [lsearch -exact $rowids $p]
6040        if {$j < 0} {
6041            # drawlineseg will do this one for us
6042            continue
6043        }
6044        assigncolor $p
6045        # should handle duplicated parents here...
6046        set coords [list $x $y]
6047        if {$i != $col} {
6048            # if attaching to a vertical segment, draw a smaller
6049            # slant for visual distinctness
6050            if {$i == $j} {
6051                if {$i < $col} {
6052                    lappend coords [expr {$x2 + $d}] $y $x2 $ymid
6053                } else {
6054                    lappend coords [expr {$x2 - $d}] $y $x2 $ymid
6055                }
6056            } elseif {$i < $col && $i < $j} {
6057                # segment slants towards us already
6058                lappend coords [xc $row $j] $y
6059            } else {
6060                if {$i < $col - 1} {
6061                    lappend coords [expr {$x2 + $linespc}] $y
6062                } elseif {$i > $col + 1} {
6063                    lappend coords [expr {$x2 - $linespc}] $y
6064                }
6065                lappend coords $x2 $y2
6066            }
6067        } else {
6068            lappend coords $x2 $y2
6069        }
6070        set t [$canv create line $coords -width [linewidth $p] \
6071                   -fill $colormap($p) -tags lines.$p]
6072        $canv lower $t
6073        bindline $t $p
6074    }
6075    if {$rmx > [lindex $idpos($id) 1]} {
6076        lset idpos($id) 1 $rmx
6077        redrawtags $id
6078    }
6079}
6080
6081proc drawlines {id} {
6082    global canv
6083
6084    $canv itemconf lines.$id -width [linewidth $id]
6085}
6086
6087proc drawcmittext {id row col} {
6088    global linespc canv canv2 canv3 fgcolor curview
6089    global cmitlisted commitinfo rowidlist parentlist
6090    global rowtextx idpos idtags idheads idotherrefs
6091    global linehtag linentag linedtag selectedline
6092    global canvxmax boldids boldnameids fgcolor markedid
6093    global mainheadid nullid nullid2 circleitem circlecolors ctxbut
6094    global mainheadcirclecolor workingfilescirclecolor indexcirclecolor
6095    global circleoutlinecolor
6096
6097    # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
6098    set listed $cmitlisted($curview,$id)
6099    if {$id eq $nullid} {
6100        set ofill $workingfilescirclecolor
6101    } elseif {$id eq $nullid2} {
6102        set ofill $indexcirclecolor
6103    } elseif {$id eq $mainheadid} {
6104        set ofill $mainheadcirclecolor
6105    } else {
6106        set ofill [lindex $circlecolors $listed]
6107    }
6108    set x [xc $row $col]
6109    set y [yc $row]
6110    set orad [expr {$linespc / 3}]
6111    if {$listed <= 2} {
6112        set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
6113                   [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6114                   -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6115    } elseif {$listed == 3} {
6116        # triangle pointing left for left-side commits
6117        set t [$canv create polygon \
6118                   [expr {$x - $orad}] $y \
6119                   [expr {$x + $orad - 1}] [expr {$y - $orad}] \
6120                   [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6121                   -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6122    } else {
6123        # triangle pointing right for right-side commits
6124        set t [$canv create polygon \
6125                   [expr {$x + $orad - 1}] $y \
6126                   [expr {$x - $orad}] [expr {$y - $orad}] \
6127                   [expr {$x - $orad}] [expr {$y + $orad - 1}] \
6128                   -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6129    }
6130    set circleitem($row) $t
6131    $canv raise $t
6132    $canv bind $t <1> {selcanvline {} %x %y}
6133    set rmx [llength [lindex $rowidlist $row]]
6134    set olds [lindex $parentlist $row]
6135    if {$olds ne {}} {
6136        set nextids [lindex $rowidlist [expr {$row + 1}]]
6137        foreach p $olds {
6138            set i [lsearch -exact $nextids $p]
6139            if {$i > $rmx} {
6140                set rmx $i
6141            }
6142        }
6143    }
6144    set xt [xc $row $rmx]
6145    set rowtextx($row) $xt
6146    set idpos($id) [list $x $xt $y]
6147    if {[info exists idtags($id)] || [info exists idheads($id)]
6148        || [info exists idotherrefs($id)]} {
6149        set xt [drawtags $id $x $xt $y]
6150    }
6151    if {[lindex $commitinfo($id) 6] > 0} {
6152        set xt [drawnotesign $xt $y]
6153    }
6154    set headline [lindex $commitinfo($id) 0]
6155    set name [lindex $commitinfo($id) 1]
6156    set date [lindex $commitinfo($id) 2]
6157    set date [formatdate $date]
6158    set font mainfont
6159    set nfont mainfont
6160    set isbold [ishighlighted $id]
6161    if {$isbold > 0} {
6162        lappend boldids $id
6163        set font mainfontbold
6164        if {$isbold > 1} {
6165            lappend boldnameids $id
6166            set nfont mainfontbold
6167        }
6168    }
6169    set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
6170                           -text $headline -font $font -tags text]
6171    $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
6172    set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
6173                           -text $name -font $nfont -tags text]
6174    set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
6175                           -text $date -font mainfont -tags text]
6176    if {$selectedline == $row} {
6177        make_secsel $id
6178    }
6179    if {[info exists markedid] && $markedid eq $id} {
6180        make_idmark $id
6181    }
6182    set xr [expr {$xt + [font measure $font $headline]}]
6183    if {$xr > $canvxmax} {
6184        set canvxmax $xr
6185        setcanvscroll
6186    }
6187}
6188
6189proc drawcmitrow {row} {
6190    global displayorder rowidlist nrows_drawn
6191    global iddrawn markingmatches
6192    global commitinfo numcommits
6193    global filehighlight fhighlights findpattern nhighlights
6194    global hlview vhighlights
6195    global highlight_related rhighlights
6196
6197    if {$row >= $numcommits} return
6198
6199    set id [lindex $displayorder $row]
6200    if {[info exists hlview] && ![info exists vhighlights($id)]} {
6201        askvhighlight $row $id
6202    }
6203    if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
6204        askfilehighlight $row $id
6205    }
6206    if {$findpattern ne {} && ![info exists nhighlights($id)]} {
6207        askfindhighlight $row $id
6208    }
6209    if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
6210        askrelhighlight $row $id
6211    }
6212    if {![info exists iddrawn($id)]} {
6213        set col [lsearch -exact [lindex $rowidlist $row] $id]
6214        if {$col < 0} {
6215            puts "oops, row $row id $id not in list"
6216            return
6217        }
6218        if {![info exists commitinfo($id)]} {
6219            getcommit $id
6220        }
6221        assigncolor $id
6222        drawcmittext $id $row $col
6223        set iddrawn($id) 1
6224        incr nrows_drawn
6225    }
6226    if {$markingmatches} {
6227        markrowmatches $row $id
6228    }
6229}
6230
6231proc drawcommits {row {endrow {}}} {
6232    global numcommits iddrawn displayorder curview need_redisplay
6233    global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
6234
6235    if {$row < 0} {
6236        set row 0
6237    }
6238    if {$endrow eq {}} {
6239        set endrow $row
6240    }
6241    if {$endrow >= $numcommits} {
6242        set endrow [expr {$numcommits - 1}]
6243    }
6244
6245    set rl1 [expr {$row - $downarrowlen - 3}]
6246    if {$rl1 < 0} {
6247        set rl1 0
6248    }
6249    set ro1 [expr {$row - 3}]
6250    if {$ro1 < 0} {
6251        set ro1 0
6252    }
6253    set r2 [expr {$endrow + $uparrowlen + 3}]
6254    if {$r2 > $numcommits} {
6255        set r2 $numcommits
6256    }
6257    for {set r $rl1} {$r < $r2} {incr r} {
6258        if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
6259            if {$rl1 < $r} {
6260                layoutrows $rl1 $r
6261            }
6262            set rl1 [expr {$r + 1}]
6263        }
6264    }
6265    if {$rl1 < $r} {
6266        layoutrows $rl1 $r
6267    }
6268    optimize_rows $ro1 0 $r2
6269    if {$need_redisplay || $nrows_drawn > 2000} {
6270        clear_display
6271    }
6272
6273    # make the lines join to already-drawn rows either side
6274    set r [expr {$row - 1}]
6275    if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
6276        set r $row
6277    }
6278    set er [expr {$endrow + 1}]
6279    if {$er >= $numcommits ||
6280        ![info exists iddrawn([lindex $displayorder $er])]} {
6281        set er $endrow
6282    }
6283    for {} {$r <= $er} {incr r} {
6284        set id [lindex $displayorder $r]
6285        set wasdrawn [info exists iddrawn($id)]
6286        drawcmitrow $r
6287        if {$r == $er} break
6288        set nextid [lindex $displayorder [expr {$r + 1}]]
6289        if {$wasdrawn && [info exists iddrawn($nextid)]} continue
6290        drawparentlinks $id $r
6291
6292        set rowids [lindex $rowidlist $r]
6293        foreach lid $rowids {
6294            if {$lid eq {}} continue
6295            if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
6296            if {$lid eq $id} {
6297                # see if this is the first child of any of its parents
6298                foreach p [lindex $parentlist $r] {
6299                    if {[lsearch -exact $rowids $p] < 0} {
6300                        # make this line extend up to the child
6301                        set lineend($p) [drawlineseg $p $r $er 0]
6302                    }
6303                }
6304            } else {
6305                set lineend($lid) [drawlineseg $lid $r $er 1]
6306            }
6307        }
6308    }
6309}
6310
6311proc undolayout {row} {
6312    global uparrowlen mingaplen downarrowlen
6313    global rowidlist rowisopt rowfinal need_redisplay
6314
6315    set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
6316    if {$r < 0} {
6317        set r 0
6318    }
6319    if {[llength $rowidlist] > $r} {
6320        incr r -1
6321        set rowidlist [lrange $rowidlist 0 $r]
6322        set rowfinal [lrange $rowfinal 0 $r]
6323        set rowisopt [lrange $rowisopt 0 $r]
6324        set need_redisplay 1
6325        run drawvisible
6326    }
6327}
6328
6329proc drawvisible {} {
6330    global canv linespc curview vrowmod selectedline targetrow targetid
6331    global need_redisplay cscroll numcommits
6332
6333    set fs [$canv yview]
6334    set ymax [lindex [$canv cget -scrollregion] 3]
6335    if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
6336    set f0 [lindex $fs 0]
6337    set f1 [lindex $fs 1]
6338    set y0 [expr {int($f0 * $ymax)}]
6339    set y1 [expr {int($f1 * $ymax)}]
6340
6341    if {[info exists targetid]} {
6342        if {[commitinview $targetid $curview]} {
6343            set r [rowofcommit $targetid]
6344            if {$r != $targetrow} {
6345                # Fix up the scrollregion and change the scrolling position
6346                # now that our target row has moved.
6347                set diff [expr {($r - $targetrow) * $linespc}]
6348                set targetrow $r
6349                setcanvscroll
6350                set ymax [lindex [$canv cget -scrollregion] 3]
6351                incr y0 $diff
6352                incr y1 $diff
6353                set f0 [expr {$y0 / $ymax}]
6354                set f1 [expr {$y1 / $ymax}]
6355                allcanvs yview moveto $f0
6356                $cscroll set $f0 $f1
6357                set need_redisplay 1
6358            }
6359        } else {
6360            unset targetid
6361        }
6362    }
6363
6364    set row [expr {int(($y0 - 3) / $linespc) - 1}]
6365    set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
6366    if {$endrow >= $vrowmod($curview)} {
6367        update_arcrows $curview
6368    }
6369    if {$selectedline ne {} &&
6370        $row <= $selectedline && $selectedline <= $endrow} {
6371        set targetrow $selectedline
6372    } elseif {[info exists targetid]} {
6373        set targetrow [expr {int(($row + $endrow) / 2)}]
6374    }
6375    if {[info exists targetrow]} {
6376        if {$targetrow >= $numcommits} {
6377            set targetrow [expr {$numcommits - 1}]
6378        }
6379        set targetid [commitonrow $targetrow]
6380    }
6381    drawcommits $row $endrow
6382}
6383
6384proc clear_display {} {
6385    global iddrawn linesegs need_redisplay nrows_drawn
6386    global vhighlights fhighlights nhighlights rhighlights
6387    global linehtag linentag linedtag boldids boldnameids
6388
6389    allcanvs delete all
6390    unset -nocomplain iddrawn
6391    unset -nocomplain linesegs
6392    unset -nocomplain linehtag
6393    unset -nocomplain linentag
6394    unset -nocomplain linedtag
6395    set boldids {}
6396    set boldnameids {}
6397    unset -nocomplain vhighlights
6398    unset -nocomplain fhighlights
6399    unset -nocomplain nhighlights
6400    unset -nocomplain rhighlights
6401    set need_redisplay 0
6402    set nrows_drawn 0
6403}
6404
6405proc findcrossings {id} {
6406    global rowidlist parentlist numcommits displayorder
6407
6408    set cross {}
6409    set ccross {}
6410    foreach {s e} [rowranges $id] {
6411        if {$e >= $numcommits} {
6412            set e [expr {$numcommits - 1}]
6413        }
6414        if {$e <= $s} continue
6415        for {set row $e} {[incr row -1] >= $s} {} {
6416            set x [lsearch -exact [lindex $rowidlist $row] $id]
6417            if {$x < 0} break
6418            set olds [lindex $parentlist $row]
6419            set kid [lindex $displayorder $row]
6420            set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
6421            if {$kidx < 0} continue
6422            set nextrow [lindex $rowidlist [expr {$row + 1}]]
6423            foreach p $olds {
6424                set px [lsearch -exact $nextrow $p]
6425                if {$px < 0} continue
6426                if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
6427                    if {[lsearch -exact $ccross $p] >= 0} continue
6428                    if {$x == $px + ($kidx < $px? -1: 1)} {
6429                        lappend ccross $p
6430                    } elseif {[lsearch -exact $cross $p] < 0} {
6431                        lappend cross $p
6432                    }
6433                }
6434            }
6435        }
6436    }
6437    return [concat $ccross {{}} $cross]
6438}
6439
6440proc assigncolor {id} {
6441    global colormap colors nextcolor
6442    global parents children children curview
6443
6444    if {[info exists colormap($id)]} return
6445    set ncolors [llength $colors]
6446    if {[info exists children($curview,$id)]} {
6447        set kids $children($curview,$id)
6448    } else {
6449        set kids {}
6450    }
6451    if {[llength $kids] == 1} {
6452        set child [lindex $kids 0]
6453        if {[info exists colormap($child)]
6454            && [llength $parents($curview,$child)] == 1} {
6455            set colormap($id) $colormap($child)
6456            return
6457        }
6458    }
6459    set badcolors {}
6460    set origbad {}
6461    foreach x [findcrossings $id] {
6462        if {$x eq {}} {
6463            # delimiter between corner crossings and other crossings
6464            if {[llength $badcolors] >= $ncolors - 1} break
6465            set origbad $badcolors
6466        }
6467        if {[info exists colormap($x)]
6468            && [lsearch -exact $badcolors $colormap($x)] < 0} {
6469            lappend badcolors $colormap($x)
6470        }
6471    }
6472    if {[llength $badcolors] >= $ncolors} {
6473        set badcolors $origbad
6474    }
6475    set origbad $badcolors
6476    if {[llength $badcolors] < $ncolors - 1} {
6477        foreach child $kids {
6478            if {[info exists colormap($child)]
6479                && [lsearch -exact $badcolors $colormap($child)] < 0} {
6480                lappend badcolors $colormap($child)
6481            }
6482            foreach p $parents($curview,$child) {
6483                if {[info exists colormap($p)]
6484                    && [lsearch -exact $badcolors $colormap($p)] < 0} {
6485                    lappend badcolors $colormap($p)
6486                }
6487            }
6488        }
6489        if {[llength $badcolors] >= $ncolors} {
6490            set badcolors $origbad
6491        }
6492    }
6493    for {set i 0} {$i <= $ncolors} {incr i} {
6494        set c [lindex $colors $nextcolor]
6495        if {[incr nextcolor] >= $ncolors} {
6496            set nextcolor 0
6497        }
6498        if {[lsearch -exact $badcolors $c]} break
6499    }
6500    set colormap($id) $c
6501}
6502
6503proc bindline {t id} {
6504    global canv
6505
6506    $canv bind $t <Enter> "lineenter %x %y $id"
6507    $canv bind $t <Motion> "linemotion %x %y $id"
6508    $canv bind $t <Leave> "lineleave $id"
6509    $canv bind $t <Button-1> "lineclick %x %y $id 1"
6510}
6511
6512proc graph_pane_width {} {
6513    global use_ttk
6514
6515    if {$use_ttk} {
6516        set g [.tf.histframe.pwclist sashpos 0]
6517    } else {
6518        set g [.tf.histframe.pwclist sash coord 0]
6519    }
6520    return [lindex $g 0]
6521}
6522
6523proc totalwidth {l font extra} {
6524    set tot 0
6525    foreach str $l {
6526        set tot [expr {$tot + [font measure $font $str] + $extra}]
6527    }
6528    return $tot
6529}
6530
6531proc drawtags {id x xt y1} {
6532    global idtags idheads idotherrefs mainhead
6533    global linespc lthickness
6534    global canv rowtextx curview fgcolor bgcolor ctxbut
6535    global headbgcolor headfgcolor headoutlinecolor remotebgcolor
6536    global tagbgcolor tagfgcolor tagoutlinecolor
6537    global reflinecolor
6538
6539    set marks {}
6540    set ntags 0
6541    set nheads 0
6542    set singletag 0
6543    set maxtags 3
6544    set maxtagpct 25
6545    set maxwidth [expr {[graph_pane_width] * $maxtagpct / 100}]
6546    set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6547    set extra [expr {$delta + $lthickness + $linespc}]
6548
6549    if {[info exists idtags($id)]} {
6550        set marks $idtags($id)
6551        set ntags [llength $marks]
6552        if {$ntags > $maxtags ||
6553            [totalwidth $marks mainfont $extra] > $maxwidth} {
6554            # show just a single "n tags..." tag
6555            set singletag 1
6556            if {$ntags == 1} {
6557                set marks [list "tag..."]
6558            } else {
6559                set marks [list [format "%d tags..." $ntags]]
6560            }
6561            set ntags 1
6562        }
6563    }
6564    if {[info exists idheads($id)]} {
6565        set marks [concat $marks $idheads($id)]
6566        set nheads [llength $idheads($id)]
6567    }
6568    if {[info exists idotherrefs($id)]} {
6569        set marks [concat $marks $idotherrefs($id)]
6570    }
6571    if {$marks eq {}} {
6572        return $xt
6573    }
6574
6575    set yt [expr {$y1 - 0.5 * $linespc}]
6576    set yb [expr {$yt + $linespc - 1}]
6577    set xvals {}
6578    set wvals {}
6579    set i -1
6580    foreach tag $marks {
6581        incr i
6582        if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
6583            set wid [font measure mainfontbold $tag]
6584        } else {
6585            set wid [font measure mainfont $tag]
6586        }
6587        lappend xvals $xt
6588        lappend wvals $wid
6589        set xt [expr {$xt + $wid + $extra}]
6590    }
6591    set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
6592               -width $lthickness -fill $reflinecolor -tags tag.$id]
6593    $canv lower $t
6594    foreach tag $marks x $xvals wid $wvals {
6595        set tag_quoted [string map {% %%} $tag]
6596        set xl [expr {$x + $delta}]
6597        set xr [expr {$x + $delta + $wid + $lthickness}]
6598        set font mainfont
6599        if {[incr ntags -1] >= 0} {
6600            # draw a tag
6601            set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6602                       $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
6603                       -width 1 -outline $tagoutlinecolor -fill $tagbgcolor \
6604                       -tags tag.$id]
6605            if {$singletag} {
6606                set tagclick [list showtags $id 1]
6607            } else {
6608                set tagclick [list showtag $tag_quoted 1]
6609            }
6610            $canv bind $t <1> $tagclick
6611            set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
6612        } else {
6613            # draw a head or other ref
6614            if {[incr nheads -1] >= 0} {
6615                set col $headbgcolor
6616                if {$tag eq $mainhead} {
6617                    set font mainfontbold
6618                }
6619            } else {
6620                set col "#ddddff"
6621            }
6622            set xl [expr {$xl - $delta/2}]
6623            $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
6624                -width 1 -outline black -fill $col -tags tag.$id
6625            if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
6626                set rwid [font measure mainfont $remoteprefix]
6627                set xi [expr {$x + 1}]
6628                set yti [expr {$yt + 1}]
6629                set xri [expr {$x + $rwid}]
6630                $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6631                        -width 0 -fill $remotebgcolor -tags tag.$id
6632            }
6633        }
6634        set t [$canv create text $xl $y1 -anchor w -text $tag -fill $headfgcolor \
6635                   -font $font -tags [list tag.$id text]]
6636        if {$ntags >= 0} {
6637            $canv bind $t <1> $tagclick
6638        } elseif {$nheads >= 0} {
6639            $canv bind $t $ctxbut [list headmenu %X %Y $id $tag_quoted]
6640        }
6641    }
6642    return $xt
6643}
6644
6645proc drawnotesign {xt y} {
6646    global linespc canv fgcolor
6647
6648    set orad [expr {$linespc / 3}]
6649    set t [$canv create rectangle [expr {$xt - $orad}] [expr {$y - $orad}] \
6650               [expr {$xt + $orad - 1}] [expr {$y + $orad - 1}] \
6651               -fill yellow -outline $fgcolor -width 1 -tags circle]
6652    set xt [expr {$xt + $orad * 3}]
6653    return $xt
6654}
6655
6656proc xcoord {i level ln} {
6657    global canvx0 xspc1 xspc2
6658
6659    set x [expr {$canvx0 + $i * $xspc1($ln)}]
6660    if {$i > 0 && $i == $level} {
6661        set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6662    } elseif {$i > $level} {
6663        set x [expr {$x + $xspc2 - $xspc1($ln)}]
6664    }
6665    return $x
6666}
6667
6668proc show_status {msg} {
6669    global canv fgcolor
6670
6671    clear_display
6672    set_window_title
6673    $canv create text 3 3 -anchor nw -text $msg -font mainfont \
6674        -tags text -fill $fgcolor
6675}
6676
6677# Don't change the text pane cursor if it is currently the hand cursor,
6678# showing that we are over a sha1 ID link.
6679proc settextcursor {c} {
6680    global ctext curtextcursor
6681
6682    if {[$ctext cget -cursor] == $curtextcursor} {
6683        $ctext config -cursor $c
6684    }
6685    set curtextcursor $c
6686}
6687
6688proc nowbusy {what {name {}}} {
6689    global isbusy busyname statusw
6690
6691    if {[array names isbusy] eq {}} {
6692        . config -cursor watch
6693        settextcursor watch
6694    }
6695    set isbusy($what) 1
6696    set busyname($what) $name
6697    if {$name ne {}} {
6698        $statusw conf -text $name
6699    }
6700}
6701
6702proc notbusy {what} {
6703    global isbusy maincursor textcursor busyname statusw
6704
6705    catch {
6706        unset isbusy($what)
6707        if {$busyname($what) ne {} &&
6708            [$statusw cget -text] eq $busyname($what)} {
6709            $statusw conf -text {}
6710        }
6711    }
6712    if {[array names isbusy] eq {}} {
6713        . config -cursor $maincursor
6714        settextcursor $textcursor
6715    }
6716}
6717
6718proc findmatches {f} {
6719    global findtype findstring
6720    if {$findtype == [mc "Regexp"]} {
6721        set matches [regexp -indices -all -inline $findstring $f]
6722    } else {
6723        set fs $findstring
6724        if {$findtype == [mc "IgnCase"]} {
6725            set f [string tolower $f]
6726            set fs [string tolower $fs]
6727        }
6728        set matches {}
6729        set i 0
6730        set l [string length $fs]
6731        while {[set j [string first $fs $f $i]] >= 0} {
6732            lappend matches [list $j [expr {$j+$l-1}]]
6733            set i [expr {$j + $l}]
6734        }
6735    }
6736    return $matches
6737}
6738
6739proc dofind {{dirn 1} {wrap 1}} {
6740    global findstring findstartline findcurline selectedline numcommits
6741    global gdttype filehighlight fh_serial find_dirn findallowwrap
6742
6743    if {[info exists find_dirn]} {
6744        if {$find_dirn == $dirn} return
6745        stopfinding
6746    }
6747    focus .
6748    if {$findstring eq {} || $numcommits == 0} return
6749    if {$selectedline eq {}} {
6750        set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6751    } else {
6752        set findstartline $selectedline
6753    }
6754    set findcurline $findstartline
6755    nowbusy finding [mc "Searching"]
6756    if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6757        after cancel do_file_hl $fh_serial
6758        do_file_hl $fh_serial
6759    }
6760    set find_dirn $dirn
6761    set findallowwrap $wrap
6762    run findmore
6763}
6764
6765proc stopfinding {} {
6766    global find_dirn findcurline fprogcoord
6767
6768    if {[info exists find_dirn]} {
6769        unset find_dirn
6770        unset findcurline
6771        notbusy finding
6772        set fprogcoord 0
6773        adjustprogress
6774    }
6775    stopblaming
6776}
6777
6778proc findmore {} {
6779    global commitdata commitinfo numcommits findpattern findloc
6780    global findstartline findcurline findallowwrap
6781    global find_dirn gdttype fhighlights fprogcoord
6782    global curview varcorder vrownum varccommits vrowmod
6783
6784    if {![info exists find_dirn]} {
6785        return 0
6786    }
6787    set fldtypes [list [mc "Headline"] [mc "Author"] "" [mc "Committer"] "" [mc "Comments"]]
6788    set l $findcurline
6789    set moretodo 0
6790    if {$find_dirn > 0} {
6791        incr l
6792        if {$l >= $numcommits} {
6793            set l 0
6794        }
6795        if {$l <= $findstartline} {
6796            set lim [expr {$findstartline + 1}]
6797        } else {
6798            set lim $numcommits
6799            set moretodo $findallowwrap
6800        }
6801    } else {
6802        if {$l == 0} {
6803            set l $numcommits
6804        }
6805        incr l -1
6806        if {$l >= $findstartline} {
6807            set lim [expr {$findstartline - 1}]
6808        } else {
6809            set lim -1
6810            set moretodo $findallowwrap
6811        }
6812    }
6813    set n [expr {($lim - $l) * $find_dirn}]
6814    if {$n > 500} {
6815        set n 500
6816        set moretodo 1
6817    }
6818    if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6819        update_arcrows $curview
6820    }
6821    set found 0
6822    set domore 1
6823    set ai [bsearch $vrownum($curview) $l]
6824    set a [lindex $varcorder($curview) $ai]
6825    set arow [lindex $vrownum($curview) $ai]
6826    set ids [lindex $varccommits($curview,$a)]
6827    set arowend [expr {$arow + [llength $ids]}]
6828    if {$gdttype eq [mc "containing:"]} {
6829        for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6830            if {$l < $arow || $l >= $arowend} {
6831                incr ai $find_dirn
6832                set a [lindex $varcorder($curview) $ai]
6833                set arow [lindex $vrownum($curview) $ai]
6834                set ids [lindex $varccommits($curview,$a)]
6835                set arowend [expr {$arow + [llength $ids]}]
6836            }
6837            set id [lindex $ids [expr {$l - $arow}]]
6838            # shouldn't happen unless git log doesn't give all the commits...
6839            if {![info exists commitdata($id)] ||
6840                ![doesmatch $commitdata($id)]} {
6841                continue
6842            }
6843            if {![info exists commitinfo($id)]} {
6844                getcommit $id
6845            }
6846            set info $commitinfo($id)
6847            foreach f $info ty $fldtypes {
6848                if {$ty eq ""} continue
6849                if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6850                    [doesmatch $f]} {
6851                    set found 1
6852                    break
6853                }
6854            }
6855            if {$found} break
6856        }
6857    } else {
6858        for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6859            if {$l < $arow || $l >= $arowend} {
6860                incr ai $find_dirn
6861                set a [lindex $varcorder($curview) $ai]
6862                set arow [lindex $vrownum($curview) $ai]
6863                set ids [lindex $varccommits($curview,$a)]
6864                set arowend [expr {$arow + [llength $ids]}]
6865            }
6866            set id [lindex $ids [expr {$l - $arow}]]
6867            if {![info exists fhighlights($id)]} {
6868                # this sets fhighlights($id) to -1
6869                askfilehighlight $l $id
6870            }
6871            if {$fhighlights($id) > 0} {
6872                set found $domore
6873                break
6874            }
6875            if {$fhighlights($id) < 0} {
6876                if {$domore} {
6877                    set domore 0
6878                    set findcurline [expr {$l - $find_dirn}]
6879                }
6880            }
6881        }
6882    }
6883    if {$found || ($domore && !$moretodo)} {
6884        unset findcurline
6885        unset find_dirn
6886        notbusy finding
6887        set fprogcoord 0
6888        adjustprogress
6889        if {$found} {
6890            findselectline $l
6891        } else {
6892            bell
6893        }
6894        return 0
6895    }
6896    if {!$domore} {
6897        flushhighlights
6898    } else {
6899        set findcurline [expr {$l - $find_dirn}]
6900    }
6901    set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6902    if {$n < 0} {
6903        incr n $numcommits
6904    }
6905    set fprogcoord [expr {$n * 1.0 / $numcommits}]
6906    adjustprogress
6907    return $domore
6908}
6909
6910proc findselectline {l} {
6911    global findloc commentend ctext findcurline markingmatches gdttype
6912
6913    set markingmatches [expr {$gdttype eq [mc "containing:"]}]
6914    set findcurline $l
6915    selectline $l 1
6916    if {$markingmatches &&
6917        ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
6918        # highlight the matches in the comments
6919        set f [$ctext get 1.0 $commentend]
6920        set matches [findmatches $f]
6921        foreach match $matches {
6922            set start [lindex $match 0]
6923            set end [expr {[lindex $match 1] + 1}]
6924            $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6925        }
6926    }
6927    drawvisible
6928}
6929
6930# mark the bits of a headline or author that match a find string
6931proc markmatches {canv l str tag matches font row} {
6932    global selectedline
6933
6934    set bbox [$canv bbox $tag]
6935    set x0 [lindex $bbox 0]
6936    set y0 [lindex $bbox 1]
6937    set y1 [lindex $bbox 3]
6938    foreach match $matches {
6939        set start [lindex $match 0]
6940        set end [lindex $match 1]
6941        if {$start > $end} continue
6942        set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6943        set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6944        set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6945                   [expr {$x0+$xlen+2}] $y1 \
6946                   -outline {} -tags [list match$l matches] -fill yellow]
6947        $canv lower $t
6948        if {$row == $selectedline} {
6949            $canv raise $t secsel
6950        }
6951    }
6952}
6953
6954proc unmarkmatches {} {
6955    global markingmatches
6956
6957    allcanvs delete matches
6958    set markingmatches 0
6959    stopfinding
6960}
6961
6962proc selcanvline {w x y} {
6963    global canv canvy0 ctext linespc
6964    global rowtextx
6965    set ymax [lindex [$canv cget -scrollregion] 3]
6966    if {$ymax == {}} return
6967    set yfrac [lindex [$canv yview] 0]
6968    set y [expr {$y + $yfrac * $ymax}]
6969    set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6970    if {$l < 0} {
6971        set l 0
6972    }
6973    if {$w eq $canv} {
6974        set xmax [lindex [$canv cget -scrollregion] 2]
6975        set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6976        if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
6977    }
6978    unmarkmatches
6979    selectline $l 1
6980}
6981
6982proc commit_descriptor {p} {
6983    global commitinfo
6984    if {![info exists commitinfo($p)]} {
6985        getcommit $p
6986    }
6987    set l "..."
6988    if {[llength $commitinfo($p)] > 1} {
6989        set l [lindex $commitinfo($p) 0]
6990    }
6991    return "$p ($l)\n"
6992}
6993
6994# append some text to the ctext widget, and make any SHA1 ID
6995# that we know about be a clickable link.
6996proc appendwithlinks {text tags} {
6997    global ctext linknum curview
6998
6999    set start [$ctext index "end - 1c"]
7000    $ctext insert end $text $tags
7001    set links [regexp -indices -all -inline {(?:\m|-g)[0-9a-f]{6,40}\M} $text]
7002    foreach l $links {
7003        set s [lindex $l 0]
7004        set e [lindex $l 1]
7005        set linkid [string range $text $s $e]
7006        incr e
7007        $ctext tag delete link$linknum
7008        $ctext tag add link$linknum "$start + $s c" "$start + $e c"
7009        setlink $linkid link$linknum
7010        incr linknum
7011    }
7012}
7013
7014proc setlink {id lk} {
7015    global curview ctext pendinglinks
7016    global linkfgcolor
7017
7018    if {[string range $id 0 1] eq "-g"} {
7019      set id [string range $id 2 end]
7020    }
7021
7022    set known 0
7023    if {[string length $id] < 40} {
7024        set matches [longid $id]
7025        if {[llength $matches] > 0} {
7026            if {[llength $matches] > 1} return
7027            set known 1
7028            set id [lindex $matches 0]
7029        }
7030    } else {
7031        set known [commitinview $id $curview]
7032    }
7033    if {$known} {
7034        $ctext tag conf $lk -foreground $linkfgcolor -underline 1
7035        $ctext tag bind $lk <1> [list selbyid $id]
7036        $ctext tag bind $lk <Enter> {linkcursor %W 1}
7037        $ctext tag bind $lk <Leave> {linkcursor %W -1}
7038    } else {
7039        lappend pendinglinks($id) $lk
7040        interestedin $id {makelink %P}
7041    }
7042}
7043
7044proc appendshortlink {id {pre {}} {post {}}} {
7045    global ctext linknum
7046
7047    $ctext insert end $pre
7048    $ctext tag delete link$linknum
7049    $ctext insert end [string range $id 0 7] link$linknum
7050    $ctext insert end $post
7051    setlink $id link$linknum
7052    incr linknum
7053}
7054
7055proc makelink {id} {
7056    global pendinglinks
7057
7058    if {![info exists pendinglinks($id)]} return
7059    foreach lk $pendinglinks($id) {
7060        setlink $id $lk
7061    }
7062    unset pendinglinks($id)
7063}
7064
7065proc linkcursor {w inc} {
7066    global linkentercount curtextcursor
7067
7068    if {[incr linkentercount $inc] > 0} {
7069        $w configure -cursor hand2
7070    } else {
7071        $w configure -cursor $curtextcursor
7072        if {$linkentercount < 0} {
7073            set linkentercount 0
7074        }
7075    }
7076}
7077
7078proc viewnextline {dir} {
7079    global canv linespc
7080
7081    $canv delete hover
7082    set ymax [lindex [$canv cget -scrollregion] 3]
7083    set wnow [$canv yview]
7084    set wtop [expr {[lindex $wnow 0] * $ymax}]
7085    set newtop [expr {$wtop + $dir * $linespc}]
7086    if {$newtop < 0} {
7087        set newtop 0
7088    } elseif {$newtop > $ymax} {
7089        set newtop $ymax
7090    }
7091    allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7092}
7093
7094# add a list of tag or branch names at position pos
7095# returns the number of names inserted
7096proc appendrefs {pos ids var} {
7097    global ctext linknum curview $var maxrefs visiblerefs mainheadid
7098
7099    if {[catch {$ctext index $pos}]} {
7100        return 0
7101    }
7102    $ctext conf -state normal
7103    $ctext delete $pos "$pos lineend"
7104    set tags {}
7105    foreach id $ids {
7106        foreach tag [set $var\($id\)] {
7107            lappend tags [list $tag $id]
7108        }
7109    }
7110
7111    set sep {}
7112    set tags [lsort -index 0 -decreasing $tags]
7113    set nutags 0
7114
7115    if {[llength $tags] > $maxrefs} {
7116        # If we are displaying heads, and there are too many,
7117        # see if there are some important heads to display.
7118        # Currently that are the current head and heads listed in $visiblerefs option
7119        set itags {}
7120        if {$var eq "idheads"} {
7121            set utags {}
7122            foreach ti $tags {
7123                set hname [lindex $ti 0]
7124                set id [lindex $ti 1]
7125                if {([lsearch -exact $visiblerefs $hname] != -1 || $id eq $mainheadid) &&
7126                    [llength $itags] < $maxrefs} {
7127                    lappend itags $ti
7128                } else {
7129                    lappend utags $ti
7130                }
7131            }
7132            set tags $utags
7133        }
7134        if {$itags ne {}} {
7135            set str [mc "and many more"]
7136            set sep " "
7137        } else {
7138            set str [mc "many"]
7139        }
7140        $ctext insert $pos "$str ([llength $tags])"
7141        set nutags [llength $tags]
7142        set tags $itags
7143    }
7144
7145    foreach ti $tags {
7146        set id [lindex $ti 1]
7147        set lk link$linknum
7148        incr linknum
7149        $ctext tag delete $lk
7150        $ctext insert $pos $sep
7151        $ctext insert $pos [lindex $ti 0] $lk
7152        setlink $id $lk
7153        set sep ", "
7154    }
7155    $ctext tag add wwrap "$pos linestart" "$pos lineend"
7156    $ctext conf -state disabled
7157    return [expr {[llength $tags] + $nutags}]
7158}
7159
7160# called when we have finished computing the nearby tags
7161proc dispneartags {delay} {
7162    global selectedline currentid showneartags tagphase
7163
7164    if {$selectedline eq {} || !$showneartags} return
7165    after cancel dispnexttag
7166    if {$delay} {
7167        after 200 dispnexttag
7168        set tagphase -1
7169    } else {
7170        after idle dispnexttag
7171        set tagphase 0
7172    }
7173}
7174
7175proc dispnexttag {} {
7176    global selectedline currentid showneartags tagphase ctext
7177
7178    if {$selectedline eq {} || !$showneartags} return
7179    switch -- $tagphase {
7180        0 {
7181            set dtags [desctags $currentid]
7182            if {$dtags ne {}} {
7183                appendrefs precedes $dtags idtags
7184            }
7185        }
7186        1 {
7187            set atags [anctags $currentid]
7188            if {$atags ne {}} {
7189                appendrefs follows $atags idtags
7190            }
7191        }
7192        2 {
7193            set dheads [descheads $currentid]
7194            if {$dheads ne {}} {
7195                if {[appendrefs branch $dheads idheads] > 1
7196                    && [$ctext get "branch -3c"] eq "h"} {
7197                    # turn "Branch" into "Branches"
7198                    $ctext conf -state normal
7199                    $ctext insert "branch -2c" "es"
7200                    $ctext conf -state disabled
7201                }
7202            }
7203        }
7204    }
7205    if {[incr tagphase] <= 2} {
7206        after idle dispnexttag
7207    }
7208}
7209
7210proc make_secsel {id} {
7211    global linehtag linentag linedtag canv canv2 canv3
7212
7213    if {![info exists linehtag($id)]} return
7214    $canv delete secsel
7215    set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
7216               -tags secsel -fill [$canv cget -selectbackground]]
7217    $canv lower $t
7218    $canv2 delete secsel
7219    set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
7220               -tags secsel -fill [$canv2 cget -selectbackground]]
7221    $canv2 lower $t
7222    $canv3 delete secsel
7223    set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
7224               -tags secsel -fill [$canv3 cget -selectbackground]]
7225    $canv3 lower $t
7226}
7227
7228proc make_idmark {id} {
7229    global linehtag canv fgcolor
7230
7231    if {![info exists linehtag($id)]} return
7232    $canv delete markid
7233    set t [eval $canv create rect [$canv bbox $linehtag($id)] \
7234               -tags markid -outline $fgcolor]
7235    $canv raise $t
7236}
7237
7238proc selectline {l isnew {desired_loc {}} {switch_to_patch 0}} {
7239    global canv ctext commitinfo selectedline
7240    global canvy0 linespc parents children curview
7241    global currentid sha1entry
7242    global commentend idtags linknum
7243    global mergemax numcommits pending_select
7244    global cmitmode showneartags allcommits
7245    global targetrow targetid lastscrollrows
7246    global autoselect autosellen jump_to_here
7247    global vinlinediff
7248
7249    unset -nocomplain pending_select
7250    $canv delete hover
7251    normalline
7252    unsel_reflist
7253    stopfinding
7254    if {$l < 0 || $l >= $numcommits} return
7255    set id [commitonrow $l]
7256    set targetid $id
7257    set targetrow $l
7258    set selectedline $l
7259    set currentid $id
7260    if {$lastscrollrows < $numcommits} {
7261        setcanvscroll
7262    }
7263
7264    if {$cmitmode ne "patch" && $switch_to_patch} {
7265        set cmitmode "patch"
7266    }
7267
7268    set y [expr {$canvy0 + $l * $linespc}]
7269    set ymax [lindex [$canv cget -scrollregion] 3]
7270    set ytop [expr {$y - $linespc - 1}]
7271    set ybot [expr {$y + $linespc + 1}]
7272    set wnow [$canv yview]
7273    set wtop [expr {[lindex $wnow 0] * $ymax}]
7274    set wbot [expr {[lindex $wnow 1] * $ymax}]
7275    set wh [expr {$wbot - $wtop}]
7276    set newtop $wtop
7277    if {$ytop < $wtop} {
7278        if {$ybot < $wtop} {
7279            set newtop [expr {$y - $wh / 2.0}]
7280        } else {
7281            set newtop $ytop
7282            if {$newtop > $wtop - $linespc} {
7283                set newtop [expr {$wtop - $linespc}]
7284            }
7285        }
7286    } elseif {$ybot > $wbot} {
7287        if {$ytop > $wbot} {
7288            set newtop [expr {$y - $wh / 2.0}]
7289        } else {
7290            set newtop [expr {$ybot - $wh}]
7291            if {$newtop < $wtop + $linespc} {
7292                set newtop [expr {$wtop + $linespc}]
7293            }
7294        }
7295    }
7296    if {$newtop != $wtop} {
7297        if {$newtop < 0} {
7298            set newtop 0
7299        }
7300        allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7301        drawvisible
7302    }
7303
7304    make_secsel $id
7305
7306    if {$isnew} {
7307        addtohistory [list selbyid $id 0] savecmitpos
7308    }
7309
7310    $sha1entry delete 0 end
7311    $sha1entry insert 0 $id
7312    if {$autoselect} {
7313        $sha1entry selection range 0 $autosellen
7314    }
7315    rhighlight_sel $id
7316
7317    $ctext conf -state normal
7318    clear_ctext
7319    set linknum 0
7320    if {![info exists commitinfo($id)]} {
7321        getcommit $id
7322    }
7323    set info $commitinfo($id)
7324    set date [formatdate [lindex $info 2]]
7325    $ctext insert end "[mc "Author"]: [lindex $info 1]  $date\n"
7326    set date [formatdate [lindex $info 4]]
7327    $ctext insert end "[mc "Committer"]: [lindex $info 3]  $date\n"
7328    if {[info exists idtags($id)]} {
7329        $ctext insert end [mc "Tags:"]
7330        foreach tag $idtags($id) {
7331            $ctext insert end " $tag"
7332        }
7333        $ctext insert end "\n"
7334    }
7335
7336    set headers {}
7337    set olds $parents($curview,$id)
7338    if {[llength $olds] > 1} {
7339        set np 0
7340        foreach p $olds {
7341            if {$np >= $mergemax} {
7342                set tag mmax
7343            } else {
7344                set tag m$np
7345            }
7346            $ctext insert end "[mc "Parent"]: " $tag
7347            appendwithlinks [commit_descriptor $p] {}
7348            incr np
7349        }
7350    } else {
7351        foreach p $olds {
7352            append headers "[mc "Parent"]: [commit_descriptor $p]"
7353        }
7354    }
7355
7356    foreach c $children($curview,$id) {
7357        append headers "[mc "Child"]:  [commit_descriptor $c]"
7358    }
7359
7360    # make anything that looks like a SHA1 ID be a clickable link
7361    appendwithlinks $headers {}
7362    if {$showneartags} {
7363        if {![info exists allcommits]} {
7364            getallcommits
7365        }
7366        $ctext insert end "[mc "Branch"]: "
7367        $ctext mark set branch "end -1c"
7368        $ctext mark gravity branch left
7369        $ctext insert end "\n[mc "Follows"]: "
7370        $ctext mark set follows "end -1c"
7371        $ctext mark gravity follows left
7372        $ctext insert end "\n[mc "Precedes"]: "
7373        $ctext mark set precedes "end -1c"
7374        $ctext mark gravity precedes left
7375        $ctext insert end "\n"
7376        dispneartags 1
7377    }
7378    $ctext insert end "\n"
7379    set comment [lindex $info 5]
7380    if {[string first "\r" $comment] >= 0} {
7381        set comment [string map {"\r" "\n    "} $comment]
7382    }
7383    appendwithlinks $comment {comment}
7384
7385    $ctext tag remove found 1.0 end
7386    $ctext conf -state disabled
7387    set commentend [$ctext index "end - 1c"]
7388
7389    set jump_to_here $desired_loc
7390    init_flist [mc "Comments"]
7391    if {$cmitmode eq "tree"} {
7392        gettree $id
7393    } elseif {$vinlinediff($curview) == 1} {
7394        showinlinediff $id
7395    } elseif {[llength $olds] <= 1} {
7396        startdiff $id
7397    } else {
7398        mergediff $id
7399    }
7400}
7401
7402proc selfirstline {} {
7403    unmarkmatches
7404    selectline 0 1
7405}
7406
7407proc sellastline {} {
7408    global numcommits
7409    unmarkmatches
7410    set l [expr {$numcommits - 1}]
7411    selectline $l 1
7412}
7413
7414proc selnextline {dir} {
7415    global selectedline
7416    focus .
7417    if {$selectedline eq {}} return
7418    set l [expr {$selectedline + $dir}]
7419    unmarkmatches
7420    selectline $l 1
7421}
7422
7423proc selnextpage {dir} {
7424    global canv linespc selectedline numcommits
7425
7426    set lpp [expr {([winfo height $canv] - 2) / $linespc}]
7427    if {$lpp < 1} {
7428        set lpp 1
7429    }
7430    allcanvs yview scroll [expr {$dir * $lpp}] units
7431    drawvisible
7432    if {$selectedline eq {}} return
7433    set l [expr {$selectedline + $dir * $lpp}]
7434    if {$l < 0} {
7435        set l 0
7436    } elseif {$l >= $numcommits} {
7437        set l [expr $numcommits - 1]
7438    }
7439    unmarkmatches
7440    selectline $l 1
7441}
7442
7443proc unselectline {} {
7444    global selectedline currentid
7445
7446    set selectedline {}
7447    unset -nocomplain currentid
7448    allcanvs delete secsel
7449    rhighlight_none
7450}
7451
7452proc reselectline {} {
7453    global selectedline
7454
7455    if {$selectedline ne {}} {
7456        selectline $selectedline 0
7457    }
7458}
7459
7460proc addtohistory {cmd {saveproc {}}} {
7461    global history historyindex curview
7462
7463    unset_posvars
7464    save_position
7465    set elt [list $curview $cmd $saveproc {}]
7466    if {$historyindex > 0
7467        && [lindex $history [expr {$historyindex - 1}]] == $elt} {
7468        return
7469    }
7470
7471    if {$historyindex < [llength $history]} {
7472        set history [lreplace $history $historyindex end $elt]
7473    } else {
7474        lappend history $elt
7475    }
7476    incr historyindex
7477    if {$historyindex > 1} {
7478        .tf.bar.leftbut conf -state normal
7479    } else {
7480        .tf.bar.leftbut conf -state disabled
7481    }
7482    .tf.bar.rightbut conf -state disabled
7483}
7484
7485# save the scrolling position of the diff display pane
7486proc save_position {} {
7487    global historyindex history
7488
7489    if {$historyindex < 1} return
7490    set hi [expr {$historyindex - 1}]
7491    set fn [lindex $history $hi 2]
7492    if {$fn ne {}} {
7493        lset history $hi 3 [eval $fn]
7494    }
7495}
7496
7497proc unset_posvars {} {
7498    global last_posvars
7499
7500    if {[info exists last_posvars]} {
7501        foreach {var val} $last_posvars {
7502            global $var
7503            unset -nocomplain $var
7504        }
7505        unset last_posvars
7506    }
7507}
7508
7509proc godo {elt} {
7510    global curview last_posvars
7511
7512    set view [lindex $elt 0]
7513    set cmd [lindex $elt 1]
7514    set pv [lindex $elt 3]
7515    if {$curview != $view} {
7516        showview $view
7517    }
7518    unset_posvars
7519    foreach {var val} $pv {
7520        global $var
7521        set $var $val
7522    }
7523    set last_posvars $pv
7524    eval $cmd
7525}
7526
7527proc goback {} {
7528    global history historyindex
7529    focus .
7530
7531    if {$historyindex > 1} {
7532        save_position
7533        incr historyindex -1
7534        godo [lindex $history [expr {$historyindex - 1}]]
7535        .tf.bar.rightbut conf -state normal
7536    }
7537    if {$historyindex <= 1} {
7538        .tf.bar.leftbut conf -state disabled
7539    }
7540}
7541
7542proc goforw {} {
7543    global history historyindex
7544    focus .
7545
7546    if {$historyindex < [llength $history]} {
7547        save_position
7548        set cmd [lindex $history $historyindex]
7549        incr historyindex
7550        godo $cmd
7551        .tf.bar.leftbut conf -state normal
7552    }
7553    if {$historyindex >= [llength $history]} {
7554        .tf.bar.rightbut conf -state disabled
7555    }
7556}
7557
7558proc go_to_parent {i} {
7559    global parents curview targetid
7560    set ps $parents($curview,$targetid)
7561    if {[llength $ps] >= $i} {
7562        selbyid [lindex $ps [expr $i - 1]]
7563    }
7564}
7565
7566proc gettree {id} {
7567    global treefilelist treeidlist diffids diffmergeid treepending
7568    global nullid nullid2
7569
7570    set diffids $id
7571    unset -nocomplain diffmergeid
7572    if {![info exists treefilelist($id)]} {
7573        if {![info exists treepending]} {
7574            if {$id eq $nullid} {
7575                set cmd [list | git ls-files]
7576            } elseif {$id eq $nullid2} {
7577                set cmd [list | git ls-files --stage -t]
7578            } else {
7579                set cmd [list | git ls-tree -r $id]
7580            }
7581            if {[catch {set gtf [open $cmd r]}]} {
7582                return
7583            }
7584            set treepending $id
7585            set treefilelist($id) {}
7586            set treeidlist($id) {}
7587            fconfigure $gtf -blocking 0 -encoding binary
7588            filerun $gtf [list gettreeline $gtf $id]
7589        }
7590    } else {
7591        setfilelist $id
7592    }
7593}
7594
7595proc gettreeline {gtf id} {
7596    global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
7597
7598    set nl 0
7599    while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
7600        if {$diffids eq $nullid} {
7601            set fname $line
7602        } else {
7603            set i [string first "\t" $line]
7604            if {$i < 0} continue
7605            set fname [string range $line [expr {$i+1}] end]
7606            set line [string range $line 0 [expr {$i-1}]]
7607            if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7608            set sha1 [lindex $line 2]
7609            lappend treeidlist($id) $sha1
7610        }
7611        if {[string index $fname 0] eq "\""} {
7612            set fname [lindex $fname 0]
7613        }
7614        set fname [encoding convertfrom $fname]
7615        lappend treefilelist($id) $fname
7616    }
7617    if {![eof $gtf]} {
7618        return [expr {$nl >= 1000? 2: 1}]
7619    }
7620    close $gtf
7621    unset treepending
7622    if {$cmitmode ne "tree"} {
7623        if {![info exists diffmergeid]} {
7624            gettreediffs $diffids
7625        }
7626    } elseif {$id ne $diffids} {
7627        gettree $diffids
7628    } else {
7629        setfilelist $id
7630    }
7631    return 0
7632}
7633
7634proc showfile {f} {
7635    global treefilelist treeidlist diffids nullid nullid2
7636    global ctext_file_names ctext_file_lines
7637    global ctext commentend
7638
7639    set i [lsearch -exact $treefilelist($diffids) $f]
7640    if {$i < 0} {
7641        puts "oops, $f not in list for id $diffids"
7642        return
7643    }
7644    if {$diffids eq $nullid} {
7645        if {[catch {set bf [open $f r]} err]} {
7646            puts "oops, can't read $f: $err"
7647            return
7648        }
7649    } else {
7650        set blob [lindex $treeidlist($diffids) $i]
7651        if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7652            puts "oops, error reading blob $blob: $err"
7653            return
7654        }
7655    }
7656    fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7657    filerun $bf [list getblobline $bf $diffids]
7658    $ctext config -state normal
7659    clear_ctext $commentend
7660    lappend ctext_file_names $f
7661    lappend ctext_file_lines [lindex [split $commentend "."] 0]
7662    $ctext insert end "\n"
7663    $ctext insert end "$f\n" filesep
7664    $ctext config -state disabled
7665    $ctext yview $commentend
7666    settabs 0
7667}
7668
7669proc getblobline {bf id} {
7670    global diffids cmitmode ctext
7671
7672    if {$id ne $diffids || $cmitmode ne "tree"} {
7673        catch {close $bf}
7674        return 0
7675    }
7676    $ctext config -state normal
7677    set nl 0
7678    while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7679        $ctext insert end "$line\n"
7680    }
7681    if {[eof $bf]} {
7682        global jump_to_here ctext_file_names commentend
7683
7684        # delete last newline
7685        $ctext delete "end - 2c" "end - 1c"
7686        close $bf
7687        if {$jump_to_here ne {} &&
7688            [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7689            set lnum [expr {[lindex $jump_to_here 1] +
7690                            [lindex [split $commentend .] 0]}]
7691            mark_ctext_line $lnum
7692        }
7693        $ctext config -state disabled
7694        return 0
7695    }
7696    $ctext config -state disabled
7697    return [expr {$nl >= 1000? 2: 1}]
7698}
7699
7700proc mark_ctext_line {lnum} {
7701    global ctext markbgcolor
7702
7703    $ctext tag delete omark
7704    $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7705    $ctext tag conf omark -background $markbgcolor
7706    $ctext see $lnum.0
7707}
7708
7709proc mergediff {id} {
7710    global diffmergeid
7711    global diffids treediffs
7712    global parents curview
7713
7714    set diffmergeid $id
7715    set diffids $id
7716    set treediffs($id) {}
7717    set np [llength $parents($curview,$id)]
7718    settabs $np
7719    getblobdiffs $id
7720}
7721
7722proc startdiff {ids} {
7723    global treediffs diffids treepending diffmergeid nullid nullid2
7724
7725    settabs 1
7726    set diffids $ids
7727    unset -nocomplain diffmergeid
7728    if {![info exists treediffs($ids)] ||
7729        [lsearch -exact $ids $nullid] >= 0 ||
7730        [lsearch -exact $ids $nullid2] >= 0} {
7731        if {![info exists treepending]} {
7732            gettreediffs $ids
7733        }
7734    } else {
7735        addtocflist $ids
7736    }
7737}
7738
7739proc showinlinediff {ids} {
7740    global commitinfo commitdata ctext
7741    global treediffs
7742
7743    set info $commitinfo($ids)
7744    set diff [lindex $info 7]
7745    set difflines [split $diff "\n"]
7746
7747    initblobdiffvars
7748    set treediff {}
7749
7750    set inhdr 0
7751    foreach line $difflines {
7752        if {![string compare -length 5 "diff " $line]} {
7753            set inhdr 1
7754        } elseif {$inhdr && ![string compare -length 4 "+++ " $line]} {
7755            # offset also accounts for the b/ prefix
7756            lappend treediff [string range $line 6 end]
7757            set inhdr 0
7758        }
7759    }
7760
7761    set treediffs($ids) $treediff
7762    add_flist $treediff
7763
7764    $ctext conf -state normal
7765    foreach line $difflines {
7766        parseblobdiffline $ids $line
7767    }
7768    maybe_scroll_ctext 1
7769    $ctext conf -state disabled
7770}
7771
7772# If the filename (name) is under any of the passed filter paths
7773# then return true to include the file in the listing.
7774proc path_filter {filter name} {
7775    set worktree [gitworktree]
7776    foreach p $filter {
7777        set fq_p [file normalize $p]
7778        set fq_n [file normalize [file join $worktree $name]]
7779        if {[string match [file normalize $fq_p]* $fq_n]} {
7780            return 1
7781        }
7782    }
7783    return 0
7784}
7785
7786proc addtocflist {ids} {
7787    global treediffs
7788
7789    add_flist $treediffs($ids)
7790    getblobdiffs $ids
7791}
7792
7793proc diffcmd {ids flags} {
7794    global log_showroot nullid nullid2 git_version
7795
7796    set i [lsearch -exact $ids $nullid]
7797    set j [lsearch -exact $ids $nullid2]
7798    if {$i >= 0} {
7799        if {[llength $ids] > 1 && $j < 0} {
7800            # comparing working directory with some specific revision
7801            set cmd [concat | git diff-index $flags]
7802            if {$i == 0} {
7803                lappend cmd -R [lindex $ids 1]
7804            } else {
7805                lappend cmd [lindex $ids 0]
7806            }
7807        } else {
7808            # comparing working directory with index
7809            set cmd [concat | git diff-files $flags]
7810            if {$j == 1} {
7811                lappend cmd -R
7812            }
7813        }
7814    } elseif {$j >= 0} {
7815        if {[package vcompare $git_version "1.7.2"] >= 0} {
7816            set flags "$flags --ignore-submodules=dirty"
7817        }
7818        set cmd [concat | git diff-index --cached $flags]
7819        if {[llength $ids] > 1} {
7820            # comparing index with specific revision
7821            if {$j == 0} {
7822                lappend cmd -R [lindex $ids 1]
7823            } else {
7824                lappend cmd [lindex $ids 0]
7825            }
7826        } else {
7827            # comparing index with HEAD
7828            lappend cmd HEAD
7829        }
7830    } else {
7831        if {$log_showroot} {
7832            lappend flags --root
7833        }
7834        set cmd [concat | git diff-tree -r $flags $ids]
7835    }
7836    return $cmd
7837}
7838
7839proc gettreediffs {ids} {
7840    global treediff treepending limitdiffs vfilelimit curview
7841
7842    set cmd [diffcmd $ids {--no-commit-id}]
7843    if {$limitdiffs && $vfilelimit($curview) ne {}} {
7844            set cmd [concat $cmd -- $vfilelimit($curview)]
7845    }
7846    if {[catch {set gdtf [open $cmd r]}]} return
7847
7848    set treepending $ids
7849    set treediff {}
7850    fconfigure $gdtf -blocking 0 -encoding binary
7851    filerun $gdtf [list gettreediffline $gdtf $ids]
7852}
7853
7854proc gettreediffline {gdtf ids} {
7855    global treediff treediffs treepending diffids diffmergeid
7856    global cmitmode vfilelimit curview limitdiffs perfile_attrs
7857
7858    set nr 0
7859    set sublist {}
7860    set max 1000
7861    if {$perfile_attrs} {
7862        # cache_gitattr is slow, and even slower on win32 where we
7863        # have to invoke it for only about 30 paths at a time
7864        set max 500
7865        if {[tk windowingsystem] == "win32"} {
7866            set max 120
7867        }
7868    }
7869    while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7870        set i [string first "\t" $line]
7871        if {$i >= 0} {
7872            set file [string range $line [expr {$i+1}] end]
7873            if {[string index $file 0] eq "\""} {
7874                set file [lindex $file 0]
7875            }
7876            set file [encoding convertfrom $file]
7877            if {$file ne [lindex $treediff end]} {
7878                lappend treediff $file
7879                lappend sublist $file
7880            }
7881        }
7882    }
7883    if {$perfile_attrs} {
7884        cache_gitattr encoding $sublist
7885    }
7886    if {![eof $gdtf]} {
7887        return [expr {$nr >= $max? 2: 1}]
7888    }
7889    close $gdtf
7890    set treediffs($ids) $treediff
7891    unset treepending
7892    if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7893        gettree $diffids
7894    } elseif {$ids != $diffids} {
7895        if {![info exists diffmergeid]} {
7896            gettreediffs $diffids
7897        }
7898    } else {
7899        addtocflist $ids
7900    }
7901    return 0
7902}
7903
7904# empty string or positive integer
7905proc diffcontextvalidate {v} {
7906    return [regexp {^(|[1-9][0-9]*)$} $v]
7907}
7908
7909proc diffcontextchange {n1 n2 op} {
7910    global diffcontextstring diffcontext
7911
7912    if {[string is integer -strict $diffcontextstring]} {
7913        if {$diffcontextstring >= 0} {
7914            set diffcontext $diffcontextstring
7915            reselectline
7916        }
7917    }
7918}
7919
7920proc changeignorespace {} {
7921    reselectline
7922}
7923
7924proc changeworddiff {name ix op} {
7925    reselectline
7926}
7927
7928proc initblobdiffvars {} {
7929    global diffencoding targetline diffnparents
7930    global diffinhdr currdiffsubmod diffseehere
7931    set targetline {}
7932    set diffnparents 0
7933    set diffinhdr 0
7934    set diffencoding [get_path_encoding {}]
7935    set currdiffsubmod ""
7936    set diffseehere -1
7937}
7938
7939proc getblobdiffs {ids} {
7940    global blobdifffd diffids env
7941    global treediffs
7942    global diffcontext
7943    global ignorespace
7944    global worddiff
7945    global limitdiffs vfilelimit curview
7946    global git_version
7947
7948    set textconv {}
7949    if {[package vcompare $git_version "1.6.1"] >= 0} {
7950        set textconv "--textconv"
7951    }
7952    set submodule {}
7953    if {[package vcompare $git_version "1.6.6"] >= 0} {
7954        set submodule "--submodule"
7955    }
7956    set cmd [diffcmd $ids "-p $textconv $submodule  -C --cc --no-commit-id -U$diffcontext"]
7957    if {$ignorespace} {
7958        append cmd " -w"
7959    }
7960    if {$worddiff ne [mc "Line diff"]} {
7961        append cmd " --word-diff=porcelain"
7962    }
7963    if {$limitdiffs && $vfilelimit($curview) ne {}} {
7964        set cmd [concat $cmd -- $vfilelimit($curview)]
7965    }
7966    if {[catch {set bdf [open $cmd r]} err]} {
7967        error_popup [mc "Error getting diffs: %s" $err]
7968        return
7969    }
7970    fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
7971    set blobdifffd($ids) $bdf
7972    initblobdiffvars
7973    filerun $bdf [list getblobdiffline $bdf $diffids]
7974}
7975
7976proc savecmitpos {} {
7977    global ctext cmitmode
7978
7979    if {$cmitmode eq "tree"} {
7980        return {}
7981    }
7982    return [list target_scrollpos [$ctext index @0,0]]
7983}
7984
7985proc savectextpos {} {
7986    global ctext
7987
7988    return [list target_scrollpos [$ctext index @0,0]]
7989}
7990
7991proc maybe_scroll_ctext {ateof} {
7992    global ctext target_scrollpos
7993
7994    if {![info exists target_scrollpos]} return
7995    if {!$ateof} {
7996        set nlines [expr {[winfo height $ctext]
7997                          / [font metrics textfont -linespace]}]
7998        if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
7999    }
8000    $ctext yview $target_scrollpos
8001    unset target_scrollpos
8002}
8003
8004proc setinlist {var i val} {
8005    global $var
8006
8007    while {[llength [set $var]] < $i} {
8008        lappend $var {}
8009    }
8010    if {[llength [set $var]] == $i} {
8011        lappend $var $val
8012    } else {
8013        lset $var $i $val
8014    }
8015}
8016
8017proc makediffhdr {fname ids} {
8018    global ctext curdiffstart treediffs diffencoding
8019    global ctext_file_names jump_to_here targetline diffline
8020
8021    set fname [encoding convertfrom $fname]
8022    set diffencoding [get_path_encoding $fname]
8023    set i [lsearch -exact $treediffs($ids) $fname]
8024    if {$i >= 0} {
8025        setinlist difffilestart $i $curdiffstart
8026    }
8027    lset ctext_file_names end $fname
8028    set l [expr {(78 - [string length $fname]) / 2}]
8029    set pad [string range "----------------------------------------" 1 $l]
8030    $ctext insert $curdiffstart "$pad $fname $pad" filesep
8031    set targetline {}
8032    if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
8033        set targetline [lindex $jump_to_here 1]
8034    }
8035    set diffline 0
8036}
8037
8038proc blobdiffmaybeseehere {ateof} {
8039    global diffseehere
8040    if {$diffseehere >= 0} {
8041        mark_ctext_line [lindex [split $diffseehere .] 0]
8042    }
8043    maybe_scroll_ctext $ateof
8044}
8045
8046proc getblobdiffline {bdf ids} {
8047    global diffids blobdifffd
8048    global ctext
8049
8050    set nr 0
8051    $ctext conf -state normal
8052    while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
8053        if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
8054            catch {close $bdf}
8055            return 0
8056        }
8057        parseblobdiffline $ids $line
8058    }
8059    $ctext conf -state disabled
8060    blobdiffmaybeseehere [eof $bdf]
8061    if {[eof $bdf]} {
8062        catch {close $bdf}
8063        return 0
8064    }
8065    return [expr {$nr >= 1000? 2: 1}]
8066}
8067
8068proc parseblobdiffline {ids line} {
8069    global ctext curdiffstart
8070    global diffnexthead diffnextnote difffilestart
8071    global ctext_file_names ctext_file_lines
8072    global diffinhdr treediffs mergemax diffnparents
8073    global diffencoding jump_to_here targetline diffline currdiffsubmod
8074    global worddiff diffseehere
8075
8076    if {![string compare -length 5 "diff " $line]} {
8077        if {![regexp {^diff (--cc|--git) } $line m type]} {
8078            set line [encoding convertfrom $line]
8079            $ctext insert end "$line\n" hunksep
8080            continue
8081        }
8082        # start of a new file
8083        set diffinhdr 1
8084        $ctext insert end "\n"
8085        set curdiffstart [$ctext index "end - 1c"]
8086        lappend ctext_file_names ""
8087        lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8088        $ctext insert end "\n" filesep
8089
8090        if {$type eq "--cc"} {
8091            # start of a new file in a merge diff
8092            set fname [string range $line 10 end]
8093            if {[lsearch -exact $treediffs($ids) $fname] < 0} {
8094                lappend treediffs($ids) $fname
8095                add_flist [list $fname]
8096            }
8097
8098        } else {
8099            set line [string range $line 11 end]
8100            # If the name hasn't changed the length will be odd,
8101            # the middle char will be a space, and the two bits either
8102            # side will be a/name and b/name, or "a/name" and "b/name".
8103            # If the name has changed we'll get "rename from" and
8104            # "rename to" or "copy from" and "copy to" lines following
8105            # this, and we'll use them to get the filenames.
8106            # This complexity is necessary because spaces in the
8107            # filename(s) don't get escaped.
8108            set l [string length $line]
8109            set i [expr {$l / 2}]
8110            if {!(($l & 1) && [string index $line $i] eq " " &&
8111                  [string range $line 2 [expr {$i - 1}]] eq \
8112                      [string range $line [expr {$i + 3}] end])} {
8113                return
8114            }
8115            # unescape if quoted and chop off the a/ from the front
8116            if {[string index $line 0] eq "\""} {
8117                set fname [string range [lindex $line 0] 2 end]
8118            } else {
8119                set fname [string range $line 2 [expr {$i - 1}]]
8120            }
8121        }
8122        makediffhdr $fname $ids
8123
8124    } elseif {![string compare -length 16 "* Unmerged path " $line]} {
8125        set fname [encoding convertfrom [string range $line 16 end]]
8126        $ctext insert end "\n"
8127        set curdiffstart [$ctext index "end - 1c"]
8128        lappend ctext_file_names $fname
8129        lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8130        $ctext insert end "$line\n" filesep
8131        set i [lsearch -exact $treediffs($ids) $fname]
8132        if {$i >= 0} {
8133            setinlist difffilestart $i $curdiffstart
8134        }
8135
8136    } elseif {![string compare -length 2 "@@" $line]} {
8137        regexp {^@@+} $line ats
8138        set line [encoding convertfrom $diffencoding $line]
8139        $ctext insert end "$line\n" hunksep
8140        if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
8141            set diffline $nl
8142        }
8143        set diffnparents [expr {[string length $ats] - 1}]
8144        set diffinhdr 0
8145
8146    } elseif {![string compare -length 10 "Submodule " $line]} {
8147        # start of a new submodule
8148        if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
8149            set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
8150        } else {
8151            set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
8152        }
8153        if {$currdiffsubmod != $fname} {
8154            $ctext insert end "\n";     # Add newline after commit message
8155        }
8156        set curdiffstart [$ctext index "end - 1c"]
8157        lappend ctext_file_names ""
8158        if {$currdiffsubmod != $fname} {
8159            lappend ctext_file_lines $fname
8160            makediffhdr $fname $ids
8161            set currdiffsubmod $fname
8162            $ctext insert end "\n$line\n" filesep
8163        } else {
8164            $ctext insert end "$line\n" filesep
8165        }
8166    } elseif {![string compare -length 3 "  >" $line]} {
8167        set $currdiffsubmod ""
8168        set line [encoding convertfrom $diffencoding $line]
8169        $ctext insert end "$line\n" dresult
8170    } elseif {![string compare -length 3 "  <" $line]} {
8171        set $currdiffsubmod ""
8172        set line [encoding convertfrom $diffencoding $line]
8173        $ctext insert end "$line\n" d0
8174    } elseif {$diffinhdr} {
8175        if {![string compare -length 12 "rename from " $line]} {
8176            set fname [string range $line [expr 6 + [string first " from " $line] ] end]
8177            if {[string index $fname 0] eq "\""} {
8178                set fname [lindex $fname 0]
8179            }
8180            set fname [encoding convertfrom $fname]
8181            set i [lsearch -exact $treediffs($ids) $fname]
8182            if {$i >= 0} {
8183                setinlist difffilestart $i $curdiffstart
8184            }
8185        } elseif {![string compare -length 10 $line "rename to "] ||
8186                  ![string compare -length 8 $line "copy to "]} {
8187            set fname [string range $line [expr 4 + [string first " to " $line] ] end]
8188            if {[string index $fname 0] eq "\""} {
8189                set fname [lindex $fname 0]
8190            }
8191            makediffhdr $fname $ids
8192        } elseif {[string compare -length 3 $line "---"] == 0} {
8193            # do nothing
8194            return
8195        } elseif {[string compare -length 3 $line "+++"] == 0} {
8196            set diffinhdr 0
8197            return
8198        }
8199        $ctext insert end "$line\n" filesep
8200
8201    } else {
8202        set line [string map {\x1A ^Z} \
8203                      [encoding convertfrom $diffencoding $line]]
8204        # parse the prefix - one ' ', '-' or '+' for each parent
8205        set prefix [string range $line 0 [expr {$diffnparents - 1}]]
8206        set tag [expr {$diffnparents > 1? "m": "d"}]
8207        set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
8208        set words_pre_markup ""
8209        set words_post_markup ""
8210        if {[string trim $prefix " -+"] eq {}} {
8211            # prefix only has " ", "-" and "+" in it: normal diff line
8212            set num [string first "-" $prefix]
8213            if {$dowords} {
8214                set line [string range $line 1 end]
8215            }
8216            if {$num >= 0} {
8217                # removed line, first parent with line is $num
8218                if {$num >= $mergemax} {
8219                    set num "max"
8220                }
8221                if {$dowords && $worddiff eq [mc "Markup words"]} {
8222                    $ctext insert end "\[-$line-\]" $tag$num
8223                } else {
8224                    $ctext insert end "$line" $tag$num
8225                }
8226                if {!$dowords} {
8227                    $ctext insert end "\n" $tag$num
8228                }
8229            } else {
8230                set tags {}
8231                if {[string first "+" $prefix] >= 0} {
8232                    # added line
8233                    lappend tags ${tag}result
8234                    if {$diffnparents > 1} {
8235                        set num [string first " " $prefix]
8236                        if {$num >= 0} {
8237                            if {$num >= $mergemax} {
8238                                set num "max"
8239                            }
8240                            lappend tags m$num
8241                        }
8242                    }
8243                    set words_pre_markup "{+"
8244                    set words_post_markup "+}"
8245                }
8246                if {$targetline ne {}} {
8247                    if {$diffline == $targetline} {
8248                        set diffseehere [$ctext index "end - 1 chars"]
8249                        set targetline {}
8250                    } else {
8251                        incr diffline
8252                    }
8253                }
8254                if {$dowords && $worddiff eq [mc "Markup words"]} {
8255                    $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
8256                } else {
8257                    $ctext insert end "$line" $tags
8258                }
8259                if {!$dowords} {
8260                    $ctext insert end "\n" $tags
8261                }
8262            }
8263        } elseif {$dowords && $prefix eq "~"} {
8264            $ctext insert end "\n" {}
8265        } else {
8266            # "\ No newline at end of file",
8267            # or something else we don't recognize
8268            $ctext insert end "$line\n" hunksep
8269        }
8270    }
8271}
8272
8273proc changediffdisp {} {
8274    global ctext diffelide
8275
8276    $ctext tag conf d0 -elide [lindex $diffelide 0]
8277    $ctext tag conf dresult -elide [lindex $diffelide 1]
8278}
8279
8280proc highlightfile {cline} {
8281    global cflist cflist_top
8282
8283    if {![info exists cflist_top]} return
8284
8285    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
8286    $cflist tag add highlight $cline.0 "$cline.0 lineend"
8287    $cflist see $cline.0
8288    set cflist_top $cline
8289}
8290
8291proc highlightfile_for_scrollpos {topidx} {
8292    global cmitmode difffilestart
8293
8294    if {$cmitmode eq "tree"} return
8295    if {![info exists difffilestart]} return
8296
8297    set top [lindex [split $topidx .] 0]
8298    if {$difffilestart eq {} || $top < [lindex $difffilestart 0]} {
8299        highlightfile 0
8300    } else {
8301        highlightfile [expr {[bsearch $difffilestart $top] + 2}]
8302    }
8303}
8304
8305proc prevfile {} {
8306    global difffilestart ctext cmitmode
8307
8308    if {$cmitmode eq "tree"} return
8309    set prev 0.0
8310    set here [$ctext index @0,0]
8311    foreach loc $difffilestart {
8312        if {[$ctext compare $loc >= $here]} {
8313            $ctext yview $prev
8314            return
8315        }
8316        set prev $loc
8317    }
8318    $ctext yview $prev
8319}
8320
8321proc nextfile {} {
8322    global difffilestart ctext cmitmode
8323
8324    if {$cmitmode eq "tree"} return
8325    set here [$ctext index @0,0]
8326    foreach loc $difffilestart {
8327        if {[$ctext compare $loc > $here]} {
8328            $ctext yview $loc
8329            return
8330        }
8331    }
8332}
8333
8334proc clear_ctext {{first 1.0}} {
8335    global ctext smarktop smarkbot
8336    global ctext_file_names ctext_file_lines
8337    global pendinglinks
8338
8339    set l [lindex [split $first .] 0]
8340    if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
8341        set smarktop $l
8342    }
8343    if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
8344        set smarkbot $l
8345    }
8346    $ctext delete $first end
8347    if {$first eq "1.0"} {
8348        unset -nocomplain pendinglinks
8349    }
8350    set ctext_file_names {}
8351    set ctext_file_lines {}
8352}
8353
8354proc settabs {{firstab {}}} {
8355    global firsttabstop tabstop ctext have_tk85
8356
8357    if {$firstab ne {} && $have_tk85} {
8358        set firsttabstop $firstab
8359    }
8360    set w [font measure textfont "0"]
8361    if {$firsttabstop != 0} {
8362        $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
8363                               [expr {($firsttabstop + 2 * $tabstop) * $w}]]
8364    } elseif {$have_tk85 || $tabstop != 8} {
8365        $ctext conf -tabs [expr {$tabstop * $w}]
8366    } else {
8367        $ctext conf -tabs {}
8368    }
8369}
8370
8371proc incrsearch {name ix op} {
8372    global ctext searchstring searchdirn
8373
8374    if {[catch {$ctext index anchor}]} {
8375        # no anchor set, use start of selection, or of visible area
8376        set sel [$ctext tag ranges sel]
8377        if {$sel ne {}} {
8378            $ctext mark set anchor [lindex $sel 0]
8379        } elseif {$searchdirn eq "-forwards"} {
8380            $ctext mark set anchor @0,0
8381        } else {
8382            $ctext mark set anchor @0,[winfo height $ctext]
8383        }
8384    }
8385    if {$searchstring ne {}} {
8386        set here [$ctext search -count mlen $searchdirn -- $searchstring anchor]
8387        if {$here ne {}} {
8388            $ctext see $here
8389            set mend "$here + $mlen c"
8390            $ctext tag remove sel 1.0 end
8391            $ctext tag add sel $here $mend
8392            suppress_highlighting_file_for_current_scrollpos
8393            highlightfile_for_scrollpos $here
8394        }
8395    }
8396    rehighlight_search_results
8397}
8398
8399proc dosearch {} {
8400    global sstring ctext searchstring searchdirn
8401
8402    focus $sstring
8403    $sstring icursor end
8404    set searchdirn -forwards
8405    if {$searchstring ne {}} {
8406        set sel [$ctext tag ranges sel]
8407        if {$sel ne {}} {
8408            set start "[lindex $sel 0] + 1c"
8409        } elseif {[catch {set start [$ctext index anchor]}]} {
8410            set start "@0,0"
8411        }
8412        set match [$ctext search -count mlen -- $searchstring $start]
8413        $ctext tag remove sel 1.0 end
8414        if {$match eq {}} {
8415            bell
8416            return
8417        }
8418        $ctext see $match
8419        suppress_highlighting_file_for_current_scrollpos
8420        highlightfile_for_scrollpos $match
8421        set mend "$match + $mlen c"
8422        $ctext tag add sel $match $mend
8423        $ctext mark unset anchor
8424        rehighlight_search_results
8425    }
8426}
8427
8428proc dosearchback {} {
8429    global sstring ctext searchstring searchdirn
8430
8431    focus $sstring
8432    $sstring icursor end
8433    set searchdirn -backwards
8434    if {$searchstring ne {}} {
8435        set sel [$ctext tag ranges sel]
8436        if {$sel ne {}} {
8437            set start [lindex $sel 0]
8438        } elseif {[catch {set start [$ctext index anchor]}]} {
8439            set start @0,[winfo height $ctext]
8440        }
8441        set match [$ctext search -backwards -count ml -- $searchstring $start]
8442        $ctext tag remove sel 1.0 end
8443        if {$match eq {}} {
8444            bell
8445            return
8446        }
8447        $ctext see $match
8448        suppress_highlighting_file_for_current_scrollpos
8449        highlightfile_for_scrollpos $match
8450        set mend "$match + $ml c"
8451        $ctext tag add sel $match $mend
8452        $ctext mark unset anchor
8453        rehighlight_search_results
8454    }
8455}
8456
8457proc rehighlight_search_results {} {
8458    global ctext searchstring
8459
8460    $ctext tag remove found 1.0 end
8461    $ctext tag remove currentsearchhit 1.0 end
8462
8463    if {$searchstring ne {}} {
8464        searchmarkvisible 1
8465    }
8466}
8467
8468proc searchmark {first last} {
8469    global ctext searchstring
8470
8471    set sel [$ctext tag ranges sel]
8472
8473    set mend $first.0
8474    while {1} {
8475        set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8476        if {$match eq {}} break
8477        set mend "$match + $mlen c"
8478        if {$sel ne {} && [$ctext compare $match == [lindex $sel 0]]} {
8479            $ctext tag add currentsearchhit $match $mend
8480        } else {
8481            $ctext tag add found $match $mend
8482        }
8483    }
8484}
8485
8486proc searchmarkvisible {doall} {
8487    global ctext smarktop smarkbot
8488
8489    set topline [lindex [split [$ctext index @0,0] .] 0]
8490    set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8491    if {$doall || $botline < $smarktop || $topline > $smarkbot} {
8492        # no overlap with previous
8493        searchmark $topline $botline
8494        set smarktop $topline
8495        set smarkbot $botline
8496    } else {
8497        if {$topline < $smarktop} {
8498            searchmark $topline [expr {$smarktop-1}]
8499            set smarktop $topline
8500        }
8501        if {$botline > $smarkbot} {
8502            searchmark [expr {$smarkbot+1}] $botline
8503            set smarkbot $botline
8504        }
8505    }
8506}
8507
8508proc suppress_highlighting_file_for_current_scrollpos {} {
8509    global ctext suppress_highlighting_file_for_this_scrollpos
8510
8511    set suppress_highlighting_file_for_this_scrollpos [$ctext index @0,0]
8512}
8513
8514proc scrolltext {f0 f1} {
8515    global searchstring cmitmode ctext
8516    global suppress_highlighting_file_for_this_scrollpos
8517
8518    set topidx [$ctext index @0,0]
8519    if {![info exists suppress_highlighting_file_for_this_scrollpos]
8520        || $topidx ne $suppress_highlighting_file_for_this_scrollpos} {
8521        highlightfile_for_scrollpos $topidx
8522    }
8523
8524    unset -nocomplain suppress_highlighting_file_for_this_scrollpos
8525
8526    .bleft.bottom.sb set $f0 $f1
8527    if {$searchstring ne {}} {
8528        searchmarkvisible 0
8529    }
8530}
8531
8532proc setcoords {} {
8533    global linespc charspc canvx0 canvy0
8534    global xspc1 xspc2 lthickness
8535
8536    set linespc [font metrics mainfont -linespace]
8537    set charspc [font measure mainfont "m"]
8538    set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8539    set canvx0 [expr {int(3 + 0.5 * $linespc)}]
8540    set lthickness [expr {int($linespc / 9) + 1}]
8541    set xspc1(0) $linespc
8542    set xspc2 $linespc
8543}
8544
8545proc redisplay {} {
8546    global canv
8547    global selectedline
8548
8549    set ymax [lindex [$canv cget -scrollregion] 3]
8550    if {$ymax eq {} || $ymax == 0} return
8551    set span [$canv yview]
8552    clear_display
8553    setcanvscroll
8554    allcanvs yview moveto [lindex $span 0]
8555    drawvisible
8556    if {$selectedline ne {}} {
8557        selectline $selectedline 0
8558        allcanvs yview moveto [lindex $span 0]
8559    }
8560}
8561
8562proc parsefont {f n} {
8563    global fontattr
8564
8565    set fontattr($f,family) [lindex $n 0]
8566    set s [lindex $n 1]
8567    if {$s eq {} || $s == 0} {
8568        set s 10
8569    } elseif {$s < 0} {
8570        set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
8571    }
8572    set fontattr($f,size) $s
8573    set fontattr($f,weight) normal
8574    set fontattr($f,slant) roman
8575    foreach style [lrange $n 2 end] {
8576        switch -- $style {
8577            "normal" -
8578            "bold"   {set fontattr($f,weight) $style}
8579            "roman" -
8580            "italic" {set fontattr($f,slant) $style}
8581        }
8582    }
8583}
8584
8585proc fontflags {f {isbold 0}} {
8586    global fontattr
8587
8588    return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8589                -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8590                -slant $fontattr($f,slant)]
8591}
8592
8593proc fontname {f} {
8594    global fontattr
8595
8596    set n [list $fontattr($f,family) $fontattr($f,size)]
8597    if {$fontattr($f,weight) eq "bold"} {
8598        lappend n "bold"
8599    }
8600    if {$fontattr($f,slant) eq "italic"} {
8601        lappend n "italic"
8602    }
8603    return $n
8604}
8605
8606proc incrfont {inc} {
8607    global mainfont textfont ctext canv cflist showrefstop
8608    global stopped entries fontattr
8609
8610    unmarkmatches
8611    set s $fontattr(mainfont,size)
8612    incr s $inc
8613    if {$s < 1} {
8614        set s 1
8615    }
8616    set fontattr(mainfont,size) $s
8617    font config mainfont -size $s
8618    font config mainfontbold -size $s
8619    set mainfont [fontname mainfont]
8620    set s $fontattr(textfont,size)
8621    incr s $inc
8622    if {$s < 1} {
8623        set s 1
8624    }
8625    set fontattr(textfont,size) $s
8626    font config textfont -size $s
8627    font config textfontbold -size $s
8628    set textfont [fontname textfont]
8629    setcoords
8630    settabs
8631    redisplay
8632}
8633
8634proc clearsha1 {} {
8635    global sha1entry sha1string
8636    if {[string length $sha1string] == 40} {
8637        $sha1entry delete 0 end
8638    }
8639}
8640
8641proc sha1change {n1 n2 op} {
8642    global sha1string currentid sha1but
8643    if {$sha1string == {}
8644        || ([info exists currentid] && $sha1string == $currentid)} {
8645        set state disabled
8646    } else {
8647        set state normal
8648    }
8649    if {[$sha1but cget -state] == $state} return
8650    if {$state == "normal"} {
8651        $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
8652    } else {
8653        $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
8654    }
8655}
8656
8657proc gotocommit {} {
8658    global sha1string tagids headids curview varcid
8659
8660    if {$sha1string == {}
8661        || ([info exists currentid] && $sha1string == $currentid)} return
8662    if {[info exists tagids($sha1string)]} {
8663        set id $tagids($sha1string)
8664    } elseif {[info exists headids($sha1string)]} {
8665        set id $headids($sha1string)
8666    } else {
8667        set id [string tolower $sha1string]
8668        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
8669            set matches [longid $id]
8670            if {$matches ne {}} {
8671                if {[llength $matches] > 1} {
8672                    error_popup [mc "Short SHA1 id %s is ambiguous" $id]
8673                    return
8674                }
8675                set id [lindex $matches 0]
8676            }
8677        } else {
8678            if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8679                error_popup [mc "Revision %s is not known" $sha1string]
8680                return
8681            }
8682        }
8683    }
8684    if {[commitinview $id $curview]} {
8685        selectline [rowofcommit $id] 1
8686        return
8687    }
8688    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
8689        set msg [mc "SHA1 id %s is not known" $sha1string]
8690    } else {
8691        set msg [mc "Revision %s is not in the current view" $sha1string]
8692    }
8693    error_popup $msg
8694}
8695
8696proc lineenter {x y id} {
8697    global hoverx hovery hoverid hovertimer
8698    global commitinfo canv
8699
8700    if {![info exists commitinfo($id)] && ![getcommit $id]} return
8701    set hoverx $x
8702    set hovery $y
8703    set hoverid $id
8704    if {[info exists hovertimer]} {
8705        after cancel $hovertimer
8706    }
8707    set hovertimer [after 500 linehover]
8708    $canv delete hover
8709}
8710
8711proc linemotion {x y id} {
8712    global hoverx hovery hoverid hovertimer
8713
8714    if {[info exists hoverid] && $id == $hoverid} {
8715        set hoverx $x
8716        set hovery $y
8717        if {[info exists hovertimer]} {
8718            after cancel $hovertimer
8719        }
8720        set hovertimer [after 500 linehover]
8721    }
8722}
8723
8724proc lineleave {id} {
8725    global hoverid hovertimer canv
8726
8727    if {[info exists hoverid] && $id == $hoverid} {
8728        $canv delete hover
8729        if {[info exists hovertimer]} {
8730            after cancel $hovertimer
8731            unset hovertimer
8732        }
8733        unset hoverid
8734    }
8735}
8736
8737proc linehover {} {
8738    global hoverx hovery hoverid hovertimer
8739    global canv linespc lthickness
8740    global linehoverbgcolor linehoverfgcolor linehoveroutlinecolor
8741
8742    global commitinfo
8743
8744    set text [lindex $commitinfo($hoverid) 0]
8745    set ymax [lindex [$canv cget -scrollregion] 3]
8746    if {$ymax == {}} return
8747    set yfrac [lindex [$canv yview] 0]
8748    set x [expr {$hoverx + 2 * $linespc}]
8749    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8750    set x0 [expr {$x - 2 * $lthickness}]
8751    set y0 [expr {$y - 2 * $lthickness}]
8752    set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
8753    set y1 [expr {$y + $linespc + 2 * $lthickness}]
8754    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8755               -fill $linehoverbgcolor -outline $linehoveroutlinecolor \
8756               -width 1 -tags hover]
8757    $canv raise $t
8758    set t [$canv create text $x $y -anchor nw -text $text -tags hover \
8759               -font mainfont -fill $linehoverfgcolor]
8760    $canv raise $t
8761}
8762
8763proc clickisonarrow {id y} {
8764    global lthickness
8765
8766    set ranges [rowranges $id]
8767    set thresh [expr {2 * $lthickness + 6}]
8768    set n [expr {[llength $ranges] - 1}]
8769    for {set i 1} {$i < $n} {incr i} {
8770        set row [lindex $ranges $i]
8771        if {abs([yc $row] - $y) < $thresh} {
8772            return $i
8773        }
8774    }
8775    return {}
8776}
8777
8778proc arrowjump {id n y} {
8779    global canv
8780
8781    # 1 <-> 2, 3 <-> 4, etc...
8782    set n [expr {(($n - 1) ^ 1) + 1}]
8783    set row [lindex [rowranges $id] $n]
8784    set yt [yc $row]
8785    set ymax [lindex [$canv cget -scrollregion] 3]
8786    if {$ymax eq {} || $ymax <= 0} return
8787    set view [$canv yview]
8788    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8789    set yfrac [expr {$yt / $ymax - $yspan / 2}]
8790    if {$yfrac < 0} {
8791        set yfrac 0
8792    }
8793    allcanvs yview moveto $yfrac
8794}
8795
8796proc lineclick {x y id isnew} {
8797    global ctext commitinfo children canv thickerline curview
8798
8799    if {![info exists commitinfo($id)] && ![getcommit $id]} return
8800    unmarkmatches
8801    unselectline
8802    normalline
8803    $canv delete hover
8804    # draw this line thicker than normal
8805    set thickerline $id
8806    drawlines $id
8807    if {$isnew} {
8808        set ymax [lindex [$canv cget -scrollregion] 3]
8809        if {$ymax eq {}} return
8810        set yfrac [lindex [$canv yview] 0]
8811        set y [expr {$y + $yfrac * $ymax}]
8812    }
8813    set dirn [clickisonarrow $id $y]
8814    if {$dirn ne {}} {
8815        arrowjump $id $dirn $y
8816        return
8817    }
8818
8819    if {$isnew} {
8820        addtohistory [list lineclick $x $y $id 0] savectextpos
8821    }
8822    # fill the details pane with info about this line
8823    $ctext conf -state normal
8824    clear_ctext
8825    settabs 0
8826    $ctext insert end "[mc "Parent"]:\t"
8827    $ctext insert end $id link0
8828    setlink $id link0
8829    set info $commitinfo($id)
8830    $ctext insert end "\n\t[lindex $info 0]\n"
8831    $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8832    set date [formatdate [lindex $info 2]]
8833    $ctext insert end "\t[mc "Date"]:\t$date\n"
8834    set kids $children($curview,$id)
8835    if {$kids ne {}} {
8836        $ctext insert end "\n[mc "Children"]:"
8837        set i 0
8838        foreach child $kids {
8839            incr i
8840            if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8841            set info $commitinfo($child)
8842            $ctext insert end "\n\t"
8843            $ctext insert end $child link$i
8844            setlink $child link$i
8845            $ctext insert end "\n\t[lindex $info 0]"
8846            $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8847            set date [formatdate [lindex $info 2]]
8848            $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8849        }
8850    }
8851    maybe_scroll_ctext 1
8852    $ctext conf -state disabled
8853    init_flist {}
8854}
8855
8856proc normalline {} {
8857    global thickerline
8858    if {[info exists thickerline]} {
8859        set id $thickerline
8860        unset thickerline
8861        drawlines $id
8862    }
8863}
8864
8865proc selbyid {id {isnew 1}} {
8866    global curview
8867    if {[commitinview $id $curview]} {
8868        selectline [rowofcommit $id] $isnew
8869    }
8870}
8871
8872proc mstime {} {
8873    global startmstime
8874    if {![info exists startmstime]} {
8875        set startmstime [clock clicks -milliseconds]
8876    }
8877    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8878}
8879
8880proc rowmenu {x y id} {
8881    global rowctxmenu selectedline rowmenuid curview
8882    global nullid nullid2 fakerowmenu mainhead markedid
8883
8884    stopfinding
8885    set rowmenuid $id
8886    if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8887        set state disabled
8888    } else {
8889        set state normal
8890    }
8891    if {[info exists markedid] && $markedid ne $id} {
8892        set mstate normal
8893    } else {
8894        set mstate disabled
8895    }
8896    if {$id ne $nullid && $id ne $nullid2} {
8897        set menu $rowctxmenu
8898        if {$mainhead ne {}} {
8899            $menu entryconfigure 8 -label [mc "Reset %s branch to here" $mainhead] -state normal
8900        } else {
8901            $menu entryconfigure 8 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8902        }
8903        $menu entryconfigure 10 -state $mstate
8904        $menu entryconfigure 11 -state $mstate
8905        $menu entryconfigure 12 -state $mstate
8906    } else {
8907        set menu $fakerowmenu
8908    }
8909    $menu entryconfigure [mca "Diff this -> selected"] -state $state
8910    $menu entryconfigure [mca "Diff selected -> this"] -state $state
8911    $menu entryconfigure [mca "Make patch"] -state $state
8912    $menu entryconfigure [mca "Diff this -> marked commit"] -state $mstate
8913    $menu entryconfigure [mca "Diff marked commit -> this"] -state $mstate
8914    tk_popup $menu $x $y
8915}
8916
8917proc markhere {} {
8918    global rowmenuid markedid canv
8919
8920    set markedid $rowmenuid
8921    make_idmark $markedid
8922}
8923
8924proc gotomark {} {
8925    global markedid
8926
8927    if {[info exists markedid]} {
8928        selbyid $markedid
8929    }
8930}
8931
8932proc replace_by_kids {l r} {
8933    global curview children
8934
8935    set id [commitonrow $r]
8936    set l [lreplace $l 0 0]
8937    foreach kid $children($curview,$id) {
8938        lappend l [rowofcommit $kid]
8939    }
8940    return [lsort -integer -decreasing -unique $l]
8941}
8942
8943proc find_common_desc {} {
8944    global markedid rowmenuid curview children
8945
8946    if {![info exists markedid]} return
8947    if {![commitinview $markedid $curview] ||
8948        ![commitinview $rowmenuid $curview]} return
8949    #set t1 [clock clicks -milliseconds]
8950    set l1 [list [rowofcommit $markedid]]
8951    set l2 [list [rowofcommit $rowmenuid]]
8952    while 1 {
8953        set r1 [lindex $l1 0]
8954        set r2 [lindex $l2 0]
8955        if {$r1 eq {} || $r2 eq {}} break
8956        if {$r1 == $r2} {
8957            selectline $r1 1
8958            break
8959        }
8960        if {$r1 > $r2} {
8961            set l1 [replace_by_kids $l1 $r1]
8962        } else {
8963            set l2 [replace_by_kids $l2 $r2]
8964        }
8965    }
8966    #set t2 [clock clicks -milliseconds]
8967    #puts "took [expr {$t2-$t1}]ms"
8968}
8969
8970proc compare_commits {} {
8971    global markedid rowmenuid curview children
8972
8973    if {![info exists markedid]} return
8974    if {![commitinview $markedid $curview]} return
8975    addtohistory [list do_cmp_commits $markedid $rowmenuid]
8976    do_cmp_commits $markedid $rowmenuid
8977}
8978
8979proc getpatchid {id} {
8980    global patchids
8981
8982    if {![info exists patchids($id)]} {
8983        set cmd [diffcmd [list $id] {-p --root}]
8984        # trim off the initial "|"
8985        set cmd [lrange $cmd 1 end]
8986        if {[catch {
8987            set x [eval exec $cmd | git patch-id]
8988            set patchids($id) [lindex $x 0]
8989        }]} {
8990            set patchids($id) "error"
8991        }
8992    }
8993    return $patchids($id)
8994}
8995
8996proc do_cmp_commits {a b} {
8997    global ctext curview parents children patchids commitinfo
8998
8999    $ctext conf -state normal
9000    clear_ctext
9001    init_flist {}
9002    for {set i 0} {$i < 100} {incr i} {
9003        set skipa 0
9004        set skipb 0
9005        if {[llength $parents($curview,$a)] > 1} {
9006            appendshortlink $a [mc "Skipping merge commit "] "\n"
9007            set skipa 1
9008        } else {
9009            set patcha [getpatchid $a]
9010        }
9011        if {[llength $parents($curview,$b)] > 1} {
9012            appendshortlink $b [mc "Skipping merge commit "] "\n"
9013            set skipb 1
9014        } else {
9015            set patchb [getpatchid $b]
9016        }
9017        if {!$skipa && !$skipb} {
9018            set heada [lindex $commitinfo($a) 0]
9019            set headb [lindex $commitinfo($b) 0]
9020            if {$patcha eq "error"} {
9021                appendshortlink $a [mc "Error getting patch ID for "] \
9022                    [mc " - stopping\n"]
9023                break
9024            }
9025            if {$patchb eq "error"} {
9026                appendshortlink $b [mc "Error getting patch ID for "] \
9027                    [mc " - stopping\n"]
9028                break
9029            }
9030            if {$patcha eq $patchb} {
9031                if {$heada eq $headb} {
9032                    appendshortlink $a [mc "Commit "]
9033                    appendshortlink $b " == " "  $heada\n"
9034                } else {
9035                    appendshortlink $a [mc "Commit "] "  $heada\n"
9036                    appendshortlink $b [mc " is the same patch as\n       "] \
9037                        "  $headb\n"
9038                }
9039                set skipa 1
9040                set skipb 1
9041            } else {
9042                $ctext insert end "\n"
9043                appendshortlink $a [mc "Commit "] "  $heada\n"
9044                appendshortlink $b [mc " differs from\n       "] \
9045                    "  $headb\n"
9046                $ctext insert end [mc "Diff of commits:\n\n"]
9047                $ctext conf -state disabled
9048                update
9049                diffcommits $a $b
9050                return
9051            }
9052        }
9053        if {$skipa} {
9054            set kids [real_children $curview,$a]
9055            if {[llength $kids] != 1} {
9056                $ctext insert end "\n"
9057                appendshortlink $a [mc "Commit "] \
9058                    [mc " has %s children - stopping\n" [llength $kids]]
9059                break
9060            }
9061            set a [lindex $kids 0]
9062        }
9063        if {$skipb} {
9064            set kids [real_children $curview,$b]
9065            if {[llength $kids] != 1} {
9066                appendshortlink $b [mc "Commit "] \
9067                    [mc " has %s children - stopping\n" [llength $kids]]
9068                break
9069            }
9070            set b [lindex $kids 0]
9071        }
9072    }
9073    $ctext conf -state disabled
9074}
9075
9076proc diffcommits {a b} {
9077    global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
9078
9079    set tmpdir [gitknewtmpdir]
9080    set fna [file join $tmpdir "commit-[string range $a 0 7]"]
9081    set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
9082    if {[catch {
9083        exec git diff-tree -p --pretty $a >$fna
9084        exec git diff-tree -p --pretty $b >$fnb
9085    } err]} {
9086        error_popup [mc "Error writing commit to file: %s" $err]
9087        return
9088    }
9089    if {[catch {
9090        set fd [open "| diff -U$diffcontext $fna $fnb" r]
9091    } err]} {
9092        error_popup [mc "Error diffing commits: %s" $err]
9093        return
9094    }
9095    set diffids [list commits $a $b]
9096    set blobdifffd($diffids) $fd
9097    set diffinhdr 0
9098    set currdiffsubmod ""
9099    filerun $fd [list getblobdiffline $fd $diffids]
9100}
9101
9102proc diffvssel {dirn} {
9103    global rowmenuid selectedline
9104
9105    if {$selectedline eq {}} return
9106    if {$dirn} {
9107        set oldid [commitonrow $selectedline]
9108        set newid $rowmenuid
9109    } else {
9110        set oldid $rowmenuid
9111        set newid [commitonrow $selectedline]
9112    }
9113    addtohistory [list doseldiff $oldid $newid] savectextpos
9114    doseldiff $oldid $newid
9115}
9116
9117proc diffvsmark {dirn} {
9118    global rowmenuid markedid
9119
9120    if {![info exists markedid]} return
9121    if {$dirn} {
9122        set oldid $markedid
9123        set newid $rowmenuid
9124    } else {
9125        set oldid $rowmenuid
9126        set newid $markedid
9127    }
9128    addtohistory [list doseldiff $oldid $newid] savectextpos
9129    doseldiff $oldid $newid
9130}
9131
9132proc doseldiff {oldid newid} {
9133    global ctext
9134    global commitinfo
9135
9136    $ctext conf -state normal
9137    clear_ctext
9138    init_flist [mc "Top"]
9139    $ctext insert end "[mc "From"] "
9140    $ctext insert end $oldid link0
9141    setlink $oldid link0
9142    $ctext insert end "\n     "
9143    $ctext insert end [lindex $commitinfo($oldid) 0]
9144    $ctext insert end "\n\n[mc "To"]   "
9145    $ctext insert end $newid link1
9146    setlink $newid link1
9147    $ctext insert end "\n     "
9148    $ctext insert end [lindex $commitinfo($newid) 0]
9149    $ctext insert end "\n"
9150    $ctext conf -state disabled
9151    $ctext tag remove found 1.0 end
9152    startdiff [list $oldid $newid]
9153}
9154
9155proc mkpatch {} {
9156    global rowmenuid currentid commitinfo patchtop patchnum NS
9157
9158    if {![info exists currentid]} return
9159    set oldid $currentid
9160    set oldhead [lindex $commitinfo($oldid) 0]
9161    set newid $rowmenuid
9162    set newhead [lindex $commitinfo($newid) 0]
9163    set top .patch
9164    set patchtop $top
9165    catch {destroy $top}
9166    ttk_toplevel $top
9167    make_transient $top .
9168    ${NS}::label $top.title -text [mc "Generate patch"]
9169    grid $top.title - -pady 10
9170    ${NS}::label $top.from -text [mc "From:"]
9171    ${NS}::entry $top.fromsha1 -width 40
9172    $top.fromsha1 insert 0 $oldid
9173    $top.fromsha1 conf -state readonly
9174    grid $top.from $top.fromsha1 -sticky w
9175    ${NS}::entry $top.fromhead -width 60
9176    $top.fromhead insert 0 $oldhead
9177    $top.fromhead conf -state readonly
9178    grid x $top.fromhead -sticky w
9179    ${NS}::label $top.to -text [mc "To:"]
9180    ${NS}::entry $top.tosha1 -width 40
9181    $top.tosha1 insert 0 $newid
9182    $top.tosha1 conf -state readonly
9183    grid $top.to $top.tosha1 -sticky w
9184    ${NS}::entry $top.tohead -width 60
9185    $top.tohead insert 0 $newhead
9186    $top.tohead conf -state readonly
9187    grid x $top.tohead -sticky w
9188    ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
9189    grid $top.rev x -pady 10 -padx 5
9190    ${NS}::label $top.flab -text [mc "Output file:"]
9191    ${NS}::entry $top.fname -width 60
9192    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
9193    incr patchnum
9194    grid $top.flab $top.fname -sticky w
9195    ${NS}::frame $top.buts
9196    ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
9197    ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
9198    bind $top <Key-Return> mkpatchgo
9199    bind $top <Key-Escape> mkpatchcan
9200    grid $top.buts.gen $top.buts.can
9201    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9202    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9203    grid $top.buts - -pady 10 -sticky ew
9204    focus $top.fname
9205}
9206
9207proc mkpatchrev {} {
9208    global patchtop
9209
9210    set oldid [$patchtop.fromsha1 get]
9211    set oldhead [$patchtop.fromhead get]
9212    set newid [$patchtop.tosha1 get]
9213    set newhead [$patchtop.tohead get]
9214    foreach e [list fromsha1 fromhead tosha1 tohead] \
9215            v [list $newid $newhead $oldid $oldhead] {
9216        $patchtop.$e conf -state normal
9217        $patchtop.$e delete 0 end
9218        $patchtop.$e insert 0 $v
9219        $patchtop.$e conf -state readonly
9220    }
9221}
9222
9223proc mkpatchgo {} {
9224    global patchtop nullid nullid2
9225
9226    set oldid [$patchtop.fromsha1 get]
9227    set newid [$patchtop.tosha1 get]
9228    set fname [$patchtop.fname get]
9229    set cmd [diffcmd [list $oldid $newid] -p]
9230    # trim off the initial "|"
9231    set cmd [lrange $cmd 1 end]
9232    lappend cmd >$fname &
9233    if {[catch {eval exec $cmd} err]} {
9234        error_popup "[mc "Error creating patch:"] $err" $patchtop
9235    }
9236    catch {destroy $patchtop}
9237    unset patchtop
9238}
9239
9240proc mkpatchcan {} {
9241    global patchtop
9242
9243    catch {destroy $patchtop}
9244    unset patchtop
9245}
9246
9247proc mktag {} {
9248    global rowmenuid mktagtop commitinfo NS
9249
9250    set top .maketag
9251    set mktagtop $top
9252    catch {destroy $top}
9253    ttk_toplevel $top
9254    make_transient $top .
9255    ${NS}::label $top.title -text [mc "Create tag"]
9256    grid $top.title - -pady 10
9257    ${NS}::label $top.id -text [mc "ID:"]
9258    ${NS}::entry $top.sha1 -width 40
9259    $top.sha1 insert 0 $rowmenuid
9260    $top.sha1 conf -state readonly
9261    grid $top.id $top.sha1 -sticky w
9262    ${NS}::entry $top.head -width 60
9263    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9264    $top.head conf -state readonly
9265    grid x $top.head -sticky w
9266    ${NS}::label $top.tlab -text [mc "Tag name:"]
9267    ${NS}::entry $top.tag -width 60
9268    grid $top.tlab $top.tag -sticky w
9269    ${NS}::label $top.op -text [mc "Tag message is optional"]
9270    grid $top.op -columnspan 2 -sticky we
9271    ${NS}::label $top.mlab -text [mc "Tag message:"]
9272    ${NS}::entry $top.msg -width 60
9273    grid $top.mlab $top.msg -sticky w
9274    ${NS}::frame $top.buts
9275    ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
9276    ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
9277    bind $top <Key-Return> mktaggo
9278    bind $top <Key-Escape> mktagcan
9279    grid $top.buts.gen $top.buts.can
9280    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9281    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9282    grid $top.buts - -pady 10 -sticky ew
9283    focus $top.tag
9284}
9285
9286proc domktag {} {
9287    global mktagtop env tagids idtags
9288
9289    set id [$mktagtop.sha1 get]
9290    set tag [$mktagtop.tag get]
9291    set msg [$mktagtop.msg get]
9292    if {$tag == {}} {
9293        error_popup [mc "No tag name specified"] $mktagtop
9294        return 0
9295    }
9296    if {[info exists tagids($tag)]} {
9297        error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
9298        return 0
9299    }
9300    if {[catch {
9301        if {$msg != {}} {
9302            exec git tag -a -m $msg $tag $id
9303        } else {
9304            exec git tag $tag $id
9305        }
9306    } err]} {
9307        error_popup "[mc "Error creating tag:"] $err" $mktagtop
9308        return 0
9309    }
9310
9311    set tagids($tag) $id
9312    lappend idtags($id) $tag
9313    redrawtags $id
9314    addedtag $id
9315    dispneartags 0
9316    run refill_reflist
9317    return 1
9318}
9319
9320proc redrawtags {id} {
9321    global canv linehtag idpos currentid curview cmitlisted markedid
9322    global canvxmax iddrawn circleitem mainheadid circlecolors
9323    global mainheadcirclecolor
9324
9325    if {![commitinview $id $curview]} return
9326    if {![info exists iddrawn($id)]} return
9327    set row [rowofcommit $id]
9328    if {$id eq $mainheadid} {
9329        set ofill $mainheadcirclecolor
9330    } else {
9331        set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
9332    }
9333    $canv itemconf $circleitem($row) -fill $ofill
9334    $canv delete tag.$id
9335    set xt [eval drawtags $id $idpos($id)]
9336    $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
9337    set text [$canv itemcget $linehtag($id) -text]
9338    set font [$canv itemcget $linehtag($id) -font]
9339    set xr [expr {$xt + [font measure $font $text]}]
9340    if {$xr > $canvxmax} {
9341        set canvxmax $xr
9342        setcanvscroll
9343    }
9344    if {[info exists currentid] && $currentid == $id} {
9345        make_secsel $id
9346    }
9347    if {[info exists markedid] && $markedid eq $id} {
9348        make_idmark $id
9349    }
9350}
9351
9352proc mktagcan {} {
9353    global mktagtop
9354
9355    catch {destroy $mktagtop}
9356    unset mktagtop
9357}
9358
9359proc mktaggo {} {
9360    if {![domktag]} return
9361    mktagcan
9362}
9363
9364proc copysummary {} {
9365    global rowmenuid autosellen
9366
9367    set format "%h (\"%s\", %ad)"
9368    set cmd [list git show -s --pretty=format:$format --date=short]
9369    if {$autosellen < 40} {
9370        lappend cmd --abbrev=$autosellen
9371    }
9372    set summary [eval exec $cmd $rowmenuid]
9373
9374    clipboard clear
9375    clipboard append $summary
9376}
9377
9378proc writecommit {} {
9379    global rowmenuid wrcomtop commitinfo wrcomcmd NS
9380
9381    set top .writecommit
9382    set wrcomtop $top
9383    catch {destroy $top}
9384    ttk_toplevel $top
9385    make_transient $top .
9386    ${NS}::label $top.title -text [mc "Write commit to file"]
9387    grid $top.title - -pady 10
9388    ${NS}::label $top.id -text [mc "ID:"]
9389    ${NS}::entry $top.sha1 -width 40
9390    $top.sha1 insert 0 $rowmenuid
9391    $top.sha1 conf -state readonly
9392    grid $top.id $top.sha1 -sticky w
9393    ${NS}::entry $top.head -width 60
9394    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9395    $top.head conf -state readonly
9396    grid x $top.head -sticky w
9397    ${NS}::label $top.clab -text [mc "Command:"]
9398    ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
9399    grid $top.clab $top.cmd -sticky w -pady 10
9400    ${NS}::label $top.flab -text [mc "Output file:"]
9401    ${NS}::entry $top.fname -width 60
9402    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
9403    grid $top.flab $top.fname -sticky w
9404    ${NS}::frame $top.buts
9405    ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
9406    ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
9407    bind $top <Key-Return> wrcomgo
9408    bind $top <Key-Escape> wrcomcan
9409    grid $top.buts.gen $top.buts.can
9410    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9411    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9412    grid $top.buts - -pady 10 -sticky ew
9413    focus $top.fname
9414}
9415
9416proc wrcomgo {} {
9417    global wrcomtop
9418
9419    set id [$wrcomtop.sha1 get]
9420    set cmd "echo $id | [$wrcomtop.cmd get]"
9421    set fname [$wrcomtop.fname get]
9422    if {[catch {exec sh -c $cmd >$fname &} err]} {
9423        error_popup "[mc "Error writing commit:"] $err" $wrcomtop
9424    }
9425    catch {destroy $wrcomtop}
9426    unset wrcomtop
9427}
9428
9429proc wrcomcan {} {
9430    global wrcomtop
9431
9432    catch {destroy $wrcomtop}
9433    unset wrcomtop
9434}
9435
9436proc mkbranch {} {
9437    global rowmenuid mkbrtop NS
9438
9439    set top .makebranch
9440    catch {destroy $top}
9441    ttk_toplevel $top
9442    make_transient $top .
9443    ${NS}::label $top.title -text [mc "Create new branch"]
9444    grid $top.title - -pady 10
9445    ${NS}::label $top.id -text [mc "ID:"]
9446    ${NS}::entry $top.sha1 -width 40
9447    $top.sha1 insert 0 $rowmenuid
9448    $top.sha1 conf -state readonly
9449    grid $top.id $top.sha1 -sticky w
9450    ${NS}::label $top.nlab -text [mc "Name:"]
9451    ${NS}::entry $top.name -width 40
9452    grid $top.nlab $top.name -sticky w
9453    ${NS}::frame $top.buts
9454    ${NS}::button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
9455    ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
9456    bind $top <Key-Return> [list mkbrgo $top]
9457    bind $top <Key-Escape> "catch {destroy $top}"
9458    grid $top.buts.go $top.buts.can
9459    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9460    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9461    grid $top.buts - -pady 10 -sticky ew
9462    focus $top.name
9463}
9464
9465proc mkbrgo {top} {
9466    global headids idheads
9467
9468    set name [$top.name get]
9469    set id [$top.sha1 get]
9470    set cmdargs {}
9471    set old_id {}
9472    if {$name eq {}} {
9473        error_popup [mc "Please specify a name for the new branch"] $top
9474        return
9475    }
9476    if {[info exists headids($name)]} {
9477        if {![confirm_popup [mc \
9478                "Branch '%s' already exists. Overwrite?" $name] $top]} {
9479            return
9480        }
9481        set old_id $headids($name)
9482        lappend cmdargs -f
9483    }
9484    catch {destroy $top}
9485    lappend cmdargs $name $id
9486    nowbusy newbranch
9487    update
9488    if {[catch {
9489        eval exec git branch $cmdargs
9490    } err]} {
9491        notbusy newbranch
9492        error_popup $err
9493    } else {
9494        notbusy newbranch
9495        if {$old_id ne {}} {
9496            movehead $id $name
9497            movedhead $id $name
9498            redrawtags $old_id
9499            redrawtags $id
9500        } else {
9501            set headids($name) $id
9502            lappend idheads($id) $name
9503            addedhead $id $name
9504            redrawtags $id
9505        }
9506        dispneartags 0
9507        run refill_reflist
9508    }
9509}
9510
9511proc exec_citool {tool_args {baseid {}}} {
9512    global commitinfo env
9513
9514    set save_env [array get env GIT_AUTHOR_*]
9515
9516    if {$baseid ne {}} {
9517        if {![info exists commitinfo($baseid)]} {
9518            getcommit $baseid
9519        }
9520        set author [lindex $commitinfo($baseid) 1]
9521        set date [lindex $commitinfo($baseid) 2]
9522        if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9523                    $author author name email]
9524            && $date ne {}} {
9525            set env(GIT_AUTHOR_NAME) $name
9526            set env(GIT_AUTHOR_EMAIL) $email
9527            set env(GIT_AUTHOR_DATE) $date
9528        }
9529    }
9530
9531    eval exec git citool $tool_args &
9532
9533    array unset env GIT_AUTHOR_*
9534    array set env $save_env
9535}
9536
9537proc cherrypick {} {
9538    global rowmenuid curview
9539    global mainhead mainheadid
9540    global gitdir
9541
9542    set oldhead [exec git rev-parse HEAD]
9543    set dheads [descheads $rowmenuid]
9544    if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
9545        set ok [confirm_popup [mc "Commit %s is already\
9546                included in branch %s -- really re-apply it?" \
9547                                   [string range $rowmenuid 0 7] $mainhead]]
9548        if {!$ok} return
9549    }
9550    nowbusy cherrypick [mc "Cherry-picking"]
9551    update
9552    # Unfortunately git-cherry-pick writes stuff to stderr even when
9553    # no error occurs, and exec takes that as an indication of error...
9554    if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9555        notbusy cherrypick
9556        if {[regexp -line \
9557                 {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9558                 $err msg fname]} {
9559            error_popup [mc "Cherry-pick failed because of local changes\
9560                        to file '%s'.\nPlease commit, reset or stash\
9561                        your changes and try again." $fname]
9562        } elseif {[regexp -line \
9563                       {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
9564                       $err]} {
9565            if {[confirm_popup [mc "Cherry-pick failed because of merge\
9566                        conflict.\nDo you wish to run git citool to\
9567                        resolve it?"]]} {
9568                # Force citool to read MERGE_MSG
9569                file delete [file join $gitdir "GITGUI_MSG"]
9570                exec_citool {} $rowmenuid
9571            }
9572        } else {
9573            error_popup $err
9574        }
9575        run updatecommits
9576        return
9577    }
9578    set newhead [exec git rev-parse HEAD]
9579    if {$newhead eq $oldhead} {
9580        notbusy cherrypick
9581        error_popup [mc "No changes committed"]
9582        return
9583    }
9584    addnewchild $newhead $oldhead
9585    if {[commitinview $oldhead $curview]} {
9586        # XXX this isn't right if we have a path limit...
9587        insertrow $newhead $oldhead $curview
9588        if {$mainhead ne {}} {
9589            movehead $newhead $mainhead
9590            movedhead $newhead $mainhead
9591        }
9592        set mainheadid $newhead
9593        redrawtags $oldhead
9594        redrawtags $newhead
9595        selbyid $newhead
9596    }
9597    notbusy cherrypick
9598}
9599
9600proc revert {} {
9601    global rowmenuid curview
9602    global mainhead mainheadid
9603    global gitdir
9604
9605    set oldhead [exec git rev-parse HEAD]
9606    set dheads [descheads $rowmenuid]
9607    if { $dheads eq {} || [lsearch -exact $dheads $oldhead] == -1 } {
9608       set ok [confirm_popup [mc "Commit %s is not\
9609           included in branch %s -- really revert it?" \
9610                      [string range $rowmenuid 0 7] $mainhead]]
9611       if {!$ok} return
9612    }
9613    nowbusy revert [mc "Reverting"]
9614    update
9615
9616    if [catch {exec git revert --no-edit $rowmenuid} err] {
9617        notbusy revert
9618        if [regexp {files would be overwritten by merge:(\n(( |\t)+[^\n]+\n)+)}\
9619                $err match files] {
9620            regsub {\n( |\t)+} $files "\n" files
9621            error_popup [mc "Revert failed because of local changes to\
9622                the following files:%s Please commit, reset or stash \
9623                your changes and try again." $files]
9624        } elseif [regexp {error: could not revert} $err] {
9625            if [confirm_popup [mc "Revert failed because of merge conflict.\n\
9626                Do you wish to run git citool to resolve it?"]] {
9627                # Force citool to read MERGE_MSG
9628                file delete [file join $gitdir "GITGUI_MSG"]
9629                exec_citool {} $rowmenuid
9630            }
9631        } else { error_popup $err }
9632        run updatecommits
9633        return
9634    }
9635
9636    set newhead [exec git rev-parse HEAD]
9637    if { $newhead eq $oldhead } {
9638        notbusy revert
9639        error_popup [mc "No changes committed"]
9640        return
9641    }
9642
9643    addnewchild $newhead $oldhead
9644
9645    if [commitinview $oldhead $curview] {
9646        # XXX this isn't right if we have a path limit...
9647        insertrow $newhead $oldhead $curview
9648        if {$mainhead ne {}} {
9649            movehead $newhead $mainhead
9650            movedhead $newhead $mainhead
9651        }
9652        set mainheadid $newhead
9653        redrawtags $oldhead
9654        redrawtags $newhead
9655        selbyid $newhead
9656    }
9657
9658    notbusy revert
9659}
9660
9661proc resethead {} {
9662    global mainhead rowmenuid confirm_ok resettype NS
9663
9664    set confirm_ok 0
9665    set w ".confirmreset"
9666    ttk_toplevel $w
9667    make_transient $w .
9668    wm title $w [mc "Confirm reset"]
9669    ${NS}::label $w.m -text \
9670        [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
9671    pack $w.m -side top -fill x -padx 20 -pady 20
9672    ${NS}::labelframe $w.f -text [mc "Reset type:"]
9673    set resettype mixed
9674    ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
9675        -text [mc "Soft: Leave working tree and index untouched"]
9676    grid $w.f.soft -sticky w
9677    ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
9678        -text [mc "Mixed: Leave working tree untouched, reset index"]
9679    grid $w.f.mixed -sticky w
9680    ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
9681        -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
9682    grid $w.f.hard -sticky w
9683    pack $w.f -side top -fill x -padx 4
9684    ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
9685    pack $w.ok -side left -fill x -padx 20 -pady 20
9686    ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
9687    bind $w <Key-Escape> [list destroy $w]
9688    pack $w.cancel -side right -fill x -padx 20 -pady 20
9689    bind $w <Visibility> "grab $w; focus $w"
9690    tkwait window $w
9691    if {!$confirm_ok} return
9692    if {[catch {set fd [open \
9693            [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
9694        error_popup $err
9695    } else {
9696        dohidelocalchanges
9697        filerun $fd [list readresetstat $fd]
9698        nowbusy reset [mc "Resetting"]
9699        selbyid $rowmenuid
9700    }
9701}
9702
9703proc readresetstat {fd} {
9704    global mainhead mainheadid showlocalchanges rprogcoord
9705
9706    if {[gets $fd line] >= 0} {
9707        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9708            set rprogcoord [expr {1.0 * $m / $n}]
9709            adjustprogress
9710        }
9711        return 1
9712    }
9713    set rprogcoord 0
9714    adjustprogress
9715    notbusy reset
9716    if {[catch {close $fd} err]} {
9717        error_popup $err
9718    }
9719    set oldhead $mainheadid
9720    set newhead [exec git rev-parse HEAD]
9721    if {$newhead ne $oldhead} {
9722        movehead $newhead $mainhead
9723        movedhead $newhead $mainhead
9724        set mainheadid $newhead
9725        redrawtags $oldhead
9726        redrawtags $newhead
9727    }
9728    if {$showlocalchanges} {
9729        doshowlocalchanges
9730    }
9731    return 0
9732}
9733
9734# context menu for a head
9735proc headmenu {x y id head} {
9736    global headmenuid headmenuhead headctxmenu mainhead
9737
9738    stopfinding
9739    set headmenuid $id
9740    set headmenuhead $head
9741    set state normal
9742    if {[string match "remotes/*" $head]} {
9743        set state disabled
9744    }
9745    if {$head eq $mainhead} {
9746        set state disabled
9747    }
9748    $headctxmenu entryconfigure 0 -state $state
9749    $headctxmenu entryconfigure 1 -state $state
9750    tk_popup $headctxmenu $x $y
9751}
9752
9753proc cobranch {} {
9754    global headmenuid headmenuhead headids
9755    global showlocalchanges
9756
9757    # check the tree is clean first??
9758    nowbusy checkout [mc "Checking out"]
9759    update
9760    dohidelocalchanges
9761    if {[catch {
9762        set fd [open [list | git checkout $headmenuhead 2>@1] r]
9763    } err]} {
9764        notbusy checkout
9765        error_popup $err
9766        if {$showlocalchanges} {
9767            dodiffindex
9768        }
9769    } else {
9770        filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
9771    }
9772}
9773
9774proc readcheckoutstat {fd newhead newheadid} {
9775    global mainhead mainheadid headids showlocalchanges progresscoords
9776    global viewmainheadid curview
9777
9778    if {[gets $fd line] >= 0} {
9779        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9780            set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9781            adjustprogress
9782        }
9783        return 1
9784    }
9785    set progresscoords {0 0}
9786    adjustprogress
9787    notbusy checkout
9788    if {[catch {close $fd} err]} {
9789        error_popup $err
9790    }
9791    set oldmainid $mainheadid
9792    set mainhead $newhead
9793    set mainheadid $newheadid
9794    set viewmainheadid($curview) $newheadid
9795    redrawtags $oldmainid
9796    redrawtags $newheadid
9797    selbyid $newheadid
9798    if {$showlocalchanges} {
9799        dodiffindex
9800    }
9801}
9802
9803proc rmbranch {} {
9804    global headmenuid headmenuhead mainhead
9805    global idheads
9806
9807    set head $headmenuhead
9808    set id $headmenuid
9809    # this check shouldn't be needed any more...
9810    if {$head eq $mainhead} {
9811        error_popup [mc "Cannot delete the currently checked-out branch"]
9812        return
9813    }
9814    set dheads [descheads $id]
9815    if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
9816        # the stuff on this branch isn't on any other branch
9817        if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9818                        branch.\nReally delete branch %s?" $head $head]]} return
9819    }
9820    nowbusy rmbranch
9821    update
9822    if {[catch {exec git branch -D $head} err]} {
9823        notbusy rmbranch
9824        error_popup $err
9825        return
9826    }
9827    removehead $id $head
9828    removedhead $id $head
9829    redrawtags $id
9830    notbusy rmbranch
9831    dispneartags 0
9832    run refill_reflist
9833}
9834
9835# Display a list of tags and heads
9836proc showrefs {} {
9837    global showrefstop bgcolor fgcolor selectbgcolor NS
9838    global bglist fglist reflistfilter reflist maincursor
9839
9840    set top .showrefs
9841    set showrefstop $top
9842    if {[winfo exists $top]} {
9843        raise $top
9844        refill_reflist
9845        return
9846    }
9847    ttk_toplevel $top
9848    wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
9849    make_transient $top .
9850    text $top.list -background $bgcolor -foreground $fgcolor \
9851        -selectbackground $selectbgcolor -font mainfont \
9852        -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
9853        -width 30 -height 20 -cursor $maincursor \
9854        -spacing1 1 -spacing3 1 -state disabled
9855    $top.list tag configure highlight -background $selectbgcolor
9856    if {![lsearch -exact $bglist $top.list]} {
9857        lappend bglist $top.list
9858        lappend fglist $top.list
9859    }
9860    ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
9861    ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
9862    grid $top.list $top.ysb -sticky nsew
9863    grid $top.xsb x -sticky ew
9864    ${NS}::frame $top.f
9865    ${NS}::label $top.f.l -text "[mc "Filter"]: "
9866    ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
9867    set reflistfilter "*"
9868    trace add variable reflistfilter write reflistfilter_change
9869    pack $top.f.e -side right -fill x -expand 1
9870    pack $top.f.l -side left
9871    grid $top.f - -sticky ew -pady 2
9872    ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
9873    bind $top <Key-Escape> [list destroy $top]
9874    grid $top.close -
9875    grid columnconfigure $top 0 -weight 1
9876    grid rowconfigure $top 0 -weight 1
9877    bind $top.list <1> {break}
9878    bind $top.list <B1-Motion> {break}
9879    bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
9880    set reflist {}
9881    refill_reflist
9882}
9883
9884proc sel_reflist {w x y} {
9885    global showrefstop reflist headids tagids otherrefids
9886
9887    if {![winfo exists $showrefstop]} return
9888    set l [lindex [split [$w index "@$x,$y"] "."] 0]
9889    set ref [lindex $reflist [expr {$l-1}]]
9890    set n [lindex $ref 0]
9891    switch -- [lindex $ref 1] {
9892        "H" {selbyid $headids($n)}
9893        "T" {selbyid $tagids($n)}
9894        "o" {selbyid $otherrefids($n)}
9895    }
9896    $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
9897}
9898
9899proc unsel_reflist {} {
9900    global showrefstop
9901
9902    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9903    $showrefstop.list tag remove highlight 0.0 end
9904}
9905
9906proc reflistfilter_change {n1 n2 op} {
9907    global reflistfilter
9908
9909    after cancel refill_reflist
9910    after 200 refill_reflist
9911}
9912
9913proc refill_reflist {} {
9914    global reflist reflistfilter showrefstop headids tagids otherrefids
9915    global curview
9916
9917    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9918    set refs {}
9919    foreach n [array names headids] {
9920        if {[string match $reflistfilter $n]} {
9921            if {[commitinview $headids($n) $curview]} {
9922                lappend refs [list $n H]
9923            } else {
9924                interestedin $headids($n) {run refill_reflist}
9925            }
9926        }
9927    }
9928    foreach n [array names tagids] {
9929        if {[string match $reflistfilter $n]} {
9930            if {[commitinview $tagids($n) $curview]} {
9931                lappend refs [list $n T]
9932            } else {
9933                interestedin $tagids($n) {run refill_reflist}
9934            }
9935        }
9936    }
9937    foreach n [array names otherrefids] {
9938        if {[string match $reflistfilter $n]} {
9939            if {[commitinview $otherrefids($n) $curview]} {
9940                lappend refs [list $n o]
9941            } else {
9942                interestedin $otherrefids($n) {run refill_reflist}
9943            }
9944        }
9945    }
9946    set refs [lsort -index 0 $refs]
9947    if {$refs eq $reflist} return
9948
9949    # Update the contents of $showrefstop.list according to the
9950    # differences between $reflist (old) and $refs (new)
9951    $showrefstop.list conf -state normal
9952    $showrefstop.list insert end "\n"
9953    set i 0
9954    set j 0
9955    while {$i < [llength $reflist] || $j < [llength $refs]} {
9956        if {$i < [llength $reflist]} {
9957            if {$j < [llength $refs]} {
9958                set cmp [string compare [lindex $reflist $i 0] \
9959                             [lindex $refs $j 0]]
9960                if {$cmp == 0} {
9961                    set cmp [string compare [lindex $reflist $i 1] \
9962                                 [lindex $refs $j 1]]
9963                }
9964            } else {
9965                set cmp -1
9966            }
9967        } else {
9968            set cmp 1
9969        }
9970        switch -- $cmp {
9971            -1 {
9972                $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
9973                incr i
9974            }
9975            0 {
9976                incr i
9977                incr j
9978            }
9979            1 {
9980                set l [expr {$j + 1}]
9981                $showrefstop.list image create $l.0 -align baseline \
9982                    -image reficon-[lindex $refs $j 1] -padx 2
9983                $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
9984                incr j
9985            }
9986        }
9987    }
9988    set reflist $refs
9989    # delete last newline
9990    $showrefstop.list delete end-2c end-1c
9991    $showrefstop.list conf -state disabled
9992}
9993
9994# Stuff for finding nearby tags
9995proc getallcommits {} {
9996    global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
9997    global idheads idtags idotherrefs allparents tagobjid
9998    global gitdir
9999
10000    if {![info exists allcommits]} {
10001        set nextarc 0
10002        set allcommits 0
10003        set seeds {}
10004        set allcwait 0
10005        set cachedarcs 0
10006        set allccache [file join $gitdir "gitk.cache"]
10007        if {![catch {
10008            set f [open $allccache r]
10009            set allcwait 1
10010            getcache $f
10011        }]} return
10012    }
10013
10014    if {$allcwait} {
10015        return
10016    }
10017    set cmd [list | git rev-list --parents]
10018    set allcupdate [expr {$seeds ne {}}]
10019    if {!$allcupdate} {
10020        set ids "--all"
10021    } else {
10022        set refs [concat [array names idheads] [array names idtags] \
10023                      [array names idotherrefs]]
10024        set ids {}
10025        set tagobjs {}
10026        foreach name [array names tagobjid] {
10027            lappend tagobjs $tagobjid($name)
10028        }
10029        foreach id [lsort -unique $refs] {
10030            if {![info exists allparents($id)] &&
10031                [lsearch -exact $tagobjs $id] < 0} {
10032                lappend ids $id
10033            }
10034        }
10035        if {$ids ne {}} {
10036            foreach id $seeds {
10037                lappend ids "^$id"
10038            }
10039        }
10040    }
10041    if {$ids ne {}} {
10042        set fd [open [concat $cmd $ids] r]
10043        fconfigure $fd -blocking 0
10044        incr allcommits
10045        nowbusy allcommits
10046        filerun $fd [list getallclines $fd]
10047    } else {
10048        dispneartags 0
10049    }
10050}
10051
10052# Since most commits have 1 parent and 1 child, we group strings of
10053# such commits into "arcs" joining branch/merge points (BMPs), which
10054# are commits that either don't have 1 parent or don't have 1 child.
10055#
10056# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
10057# arcout(id) - outgoing arcs for BMP
10058# arcids(a) - list of IDs on arc including end but not start
10059# arcstart(a) - BMP ID at start of arc
10060# arcend(a) - BMP ID at end of arc
10061# growing(a) - arc a is still growing
10062# arctags(a) - IDs out of arcids (excluding end) that have tags
10063# archeads(a) - IDs out of arcids (excluding end) that have heads
10064# The start of an arc is at the descendent end, so "incoming" means
10065# coming from descendents, and "outgoing" means going towards ancestors.
10066
10067proc getallclines {fd} {
10068    global allparents allchildren idtags idheads nextarc
10069    global arcnos arcids arctags arcout arcend arcstart archeads growing
10070    global seeds allcommits cachedarcs allcupdate
10071
10072    set nid 0
10073    while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
10074        set id [lindex $line 0]
10075        if {[info exists allparents($id)]} {
10076            # seen it already
10077            continue
10078        }
10079        set cachedarcs 0
10080        set olds [lrange $line 1 end]
10081        set allparents($id) $olds
10082        if {![info exists allchildren($id)]} {
10083            set allchildren($id) {}
10084            set arcnos($id) {}
10085            lappend seeds $id
10086        } else {
10087            set a $arcnos($id)
10088            if {[llength $olds] == 1 && [llength $a] == 1} {
10089                lappend arcids($a) $id
10090                if {[info exists idtags($id)]} {
10091                    lappend arctags($a) $id
10092                }
10093                if {[info exists idheads($id)]} {
10094                    lappend archeads($a) $id
10095                }
10096                if {[info exists allparents($olds)]} {
10097                    # seen parent already
10098                    if {![info exists arcout($olds)]} {
10099                        splitarc $olds
10100                    }
10101                    lappend arcids($a) $olds
10102                    set arcend($a) $olds
10103                    unset growing($a)
10104                }
10105                lappend allchildren($olds) $id
10106                lappend arcnos($olds) $a
10107                continue
10108            }
10109        }
10110        foreach a $arcnos($id) {
10111            lappend arcids($a) $id
10112            set arcend($a) $id
10113            unset growing($a)
10114        }
10115
10116        set ao {}
10117        foreach p $olds {
10118            lappend allchildren($p) $id
10119            set a [incr nextarc]
10120            set arcstart($a) $id
10121            set archeads($a) {}
10122            set arctags($a) {}
10123            set archeads($a) {}
10124            set arcids($a) {}
10125            lappend ao $a
10126            set growing($a) 1
10127            if {[info exists allparents($p)]} {
10128                # seen it already, may need to make a new branch
10129                if {![info exists arcout($p)]} {
10130                    splitarc $p
10131                }
10132                lappend arcids($a) $p
10133                set arcend($a) $p
10134                unset growing($a)
10135            }
10136            lappend arcnos($p) $a
10137        }
10138        set arcout($id) $ao
10139    }
10140    if {$nid > 0} {
10141        global cached_dheads cached_dtags cached_atags
10142        unset -nocomplain cached_dheads
10143        unset -nocomplain cached_dtags
10144        unset -nocomplain cached_atags
10145    }
10146    if {![eof $fd]} {
10147        return [expr {$nid >= 1000? 2: 1}]
10148    }
10149    set cacheok 1
10150    if {[catch {
10151        fconfigure $fd -blocking 1
10152        close $fd
10153    } err]} {
10154        # got an error reading the list of commits
10155        # if we were updating, try rereading the whole thing again
10156        if {$allcupdate} {
10157            incr allcommits -1
10158            dropcache $err
10159            return
10160        }
10161        error_popup "[mc "Error reading commit topology information;\
10162                branch and preceding/following tag information\
10163                will be incomplete."]\n($err)"
10164        set cacheok 0
10165    }
10166    if {[incr allcommits -1] == 0} {
10167        notbusy allcommits
10168        if {$cacheok} {
10169            run savecache
10170        }
10171    }
10172    dispneartags 0
10173    return 0
10174}
10175
10176proc recalcarc {a} {
10177    global arctags archeads arcids idtags idheads
10178
10179    set at {}
10180    set ah {}
10181    foreach id [lrange $arcids($a) 0 end-1] {
10182        if {[info exists idtags($id)]} {
10183            lappend at $id
10184        }
10185        if {[info exists idheads($id)]} {
10186            lappend ah $id
10187        }
10188    }
10189    set arctags($a) $at
10190    set archeads($a) $ah
10191}
10192
10193proc splitarc {p} {
10194    global arcnos arcids nextarc arctags archeads idtags idheads
10195    global arcstart arcend arcout allparents growing
10196
10197    set a $arcnos($p)
10198    if {[llength $a] != 1} {
10199        puts "oops splitarc called but [llength $a] arcs already"
10200        return
10201    }
10202    set a [lindex $a 0]
10203    set i [lsearch -exact $arcids($a) $p]
10204    if {$i < 0} {
10205        puts "oops splitarc $p not in arc $a"
10206        return
10207    }
10208    set na [incr nextarc]
10209    if {[info exists arcend($a)]} {
10210        set arcend($na) $arcend($a)
10211    } else {
10212        set l [lindex $allparents([lindex $arcids($a) end]) 0]
10213        set j [lsearch -exact $arcnos($l) $a]
10214        set arcnos($l) [lreplace $arcnos($l) $j $j $na]
10215    }
10216    set tail [lrange $arcids($a) [expr {$i+1}] end]
10217    set arcids($a) [lrange $arcids($a) 0 $i]
10218    set arcend($a) $p
10219    set arcstart($na) $p
10220    set arcout($p) $na
10221    set arcids($na) $tail
10222    if {[info exists growing($a)]} {
10223        set growing($na) 1
10224        unset growing($a)
10225    }
10226
10227    foreach id $tail {
10228        if {[llength $arcnos($id)] == 1} {
10229            set arcnos($id) $na
10230        } else {
10231            set j [lsearch -exact $arcnos($id) $a]
10232            set arcnos($id) [lreplace $arcnos($id) $j $j $na]
10233        }
10234    }
10235
10236    # reconstruct tags and heads lists
10237    if {$arctags($a) ne {} || $archeads($a) ne {}} {
10238        recalcarc $a
10239        recalcarc $na
10240    } else {
10241        set arctags($na) {}
10242        set archeads($na) {}
10243    }
10244}
10245
10246# Update things for a new commit added that is a child of one
10247# existing commit.  Used when cherry-picking.
10248proc addnewchild {id p} {
10249    global allparents allchildren idtags nextarc
10250    global arcnos arcids arctags arcout arcend arcstart archeads growing
10251    global seeds allcommits
10252
10253    if {![info exists allcommits] || ![info exists arcnos($p)]} return
10254    set allparents($id) [list $p]
10255    set allchildren($id) {}
10256    set arcnos($id) {}
10257    lappend seeds $id
10258    lappend allchildren($p) $id
10259    set a [incr nextarc]
10260    set arcstart($a) $id
10261    set archeads($a) {}
10262    set arctags($a) {}
10263    set arcids($a) [list $p]
10264    set arcend($a) $p
10265    if {![info exists arcout($p)]} {
10266        splitarc $p
10267    }
10268    lappend arcnos($p) $a
10269    set arcout($id) [list $a]
10270}
10271
10272# This implements a cache for the topology information.
10273# The cache saves, for each arc, the start and end of the arc,
10274# the ids on the arc, and the outgoing arcs from the end.
10275proc readcache {f} {
10276    global arcnos arcids arcout arcstart arcend arctags archeads nextarc
10277    global idtags idheads allparents cachedarcs possible_seeds seeds growing
10278    global allcwait
10279
10280    set a $nextarc
10281    set lim $cachedarcs
10282    if {$lim - $a > 500} {
10283        set lim [expr {$a + 500}]
10284    }
10285    if {[catch {
10286        if {$a == $lim} {
10287            # finish reading the cache and setting up arctags, etc.
10288            set line [gets $f]
10289            if {$line ne "1"} {error "bad final version"}
10290            close $f
10291            foreach id [array names idtags] {
10292                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10293                    [llength $allparents($id)] == 1} {
10294                    set a [lindex $arcnos($id) 0]
10295                    if {$arctags($a) eq {}} {
10296                        recalcarc $a
10297                    }
10298                }
10299            }
10300            foreach id [array names idheads] {
10301                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10302                    [llength $allparents($id)] == 1} {
10303                    set a [lindex $arcnos($id) 0]
10304                    if {$archeads($a) eq {}} {
10305                        recalcarc $a
10306                    }
10307                }
10308            }
10309            foreach id [lsort -unique $possible_seeds] {
10310                if {$arcnos($id) eq {}} {
10311                    lappend seeds $id
10312                }
10313            }
10314            set allcwait 0
10315        } else {
10316            while {[incr a] <= $lim} {
10317                set line [gets $f]
10318                if {[llength $line] != 3} {error "bad line"}
10319                set s [lindex $line 0]
10320                set arcstart($a) $s
10321                lappend arcout($s) $a
10322                if {![info exists arcnos($s)]} {
10323                    lappend possible_seeds $s
10324                    set arcnos($s) {}
10325                }
10326                set e [lindex $line 1]
10327                if {$e eq {}} {
10328                    set growing($a) 1
10329                } else {
10330                    set arcend($a) $e
10331                    if {![info exists arcout($e)]} {
10332                        set arcout($e) {}
10333                    }
10334                }
10335                set arcids($a) [lindex $line 2]
10336                foreach id $arcids($a) {
10337                    lappend allparents($s) $id
10338                    set s $id
10339                    lappend arcnos($id) $a
10340                }
10341                if {![info exists allparents($s)]} {
10342                    set allparents($s) {}
10343                }
10344                set arctags($a) {}
10345                set archeads($a) {}
10346            }
10347            set nextarc [expr {$a - 1}]
10348        }
10349    } err]} {
10350        dropcache $err
10351        return 0
10352    }
10353    if {!$allcwait} {
10354        getallcommits
10355    }
10356    return $allcwait
10357}
10358
10359proc getcache {f} {
10360    global nextarc cachedarcs possible_seeds
10361
10362    if {[catch {
10363        set line [gets $f]
10364        if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
10365        # make sure it's an integer
10366        set cachedarcs [expr {int([lindex $line 1])}]
10367        if {$cachedarcs < 0} {error "bad number of arcs"}
10368        set nextarc 0
10369        set possible_seeds {}
10370        run readcache $f
10371    } err]} {
10372        dropcache $err
10373    }
10374    return 0
10375}
10376
10377proc dropcache {err} {
10378    global allcwait nextarc cachedarcs seeds
10379
10380    #puts "dropping cache ($err)"
10381    foreach v {arcnos arcout arcids arcstart arcend growing \
10382                   arctags archeads allparents allchildren} {
10383        global $v
10384        unset -nocomplain $v
10385    }
10386    set allcwait 0
10387    set nextarc 0
10388    set cachedarcs 0
10389    set seeds {}
10390    getallcommits
10391}
10392
10393proc writecache {f} {
10394    global cachearc cachedarcs allccache
10395    global arcstart arcend arcnos arcids arcout
10396
10397    set a $cachearc
10398    set lim $cachedarcs
10399    if {$lim - $a > 1000} {
10400        set lim [expr {$a + 1000}]
10401    }
10402    if {[catch {
10403        while {[incr a] <= $lim} {
10404            if {[info exists arcend($a)]} {
10405                puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
10406            } else {
10407                puts $f [list $arcstart($a) {} $arcids($a)]
10408            }
10409        }
10410    } err]} {
10411        catch {close $f}
10412        catch {file delete $allccache}
10413        #puts "writing cache failed ($err)"
10414        return 0
10415    }
10416    set cachearc [expr {$a - 1}]
10417    if {$a > $cachedarcs} {
10418        puts $f "1"
10419        close $f
10420        return 0
10421    }
10422    return 1
10423}
10424
10425proc savecache {} {
10426    global nextarc cachedarcs cachearc allccache
10427
10428    if {$nextarc == $cachedarcs} return
10429    set cachearc 0
10430    set cachedarcs $nextarc
10431    catch {
10432        set f [open $allccache w]
10433        puts $f [list 1 $cachedarcs]
10434        run writecache $f
10435    }
10436}
10437
10438# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
10439# or 0 if neither is true.
10440proc anc_or_desc {a b} {
10441    global arcout arcstart arcend arcnos cached_isanc
10442
10443    if {$arcnos($a) eq $arcnos($b)} {
10444        # Both are on the same arc(s); either both are the same BMP,
10445        # or if one is not a BMP, the other is also not a BMP or is
10446        # the BMP at end of the arc (and it only has 1 incoming arc).
10447        # Or both can be BMPs with no incoming arcs.
10448        if {$a eq $b || $arcnos($a) eq {}} {
10449            return 0
10450        }
10451        # assert {[llength $arcnos($a)] == 1}
10452        set arc [lindex $arcnos($a) 0]
10453        set i [lsearch -exact $arcids($arc) $a]
10454        set j [lsearch -exact $arcids($arc) $b]
10455        if {$i < 0 || $i > $j} {
10456            return 1
10457        } else {
10458            return -1
10459        }
10460    }
10461
10462    if {![info exists arcout($a)]} {
10463        set arc [lindex $arcnos($a) 0]
10464        if {[info exists arcend($arc)]} {
10465            set aend $arcend($arc)
10466        } else {
10467            set aend {}
10468        }
10469        set a $arcstart($arc)
10470    } else {
10471        set aend $a
10472    }
10473    if {![info exists arcout($b)]} {
10474        set arc [lindex $arcnos($b) 0]
10475        if {[info exists arcend($arc)]} {
10476            set bend $arcend($arc)
10477        } else {
10478            set bend {}
10479        }
10480        set b $arcstart($arc)
10481    } else {
10482        set bend $b
10483    }
10484    if {$a eq $bend} {
10485        return 1
10486    }
10487    if {$b eq $aend} {
10488        return -1
10489    }
10490    if {[info exists cached_isanc($a,$bend)]} {
10491        if {$cached_isanc($a,$bend)} {
10492            return 1
10493        }
10494    }
10495    if {[info exists cached_isanc($b,$aend)]} {
10496        if {$cached_isanc($b,$aend)} {
10497            return -1
10498        }
10499        if {[info exists cached_isanc($a,$bend)]} {
10500            return 0
10501        }
10502    }
10503
10504    set todo [list $a $b]
10505    set anc($a) a
10506    set anc($b) b
10507    for {set i 0} {$i < [llength $todo]} {incr i} {
10508        set x [lindex $todo $i]
10509        if {$anc($x) eq {}} {
10510            continue
10511        }
10512        foreach arc $arcnos($x) {
10513            set xd $arcstart($arc)
10514            if {$xd eq $bend} {
10515                set cached_isanc($a,$bend) 1
10516                set cached_isanc($b,$aend) 0
10517                return 1
10518            } elseif {$xd eq $aend} {
10519                set cached_isanc($b,$aend) 1
10520                set cached_isanc($a,$bend) 0
10521                return -1
10522            }
10523            if {![info exists anc($xd)]} {
10524                set anc($xd) $anc($x)
10525                lappend todo $xd
10526            } elseif {$anc($xd) ne $anc($x)} {
10527                set anc($xd) {}
10528            }
10529        }
10530    }
10531    set cached_isanc($a,$bend) 0
10532    set cached_isanc($b,$aend) 0
10533    return 0
10534}
10535
10536# This identifies whether $desc has an ancestor that is
10537# a growing tip of the graph and which is not an ancestor of $anc
10538# and returns 0 if so and 1 if not.
10539# If we subsequently discover a tag on such a growing tip, and that
10540# turns out to be a descendent of $anc (which it could, since we
10541# don't necessarily see children before parents), then $desc
10542# isn't a good choice to display as a descendent tag of
10543# $anc (since it is the descendent of another tag which is
10544# a descendent of $anc).  Similarly, $anc isn't a good choice to
10545# display as a ancestor tag of $desc.
10546#
10547proc is_certain {desc anc} {
10548    global arcnos arcout arcstart arcend growing problems
10549
10550    set certain {}
10551    if {[llength $arcnos($anc)] == 1} {
10552        # tags on the same arc are certain
10553        if {$arcnos($desc) eq $arcnos($anc)} {
10554            return 1
10555        }
10556        if {![info exists arcout($anc)]} {
10557            # if $anc is partway along an arc, use the start of the arc instead
10558            set a [lindex $arcnos($anc) 0]
10559            set anc $arcstart($a)
10560        }
10561    }
10562    if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
10563        set x $desc
10564    } else {
10565        set a [lindex $arcnos($desc) 0]
10566        set x $arcend($a)
10567    }
10568    if {$x == $anc} {
10569        return 1
10570    }
10571    set anclist [list $x]
10572    set dl($x) 1
10573    set nnh 1
10574    set ngrowanc 0
10575    for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
10576        set x [lindex $anclist $i]
10577        if {$dl($x)} {
10578            incr nnh -1
10579        }
10580        set done($x) 1
10581        foreach a $arcout($x) {
10582            if {[info exists growing($a)]} {
10583                if {![info exists growanc($x)] && $dl($x)} {
10584                    set growanc($x) 1
10585                    incr ngrowanc
10586                }
10587            } else {
10588                set y $arcend($a)
10589                if {[info exists dl($y)]} {
10590                    if {$dl($y)} {
10591                        if {!$dl($x)} {
10592                            set dl($y) 0
10593                            if {![info exists done($y)]} {
10594                                incr nnh -1
10595                            }
10596                            if {[info exists growanc($x)]} {
10597                                incr ngrowanc -1
10598                            }
10599                            set xl [list $y]
10600                            for {set k 0} {$k < [llength $xl]} {incr k} {
10601                                set z [lindex $xl $k]
10602                                foreach c $arcout($z) {
10603                                    if {[info exists arcend($c)]} {
10604                                        set v $arcend($c)
10605                                        if {[info exists dl($v)] && $dl($v)} {
10606                                            set dl($v) 0
10607                                            if {![info exists done($v)]} {
10608                                                incr nnh -1
10609                                            }
10610                                            if {[info exists growanc($v)]} {
10611                                                incr ngrowanc -1
10612                                            }
10613                                            lappend xl $v
10614                                        }
10615                                    }
10616                                }
10617                            }
10618                        }
10619                    }
10620                } elseif {$y eq $anc || !$dl($x)} {
10621                    set dl($y) 0
10622                    lappend anclist $y
10623                } else {
10624                    set dl($y) 1
10625                    lappend anclist $y
10626                    incr nnh
10627                }
10628            }
10629        }
10630    }
10631    foreach x [array names growanc] {
10632        if {$dl($x)} {
10633            return 0
10634        }
10635        return 0
10636    }
10637    return 1
10638}
10639
10640proc validate_arctags {a} {
10641    global arctags idtags
10642
10643    set i -1
10644    set na $arctags($a)
10645    foreach id $arctags($a) {
10646        incr i
10647        if {![info exists idtags($id)]} {
10648            set na [lreplace $na $i $i]
10649            incr i -1
10650        }
10651    }
10652    set arctags($a) $na
10653}
10654
10655proc validate_archeads {a} {
10656    global archeads idheads
10657
10658    set i -1
10659    set na $archeads($a)
10660    foreach id $archeads($a) {
10661        incr i
10662        if {![info exists idheads($id)]} {
10663            set na [lreplace $na $i $i]
10664            incr i -1
10665        }
10666    }
10667    set archeads($a) $na
10668}
10669
10670# Return the list of IDs that have tags that are descendents of id,
10671# ignoring IDs that are descendents of IDs already reported.
10672proc desctags {id} {
10673    global arcnos arcstart arcids arctags idtags allparents
10674    global growing cached_dtags
10675
10676    if {![info exists allparents($id)]} {
10677        return {}
10678    }
10679    set t1 [clock clicks -milliseconds]
10680    set argid $id
10681    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10682        # part-way along an arc; check that arc first
10683        set a [lindex $arcnos($id) 0]
10684        if {$arctags($a) ne {}} {
10685            validate_arctags $a
10686            set i [lsearch -exact $arcids($a) $id]
10687            set tid {}
10688            foreach t $arctags($a) {
10689                set j [lsearch -exact $arcids($a) $t]
10690                if {$j >= $i} break
10691                set tid $t
10692            }
10693            if {$tid ne {}} {
10694                return $tid
10695            }
10696        }
10697        set id $arcstart($a)
10698        if {[info exists idtags($id)]} {
10699            return $id
10700        }
10701    }
10702    if {[info exists cached_dtags($id)]} {
10703        return $cached_dtags($id)
10704    }
10705
10706    set origid $id
10707    set todo [list $id]
10708    set queued($id) 1
10709    set nc 1
10710    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10711        set id [lindex $todo $i]
10712        set done($id) 1
10713        set ta [info exists hastaggedancestor($id)]
10714        if {!$ta} {
10715            incr nc -1
10716        }
10717        # ignore tags on starting node
10718        if {!$ta && $i > 0} {
10719            if {[info exists idtags($id)]} {
10720                set tagloc($id) $id
10721                set ta 1
10722            } elseif {[info exists cached_dtags($id)]} {
10723                set tagloc($id) $cached_dtags($id)
10724                set ta 1
10725            }
10726        }
10727        foreach a $arcnos($id) {
10728            set d $arcstart($a)
10729            if {!$ta && $arctags($a) ne {}} {
10730                validate_arctags $a
10731                if {$arctags($a) ne {}} {
10732                    lappend tagloc($id) [lindex $arctags($a) end]
10733                }
10734            }
10735            if {$ta || $arctags($a) ne {}} {
10736                set tomark [list $d]
10737                for {set j 0} {$j < [llength $tomark]} {incr j} {
10738                    set dd [lindex $tomark $j]
10739                    if {![info exists hastaggedancestor($dd)]} {
10740                        if {[info exists done($dd)]} {
10741                            foreach b $arcnos($dd) {
10742                                lappend tomark $arcstart($b)
10743                            }
10744                            if {[info exists tagloc($dd)]} {
10745                                unset tagloc($dd)
10746                            }
10747                        } elseif {[info exists queued($dd)]} {
10748                            incr nc -1
10749                        }
10750                        set hastaggedancestor($dd) 1
10751                    }
10752                }
10753            }
10754            if {![info exists queued($d)]} {
10755                lappend todo $d
10756                set queued($d) 1
10757                if {![info exists hastaggedancestor($d)]} {
10758                    incr nc
10759                }
10760            }
10761        }
10762    }
10763    set tags {}
10764    foreach id [array names tagloc] {
10765        if {![info exists hastaggedancestor($id)]} {
10766            foreach t $tagloc($id) {
10767                if {[lsearch -exact $tags $t] < 0} {
10768                    lappend tags $t
10769                }
10770            }
10771        }
10772    }
10773    set t2 [clock clicks -milliseconds]
10774    set loopix $i
10775
10776    # remove tags that are descendents of other tags
10777    for {set i 0} {$i < [llength $tags]} {incr i} {
10778        set a [lindex $tags $i]
10779        for {set j 0} {$j < $i} {incr j} {
10780            set b [lindex $tags $j]
10781            set r [anc_or_desc $a $b]
10782            if {$r == 1} {
10783                set tags [lreplace $tags $j $j]
10784                incr j -1
10785                incr i -1
10786            } elseif {$r == -1} {
10787                set tags [lreplace $tags $i $i]
10788                incr i -1
10789                break
10790            }
10791        }
10792    }
10793
10794    if {[array names growing] ne {}} {
10795        # graph isn't finished, need to check if any tag could get
10796        # eclipsed by another tag coming later.  Simply ignore any
10797        # tags that could later get eclipsed.
10798        set ctags {}
10799        foreach t $tags {
10800            if {[is_certain $t $origid]} {
10801                lappend ctags $t
10802            }
10803        }
10804        if {$tags eq $ctags} {
10805            set cached_dtags($origid) $tags
10806        } else {
10807            set tags $ctags
10808        }
10809    } else {
10810        set cached_dtags($origid) $tags
10811    }
10812    set t3 [clock clicks -milliseconds]
10813    if {0 && $t3 - $t1 >= 100} {
10814        puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10815            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10816    }
10817    return $tags
10818}
10819
10820proc anctags {id} {
10821    global arcnos arcids arcout arcend arctags idtags allparents
10822    global growing cached_atags
10823
10824    if {![info exists allparents($id)]} {
10825        return {}
10826    }
10827    set t1 [clock clicks -milliseconds]
10828    set argid $id
10829    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10830        # part-way along an arc; check that arc first
10831        set a [lindex $arcnos($id) 0]
10832        if {$arctags($a) ne {}} {
10833            validate_arctags $a
10834            set i [lsearch -exact $arcids($a) $id]
10835            foreach t $arctags($a) {
10836                set j [lsearch -exact $arcids($a) $t]
10837                if {$j > $i} {
10838                    return $t
10839                }
10840            }
10841        }
10842        if {![info exists arcend($a)]} {
10843            return {}
10844        }
10845        set id $arcend($a)
10846        if {[info exists idtags($id)]} {
10847            return $id
10848        }
10849    }
10850    if {[info exists cached_atags($id)]} {
10851        return $cached_atags($id)
10852    }
10853
10854    set origid $id
10855    set todo [list $id]
10856    set queued($id) 1
10857    set taglist {}
10858    set nc 1
10859    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10860        set id [lindex $todo $i]
10861        set done($id) 1
10862        set td [info exists hastaggeddescendent($id)]
10863        if {!$td} {
10864            incr nc -1
10865        }
10866        # ignore tags on starting node
10867        if {!$td && $i > 0} {
10868            if {[info exists idtags($id)]} {
10869                set tagloc($id) $id
10870                set td 1
10871            } elseif {[info exists cached_atags($id)]} {
10872                set tagloc($id) $cached_atags($id)
10873                set td 1
10874            }
10875        }
10876        foreach a $arcout($id) {
10877            if {!$td && $arctags($a) ne {}} {
10878                validate_arctags $a
10879                if {$arctags($a) ne {}} {
10880                    lappend tagloc($id) [lindex $arctags($a) 0]
10881                }
10882            }
10883            if {![info exists arcend($a)]} continue
10884            set d $arcend($a)
10885            if {$td || $arctags($a) ne {}} {
10886                set tomark [list $d]
10887                for {set j 0} {$j < [llength $tomark]} {incr j} {
10888                    set dd [lindex $tomark $j]
10889                    if {![info exists hastaggeddescendent($dd)]} {
10890                        if {[info exists done($dd)]} {
10891                            foreach b $arcout($dd) {
10892                                if {[info exists arcend($b)]} {
10893                                    lappend tomark $arcend($b)
10894                                }
10895                            }
10896                            if {[info exists tagloc($dd)]} {
10897                                unset tagloc($dd)
10898                            }
10899                        } elseif {[info exists queued($dd)]} {
10900                            incr nc -1
10901                        }
10902                        set hastaggeddescendent($dd) 1
10903                    }
10904                }
10905            }
10906            if {![info exists queued($d)]} {
10907                lappend todo $d
10908                set queued($d) 1
10909                if {![info exists hastaggeddescendent($d)]} {
10910                    incr nc
10911                }
10912            }
10913        }
10914    }
10915    set t2 [clock clicks -milliseconds]
10916    set loopix $i
10917    set tags {}
10918    foreach id [array names tagloc] {
10919        if {![info exists hastaggeddescendent($id)]} {
10920            foreach t $tagloc($id) {
10921                if {[lsearch -exact $tags $t] < 0} {
10922                    lappend tags $t
10923                }
10924            }
10925        }
10926    }
10927
10928    # remove tags that are ancestors of other tags
10929    for {set i 0} {$i < [llength $tags]} {incr i} {
10930        set a [lindex $tags $i]
10931        for {set j 0} {$j < $i} {incr j} {
10932            set b [lindex $tags $j]
10933            set r [anc_or_desc $a $b]
10934            if {$r == -1} {
10935                set tags [lreplace $tags $j $j]
10936                incr j -1
10937                incr i -1
10938            } elseif {$r == 1} {
10939                set tags [lreplace $tags $i $i]
10940                incr i -1
10941                break
10942            }
10943        }
10944    }
10945
10946    if {[array names growing] ne {}} {
10947        # graph isn't finished, need to check if any tag could get
10948        # eclipsed by another tag coming later.  Simply ignore any
10949        # tags that could later get eclipsed.
10950        set ctags {}
10951        foreach t $tags {
10952            if {[is_certain $origid $t]} {
10953                lappend ctags $t
10954            }
10955        }
10956        if {$tags eq $ctags} {
10957            set cached_atags($origid) $tags
10958        } else {
10959            set tags $ctags
10960        }
10961    } else {
10962        set cached_atags($origid) $tags
10963    }
10964    set t3 [clock clicks -milliseconds]
10965    if {0 && $t3 - $t1 >= 100} {
10966        puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
10967            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10968    }
10969    return $tags
10970}
10971
10972# Return the list of IDs that have heads that are descendents of id,
10973# including id itself if it has a head.
10974proc descheads {id} {
10975    global arcnos arcstart arcids archeads idheads cached_dheads
10976    global allparents arcout
10977
10978    if {![info exists allparents($id)]} {
10979        return {}
10980    }
10981    set aret {}
10982    if {![info exists arcout($id)]} {
10983        # part-way along an arc; check it first
10984        set a [lindex $arcnos($id) 0]
10985        if {$archeads($a) ne {}} {
10986            validate_archeads $a
10987            set i [lsearch -exact $arcids($a) $id]
10988            foreach t $archeads($a) {
10989                set j [lsearch -exact $arcids($a) $t]
10990                if {$j > $i} break
10991                lappend aret $t
10992            }
10993        }
10994        set id $arcstart($a)
10995    }
10996    set origid $id
10997    set todo [list $id]
10998    set seen($id) 1
10999    set ret {}
11000    for {set i 0} {$i < [llength $todo]} {incr i} {
11001        set id [lindex $todo $i]
11002        if {[info exists cached_dheads($id)]} {
11003            set ret [concat $ret $cached_dheads($id)]
11004        } else {
11005            if {[info exists idheads($id)]} {
11006                lappend ret $id
11007            }
11008            foreach a $arcnos($id) {
11009                if {$archeads($a) ne {}} {
11010                    validate_archeads $a
11011                    if {$archeads($a) ne {}} {
11012                        set ret [concat $ret $archeads($a)]
11013                    }
11014                }
11015                set d $arcstart($a)
11016                if {![info exists seen($d)]} {
11017                    lappend todo $d
11018                    set seen($d) 1
11019                }
11020            }
11021        }
11022    }
11023    set ret [lsort -unique $ret]
11024    set cached_dheads($origid) $ret
11025    return [concat $ret $aret]
11026}
11027
11028proc addedtag {id} {
11029    global arcnos arcout cached_dtags cached_atags
11030
11031    if {![info exists arcnos($id)]} return
11032    if {![info exists arcout($id)]} {
11033        recalcarc [lindex $arcnos($id) 0]
11034    }
11035    unset -nocomplain cached_dtags
11036    unset -nocomplain cached_atags
11037}
11038
11039proc addedhead {hid head} {
11040    global arcnos arcout cached_dheads
11041
11042    if {![info exists arcnos($hid)]} return
11043    if {![info exists arcout($hid)]} {
11044        recalcarc [lindex $arcnos($hid) 0]
11045    }
11046    unset -nocomplain cached_dheads
11047}
11048
11049proc removedhead {hid head} {
11050    global cached_dheads
11051
11052    unset -nocomplain cached_dheads
11053}
11054
11055proc movedhead {hid head} {
11056    global arcnos arcout cached_dheads
11057
11058    if {![info exists arcnos($hid)]} return
11059    if {![info exists arcout($hid)]} {
11060        recalcarc [lindex $arcnos($hid) 0]
11061    }
11062    unset -nocomplain cached_dheads
11063}
11064
11065proc changedrefs {} {
11066    global cached_dheads cached_dtags cached_atags cached_tagcontent
11067    global arctags archeads arcnos arcout idheads idtags
11068
11069    foreach id [concat [array names idheads] [array names idtags]] {
11070        if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
11071            set a [lindex $arcnos($id) 0]
11072            if {![info exists donearc($a)]} {
11073                recalcarc $a
11074                set donearc($a) 1
11075            }
11076        }
11077    }
11078    unset -nocomplain cached_tagcontent
11079    unset -nocomplain cached_dtags
11080    unset -nocomplain cached_atags
11081    unset -nocomplain cached_dheads
11082}
11083
11084proc rereadrefs {} {
11085    global idtags idheads idotherrefs mainheadid
11086
11087    set refids [concat [array names idtags] \
11088                    [array names idheads] [array names idotherrefs]]
11089    foreach id $refids {
11090        if {![info exists ref($id)]} {
11091            set ref($id) [listrefs $id]
11092        }
11093    }
11094    set oldmainhead $mainheadid
11095    readrefs
11096    changedrefs
11097    set refids [lsort -unique [concat $refids [array names idtags] \
11098                        [array names idheads] [array names idotherrefs]]]
11099    foreach id $refids {
11100        set v [listrefs $id]
11101        if {![info exists ref($id)] || $ref($id) != $v} {
11102            redrawtags $id
11103        }
11104    }
11105    if {$oldmainhead ne $mainheadid} {
11106        redrawtags $oldmainhead
11107        redrawtags $mainheadid
11108    }
11109    run refill_reflist
11110}
11111
11112proc listrefs {id} {
11113    global idtags idheads idotherrefs
11114
11115    set x {}
11116    if {[info exists idtags($id)]} {
11117        set x $idtags($id)
11118    }
11119    set y {}
11120    if {[info exists idheads($id)]} {
11121        set y $idheads($id)
11122    }
11123    set z {}
11124    if {[info exists idotherrefs($id)]} {
11125        set z $idotherrefs($id)
11126    }
11127    return [list $x $y $z]
11128}
11129
11130proc add_tag_ctext {tag} {
11131    global ctext cached_tagcontent tagids
11132
11133    if {![info exists cached_tagcontent($tag)]} {
11134        catch {
11135            set cached_tagcontent($tag) [exec git cat-file -p $tag]
11136        }
11137    }
11138    $ctext insert end "[mc "Tag"]: $tag\n" bold
11139    if {[info exists cached_tagcontent($tag)]} {
11140        set text $cached_tagcontent($tag)
11141    } else {
11142        set text "[mc "Id"]:  $tagids($tag)"
11143    }
11144    appendwithlinks $text {}
11145}
11146
11147proc showtag {tag isnew} {
11148    global ctext cached_tagcontent tagids linknum tagobjid
11149
11150    if {$isnew} {
11151        addtohistory [list showtag $tag 0] savectextpos
11152    }
11153    $ctext conf -state normal
11154    clear_ctext
11155    settabs 0
11156    set linknum 0
11157    add_tag_ctext $tag
11158    maybe_scroll_ctext 1
11159    $ctext conf -state disabled
11160    init_flist {}
11161}
11162
11163proc showtags {id isnew} {
11164    global idtags ctext linknum
11165
11166    if {$isnew} {
11167        addtohistory [list showtags $id 0] savectextpos
11168    }
11169    $ctext conf -state normal
11170    clear_ctext
11171    settabs 0
11172    set linknum 0
11173    set sep {}
11174    foreach tag $idtags($id) {
11175        $ctext insert end $sep
11176        add_tag_ctext $tag
11177        set sep "\n\n"
11178    }
11179    maybe_scroll_ctext 1
11180    $ctext conf -state disabled
11181    init_flist {}
11182}
11183
11184proc doquit {} {
11185    global stopped
11186    global gitktmpdir
11187
11188    set stopped 100
11189    savestuff .
11190    destroy .
11191
11192    if {[info exists gitktmpdir]} {
11193        catch {file delete -force $gitktmpdir}
11194    }
11195}
11196
11197proc mkfontdisp {font top which} {
11198    global fontattr fontpref $font NS use_ttk
11199
11200    set fontpref($font) [set $font]
11201    ${NS}::button $top.${font}but -text $which \
11202        -command [list choosefont $font $which]
11203    ${NS}::label $top.$font -relief flat -font $font \
11204        -text $fontattr($font,family) -justify left
11205    grid x $top.${font}but $top.$font -sticky w
11206}
11207
11208proc choosefont {font which} {
11209    global fontparam fontlist fonttop fontattr
11210    global prefstop NS
11211
11212    set fontparam(which) $which
11213    set fontparam(font) $font
11214    set fontparam(family) [font actual $font -family]
11215    set fontparam(size) $fontattr($font,size)
11216    set fontparam(weight) $fontattr($font,weight)
11217    set fontparam(slant) $fontattr($font,slant)
11218    set top .gitkfont
11219    set fonttop $top
11220    if {![winfo exists $top]} {
11221        font create sample
11222        eval font config sample [font actual $font]
11223        ttk_toplevel $top
11224        make_transient $top $prefstop
11225        wm title $top [mc "Gitk font chooser"]
11226        ${NS}::label $top.l -textvariable fontparam(which)
11227        pack $top.l -side top
11228        set fontlist [lsort [font families]]
11229        ${NS}::frame $top.f
11230        listbox $top.f.fam -listvariable fontlist \
11231            -yscrollcommand [list $top.f.sb set]
11232        bind $top.f.fam <<ListboxSelect>> selfontfam
11233        ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
11234        pack $top.f.sb -side right -fill y
11235        pack $top.f.fam -side left -fill both -expand 1
11236        pack $top.f -side top -fill both -expand 1
11237        ${NS}::frame $top.g
11238        spinbox $top.g.size -from 4 -to 40 -width 4 \
11239            -textvariable fontparam(size) \
11240            -validatecommand {string is integer -strict %s}
11241        checkbutton $top.g.bold -padx 5 \
11242            -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
11243            -variable fontparam(weight) -onvalue bold -offvalue normal
11244        checkbutton $top.g.ital -padx 5 \
11245            -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
11246            -variable fontparam(slant) -onvalue italic -offvalue roman
11247        pack $top.g.size $top.g.bold $top.g.ital -side left
11248        pack $top.g -side top
11249        canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
11250            -background white
11251        $top.c create text 100 25 -anchor center -text $which -font sample \
11252            -fill black -tags text
11253        bind $top.c <Configure> [list centertext $top.c]
11254        pack $top.c -side top -fill x
11255        ${NS}::frame $top.buts
11256        ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
11257        ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
11258        bind $top <Key-Return> fontok
11259        bind $top <Key-Escape> fontcan
11260        grid $top.buts.ok $top.buts.can
11261        grid columnconfigure $top.buts 0 -weight 1 -uniform a
11262        grid columnconfigure $top.buts 1 -weight 1 -uniform a
11263        pack $top.buts -side bottom -fill x
11264        trace add variable fontparam write chg_fontparam
11265    } else {
11266        raise $top
11267        $top.c itemconf text -text $which
11268    }
11269    set i [lsearch -exact $fontlist $fontparam(family)]
11270    if {$i >= 0} {
11271        $top.f.fam selection set $i
11272        $top.f.fam see $i
11273    }
11274}
11275
11276proc centertext {w} {
11277    $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
11278}
11279
11280proc fontok {} {
11281    global fontparam fontpref prefstop
11282
11283    set f $fontparam(font)
11284    set fontpref($f) [list $fontparam(family) $fontparam(size)]
11285    if {$fontparam(weight) eq "bold"} {
11286        lappend fontpref($f) "bold"
11287    }
11288    if {$fontparam(slant) eq "italic"} {
11289        lappend fontpref($f) "italic"
11290    }
11291    set w $prefstop.notebook.fonts.$f
11292    $w conf -text $fontparam(family) -font $fontpref($f)
11293
11294    fontcan
11295}
11296
11297proc fontcan {} {
11298    global fonttop fontparam
11299
11300    if {[info exists fonttop]} {
11301        catch {destroy $fonttop}
11302        catch {font delete sample}
11303        unset fonttop
11304        unset fontparam
11305    }
11306}
11307
11308if {[package vsatisfies [package provide Tk] 8.6]} {
11309    # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
11310    # function to make use of it.
11311    proc choosefont {font which} {
11312        tk fontchooser configure -title $which -font $font \
11313            -command [list on_choosefont $font $which]
11314        tk fontchooser show
11315    }
11316    proc on_choosefont {font which newfont} {
11317        global fontparam
11318        puts stderr "$font $newfont"
11319        array set f [font actual $newfont]
11320        set fontparam(which) $which
11321        set fontparam(font) $font
11322        set fontparam(family) $f(-family)
11323        set fontparam(size) $f(-size)
11324        set fontparam(weight) $f(-weight)
11325        set fontparam(slant) $f(-slant)
11326        fontok
11327    }
11328}
11329
11330proc selfontfam {} {
11331    global fonttop fontparam
11332
11333    set i [$fonttop.f.fam curselection]
11334    if {$i ne {}} {
11335        set fontparam(family) [$fonttop.f.fam get $i]
11336    }
11337}
11338
11339proc chg_fontparam {v sub op} {
11340    global fontparam
11341
11342    font config sample -$sub $fontparam($sub)
11343}
11344
11345# Create a property sheet tab page
11346proc create_prefs_page {w} {
11347    global NS
11348    set parent [join [lrange [split $w .] 0 end-1] .]
11349    if {[winfo class $parent] eq "TNotebook"} {
11350        ${NS}::frame $w
11351    } else {
11352        ${NS}::labelframe $w
11353    }
11354}
11355
11356proc prefspage_general {notebook} {
11357    global NS maxwidth maxgraphpct showneartags showlocalchanges
11358    global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11359    global hideremotes want_ttk have_ttk maxrefs
11360
11361    set page [create_prefs_page $notebook.general]
11362
11363    ${NS}::label $page.ldisp -text [mc "Commit list display options"]
11364    grid $page.ldisp - -sticky w -pady 10
11365    ${NS}::label $page.spacer -text " "
11366    ${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
11367    spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
11368    grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w
11369                                         #xgettext:no-tcl-format
11370    ${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
11371    spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
11372    grid x $page.maxpctl $page.maxpct -sticky w
11373    ${NS}::checkbutton $page.showlocal -text [mc "Show local changes"] \
11374        -variable showlocalchanges
11375    grid x $page.showlocal -sticky w
11376    ${NS}::checkbutton $page.autoselect -text [mc "Auto-select SHA1 (length)"] \
11377        -variable autoselect
11378    spinbox $page.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
11379    grid x $page.autoselect $page.autosellen -sticky w
11380    ${NS}::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \
11381        -variable hideremotes
11382    grid x $page.hideremotes -sticky w
11383
11384    ${NS}::label $page.ddisp -text [mc "Diff display options"]
11385    grid $page.ddisp - -sticky w -pady 10
11386    ${NS}::label $page.tabstopl -text [mc "Tab spacing"]
11387    spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
11388    grid x $page.tabstopl $page.tabstop -sticky w
11389    ${NS}::checkbutton $page.ntag -text [mc "Display nearby tags/heads"] \
11390        -variable showneartags
11391    grid x $page.ntag -sticky w
11392    ${NS}::label $page.maxrefsl -text [mc "Maximum # tags/heads to show"]
11393    spinbox $page.maxrefs -from 1 -to 1000 -width 4 -textvariable maxrefs
11394    grid x $page.maxrefsl $page.maxrefs -sticky w
11395    ${NS}::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \
11396        -variable limitdiffs
11397    grid x $page.ldiff -sticky w
11398    ${NS}::checkbutton $page.lattr -text [mc "Support per-file encodings"] \
11399        -variable perfile_attrs
11400    grid x $page.lattr -sticky w
11401
11402    ${NS}::entry $page.extdifft -textvariable extdifftool
11403    ${NS}::frame $page.extdifff
11404    ${NS}::label $page.extdifff.l -text [mc "External diff tool" ]
11405    ${NS}::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff
11406    pack $page.extdifff.l $page.extdifff.b -side left
11407    pack configure $page.extdifff.l -padx 10
11408    grid x $page.extdifff $page.extdifft -sticky ew
11409
11410    ${NS}::label $page.lgen -text [mc "General options"]
11411    grid $page.lgen - -sticky w -pady 10
11412    ${NS}::checkbutton $page.want_ttk -variable want_ttk \
11413        -text [mc "Use themed widgets"]
11414    if {$have_ttk} {
11415        ${NS}::label $page.ttk_note -text [mc "(change requires restart)"]
11416    } else {
11417        ${NS}::label $page.ttk_note -text [mc "(currently unavailable)"]
11418    }
11419    grid x $page.want_ttk $page.ttk_note -sticky w
11420    return $page
11421}
11422
11423proc prefspage_colors {notebook} {
11424    global NS uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11425
11426    set page [create_prefs_page $notebook.colors]
11427
11428    ${NS}::label $page.cdisp -text [mc "Colors: press to choose"]
11429    grid $page.cdisp - -sticky w -pady 10
11430    label $page.ui -padx 40 -relief sunk -background $uicolor
11431    ${NS}::button $page.uibut -text [mc "Interface"] \
11432       -command [list choosecolor uicolor {} $page.ui [mc "interface"] setui]
11433    grid x $page.uibut $page.ui -sticky w
11434    label $page.bg -padx 40 -relief sunk -background $bgcolor
11435    ${NS}::button $page.bgbut -text [mc "Background"] \
11436        -command [list choosecolor bgcolor {} $page.bg [mc "background"] setbg]
11437    grid x $page.bgbut $page.bg -sticky w
11438    label $page.fg -padx 40 -relief sunk -background $fgcolor
11439    ${NS}::button $page.fgbut -text [mc "Foreground"] \
11440        -command [list choosecolor fgcolor {} $page.fg [mc "foreground"] setfg]
11441    grid x $page.fgbut $page.fg -sticky w
11442    label $page.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
11443    ${NS}::button $page.diffoldbut -text [mc "Diff: old lines"] \
11444        -command [list choosecolor diffcolors 0 $page.diffold [mc "diff old lines"] \
11445                      [list $ctext tag conf d0 -foreground]]
11446    grid x $page.diffoldbut $page.diffold -sticky w
11447    label $page.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
11448    ${NS}::button $page.diffnewbut -text [mc "Diff: new lines"] \
11449        -command [list choosecolor diffcolors 1 $page.diffnew [mc "diff new lines"] \
11450                      [list $ctext tag conf dresult -foreground]]
11451    grid x $page.diffnewbut $page.diffnew -sticky w
11452    label $page.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
11453    ${NS}::button $page.hunksepbut -text [mc "Diff: hunk header"] \
11454        -command [list choosecolor diffcolors 2 $page.hunksep \
11455                      [mc "diff hunk header"] \
11456                      [list $ctext tag conf hunksep -foreground]]
11457    grid x $page.hunksepbut $page.hunksep -sticky w
11458    label $page.markbgsep -padx 40 -relief sunk -background $markbgcolor
11459    ${NS}::button $page.markbgbut -text [mc "Marked line bg"] \
11460        -command [list choosecolor markbgcolor {} $page.markbgsep \
11461                      [mc "marked line background"] \
11462                      [list $ctext tag conf omark -background]]
11463    grid x $page.markbgbut $page.markbgsep -sticky w
11464    label $page.selbgsep -padx 40 -relief sunk -background $selectbgcolor
11465    ${NS}::button $page.selbgbut -text [mc "Select bg"] \
11466        -command [list choosecolor selectbgcolor {} $page.selbgsep [mc "background"] setselbg]
11467    grid x $page.selbgbut $page.selbgsep -sticky w
11468    return $page
11469}
11470
11471proc prefspage_fonts {notebook} {
11472    global NS
11473    set page [create_prefs_page $notebook.fonts]
11474    ${NS}::label $page.cfont -text [mc "Fonts: press to choose"]
11475    grid $page.cfont - -sticky w -pady 10
11476    mkfontdisp mainfont $page [mc "Main font"]
11477    mkfontdisp textfont $page [mc "Diff display font"]
11478    mkfontdisp uifont $page [mc "User interface font"]
11479    return $page
11480}
11481
11482proc doprefs {} {
11483    global maxwidth maxgraphpct use_ttk NS
11484    global oldprefs prefstop showneartags showlocalchanges
11485    global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11486    global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11487    global hideremotes want_ttk have_ttk
11488
11489    set top .gitkprefs
11490    set prefstop $top
11491    if {[winfo exists $top]} {
11492        raise $top
11493        return
11494    }
11495    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11496                   limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11497        set oldprefs($v) [set $v]
11498    }
11499    ttk_toplevel $top
11500    wm title $top [mc "Gitk preferences"]
11501    make_transient $top .
11502
11503    if {[set use_notebook [expr {$use_ttk && [info command ::ttk::notebook] ne ""}]]} {
11504        set notebook [ttk::notebook $top.notebook]
11505    } else {
11506        set notebook [${NS}::frame $top.notebook -borderwidth 0 -relief flat]
11507    }
11508
11509    lappend pages [prefspage_general $notebook] [mc "General"]
11510    lappend pages [prefspage_colors $notebook] [mc "Colors"]
11511    lappend pages [prefspage_fonts $notebook] [mc "Fonts"]
11512    set col 0
11513    foreach {page title} $pages {
11514        if {$use_notebook} {
11515            $notebook add $page -text $title
11516        } else {
11517            set btn [${NS}::button $notebook.b_[string map {. X} $page] \
11518                         -text $title -command [list raise $page]]
11519            $page configure -text $title
11520            grid $btn -row 0 -column [incr col] -sticky w
11521            grid $page -row 1 -column 0 -sticky news -columnspan 100
11522        }
11523    }
11524
11525    if {!$use_notebook} {
11526        grid columnconfigure $notebook 0 -weight 1
11527        grid rowconfigure $notebook 1 -weight 1
11528        raise [lindex $pages 0]
11529    }
11530
11531    grid $notebook -sticky news -padx 2 -pady 2
11532    grid rowconfigure $top 0 -weight 1
11533    grid columnconfigure $top 0 -weight 1
11534
11535    ${NS}::frame $top.buts
11536    ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
11537    ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
11538    bind $top <Key-Return> prefsok
11539    bind $top <Key-Escape> prefscan
11540    grid $top.buts.ok $top.buts.can
11541    grid columnconfigure $top.buts 0 -weight 1 -uniform a
11542    grid columnconfigure $top.buts 1 -weight 1 -uniform a
11543    grid $top.buts - - -pady 10 -sticky ew
11544    grid columnconfigure $top 2 -weight 1
11545    bind $top <Visibility> [list focus $top.buts.ok]
11546}
11547
11548proc choose_extdiff {} {
11549    global extdifftool
11550
11551    set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
11552    if {$prog ne {}} {
11553        set extdifftool $prog
11554    }
11555}
11556
11557proc choosecolor {v vi w x cmd} {
11558    global $v
11559
11560    set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
11561               -title [mc "Gitk: choose color for %s" $x]]
11562    if {$c eq {}} return
11563    $w conf -background $c
11564    lset $v $vi $c
11565    eval $cmd $c
11566}
11567
11568proc setselbg {c} {
11569    global bglist cflist
11570    foreach w $bglist {
11571        if {[winfo exists $w]} {
11572            $w configure -selectbackground $c
11573        }
11574    }
11575    $cflist tag configure highlight \
11576        -background [$cflist cget -selectbackground]
11577    allcanvs itemconf secsel -fill $c
11578}
11579
11580# This sets the background color and the color scheme for the whole UI.
11581# For some reason, tk_setPalette chooses a nasty dark red for selectColor
11582# if we don't specify one ourselves, which makes the checkbuttons and
11583# radiobuttons look bad.  This chooses white for selectColor if the
11584# background color is light, or black if it is dark.
11585proc setui {c} {
11586    if {[tk windowingsystem] eq "win32"} { return }
11587    set bg [winfo rgb . $c]
11588    set selc black
11589    if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
11590        set selc white
11591    }
11592    tk_setPalette background $c selectColor $selc
11593}
11594
11595proc setbg {c} {
11596    global bglist
11597
11598    foreach w $bglist {
11599        if {[winfo exists $w]} {
11600            $w conf -background $c
11601        }
11602    }
11603}
11604
11605proc setfg {c} {
11606    global fglist canv
11607
11608    foreach w $fglist {
11609        if {[winfo exists $w]} {
11610            $w conf -foreground $c
11611        }
11612    }
11613    allcanvs itemconf text -fill $c
11614    $canv itemconf circle -outline $c
11615    $canv itemconf markid -outline $c
11616}
11617
11618proc prefscan {} {
11619    global oldprefs prefstop
11620
11621    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11622                   limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11623        global $v
11624        set $v $oldprefs($v)
11625    }
11626    catch {destroy $prefstop}
11627    unset prefstop
11628    fontcan
11629}
11630
11631proc prefsok {} {
11632    global maxwidth maxgraphpct
11633    global oldprefs prefstop showneartags showlocalchanges
11634    global fontpref mainfont textfont uifont
11635    global limitdiffs treediffs perfile_attrs
11636    global hideremotes
11637
11638    catch {destroy $prefstop}
11639    unset prefstop
11640    fontcan
11641    set fontchanged 0
11642    if {$mainfont ne $fontpref(mainfont)} {
11643        set mainfont $fontpref(mainfont)
11644        parsefont mainfont $mainfont
11645        eval font configure mainfont [fontflags mainfont]
11646        eval font configure mainfontbold [fontflags mainfont 1]
11647        setcoords
11648        set fontchanged 1
11649    }
11650    if {$textfont ne $fontpref(textfont)} {
11651        set textfont $fontpref(textfont)
11652        parsefont textfont $textfont
11653        eval font configure textfont [fontflags textfont]
11654        eval font configure textfontbold [fontflags textfont 1]
11655    }
11656    if {$uifont ne $fontpref(uifont)} {
11657        set uifont $fontpref(uifont)
11658        parsefont uifont $uifont
11659        eval font configure uifont [fontflags uifont]
11660    }
11661    settabs
11662    if {$showlocalchanges != $oldprefs(showlocalchanges)} {
11663        if {$showlocalchanges} {
11664            doshowlocalchanges
11665        } else {
11666            dohidelocalchanges
11667        }
11668    }
11669    if {$limitdiffs != $oldprefs(limitdiffs) ||
11670        ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11671        # treediffs elements are limited by path;
11672        # won't have encodings cached if perfile_attrs was just turned on
11673        unset -nocomplain treediffs
11674    }
11675    if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
11676        || $maxgraphpct != $oldprefs(maxgraphpct)} {
11677        redisplay
11678    } elseif {$showneartags != $oldprefs(showneartags) ||
11679          $limitdiffs != $oldprefs(limitdiffs)} {
11680        reselectline
11681    }
11682    if {$hideremotes != $oldprefs(hideremotes)} {
11683        rereadrefs
11684    }
11685}
11686
11687proc formatdate {d} {
11688    global datetimeformat
11689    if {$d ne {}} {
11690        # If $datetimeformat includes a timezone, display in the
11691        # timezone of the argument.  Otherwise, display in local time.
11692        if {[string match {*%[zZ]*} $datetimeformat]} {
11693            if {[catch {set d [clock format [lindex $d 0] -timezone [lindex $d 1] -format $datetimeformat]}]} {
11694                # Tcl < 8.5 does not support -timezone.  Emulate it by
11695                # setting TZ (e.g. TZ=<-0430>+04:30).
11696                global env
11697                if {[info exists env(TZ)]} {
11698                    set savedTZ $env(TZ)
11699                }
11700                set zone [lindex $d 1]
11701                set sign [string map {+ - - +} [string index $zone 0]]
11702                set env(TZ) <$zone>$sign[string range $zone 1 2]:[string range $zone 3 4]
11703                set d [clock format [lindex $d 0] -format $datetimeformat]
11704                if {[info exists savedTZ]} {
11705                    set env(TZ) $savedTZ
11706                } else {
11707                    unset env(TZ)
11708                }
11709            }
11710        } else {
11711            set d [clock format [lindex $d 0] -format $datetimeformat]
11712        }
11713    }
11714    return $d
11715}
11716
11717# This list of encoding names and aliases is distilled from
11718# http://www.iana.org/assignments/character-sets.
11719# Not all of them are supported by Tcl.
11720set encoding_aliases {
11721    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11722      ISO646-US US-ASCII us IBM367 cp367 csASCII }
11723    { ISO-10646-UTF-1 csISO10646UTF1 }
11724    { ISO_646.basic:1983 ref csISO646basic1983 }
11725    { INVARIANT csINVARIANT }
11726    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11727    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11728    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11729    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11730    { NATS-DANO iso-ir-9-1 csNATSDANO }
11731    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11732    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11733    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11734    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11735    { ISO-2022-KR csISO2022KR }
11736    { EUC-KR csEUCKR }
11737    { ISO-2022-JP csISO2022JP }
11738    { ISO-2022-JP-2 csISO2022JP2 }
11739    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11740      csISO13JISC6220jp }
11741    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11742    { IT iso-ir-15 ISO646-IT csISO15Italian }
11743    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11744    { ES iso-ir-17 ISO646-ES csISO17Spanish }
11745    { greek7-old iso-ir-18 csISO18Greek7Old }
11746    { latin-greek iso-ir-19 csISO19LatinGreek }
11747    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11748    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11749    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11750    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11751    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11752    { BS_viewdata iso-ir-47 csISO47BSViewdata }
11753    { INIS iso-ir-49 csISO49INIS }
11754    { INIS-8 iso-ir-50 csISO50INIS8 }
11755    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11756    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11757    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11758    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11759    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11760    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11761      csISO60Norwegian1 }
11762    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11763    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11764    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11765    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11766    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11767    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11768    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11769    { greek7 iso-ir-88 csISO88Greek7 }
11770    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11771    { iso-ir-90 csISO90 }
11772    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11773    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11774      csISO92JISC62991984b }
11775    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11776    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11777    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11778      csISO95JIS62291984handadd }
11779    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11780    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11781    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11782    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11783      CP819 csISOLatin1 }
11784    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11785    { T.61-7bit iso-ir-102 csISO102T617bit }
11786    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11787    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
11788    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
11789    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
11790    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
11791    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
11792    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
11793    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
11794      arabic csISOLatinArabic }
11795    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
11796    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
11797    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
11798      greek greek8 csISOLatinGreek }
11799    { T.101-G2 iso-ir-128 csISO128T101G2 }
11800    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
11801      csISOLatinHebrew }
11802    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
11803    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
11804    { CSN_369103 iso-ir-139 csISO139CSN369103 }
11805    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
11806    { ISO_6937-2-add iso-ir-142 csISOTextComm }
11807    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
11808    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
11809      csISOLatinCyrillic }
11810    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
11811    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
11812    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
11813    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
11814    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
11815    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
11816    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
11817    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
11818    { ISO_10367-box iso-ir-155 csISO10367Box }
11819    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
11820    { latin-lap lap iso-ir-158 csISO158Lap }
11821    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
11822    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
11823    { us-dk csUSDK }
11824    { dk-us csDKUS }
11825    { JIS_X0201 X0201 csHalfWidthKatakana }
11826    { KSC5636 ISO646-KR csKSC5636 }
11827    { ISO-10646-UCS-2 csUnicode }
11828    { ISO-10646-UCS-4 csUCS4 }
11829    { DEC-MCS dec csDECMCS }
11830    { hp-roman8 roman8 r8 csHPRoman8 }
11831    { macintosh mac csMacintosh }
11832    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
11833      csIBM037 }
11834    { IBM038 EBCDIC-INT cp038 csIBM038 }
11835    { IBM273 CP273 csIBM273 }
11836    { IBM274 EBCDIC-BE CP274 csIBM274 }
11837    { IBM275 EBCDIC-BR cp275 csIBM275 }
11838    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
11839    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
11840    { IBM280 CP280 ebcdic-cp-it csIBM280 }
11841    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
11842    { IBM284 CP284 ebcdic-cp-es csIBM284 }
11843    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
11844    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
11845    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
11846    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
11847    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
11848    { IBM424 cp424 ebcdic-cp-he csIBM424 }
11849    { IBM437 cp437 437 csPC8CodePage437 }
11850    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
11851    { IBM775 cp775 csPC775Baltic }
11852    { IBM850 cp850 850 csPC850Multilingual }
11853    { IBM851 cp851 851 csIBM851 }
11854    { IBM852 cp852 852 csPCp852 }
11855    { IBM855 cp855 855 csIBM855 }
11856    { IBM857 cp857 857 csIBM857 }
11857    { IBM860 cp860 860 csIBM860 }
11858    { IBM861 cp861 861 cp-is csIBM861 }
11859    { IBM862 cp862 862 csPC862LatinHebrew }
11860    { IBM863 cp863 863 csIBM863 }
11861    { IBM864 cp864 csIBM864 }
11862    { IBM865 cp865 865 csIBM865 }
11863    { IBM866 cp866 866 csIBM866 }
11864    { IBM868 CP868 cp-ar csIBM868 }
11865    { IBM869 cp869 869 cp-gr csIBM869 }
11866    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
11867    { IBM871 CP871 ebcdic-cp-is csIBM871 }
11868    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
11869    { IBM891 cp891 csIBM891 }
11870    { IBM903 cp903 csIBM903 }
11871    { IBM904 cp904 904 csIBBM904 }
11872    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
11873    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
11874    { IBM1026 CP1026 csIBM1026 }
11875    { EBCDIC-AT-DE csIBMEBCDICATDE }
11876    { EBCDIC-AT-DE-A csEBCDICATDEA }
11877    { EBCDIC-CA-FR csEBCDICCAFR }
11878    { EBCDIC-DK-NO csEBCDICDKNO }
11879    { EBCDIC-DK-NO-A csEBCDICDKNOA }
11880    { EBCDIC-FI-SE csEBCDICFISE }
11881    { EBCDIC-FI-SE-A csEBCDICFISEA }
11882    { EBCDIC-FR csEBCDICFR }
11883    { EBCDIC-IT csEBCDICIT }
11884    { EBCDIC-PT csEBCDICPT }
11885    { EBCDIC-ES csEBCDICES }
11886    { EBCDIC-ES-A csEBCDICESA }
11887    { EBCDIC-ES-S csEBCDICESS }
11888    { EBCDIC-UK csEBCDICUK }
11889    { EBCDIC-US csEBCDICUS }
11890    { UNKNOWN-8BIT csUnknown8BiT }
11891    { MNEMONIC csMnemonic }
11892    { MNEM csMnem }
11893    { VISCII csVISCII }
11894    { VIQR csVIQR }
11895    { KOI8-R csKOI8R }
11896    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
11897    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
11898    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
11899    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
11900    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
11901    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
11902    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
11903    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
11904    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
11905    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
11906    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
11907    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
11908    { IBM1047 IBM-1047 }
11909    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
11910    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
11911    { UNICODE-1-1 csUnicode11 }
11912    { CESU-8 csCESU-8 }
11913    { BOCU-1 csBOCU-1 }
11914    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
11915    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
11916      l8 }
11917    { ISO-8859-15 ISO_8859-15 Latin-9 }
11918    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
11919    { GBK CP936 MS936 windows-936 }
11920    { JIS_Encoding csJISEncoding }
11921    { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
11922    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
11923      EUC-JP }
11924    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
11925    { ISO-10646-UCS-Basic csUnicodeASCII }
11926    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
11927    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
11928    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
11929    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
11930    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
11931    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
11932    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
11933    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
11934    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
11935    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
11936    { Adobe-Standard-Encoding csAdobeStandardEncoding }
11937    { Ventura-US csVenturaUS }
11938    { Ventura-International csVenturaInternational }
11939    { PC8-Danish-Norwegian csPC8DanishNorwegian }
11940    { PC8-Turkish csPC8Turkish }
11941    { IBM-Symbols csIBMSymbols }
11942    { IBM-Thai csIBMThai }
11943    { HP-Legal csHPLegal }
11944    { HP-Pi-font csHPPiFont }
11945    { HP-Math8 csHPMath8 }
11946    { Adobe-Symbol-Encoding csHPPSMath }
11947    { HP-DeskTop csHPDesktop }
11948    { Ventura-Math csVenturaMath }
11949    { Microsoft-Publishing csMicrosoftPublishing }
11950    { Windows-31J csWindows31J }
11951    { GB2312 csGB2312 }
11952    { Big5 csBig5 }
11953}
11954
11955proc tcl_encoding {enc} {
11956    global encoding_aliases tcl_encoding_cache
11957    if {[info exists tcl_encoding_cache($enc)]} {
11958        return $tcl_encoding_cache($enc)
11959    }
11960    set names [encoding names]
11961    set lcnames [string tolower $names]
11962    set enc [string tolower $enc]
11963    set i [lsearch -exact $lcnames $enc]
11964    if {$i < 0} {
11965        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
11966        if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
11967            set i [lsearch -exact $lcnames $encx]
11968        }
11969    }
11970    if {$i < 0} {
11971        foreach l $encoding_aliases {
11972            set ll [string tolower $l]
11973            if {[lsearch -exact $ll $enc] < 0} continue
11974            # look through the aliases for one that tcl knows about
11975            foreach e $ll {
11976                set i [lsearch -exact $lcnames $e]
11977                if {$i < 0} {
11978                    if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
11979                        set i [lsearch -exact $lcnames $ex]
11980                    }
11981                }
11982                if {$i >= 0} break
11983            }
11984            break
11985        }
11986    }
11987    set tclenc {}
11988    if {$i >= 0} {
11989        set tclenc [lindex $names $i]
11990    }
11991    set tcl_encoding_cache($enc) $tclenc
11992    return $tclenc
11993}
11994
11995proc gitattr {path attr default} {
11996    global path_attr_cache
11997    if {[info exists path_attr_cache($attr,$path)]} {
11998        set r $path_attr_cache($attr,$path)
11999    } else {
12000        set r "unspecified"
12001        if {![catch {set line [exec git check-attr $attr -- $path]}]} {
12002            regexp "(.*): $attr: (.*)" $line m f r
12003        }
12004        set path_attr_cache($attr,$path) $r
12005    }
12006    if {$r eq "unspecified"} {
12007        return $default
12008    }
12009    return $r
12010}
12011
12012proc cache_gitattr {attr pathlist} {
12013    global path_attr_cache
12014    set newlist {}
12015    foreach path $pathlist {
12016        if {![info exists path_attr_cache($attr,$path)]} {
12017            lappend newlist $path
12018        }
12019    }
12020    set lim 1000
12021    if {[tk windowingsystem] == "win32"} {
12022        # windows has a 32k limit on the arguments to a command...
12023        set lim 30
12024    }
12025    while {$newlist ne {}} {
12026        set head [lrange $newlist 0 [expr {$lim - 1}]]
12027        set newlist [lrange $newlist $lim end]
12028        if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
12029            foreach row [split $rlist "\n"] {
12030                if {[regexp "(.*): $attr: (.*)" $row m path value]} {
12031                    if {[string index $path 0] eq "\""} {
12032                        set path [encoding convertfrom [lindex $path 0]]
12033                    }
12034                    set path_attr_cache($attr,$path) $value
12035                }
12036            }
12037        }
12038    }
12039}
12040
12041proc get_path_encoding {path} {
12042    global gui_encoding perfile_attrs
12043    set tcl_enc $gui_encoding
12044    if {$path ne {} && $perfile_attrs} {
12045        set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
12046        if {$enc2 ne {}} {
12047            set tcl_enc $enc2
12048        }
12049    }
12050    return $tcl_enc
12051}
12052
12053## For msgcat loading, first locate the installation location.
12054if { [info exists ::env(GITK_MSGSDIR)] } {
12055    ## Msgsdir was manually set in the environment.
12056    set gitk_msgsdir $::env(GITK_MSGSDIR)
12057} else {
12058    ## Let's guess the prefix from argv0.
12059    set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
12060    set gitk_libdir [file join $gitk_prefix share gitk lib]
12061    set gitk_msgsdir [file join $gitk_libdir msgs]
12062    unset gitk_prefix
12063}
12064
12065## Internationalization (i18n) through msgcat and gettext. See
12066## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
12067package require msgcat
12068namespace import ::msgcat::mc
12069## And eventually load the actual message catalog
12070::msgcat::mcload $gitk_msgsdir
12071
12072# First check that Tcl/Tk is recent enough
12073if {[catch {package require Tk 8.4} err]} {
12074    show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
12075                         Gitk requires at least Tcl/Tk 8.4."]
12076    exit 1
12077}
12078
12079# on OSX bring the current Wish process window to front
12080if {[tk windowingsystem] eq "aqua"} {
12081    exec osascript -e [format {
12082        tell application "System Events"
12083            set frontmost of processes whose unix id is %d to true
12084        end tell
12085    } [pid] ]
12086}
12087
12088# Unset GIT_TRACE var if set
12089if { [info exists ::env(GIT_TRACE)] } {
12090    unset ::env(GIT_TRACE)
12091}
12092
12093# defaults...
12094set wrcomcmd "git diff-tree --stdin -p --pretty=email"
12095
12096set gitencoding {}
12097catch {
12098    set gitencoding [exec git config --get i18n.commitencoding]
12099}
12100catch {
12101    set gitencoding [exec git config --get i18n.logoutputencoding]
12102}
12103if {$gitencoding == ""} {
12104    set gitencoding "utf-8"
12105}
12106set tclencoding [tcl_encoding $gitencoding]
12107if {$tclencoding == {}} {
12108    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
12109}
12110
12111set gui_encoding [encoding system]
12112catch {
12113    set enc [exec git config --get gui.encoding]
12114    if {$enc ne {}} {
12115        set tclenc [tcl_encoding $enc]
12116        if {$tclenc ne {}} {
12117            set gui_encoding $tclenc
12118        } else {
12119            puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
12120        }
12121    }
12122}
12123
12124set log_showroot true
12125catch {
12126    set log_showroot [exec git config --bool --get log.showroot]
12127}
12128
12129if {[tk windowingsystem] eq "aqua"} {
12130    set mainfont {{Lucida Grande} 9}
12131    set textfont {Monaco 9}
12132    set uifont {{Lucida Grande} 9 bold}
12133} elseif {![catch {::tk::pkgconfig get fontsystem} xft] && $xft eq "xft"} {
12134    # fontconfig!
12135    set mainfont {sans 9}
12136    set textfont {monospace 9}
12137    set uifont {sans 9 bold}
12138} else {
12139    set mainfont {Helvetica 9}
12140    set textfont {Courier 9}
12141    set uifont {Helvetica 9 bold}
12142}
12143set tabstop 8
12144set findmergefiles 0
12145set maxgraphpct 50
12146set maxwidth 16
12147set revlistorder 0
12148set fastdate 0
12149set uparrowlen 5
12150set downarrowlen 5
12151set mingaplen 100
12152set cmitmode "patch"
12153set wrapcomment "none"
12154set showneartags 1
12155set hideremotes 0
12156set maxrefs 20
12157set visiblerefs {"master"}
12158set maxlinelen 200
12159set showlocalchanges 1
12160set limitdiffs 1
12161set datetimeformat "%Y-%m-%d %H:%M:%S"
12162set autoselect 1
12163set autosellen 40
12164set perfile_attrs 0
12165set want_ttk 1
12166
12167if {[tk windowingsystem] eq "aqua"} {
12168    set extdifftool "opendiff"
12169} else {
12170    set extdifftool "meld"
12171}
12172
12173set colors {green red blue magenta darkgrey brown orange}
12174if {[tk windowingsystem] eq "win32"} {
12175    set uicolor SystemButtonFace
12176    set uifgcolor SystemButtonText
12177    set uifgdisabledcolor SystemDisabledText
12178    set bgcolor SystemWindow
12179    set fgcolor SystemWindowText
12180    set selectbgcolor SystemHighlight
12181} else {
12182    set uicolor grey85
12183    set uifgcolor black
12184    set uifgdisabledcolor "#999"
12185    set bgcolor white
12186    set fgcolor black
12187    set selectbgcolor gray85
12188}
12189set diffcolors {red "#00a000" blue}
12190set diffcontext 3
12191set mergecolors {red blue green purple brown "#009090" magenta "#808000" "#009000" "#ff0080" cyan "#b07070" "#70b0f0" "#70f0b0" "#f0b070" "#ff70b0"}
12192set ignorespace 0
12193set worddiff ""
12194set markbgcolor "#e0e0ff"
12195
12196set headbgcolor green
12197set headfgcolor black
12198set headoutlinecolor black
12199set remotebgcolor #ffddaa
12200set tagbgcolor yellow
12201set tagfgcolor black
12202set tagoutlinecolor black
12203set reflinecolor black
12204set filesepbgcolor #aaaaaa
12205set filesepfgcolor black
12206set linehoverbgcolor #ffff80
12207set linehoverfgcolor black
12208set linehoveroutlinecolor black
12209set mainheadcirclecolor yellow
12210set workingfilescirclecolor red
12211set indexcirclecolor green
12212set circlecolors {white blue gray blue blue}
12213set linkfgcolor blue
12214set circleoutlinecolor $fgcolor
12215set foundbgcolor yellow
12216set currentsearchhitbgcolor orange
12217
12218# button for popping up context menus
12219if {[tk windowingsystem] eq "aqua"} {
12220    set ctxbut <Button-2>
12221} else {
12222    set ctxbut <Button-3>
12223}
12224
12225catch {
12226    # follow the XDG base directory specification by default. See
12227    # http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html
12228    if {[info exists env(XDG_CONFIG_HOME)] && $env(XDG_CONFIG_HOME) ne ""} {
12229        # XDG_CONFIG_HOME environment variable is set
12230        set config_file [file join $env(XDG_CONFIG_HOME) git gitk]
12231        set config_file_tmp [file join $env(XDG_CONFIG_HOME) git gitk-tmp]
12232    } else {
12233        # default XDG_CONFIG_HOME
12234        set config_file "~/.config/git/gitk"
12235        set config_file_tmp "~/.config/git/gitk-tmp"
12236    }
12237    if {![file exists $config_file]} {
12238        # for backward compatibility use the old config file if it exists
12239        if {[file exists "~/.gitk"]} {
12240            set config_file "~/.gitk"
12241            set config_file_tmp "~/.gitk-tmp"
12242        } elseif {![file exists [file dirname $config_file]]} {
12243            file mkdir [file dirname $config_file]
12244        }
12245    }
12246    source $config_file
12247}
12248config_check_tmp_exists 50
12249
12250set config_variables {
12251    mainfont textfont uifont tabstop findmergefiles maxgraphpct maxwidth
12252    cmitmode wrapcomment autoselect autosellen showneartags maxrefs visiblerefs
12253    hideremotes showlocalchanges datetimeformat limitdiffs uicolor want_ttk
12254    bgcolor fgcolor uifgcolor uifgdisabledcolor colors diffcolors mergecolors
12255    markbgcolor diffcontext selectbgcolor foundbgcolor currentsearchhitbgcolor
12256    extdifftool perfile_attrs headbgcolor headfgcolor headoutlinecolor
12257    remotebgcolor tagbgcolor tagfgcolor tagoutlinecolor reflinecolor
12258    filesepbgcolor filesepfgcolor linehoverbgcolor linehoverfgcolor
12259    linehoveroutlinecolor mainheadcirclecolor workingfilescirclecolor
12260    indexcirclecolor circlecolors linkfgcolor circleoutlinecolor
12261}
12262foreach var $config_variables {
12263    config_init_trace $var
12264    trace add variable $var write config_variable_change_cb
12265}
12266
12267parsefont mainfont $mainfont
12268eval font create mainfont [fontflags mainfont]
12269eval font create mainfontbold [fontflags mainfont 1]
12270
12271parsefont textfont $textfont
12272eval font create textfont [fontflags textfont]
12273eval font create textfontbold [fontflags textfont 1]
12274
12275parsefont uifont $uifont
12276eval font create uifont [fontflags uifont]
12277
12278setui $uicolor
12279
12280setoptions
12281
12282# check that we can find a .git directory somewhere...
12283if {[catch {set gitdir [exec git rev-parse --git-dir]}]} {
12284    show_error {} . [mc "Cannot find a git repository here."]
12285    exit 1
12286}
12287
12288set selecthead {}
12289set selectheadid {}
12290
12291set revtreeargs {}
12292set cmdline_files {}
12293set i 0
12294set revtreeargscmd {}
12295foreach arg $argv {
12296    switch -glob -- $arg {
12297        "" { }
12298        "--" {
12299            set cmdline_files [lrange $argv [expr {$i + 1}] end]
12300            break
12301        }
12302        "--select-commit=*" {
12303            set selecthead [string range $arg 16 end]
12304        }
12305        "--argscmd=*" {
12306            set revtreeargscmd [string range $arg 10 end]
12307        }
12308        default {
12309            lappend revtreeargs $arg
12310        }
12311    }
12312    incr i
12313}
12314
12315if {$selecthead eq "HEAD"} {
12316    set selecthead {}
12317}
12318
12319if {$i >= [llength $argv] && $revtreeargs ne {}} {
12320    # no -- on command line, but some arguments (other than --argscmd)
12321    if {[catch {
12322        set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
12323        set cmdline_files [split $f "\n"]
12324        set n [llength $cmdline_files]
12325        set revtreeargs [lrange $revtreeargs 0 end-$n]
12326        # Unfortunately git rev-parse doesn't produce an error when
12327        # something is both a revision and a filename.  To be consistent
12328        # with git log and git rev-list, check revtreeargs for filenames.
12329        foreach arg $revtreeargs {
12330            if {[file exists $arg]} {
12331                show_error {} . [mc "Ambiguous argument '%s': both revision\
12332                                 and filename" $arg]
12333                exit 1
12334            }
12335        }
12336    } err]} {
12337        # unfortunately we get both stdout and stderr in $err,
12338        # so look for "fatal:".
12339        set i [string first "fatal:" $err]
12340        if {$i > 0} {
12341            set err [string range $err [expr {$i + 6}] end]
12342        }
12343        show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
12344        exit 1
12345    }
12346}
12347
12348set nullid "0000000000000000000000000000000000000000"
12349set nullid2 "0000000000000000000000000000000000000001"
12350set nullfile "/dev/null"
12351
12352set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
12353if {![info exists have_ttk]} {
12354    set have_ttk [llength [info commands ::ttk::style]]
12355}
12356set use_ttk [expr {$have_ttk && $want_ttk}]
12357set NS [expr {$use_ttk ? "ttk" : ""}]
12358
12359regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
12360
12361set show_notes {}
12362if {[package vcompare $git_version "1.6.6.2"] >= 0} {
12363    set show_notes "--show-notes"
12364}
12365
12366set appname "gitk"
12367
12368set runq {}
12369set history {}
12370set historyindex 0
12371set fh_serial 0
12372set nhl_names {}
12373set highlight_paths {}
12374set findpattern {}
12375set searchdirn -forwards
12376set boldids {}
12377set boldnameids {}
12378set diffelide {0 0}
12379set markingmatches 0
12380set linkentercount 0
12381set need_redisplay 0
12382set nrows_drawn 0
12383set firsttabstop 0
12384
12385set nextviewnum 1
12386set curview 0
12387set selectedview 0
12388set selectedhlview [mc "None"]
12389set highlight_related [mc "None"]
12390set highlight_files {}
12391set viewfiles(0) {}
12392set viewperm(0) 0
12393set viewchanged(0) 0
12394set viewargs(0) {}
12395set viewargscmd(0) {}
12396
12397set selectedline {}
12398set numcommits 0
12399set loginstance 0
12400set cmdlineok 0
12401set stopped 0
12402set stuffsaved 0
12403set patchnum 0
12404set lserial 0
12405set hasworktree [hasworktree]
12406set cdup {}
12407if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} {
12408    set cdup [exec git rev-parse --show-cdup]
12409}
12410set worktree [exec git rev-parse --show-toplevel]
12411setcoords
12412makewindow
12413catch {
12414    image create photo gitlogo      -width 16 -height 16
12415
12416    image create photo gitlogominus -width  4 -height  2
12417    gitlogominus put #C00000 -to 0 0 4 2
12418    gitlogo copy gitlogominus -to  1 5
12419    gitlogo copy gitlogominus -to  6 5
12420    gitlogo copy gitlogominus -to 11 5
12421    image delete gitlogominus
12422
12423    image create photo gitlogoplus  -width  4 -height  4
12424    gitlogoplus  put #008000 -to 1 0 3 4
12425    gitlogoplus  put #008000 -to 0 1 4 3
12426    gitlogo copy gitlogoplus  -to  1 9
12427    gitlogo copy gitlogoplus  -to  6 9
12428    gitlogo copy gitlogoplus  -to 11 9
12429    image delete gitlogoplus
12430
12431    image create photo gitlogo32    -width 32 -height 32
12432    gitlogo32 copy gitlogo -zoom 2 2
12433
12434    wm iconphoto . -default gitlogo gitlogo32
12435}
12436# wait for the window to become visible
12437tkwait visibility .
12438set_window_title
12439update
12440readrefs
12441
12442if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
12443    # create a view for the files/dirs specified on the command line
12444    set curview 1
12445    set selectedview 1
12446    set nextviewnum 2
12447    set viewname(1) [mc "Command line"]
12448    set viewfiles(1) $cmdline_files
12449    set viewargs(1) $revtreeargs
12450    set viewargscmd(1) $revtreeargscmd
12451    set viewperm(1) 0
12452    set viewchanged(1) 0
12453    set vdatemode(1) 0
12454    addviewmenu 1
12455    .bar.view entryconf [mca "&Edit view..."] -state normal
12456    .bar.view entryconf [mca "&Delete view"] -state normal
12457}
12458
12459if {[info exists permviews]} {
12460    foreach v $permviews {
12461        set n $nextviewnum
12462        incr nextviewnum
12463        set viewname($n) [lindex $v 0]
12464        set viewfiles($n) [lindex $v 1]
12465        set viewargs($n) [lindex $v 2]
12466        set viewargscmd($n) [lindex $v 3]
12467        set viewperm($n) 1
12468        set viewchanged($n) 0
12469        addviewmenu $n
12470    }
12471}
12472
12473if {[tk windowingsystem] eq "win32"} {
12474    focus -force .
12475}
12476
12477getcommits {}
12478
12479# Local variables:
12480# mode: tcl
12481# indent-tabs-mode: t
12482# tab-width: 8
12483# End: