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