gitk-git / gitkon commit git-p4: do not pass '-r 0' to p4 commands (bc23352)
   1#!/bin/sh
   2# Tcl ignores the next line -*- tcl -*- \
   3exec wish "$0" -- "$@"
   4
   5# Copyright © 2005-2014 Paul Mackerras.  All rights reserved.
   6# This program is free software; it may be used, copied, modified
   7# and distributed under the terms of the GNU General Public Licence,
   8# either version 2, or (at your option) any later version.
   9
  10package require Tk
  11
  12proc hasworktree {} {
  13    return [expr {[exec git rev-parse --is-bare-repository] == "false" &&
  14                  [exec git rev-parse --is-inside-git-dir] == "false"}]
  15}
  16
  17proc reponame {} {
  18    global gitdir
  19    set n [file normalize $gitdir]
  20    if {[string match "*/.git" $n]} {
  21        set n [string range $n 0 end-5]
  22    }
  23    return [file tail $n]
  24}
  25
  26proc gitworktree {} {
  27    variable _gitworktree
  28    if {[info exists _gitworktree]} {
  29        return $_gitworktree
  30    }
  31    # v1.7.0 introduced --show-toplevel to return the canonical work-tree
  32    if {[catch {set _gitworktree [exec git rev-parse --show-toplevel]}]} {
  33        # try to set work tree from environment, core.worktree or use
  34        # cdup to obtain a relative path to the top of the worktree. If
  35        # run from the top, the ./ prefix ensures normalize expands pwd.
  36        if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
  37            catch {set _gitworktree [exec git config --get core.worktree]}
  38            if {$_gitworktree eq ""} {
  39                set _gitworktree [file normalize ./[exec git rev-parse --show-cdup]]
  40            }
  41        }
  42    }
  43    return $_gitworktree
  44}
  45
  46# A simple scheduler for compute-intensive stuff.
  47# The aim is to make sure that event handlers for GUI actions can
  48# run at least every 50-100 ms.  Unfortunately fileevent handlers are
  49# run before X event handlers, so reading from a fast source can
  50# make the GUI completely unresponsive.
  51proc run args {
  52    global isonrunq runq currunq
  53
  54    set script $args
  55    if {[info exists isonrunq($script)]} return
  56    if {$runq eq {} && ![info exists currunq]} {
  57        after idle dorunq
  58    }
  59    lappend runq [list {} $script]
  60    set isonrunq($script) 1
  61}
  62
  63proc filerun {fd script} {
  64    fileevent $fd readable [list filereadable $fd $script]
  65}
  66
  67proc filereadable {fd script} {
  68    global runq currunq
  69
  70    fileevent $fd readable {}
  71    if {$runq eq {} && ![info exists currunq]} {
  72        after idle dorunq
  73    }
  74    lappend runq [list $fd $script]
  75}
  76
  77proc nukefile {fd} {
  78    global runq
  79
  80    for {set i 0} {$i < [llength $runq]} {} {
  81        if {[lindex $runq $i 0] eq $fd} {
  82            set runq [lreplace $runq $i $i]
  83        } else {
  84            incr i
  85        }
  86    }
  87}
  88
  89proc dorunq {} {
  90    global isonrunq runq currunq
  91
  92    set tstart [clock clicks -milliseconds]
  93    set t0 $tstart
  94    while {[llength $runq] > 0} {
  95        set fd [lindex $runq 0 0]
  96        set script [lindex $runq 0 1]
  97        set currunq [lindex $runq 0]
  98        set runq [lrange $runq 1 end]
  99        set repeat [eval $script]
 100        unset currunq
 101        set t1 [clock clicks -milliseconds]
 102        set t [expr {$t1 - $t0}]
 103        if {$repeat ne {} && $repeat} {
 104            if {$fd eq {} || $repeat == 2} {
 105                # script returns 1 if it wants to be readded
 106                # file readers return 2 if they could do more straight away
 107                lappend runq [list $fd $script]
 108            } else {
 109                fileevent $fd readable [list filereadable $fd $script]
 110            }
 111        } elseif {$fd eq {}} {
 112            unset isonrunq($script)
 113        }
 114        set t0 $t1
 115        if {$t1 - $tstart >= 80} break
 116    }
 117    if {$runq ne {}} {
 118        after idle dorunq
 119    }
 120}
 121
 122proc reg_instance {fd} {
 123    global commfd leftover loginstance
 124
 125    set i [incr loginstance]
 126    set commfd($i) $fd
 127    set leftover($i) {}
 128    return $i
 129}
 130
 131proc unmerged_files {files} {
 132    global nr_unmerged
 133
 134    # find the list of unmerged files
 135    set mlist {}
 136    set nr_unmerged 0
 137    if {[catch {
 138        set fd [open "| git ls-files -u" r]
 139    } err]} {
 140        show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
 141        exit 1
 142    }
 143    while {[gets $fd line] >= 0} {
 144        set i [string first "\t" $line]
 145        if {$i < 0} continue
 146        set fname [string range $line [expr {$i+1}] end]
 147        if {[lsearch -exact $mlist $fname] >= 0} continue
 148        incr nr_unmerged
 149        if {$files eq {} || [path_filter $files $fname]} {
 150            lappend mlist $fname
 151        }
 152    }
 153    catch {close $fd}
 154    return $mlist
 155}
 156
 157proc parseviewargs {n arglist} {
 158    global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs env
 159    global vinlinediff
 160    global worddiff git_version
 161
 162    set vdatemode($n) 0
 163    set vmergeonly($n) 0
 164    set vinlinediff($n) 0
 165    set glflags {}
 166    set diffargs {}
 167    set nextisval 0
 168    set revargs {}
 169    set origargs $arglist
 170    set allknown 1
 171    set filtered 0
 172    set i -1
 173    foreach arg $arglist {
 174        incr i
 175        if {$nextisval} {
 176            lappend glflags $arg
 177            set nextisval 0
 178            continue
 179        }
 180        switch -glob -- $arg {
 181            "-d" -
 182            "--date-order" {
 183                set vdatemode($n) 1
 184                # remove from origargs in case we hit an unknown option
 185                set origargs [lreplace $origargs $i $i]
 186                incr i -1
 187            }
 188            "-[puabwcrRBMC]" -
 189            "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
 190            "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
 191            "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
 192            "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
 193            "--ignore-space-change" - "-U*" - "--unified=*" {
 194                # These request or affect diff output, which we don't want.
 195                # Some could be used to set our defaults for diff display.
 196                lappend diffargs $arg
 197            }
 198            "--raw" - "--patch-with-raw" - "--patch-with-stat" -
 199            "--name-only" - "--name-status" - "--color" -
 200            "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
 201            "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
 202            "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
 203            "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
 204            "--objects" - "--objects-edge" - "--reverse" {
 205                # These cause our parsing of git log's output to fail, or else
 206                # they're options we want to set ourselves, so ignore them.
 207            }
 208            "--color-words*" - "--word-diff=color" {
 209                # These trigger a word diff in the console interface,
 210                # so help the user by enabling our own support
 211                if {[package vcompare $git_version "1.7.2"] >= 0} {
 212                    set worddiff [mc "Color words"]
 213                }
 214            }
 215            "--word-diff*" {
 216                if {[package vcompare $git_version "1.7.2"] >= 0} {
 217                    set worddiff [mc "Markup words"]
 218                }
 219            }
 220            "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
 221            "--check" - "--exit-code" - "--quiet" - "--topo-order" -
 222            "--full-history" - "--dense" - "--sparse" -
 223            "--follow" - "--left-right" - "--encoding=*" {
 224                # These are harmless, and some are even useful
 225                lappend glflags $arg
 226            }
 227            "--diff-filter=*" - "--no-merges" - "--unpacked" -
 228            "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
 229            "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
 230            "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
 231            "--remove-empty" - "--first-parent" - "--cherry-pick" -
 232            "-S*" - "-G*" - "--pickaxe-all" - "--pickaxe-regex" -
 233            "--simplify-by-decoration" {
 234                # These mean that we get a subset of the commits
 235                set filtered 1
 236                lappend glflags $arg
 237            }
 238            "-L*" {
 239                # Line-log with 'stuck' argument (unstuck form is
 240                # not supported)
 241                set filtered 1
 242                set vinlinediff($n) 1
 243                set allknown 0
 244                lappend glflags $arg
 245            }
 246            "-n" {
 247                # This appears to be the only one that has a value as a
 248                # separate word following it
 249                set filtered 1
 250                set nextisval 1
 251                lappend glflags $arg
 252            }
 253            "--not" - "--all" {
 254                lappend revargs $arg
 255            }
 256            "--merge" {
 257                set vmergeonly($n) 1
 258                # git rev-parse doesn't understand --merge
 259                lappend revargs --gitk-symmetric-diff-marker MERGE_HEAD...HEAD
 260            }
 261            "--no-replace-objects" {
 262                set env(GIT_NO_REPLACE_OBJECTS) "1"
 263            }
 264            "-*" {
 265                # Other flag arguments including -<n>
 266                if {[string is digit -strict [string range $arg 1 end]]} {
 267                    set filtered 1
 268                } else {
 269                    # a flag argument that we don't recognize;
 270                    # that means we can't optimize
 271                    set allknown 0
 272                }
 273                lappend glflags $arg
 274            }
 275            default {
 276                # Non-flag arguments specify commits or ranges of commits
 277                if {[string match "*...*" $arg]} {
 278                    lappend revargs --gitk-symmetric-diff-marker
 279                }
 280                lappend revargs $arg
 281            }
 282        }
 283    }
 284    set vdflags($n) $diffargs
 285    set vflags($n) $glflags
 286    set vrevs($n) $revargs
 287    set vfiltered($n) $filtered
 288    set vorigargs($n) $origargs
 289    return $allknown
 290}
 291
 292proc parseviewrevs {view revs} {
 293    global vposids vnegids
 294
 295    if {$revs eq {}} {
 296        set revs HEAD
 297    } elseif {[lsearch -exact $revs --all] >= 0} {
 298        lappend revs HEAD
 299    }
 300    if {[catch {set ids [eval exec git rev-parse $revs]} err]} {
 301        # we get stdout followed by stderr in $err
 302        # for an unknown rev, git rev-parse echoes it and then errors out
 303        set errlines [split $err "\n"]
 304        set badrev {}
 305        for {set l 0} {$l < [llength $errlines]} {incr l} {
 306            set line [lindex $errlines $l]
 307            if {!([string length $line] == 40 && [string is xdigit $line])} {
 308                if {[string match "fatal:*" $line]} {
 309                    if {[string match "fatal: ambiguous argument*" $line]
 310                        && $badrev ne {}} {
 311                        if {[llength $badrev] == 1} {
 312                            set err "unknown revision $badrev"
 313                        } else {
 314                            set err "unknown revisions: [join $badrev ", "]"
 315                        }
 316                    } else {
 317                        set err [join [lrange $errlines $l end] "\n"]
 318                    }
 319                    break
 320                }
 321                lappend badrev $line
 322            }
 323        }
 324        error_popup "[mc "Error parsing revisions:"] $err"
 325        return {}
 326    }
 327    set ret {}
 328    set pos {}
 329    set neg {}
 330    set sdm 0
 331    foreach id [split $ids "\n"] {
 332        if {$id eq "--gitk-symmetric-diff-marker"} {
 333            set sdm 4
 334        } elseif {[string match "^*" $id]} {
 335            if {$sdm != 1} {
 336                lappend ret $id
 337                if {$sdm == 3} {
 338                    set sdm 0
 339                }
 340            }
 341            lappend neg [string range $id 1 end]
 342        } else {
 343            if {$sdm != 2} {
 344                lappend ret $id
 345            } else {
 346                lset ret end $id...[lindex $ret end]
 347            }
 348            lappend pos $id
 349        }
 350        incr sdm -1
 351    }
 352    set vposids($view) $pos
 353    set vnegids($view) $neg
 354    return $ret
 355}
 356
 357# Start off a git log process and arrange to read its output
 358proc start_rev_list {view} {
 359    global startmsecs commitidx viewcomplete curview
 360    global tclencoding
 361    global viewargs viewargscmd viewfiles vfilelimit
 362    global showlocalchanges
 363    global viewactive viewinstances vmergeonly
 364    global mainheadid viewmainheadid viewmainheadid_orig
 365    global vcanopt vflags vrevs vorigargs
 366    global show_notes
 367
 368    set startmsecs [clock clicks -milliseconds]
 369    set commitidx($view) 0
 370    # these are set this way for the error exits
 371    set viewcomplete($view) 1
 372    set viewactive($view) 0
 373    varcinit $view
 374
 375    set args $viewargs($view)
 376    if {$viewargscmd($view) ne {}} {
 377        if {[catch {
 378            set str [exec sh -c $viewargscmd($view)]
 379        } err]} {
 380            error_popup "[mc "Error executing --argscmd command:"] $err"
 381            return 0
 382        }
 383        set args [concat $args [split $str "\n"]]
 384    }
 385    set vcanopt($view) [parseviewargs $view $args]
 386
 387    set files $viewfiles($view)
 388    if {$vmergeonly($view)} {
 389        set files [unmerged_files $files]
 390        if {$files eq {}} {
 391            global nr_unmerged
 392            if {$nr_unmerged == 0} {
 393                error_popup [mc "No files selected: --merge specified but\
 394                             no files are unmerged."]
 395            } else {
 396                error_popup [mc "No files selected: --merge specified but\
 397                             no unmerged files are within file limit."]
 398            }
 399            return 0
 400        }
 401    }
 402    set vfilelimit($view) $files
 403
 404    if {$vcanopt($view)} {
 405        set revs [parseviewrevs $view $vrevs($view)]
 406        if {$revs eq {}} {
 407            return 0
 408        }
 409        set args [concat $vflags($view) $revs]
 410    } else {
 411        set args $vorigargs($view)
 412    }
 413
 414    if {[catch {
 415        set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
 416                        --parents --boundary $args "--" $files] r]
 417    } err]} {
 418        error_popup "[mc "Error executing git log:"] $err"
 419        return 0
 420    }
 421    set i [reg_instance $fd]
 422    set viewinstances($view) [list $i]
 423    set viewmainheadid($view) $mainheadid
 424    set viewmainheadid_orig($view) $mainheadid
 425    if {$files ne {} && $mainheadid ne {}} {
 426        get_viewmainhead $view
 427    }
 428    if {$showlocalchanges && $viewmainheadid($view) ne {}} {
 429        interestedin $viewmainheadid($view) dodiffindex
 430    }
 431    fconfigure $fd -blocking 0 -translation lf -eofchar {}
 432    if {$tclencoding != {}} {
 433        fconfigure $fd -encoding $tclencoding
 434    }
 435    filerun $fd [list getcommitlines $fd $i $view 0]
 436    nowbusy $view [mc "Reading"]
 437    set viewcomplete($view) 0
 438    set viewactive($view) 1
 439    return 1
 440}
 441
 442proc stop_instance {inst} {
 443    global commfd leftover
 444
 445    set fd $commfd($inst)
 446    catch {
 447        set pid [pid $fd]
 448
 449        if {$::tcl_platform(platform) eq {windows}} {
 450            exec taskkill /pid $pid
 451        } else {
 452            exec kill $pid
 453        }
 454    }
 455    catch {close $fd}
 456    nukefile $fd
 457    unset commfd($inst)
 458    unset leftover($inst)
 459}
 460
 461proc stop_backends {} {
 462    global commfd
 463
 464    foreach inst [array names commfd] {
 465        stop_instance $inst
 466    }
 467}
 468
 469proc stop_rev_list {view} {
 470    global viewinstances
 471
 472    foreach inst $viewinstances($view) {
 473        stop_instance $inst
 474    }
 475    set viewinstances($view) {}
 476}
 477
 478proc reset_pending_select {selid} {
 479    global pending_select mainheadid selectheadid
 480
 481    if {$selid ne {}} {
 482        set pending_select $selid
 483    } elseif {$selectheadid ne {}} {
 484        set pending_select $selectheadid
 485    } else {
 486        set pending_select $mainheadid
 487    }
 488}
 489
 490proc getcommits {selid} {
 491    global canv curview need_redisplay viewactive
 492
 493    initlayout
 494    if {[start_rev_list $curview]} {
 495        reset_pending_select $selid
 496        show_status [mc "Reading commits..."]
 497        set need_redisplay 1
 498    } else {
 499        show_status [mc "No commits selected"]
 500    }
 501}
 502
 503proc updatecommits {} {
 504    global curview vcanopt vorigargs vfilelimit viewinstances
 505    global viewactive viewcomplete tclencoding
 506    global startmsecs showneartags showlocalchanges
 507    global mainheadid viewmainheadid viewmainheadid_orig pending_select
 508    global hasworktree
 509    global varcid vposids vnegids vflags vrevs
 510    global show_notes
 511
 512    set hasworktree [hasworktree]
 513    rereadrefs
 514    set view $curview
 515    if {$mainheadid ne $viewmainheadid_orig($view)} {
 516        if {$showlocalchanges} {
 517            dohidelocalchanges
 518        }
 519        set viewmainheadid($view) $mainheadid
 520        set viewmainheadid_orig($view) $mainheadid
 521        if {$vfilelimit($view) ne {}} {
 522            get_viewmainhead $view
 523        }
 524    }
 525    if {$showlocalchanges} {
 526        doshowlocalchanges
 527    }
 528    if {$vcanopt($view)} {
 529        set oldpos $vposids($view)
 530        set oldneg $vnegids($view)
 531        set revs [parseviewrevs $view $vrevs($view)]
 532        if {$revs eq {}} {
 533            return
 534        }
 535        # note: getting the delta when negative refs change is hard,
 536        # and could require multiple git log invocations, so in that
 537        # case we ask git log for all the commits (not just the delta)
 538        if {$oldneg eq $vnegids($view)} {
 539            set newrevs {}
 540            set npos 0
 541            # take out positive refs that we asked for before or
 542            # that we have already seen
 543            foreach rev $revs {
 544                if {[string length $rev] == 40} {
 545                    if {[lsearch -exact $oldpos $rev] < 0
 546                        && ![info exists varcid($view,$rev)]} {
 547                        lappend newrevs $rev
 548                        incr npos
 549                    }
 550                } else {
 551                    lappend $newrevs $rev
 552                }
 553            }
 554            if {$npos == 0} return
 555            set revs $newrevs
 556            set vposids($view) [lsort -unique [concat $oldpos $vposids($view)]]
 557        }
 558        set args [concat $vflags($view) $revs --not $oldpos]
 559    } else {
 560        set args $vorigargs($view)
 561    }
 562    if {[catch {
 563        set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
 564                        --parents --boundary $args "--" $vfilelimit($view)] r]
 565    } err]} {
 566        error_popup "[mc "Error executing git log:"] $err"
 567        return
 568    }
 569    if {$viewactive($view) == 0} {
 570        set startmsecs [clock clicks -milliseconds]
 571    }
 572    set i [reg_instance $fd]
 573    lappend viewinstances($view) $i
 574    fconfigure $fd -blocking 0 -translation lf -eofchar {}
 575    if {$tclencoding != {}} {
 576        fconfigure $fd -encoding $tclencoding
 577    }
 578    filerun $fd [list getcommitlines $fd $i $view 1]
 579    incr viewactive($view)
 580    set viewcomplete($view) 0
 581    reset_pending_select {}
 582    nowbusy $view [mc "Reading"]
 583    if {$showneartags} {
 584        getallcommits
 585    }
 586}
 587
 588proc reloadcommits {} {
 589    global curview viewcomplete selectedline currentid thickerline
 590    global showneartags treediffs commitinterest cached_commitrow
 591    global targetid
 592
 593    set selid {}
 594    if {$selectedline ne {}} {
 595        set selid $currentid
 596    }
 597
 598    if {!$viewcomplete($curview)} {
 599        stop_rev_list $curview
 600    }
 601    resetvarcs $curview
 602    set selectedline {}
 603    unset -nocomplain currentid
 604    unset -nocomplain thickerline
 605    unset -nocomplain treediffs
 606    readrefs
 607    changedrefs
 608    if {$showneartags} {
 609        getallcommits
 610    }
 611    clear_display
 612    unset -nocomplain commitinterest
 613    unset -nocomplain cached_commitrow
 614    unset -nocomplain targetid
 615    setcanvscroll
 616    getcommits $selid
 617    return 0
 618}
 619
 620# This makes a string representation of a positive integer which
 621# sorts as a string in numerical order
 622proc strrep {n} {
 623    if {$n < 16} {
 624        return [format "%x" $n]
 625    } elseif {$n < 256} {
 626        return [format "x%.2x" $n]
 627    } elseif {$n < 65536} {
 628        return [format "y%.4x" $n]
 629    }
 630    return [format "z%.8x" $n]
 631}
 632
 633# Procedures used in reordering commits from git log (without
 634# --topo-order) into the order for display.
 635
 636proc varcinit {view} {
 637    global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
 638    global vtokmod varcmod vrowmod varcix vlastins
 639
 640    set varcstart($view) {{}}
 641    set vupptr($view) {0}
 642    set vdownptr($view) {0}
 643    set vleftptr($view) {0}
 644    set vbackptr($view) {0}
 645    set varctok($view) {{}}
 646    set varcrow($view) {{}}
 647    set vtokmod($view) {}
 648    set varcmod($view) 0
 649    set vrowmod($view) 0
 650    set varcix($view) {{}}
 651    set vlastins($view) {0}
 652}
 653
 654proc resetvarcs {view} {
 655    global varcid varccommits parents children vseedcount ordertok
 656    global vshortids
 657
 658    foreach vid [array names varcid $view,*] {
 659        unset varcid($vid)
 660        unset children($vid)
 661        unset parents($vid)
 662    }
 663    foreach vid [array names vshortids $view,*] {
 664        unset vshortids($vid)
 665    }
 666    # some commits might have children but haven't been seen yet
 667    foreach vid [array names children $view,*] {
 668        unset children($vid)
 669    }
 670    foreach va [array names varccommits $view,*] {
 671        unset varccommits($va)
 672    }
 673    foreach vd [array names vseedcount $view,*] {
 674        unset vseedcount($vd)
 675    }
 676    unset -nocomplain ordertok
 677}
 678
 679# returns a list of the commits with no children
 680proc seeds {v} {
 681    global vdownptr vleftptr varcstart
 682
 683    set ret {}
 684    set a [lindex $vdownptr($v) 0]
 685    while {$a != 0} {
 686        lappend ret [lindex $varcstart($v) $a]
 687        set a [lindex $vleftptr($v) $a]
 688    }
 689    return $ret
 690}
 691
 692proc newvarc {view id} {
 693    global varcid varctok parents children vdatemode
 694    global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
 695    global commitdata commitinfo vseedcount varccommits vlastins
 696
 697    set a [llength $varctok($view)]
 698    set vid $view,$id
 699    if {[llength $children($vid)] == 0 || $vdatemode($view)} {
 700        if {![info exists commitinfo($id)]} {
 701            parsecommit $id $commitdata($id) 1
 702        }
 703        set cdate [lindex [lindex $commitinfo($id) 4] 0]
 704        if {![string is integer -strict $cdate]} {
 705            set cdate 0
 706        }
 707        if {![info exists vseedcount($view,$cdate)]} {
 708            set vseedcount($view,$cdate) -1
 709        }
 710        set c [incr vseedcount($view,$cdate)]
 711        set cdate [expr {$cdate ^ 0xffffffff}]
 712        set tok "s[strrep $cdate][strrep $c]"
 713    } else {
 714        set tok {}
 715    }
 716    set ka 0
 717    if {[llength $children($vid)] > 0} {
 718        set kid [lindex $children($vid) end]
 719        set k $varcid($view,$kid)
 720        if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
 721            set ki $kid
 722            set ka $k
 723            set tok [lindex $varctok($view) $k]
 724        }
 725    }
 726    if {$ka != 0} {
 727        set i [lsearch -exact $parents($view,$ki) $id]
 728        set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
 729        append tok [strrep $j]
 730    }
 731    set c [lindex $vlastins($view) $ka]
 732    if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
 733        set c $ka
 734        set b [lindex $vdownptr($view) $ka]
 735    } else {
 736        set b [lindex $vleftptr($view) $c]
 737    }
 738    while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
 739        set c $b
 740        set b [lindex $vleftptr($view) $c]
 741    }
 742    if {$c == $ka} {
 743        lset vdownptr($view) $ka $a
 744        lappend vbackptr($view) 0
 745    } else {
 746        lset vleftptr($view) $c $a
 747        lappend vbackptr($view) $c
 748    }
 749    lset vlastins($view) $ka $a
 750    lappend vupptr($view) $ka
 751    lappend vleftptr($view) $b
 752    if {$b != 0} {
 753        lset vbackptr($view) $b $a
 754    }
 755    lappend varctok($view) $tok
 756    lappend varcstart($view) $id
 757    lappend vdownptr($view) 0
 758    lappend varcrow($view) {}
 759    lappend varcix($view) {}
 760    set varccommits($view,$a) {}
 761    lappend vlastins($view) 0
 762    return $a
 763}
 764
 765proc splitvarc {p v} {
 766    global varcid varcstart varccommits varctok vtokmod
 767    global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
 768
 769    set oa $varcid($v,$p)
 770    set otok [lindex $varctok($v) $oa]
 771    set ac $varccommits($v,$oa)
 772    set i [lsearch -exact $varccommits($v,$oa) $p]
 773    if {$i <= 0} return
 774    set na [llength $varctok($v)]
 775    # "%" sorts before "0"...
 776    set tok "$otok%[strrep $i]"
 777    lappend varctok($v) $tok
 778    lappend varcrow($v) {}
 779    lappend varcix($v) {}
 780    set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
 781    set varccommits($v,$na) [lrange $ac $i end]
 782    lappend varcstart($v) $p
 783    foreach id $varccommits($v,$na) {
 784        set varcid($v,$id) $na
 785    }
 786    lappend vdownptr($v) [lindex $vdownptr($v) $oa]
 787    lappend vlastins($v) [lindex $vlastins($v) $oa]
 788    lset vdownptr($v) $oa $na
 789    lset vlastins($v) $oa 0
 790    lappend vupptr($v) $oa
 791    lappend vleftptr($v) 0
 792    lappend vbackptr($v) 0
 793    for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
 794        lset vupptr($v) $b $na
 795    }
 796    if {[string compare $otok $vtokmod($v)] <= 0} {
 797        modify_arc $v $oa
 798    }
 799}
 800
 801proc renumbervarc {a v} {
 802    global parents children varctok varcstart varccommits
 803    global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
 804
 805    set t1 [clock clicks -milliseconds]
 806    set todo {}
 807    set isrelated($a) 1
 808    set kidchanged($a) 1
 809    set ntot 0
 810    while {$a != 0} {
 811        if {[info exists isrelated($a)]} {
 812            lappend todo $a
 813            set id [lindex $varccommits($v,$a) end]
 814            foreach p $parents($v,$id) {
 815                if {[info exists varcid($v,$p)]} {
 816                    set isrelated($varcid($v,$p)) 1
 817                }
 818            }
 819        }
 820        incr ntot
 821        set b [lindex $vdownptr($v) $a]
 822        if {$b == 0} {
 823            while {$a != 0} {
 824                set b [lindex $vleftptr($v) $a]
 825                if {$b != 0} break
 826                set a [lindex $vupptr($v) $a]
 827            }
 828        }
 829        set a $b
 830    }
 831    foreach a $todo {
 832        if {![info exists kidchanged($a)]} continue
 833        set id [lindex $varcstart($v) $a]
 834        if {[llength $children($v,$id)] > 1} {
 835            set children($v,$id) [lsort -command [list vtokcmp $v] \
 836                                      $children($v,$id)]
 837        }
 838        set oldtok [lindex $varctok($v) $a]
 839        if {!$vdatemode($v)} {
 840            set tok {}
 841        } else {
 842            set tok $oldtok
 843        }
 844        set ka 0
 845        set kid [last_real_child $v,$id]
 846        if {$kid ne {}} {
 847            set k $varcid($v,$kid)
 848            if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
 849                set ki $kid
 850                set ka $k
 851                set tok [lindex $varctok($v) $k]
 852            }
 853        }
 854        if {$ka != 0} {
 855            set i [lsearch -exact $parents($v,$ki) $id]
 856            set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
 857            append tok [strrep $j]
 858        }
 859        if {$tok eq $oldtok} {
 860            continue
 861        }
 862        set id [lindex $varccommits($v,$a) end]
 863        foreach p $parents($v,$id) {
 864            if {[info exists varcid($v,$p)]} {
 865                set kidchanged($varcid($v,$p)) 1
 866            } else {
 867                set sortkids($p) 1
 868            }
 869        }
 870        lset varctok($v) $a $tok
 871        set b [lindex $vupptr($v) $a]
 872        if {$b != $ka} {
 873            if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
 874                modify_arc $v $ka
 875            }
 876            if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
 877                modify_arc $v $b
 878            }
 879            set c [lindex $vbackptr($v) $a]
 880            set d [lindex $vleftptr($v) $a]
 881            if {$c == 0} {
 882                lset vdownptr($v) $b $d
 883            } else {
 884                lset vleftptr($v) $c $d
 885            }
 886            if {$d != 0} {
 887                lset vbackptr($v) $d $c
 888            }
 889            if {[lindex $vlastins($v) $b] == $a} {
 890                lset vlastins($v) $b $c
 891            }
 892            lset vupptr($v) $a $ka
 893            set c [lindex $vlastins($v) $ka]
 894            if {$c == 0 || \
 895                    [string compare $tok [lindex $varctok($v) $c]] < 0} {
 896                set c $ka
 897                set b [lindex $vdownptr($v) $ka]
 898            } else {
 899                set b [lindex $vleftptr($v) $c]
 900            }
 901            while {$b != 0 && \
 902                      [string compare $tok [lindex $varctok($v) $b]] >= 0} {
 903                set c $b
 904                set b [lindex $vleftptr($v) $c]
 905            }
 906            if {$c == $ka} {
 907                lset vdownptr($v) $ka $a
 908                lset vbackptr($v) $a 0
 909            } else {
 910                lset vleftptr($v) $c $a
 911                lset vbackptr($v) $a $c
 912            }
 913            lset vleftptr($v) $a $b
 914            if {$b != 0} {
 915                lset vbackptr($v) $b $a
 916            }
 917            lset vlastins($v) $ka $a
 918        }
 919    }
 920    foreach id [array names sortkids] {
 921        if {[llength $children($v,$id)] > 1} {
 922            set children($v,$id) [lsort -command [list vtokcmp $v] \
 923                                      $children($v,$id)]
 924        }
 925    }
 926    set t2 [clock clicks -milliseconds]
 927    #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
 928}
 929
 930# Fix up the graph after we have found out that in view $v,
 931# $p (a commit that we have already seen) is actually the parent
 932# of the last commit in arc $a.
 933proc fix_reversal {p a v} {
 934    global varcid varcstart varctok vupptr
 935
 936    set pa $varcid($v,$p)
 937    if {$p ne [lindex $varcstart($v) $pa]} {
 938        splitvarc $p $v
 939        set pa $varcid($v,$p)
 940    }
 941    # seeds always need to be renumbered
 942    if {[lindex $vupptr($v) $pa] == 0 ||
 943        [string compare [lindex $varctok($v) $a] \
 944             [lindex $varctok($v) $pa]] > 0} {
 945        renumbervarc $pa $v
 946    }
 947}
 948
 949proc insertrow {id p v} {
 950    global cmitlisted children parents varcid varctok vtokmod
 951    global varccommits ordertok commitidx numcommits curview
 952    global targetid targetrow vshortids
 953
 954    readcommit $id
 955    set vid $v,$id
 956    set cmitlisted($vid) 1
 957    set children($vid) {}
 958    set parents($vid) [list $p]
 959    set a [newvarc $v $id]
 960    set varcid($vid) $a
 961    lappend vshortids($v,[string range $id 0 3]) $id
 962    if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
 963        modify_arc $v $a
 964    }
 965    lappend varccommits($v,$a) $id
 966    set vp $v,$p
 967    if {[llength [lappend children($vp) $id]] > 1} {
 968        set children($vp) [lsort -command [list vtokcmp $v] $children($vp)]
 969        unset -nocomplain ordertok
 970    }
 971    fix_reversal $p $a $v
 972    incr commitidx($v)
 973    if {$v == $curview} {
 974        set numcommits $commitidx($v)
 975        setcanvscroll
 976        if {[info exists targetid]} {
 977            if {![comes_before $targetid $p]} {
 978                incr targetrow
 979            }
 980        }
 981    }
 982}
 983
 984proc insertfakerow {id p} {
 985    global varcid varccommits parents children cmitlisted
 986    global commitidx varctok vtokmod targetid targetrow curview numcommits
 987
 988    set v $curview
 989    set a $varcid($v,$p)
 990    set i [lsearch -exact $varccommits($v,$a) $p]
 991    if {$i < 0} {
 992        puts "oops: insertfakerow can't find [shortids $p] on arc $a"
 993        return
 994    }
 995    set children($v,$id) {}
 996    set parents($v,$id) [list $p]
 997    set varcid($v,$id) $a
 998    lappend children($v,$p) $id
 999    set cmitlisted($v,$id) 1
1000    set numcommits [incr commitidx($v)]
1001    # note we deliberately don't update varcstart($v) even if $i == 0
1002    set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
1003    modify_arc $v $a $i
1004    if {[info exists targetid]} {
1005        if {![comes_before $targetid $p]} {
1006            incr targetrow
1007        }
1008    }
1009    setcanvscroll
1010    drawvisible
1011}
1012
1013proc removefakerow {id} {
1014    global varcid varccommits parents children commitidx
1015    global varctok vtokmod cmitlisted currentid selectedline
1016    global targetid curview numcommits
1017
1018    set v $curview
1019    if {[llength $parents($v,$id)] != 1} {
1020        puts "oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
1021        return
1022    }
1023    set p [lindex $parents($v,$id) 0]
1024    set a $varcid($v,$id)
1025    set i [lsearch -exact $varccommits($v,$a) $id]
1026    if {$i < 0} {
1027        puts "oops: removefakerow can't find [shortids $id] on arc $a"
1028        return
1029    }
1030    unset varcid($v,$id)
1031    set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
1032    unset parents($v,$id)
1033    unset children($v,$id)
1034    unset cmitlisted($v,$id)
1035    set numcommits [incr commitidx($v) -1]
1036    set j [lsearch -exact $children($v,$p) $id]
1037    if {$j >= 0} {
1038        set children($v,$p) [lreplace $children($v,$p) $j $j]
1039    }
1040    modify_arc $v $a $i
1041    if {[info exist currentid] && $id eq $currentid} {
1042        unset currentid
1043        set selectedline {}
1044    }
1045    if {[info exists targetid] && $targetid eq $id} {
1046        set targetid $p
1047    }
1048    setcanvscroll
1049    drawvisible
1050}
1051
1052proc real_children {vp} {
1053    global children nullid nullid2
1054
1055    set kids {}
1056    foreach id $children($vp) {
1057        if {$id ne $nullid && $id ne $nullid2} {
1058            lappend kids $id
1059        }
1060    }
1061    return $kids
1062}
1063
1064proc first_real_child {vp} {
1065    global children nullid nullid2
1066
1067    foreach id $children($vp) {
1068        if {$id ne $nullid && $id ne $nullid2} {
1069            return $id
1070        }
1071    }
1072    return {}
1073}
1074
1075proc last_real_child {vp} {
1076    global children nullid nullid2
1077
1078    set kids $children($vp)
1079    for {set i [llength $kids]} {[incr i -1] >= 0} {} {
1080        set id [lindex $kids $i]
1081        if {$id ne $nullid && $id ne $nullid2} {
1082            return $id
1083        }
1084    }
1085    return {}
1086}
1087
1088proc vtokcmp {v a b} {
1089    global varctok varcid
1090
1091    return [string compare [lindex $varctok($v) $varcid($v,$a)] \
1092                [lindex $varctok($v) $varcid($v,$b)]]
1093}
1094
1095# This assumes that if lim is not given, the caller has checked that
1096# arc a's token is less than $vtokmod($v)
1097proc modify_arc {v a {lim {}}} {
1098    global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
1099
1100    if {$lim ne {}} {
1101        set c [string compare [lindex $varctok($v) $a] $vtokmod($v)]
1102        if {$c > 0} return
1103        if {$c == 0} {
1104            set r [lindex $varcrow($v) $a]
1105            if {$r ne {} && $vrowmod($v) <= $r + $lim} return
1106        }
1107    }
1108    set vtokmod($v) [lindex $varctok($v) $a]
1109    set varcmod($v) $a
1110    if {$v == $curview} {
1111        while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
1112            set a [lindex $vupptr($v) $a]
1113            set lim {}
1114        }
1115        set r 0
1116        if {$a != 0} {
1117            if {$lim eq {}} {
1118                set lim [llength $varccommits($v,$a)]
1119            }
1120            set r [expr {[lindex $varcrow($v) $a] + $lim}]
1121        }
1122        set vrowmod($v) $r
1123        undolayout $r
1124    }
1125}
1126
1127proc update_arcrows {v} {
1128    global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
1129    global varcid vrownum varcorder varcix varccommits
1130    global vupptr vdownptr vleftptr varctok
1131    global displayorder parentlist curview cached_commitrow
1132
1133    if {$vrowmod($v) == $commitidx($v)} return
1134    if {$v == $curview} {
1135        if {[llength $displayorder] > $vrowmod($v)} {
1136            set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
1137            set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
1138        }
1139        unset -nocomplain cached_commitrow
1140    }
1141    set narctot [expr {[llength $varctok($v)] - 1}]
1142    set a $varcmod($v)
1143    while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
1144        # go up the tree until we find something that has a row number,
1145        # or we get to a seed
1146        set a [lindex $vupptr($v) $a]
1147    }
1148    if {$a == 0} {
1149        set a [lindex $vdownptr($v) 0]
1150        if {$a == 0} return
1151        set vrownum($v) {0}
1152        set varcorder($v) [list $a]
1153        lset varcix($v) $a 0
1154        lset varcrow($v) $a 0
1155        set arcn 0
1156        set row 0
1157    } else {
1158        set arcn [lindex $varcix($v) $a]
1159        if {[llength $vrownum($v)] > $arcn + 1} {
1160            set vrownum($v) [lrange $vrownum($v) 0 $arcn]
1161            set varcorder($v) [lrange $varcorder($v) 0 $arcn]
1162        }
1163        set row [lindex $varcrow($v) $a]
1164    }
1165    while {1} {
1166        set p $a
1167        incr row [llength $varccommits($v,$a)]
1168        # go down if possible
1169        set b [lindex $vdownptr($v) $a]
1170        if {$b == 0} {
1171            # if not, go left, or go up until we can go left
1172            while {$a != 0} {
1173                set b [lindex $vleftptr($v) $a]
1174                if {$b != 0} break
1175                set a [lindex $vupptr($v) $a]
1176            }
1177            if {$a == 0} break
1178        }
1179        set a $b
1180        incr arcn
1181        lappend vrownum($v) $row
1182        lappend varcorder($v) $a
1183        lset varcix($v) $a $arcn
1184        lset varcrow($v) $a $row
1185    }
1186    set vtokmod($v) [lindex $varctok($v) $p]
1187    set varcmod($v) $p
1188    set vrowmod($v) $row
1189    if {[info exists currentid]} {
1190        set selectedline [rowofcommit $currentid]
1191    }
1192}
1193
1194# Test whether view $v contains commit $id
1195proc commitinview {id v} {
1196    global varcid
1197
1198    return [info exists varcid($v,$id)]
1199}
1200
1201# Return the row number for commit $id in the current view
1202proc rowofcommit {id} {
1203    global varcid varccommits varcrow curview cached_commitrow
1204    global varctok vtokmod
1205
1206    set v $curview
1207    if {![info exists varcid($v,$id)]} {
1208        puts "oops rowofcommit no arc for [shortids $id]"
1209        return {}
1210    }
1211    set a $varcid($v,$id)
1212    if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
1213        update_arcrows $v
1214    }
1215    if {[info exists cached_commitrow($id)]} {
1216        return $cached_commitrow($id)
1217    }
1218    set i [lsearch -exact $varccommits($v,$a) $id]
1219    if {$i < 0} {
1220        puts "oops didn't find commit [shortids $id] in arc $a"
1221        return {}
1222    }
1223    incr i [lindex $varcrow($v) $a]
1224    set cached_commitrow($id) $i
1225    return $i
1226}
1227
1228# Returns 1 if a is on an earlier row than b, otherwise 0
1229proc comes_before {a b} {
1230    global varcid varctok curview
1231
1232    set v $curview
1233    if {$a eq $b || ![info exists varcid($v,$a)] || \
1234            ![info exists varcid($v,$b)]} {
1235        return 0
1236    }
1237    if {$varcid($v,$a) != $varcid($v,$b)} {
1238        return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
1239                           [lindex $varctok($v) $varcid($v,$b)]] < 0}]
1240    }
1241    return [expr {[rowofcommit $a] < [rowofcommit $b]}]
1242}
1243
1244proc bsearch {l elt} {
1245    if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
1246        return 0
1247    }
1248    set lo 0
1249    set hi [llength $l]
1250    while {$hi - $lo > 1} {
1251        set mid [expr {int(($lo + $hi) / 2)}]
1252        set t [lindex $l $mid]
1253        if {$elt < $t} {
1254            set hi $mid
1255        } elseif {$elt > $t} {
1256            set lo $mid
1257        } else {
1258            return $mid
1259        }
1260    }
1261    return $lo
1262}
1263
1264# Make sure rows $start..$end-1 are valid in displayorder and parentlist
1265proc make_disporder {start end} {
1266    global vrownum curview commitidx displayorder parentlist
1267    global varccommits varcorder parents vrowmod varcrow
1268    global d_valid_start d_valid_end
1269
1270    if {$end > $vrowmod($curview)} {
1271        update_arcrows $curview
1272    }
1273    set ai [bsearch $vrownum($curview) $start]
1274    set start [lindex $vrownum($curview) $ai]
1275    set narc [llength $vrownum($curview)]
1276    for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
1277        set a [lindex $varcorder($curview) $ai]
1278        set l [llength $displayorder]
1279        set al [llength $varccommits($curview,$a)]
1280        if {$l < $r + $al} {
1281            if {$l < $r} {
1282                set pad [ntimes [expr {$r - $l}] {}]
1283                set displayorder [concat $displayorder $pad]
1284                set parentlist [concat $parentlist $pad]
1285            } elseif {$l > $r} {
1286                set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
1287                set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
1288            }
1289            foreach id $varccommits($curview,$a) {
1290                lappend displayorder $id
1291                lappend parentlist $parents($curview,$id)
1292            }
1293        } elseif {[lindex $displayorder [expr {$r + $al - 1}]] eq {}} {
1294            set i $r
1295            foreach id $varccommits($curview,$a) {
1296                lset displayorder $i $id
1297                lset parentlist $i $parents($curview,$id)
1298                incr i
1299            }
1300        }
1301        incr r $al
1302    }
1303}
1304
1305proc commitonrow {row} {
1306    global displayorder
1307
1308    set id [lindex $displayorder $row]
1309    if {$id eq {}} {
1310        make_disporder $row [expr {$row + 1}]
1311        set id [lindex $displayorder $row]
1312    }
1313    return $id
1314}
1315
1316proc closevarcs {v} {
1317    global varctok varccommits varcid parents children
1318    global cmitlisted commitidx vtokmod
1319
1320    set missing_parents 0
1321    set scripts {}
1322    set narcs [llength $varctok($v)]
1323    for {set a 1} {$a < $narcs} {incr a} {
1324        set id [lindex $varccommits($v,$a) end]
1325        foreach p $parents($v,$id) {
1326            if {[info exists varcid($v,$p)]} continue
1327            # add p as a new commit
1328            incr missing_parents
1329            set cmitlisted($v,$p) 0
1330            set parents($v,$p) {}
1331            if {[llength $children($v,$p)] == 1 &&
1332                [llength $parents($v,$id)] == 1} {
1333                set b $a
1334            } else {
1335                set b [newvarc $v $p]
1336            }
1337            set varcid($v,$p) $b
1338            if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
1339                modify_arc $v $b
1340            }
1341            lappend varccommits($v,$b) $p
1342            incr commitidx($v)
1343            set scripts [check_interest $p $scripts]
1344        }
1345    }
1346    if {$missing_parents > 0} {
1347        foreach s $scripts {
1348            eval $s
1349        }
1350    }
1351}
1352
1353# Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1354# Assumes we already have an arc for $rwid.
1355proc rewrite_commit {v id rwid} {
1356    global children parents varcid varctok vtokmod varccommits
1357
1358    foreach ch $children($v,$id) {
1359        # make $rwid be $ch's parent in place of $id
1360        set i [lsearch -exact $parents($v,$ch) $id]
1361        if {$i < 0} {
1362            puts "oops rewrite_commit didn't find $id in parent list for $ch"
1363        }
1364        set parents($v,$ch) [lreplace $parents($v,$ch) $i $i $rwid]
1365        # add $ch to $rwid's children and sort the list if necessary
1366        if {[llength [lappend children($v,$rwid) $ch]] > 1} {
1367            set children($v,$rwid) [lsort -command [list vtokcmp $v] \
1368                                        $children($v,$rwid)]
1369        }
1370        # fix the graph after joining $id to $rwid
1371        set a $varcid($v,$ch)
1372        fix_reversal $rwid $a $v
1373        # parentlist is wrong for the last element of arc $a
1374        # even if displayorder is right, hence the 3rd arg here
1375        modify_arc $v $a [expr {[llength $varccommits($v,$a)] - 1}]
1376    }
1377}
1378
1379# Mechanism for registering a command to be executed when we come
1380# across a particular commit.  To handle the case when only the
1381# prefix of the commit is known, the commitinterest array is now
1382# indexed by the first 4 characters of the ID.  Each element is a
1383# list of id, cmd pairs.
1384proc interestedin {id cmd} {
1385    global commitinterest
1386
1387    lappend commitinterest([string range $id 0 3]) $id $cmd
1388}
1389
1390proc check_interest {id scripts} {
1391    global commitinterest
1392
1393    set prefix [string range $id 0 3]
1394    if {[info exists commitinterest($prefix)]} {
1395        set newlist {}
1396        foreach {i script} $commitinterest($prefix) {
1397            if {[string match "$i*" $id]} {
1398                lappend scripts [string map [list "%I" $id "%P" $i] $script]
1399            } else {
1400                lappend newlist $i $script
1401            }
1402        }
1403        if {$newlist ne {}} {
1404            set commitinterest($prefix) $newlist
1405        } else {
1406            unset commitinterest($prefix)
1407        }
1408    }
1409    return $scripts
1410}
1411
1412proc getcommitlines {fd inst view updating}  {
1413    global cmitlisted leftover
1414    global commitidx commitdata vdatemode
1415    global parents children curview hlview
1416    global idpending ordertok
1417    global varccommits varcid varctok vtokmod vfilelimit vshortids
1418
1419    set stuff [read $fd 500000]
1420    # git log doesn't terminate the last commit with a null...
1421    if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
1422        set stuff "\0"
1423    }
1424    if {$stuff == {}} {
1425        if {![eof $fd]} {
1426            return 1
1427        }
1428        global commfd viewcomplete viewactive viewname
1429        global viewinstances
1430        unset commfd($inst)
1431        set i [lsearch -exact $viewinstances($view) $inst]
1432        if {$i >= 0} {
1433            set viewinstances($view) [lreplace $viewinstances($view) $i $i]
1434        }
1435        # set it blocking so we wait for the process to terminate
1436        fconfigure $fd -blocking 1
1437        if {[catch {close $fd} err]} {
1438            set fv {}
1439            if {$view != $curview} {
1440                set fv " for the \"$viewname($view)\" view"
1441            }
1442            if {[string range $err 0 4] == "usage"} {
1443                set err "Gitk: error reading commits$fv:\
1444                        bad arguments to git log."
1445                if {$viewname($view) eq [mc "Command line"]} {
1446                    append err \
1447                        "  (Note: arguments to gitk are passed to git log\
1448                         to allow selection of commits to be displayed.)"
1449                }
1450            } else {
1451                set err "Error reading commits$fv: $err"
1452            }
1453            error_popup $err
1454        }
1455        if {[incr viewactive($view) -1] <= 0} {
1456            set viewcomplete($view) 1
1457            # Check if we have seen any ids listed as parents that haven't
1458            # appeared in the list
1459            closevarcs $view
1460            notbusy $view
1461        }
1462        if {$view == $curview} {
1463            run chewcommits
1464        }
1465        return 0
1466    }
1467    set start 0
1468    set gotsome 0
1469    set scripts {}
1470    while 1 {
1471        set i [string first "\0" $stuff $start]
1472        if {$i < 0} {
1473            append leftover($inst) [string range $stuff $start end]
1474            break
1475        }
1476        if {$start == 0} {
1477            set cmit $leftover($inst)
1478            append cmit [string range $stuff 0 [expr {$i - 1}]]
1479            set leftover($inst) {}
1480        } else {
1481            set cmit [string range $stuff $start [expr {$i - 1}]]
1482        }
1483        set start [expr {$i + 1}]
1484        set j [string first "\n" $cmit]
1485        set ok 0
1486        set listed 1
1487        if {$j >= 0 && [string match "commit *" $cmit]} {
1488            set ids [string range $cmit 7 [expr {$j - 1}]]
1489            if {[string match {[-^<>]*} $ids]} {
1490                switch -- [string index $ids 0] {
1491                    "-" {set listed 0}
1492                    "^" {set listed 2}
1493                    "<" {set listed 3}
1494                    ">" {set listed 4}
1495                }
1496                set ids [string range $ids 1 end]
1497            }
1498            set ok 1
1499            foreach id $ids {
1500                if {[string length $id] != 40} {
1501                    set ok 0
1502                    break
1503                }
1504            }
1505        }
1506        if {!$ok} {
1507            set shortcmit $cmit
1508            if {[string length $shortcmit] > 80} {
1509                set shortcmit "[string range $shortcmit 0 80]..."
1510            }
1511            error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
1512            exit 1
1513        }
1514        set id [lindex $ids 0]
1515        set vid $view,$id
1516
1517        lappend vshortids($view,[string range $id 0 3]) $id
1518
1519        if {!$listed && $updating && ![info exists varcid($vid)] &&
1520            $vfilelimit($view) ne {}} {
1521            # git log doesn't rewrite parents for unlisted commits
1522            # when doing path limiting, so work around that here
1523            # by working out the rewritten parent with git rev-list
1524            # and if we already know about it, using the rewritten
1525            # parent as a substitute parent for $id's children.
1526            if {![catch {
1527                set rwid [exec git rev-list --first-parent --max-count=1 \
1528                              $id -- $vfilelimit($view)]
1529            }]} {
1530                if {$rwid ne {} && [info exists varcid($view,$rwid)]} {
1531                    # use $rwid in place of $id
1532                    rewrite_commit $view $id $rwid
1533                    continue
1534                }
1535            }
1536        }
1537
1538        set a 0
1539        if {[info exists varcid($vid)]} {
1540            if {$cmitlisted($vid) || !$listed} continue
1541            set a $varcid($vid)
1542        }
1543        if {$listed} {
1544            set olds [lrange $ids 1 end]
1545        } else {
1546            set olds {}
1547        }
1548        set commitdata($id) [string range $cmit [expr {$j + 1}] end]
1549        set cmitlisted($vid) $listed
1550        set parents($vid) $olds
1551        if {![info exists children($vid)]} {
1552            set children($vid) {}
1553        } elseif {$a == 0 && [llength $children($vid)] == 1} {
1554            set k [lindex $children($vid) 0]
1555            if {[llength $parents($view,$k)] == 1 &&
1556                (!$vdatemode($view) ||
1557                 $varcid($view,$k) == [llength $varctok($view)] - 1)} {
1558                set a $varcid($view,$k)
1559            }
1560        }
1561        if {$a == 0} {
1562            # new arc
1563            set a [newvarc $view $id]
1564        }
1565        if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
1566            modify_arc $view $a
1567        }
1568        if {![info exists varcid($vid)]} {
1569            set varcid($vid) $a
1570            lappend varccommits($view,$a) $id
1571            incr commitidx($view)
1572        }
1573
1574        set i 0
1575        foreach p $olds {
1576            if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
1577                set vp $view,$p
1578                if {[llength [lappend children($vp) $id]] > 1 &&
1579                    [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
1580                    set children($vp) [lsort -command [list vtokcmp $view] \
1581                                           $children($vp)]
1582                    unset -nocomplain ordertok
1583                }
1584                if {[info exists varcid($view,$p)]} {
1585                    fix_reversal $p $a $view
1586                }
1587            }
1588            incr i
1589        }
1590
1591        set scripts [check_interest $id $scripts]
1592        set gotsome 1
1593    }
1594    if {$gotsome} {
1595        global numcommits hlview
1596
1597        if {$view == $curview} {
1598            set numcommits $commitidx($view)
1599            run chewcommits
1600        }
1601        if {[info exists hlview] && $view == $hlview} {
1602            # we never actually get here...
1603            run vhighlightmore
1604        }
1605        foreach s $scripts {
1606            eval $s
1607        }
1608    }
1609    return 2
1610}
1611
1612proc chewcommits {} {
1613    global curview hlview viewcomplete
1614    global pending_select
1615
1616    layoutmore
1617    if {$viewcomplete($curview)} {
1618        global commitidx varctok
1619        global numcommits startmsecs
1620
1621        if {[info exists pending_select]} {
1622            update
1623            reset_pending_select {}
1624
1625            if {[commitinview $pending_select $curview]} {
1626                selectline [rowofcommit $pending_select] 1
1627            } else {
1628                set row [first_real_row]
1629                selectline $row 1
1630            }
1631        }
1632        if {$commitidx($curview) > 0} {
1633            #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1634            #puts "overall $ms ms for $numcommits commits"
1635            #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1636        } else {
1637            show_status [mc "No commits selected"]
1638        }
1639        notbusy layout
1640    }
1641    return 0
1642}
1643
1644proc do_readcommit {id} {
1645    global tclencoding
1646
1647    # Invoke git-log to handle automatic encoding conversion
1648    set fd [open [concat | git log --no-color --pretty=raw -1 $id] r]
1649    # Read the results using i18n.logoutputencoding
1650    fconfigure $fd -translation lf -eofchar {}
1651    if {$tclencoding != {}} {
1652        fconfigure $fd -encoding $tclencoding
1653    }
1654    set contents [read $fd]
1655    close $fd
1656    # Remove the heading line
1657    regsub {^commit [0-9a-f]+\n} $contents {} contents
1658
1659    return $contents
1660}
1661
1662proc readcommit {id} {
1663    if {[catch {set contents [do_readcommit $id]}]} return
1664    parsecommit $id $contents 1
1665}
1666
1667proc parsecommit {id contents listed} {
1668    global commitinfo
1669
1670    set inhdr 1
1671    set comment {}
1672    set headline {}
1673    set auname {}
1674    set audate {}
1675    set comname {}
1676    set comdate {}
1677    set hdrend [string first "\n\n" $contents]
1678    if {$hdrend < 0} {
1679        # should never happen...
1680        set hdrend [string length $contents]
1681    }
1682    set header [string range $contents 0 [expr {$hdrend - 1}]]
1683    set comment [string range $contents [expr {$hdrend + 2}] end]
1684    foreach line [split $header "\n"] {
1685        set line [split $line " "]
1686        set tag [lindex $line 0]
1687        if {$tag == "author"} {
1688            set audate [lrange $line end-1 end]
1689            set auname [join [lrange $line 1 end-2] " "]
1690        } elseif {$tag == "committer"} {
1691            set comdate [lrange $line end-1 end]
1692            set comname [join [lrange $line 1 end-2] " "]
1693        }
1694    }
1695    set headline {}
1696    # take the first non-blank line of the comment as the headline
1697    set headline [string trimleft $comment]
1698    set i [string first "\n" $headline]
1699    if {$i >= 0} {
1700        set headline [string range $headline 0 $i]
1701    }
1702    set headline [string trimright $headline]
1703    set i [string first "\r" $headline]
1704    if {$i >= 0} {
1705        set headline [string trimright [string range $headline 0 $i]]
1706    }
1707    if {!$listed} {
1708        # git log indents the comment by 4 spaces;
1709        # if we got this via git cat-file, add the indentation
1710        set newcomment {}
1711        foreach line [split $comment "\n"] {
1712            append newcomment "    "
1713            append newcomment $line
1714            append newcomment "\n"
1715        }
1716        set comment $newcomment
1717    }
1718    set hasnote [string first "\nNotes:\n" $contents]
1719    set diff ""
1720    # If there is diff output shown in the git-log stream, split it
1721    # out.  But get rid of the empty line that always precedes the
1722    # diff.
1723    set i [string first "\n\ndiff" $comment]
1724    if {$i >= 0} {
1725        set diff [string range $comment $i+1 end]
1726        set comment [string range $comment 0 $i-1]
1727    }
1728    set commitinfo($id) [list $headline $auname $audate \
1729                             $comname $comdate $comment $hasnote $diff]
1730}
1731
1732proc getcommit {id} {
1733    global commitdata commitinfo
1734
1735    if {[info exists commitdata($id)]} {
1736        parsecommit $id $commitdata($id) 1
1737    } else {
1738        readcommit $id
1739        if {![info exists commitinfo($id)]} {
1740            set commitinfo($id) [list [mc "No commit information available"]]
1741        }
1742    }
1743    return 1
1744}
1745
1746# Expand an abbreviated commit ID to a list of full 40-char IDs that match
1747# and are present in the current view.
1748# This is fairly slow...
1749proc longid {prefix} {
1750    global varcid curview vshortids
1751
1752    set ids {}
1753    if {[string length $prefix] >= 4} {
1754        set vshortid $curview,[string range $prefix 0 3]
1755        if {[info exists vshortids($vshortid)]} {
1756            foreach id $vshortids($vshortid) {
1757                if {[string match "$prefix*" $id]} {
1758                    if {[lsearch -exact $ids $id] < 0} {
1759                        lappend ids $id
1760                        if {[llength $ids] >= 2} break
1761                    }
1762                }
1763            }
1764        }
1765    } else {
1766        foreach match [array names varcid "$curview,$prefix*"] {
1767            lappend ids [lindex [split $match ","] 1]
1768            if {[llength $ids] >= 2} break
1769        }
1770    }
1771    return $ids
1772}
1773
1774proc readrefs {} {
1775    global tagids idtags headids idheads tagobjid
1776    global otherrefids idotherrefs mainhead mainheadid
1777    global selecthead selectheadid
1778    global hideremotes
1779
1780    foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
1781        unset -nocomplain $v
1782    }
1783    set refd [open [list | git show-ref -d] r]
1784    while {[gets $refd line] >= 0} {
1785        if {[string index $line 40] ne " "} continue
1786        set id [string range $line 0 39]
1787        set ref [string range $line 41 end]
1788        if {![string match "refs/*" $ref]} continue
1789        set name [string range $ref 5 end]
1790        if {[string match "remotes/*" $name]} {
1791            if {![string match "*/HEAD" $name] && !$hideremotes} {
1792                set headids($name) $id
1793                lappend idheads($id) $name
1794            }
1795        } elseif {[string match "heads/*" $name]} {
1796            set name [string range $name 6 end]
1797            set headids($name) $id
1798            lappend idheads($id) $name
1799        } elseif {[string match "tags/*" $name]} {
1800            # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1801            # which is what we want since the former is the commit ID
1802            set name [string range $name 5 end]
1803            if {[string match "*^{}" $name]} {
1804                set name [string range $name 0 end-3]
1805            } else {
1806                set tagobjid($name) $id
1807            }
1808            set tagids($name) $id
1809            lappend idtags($id) $name
1810        } else {
1811            set otherrefids($name) $id
1812            lappend idotherrefs($id) $name
1813        }
1814    }
1815    catch {close $refd}
1816    set mainhead {}
1817    set mainheadid {}
1818    catch {
1819        set mainheadid [exec git rev-parse HEAD]
1820        set thehead [exec git symbolic-ref HEAD]
1821        if {[string match "refs/heads/*" $thehead]} {
1822            set mainhead [string range $thehead 11 end]
1823        }
1824    }
1825    set selectheadid {}
1826    if {$selecthead ne {}} {
1827        catch {
1828            set selectheadid [exec git rev-parse --verify $selecthead]
1829        }
1830    }
1831}
1832
1833# skip over fake commits
1834proc first_real_row {} {
1835    global nullid nullid2 numcommits
1836
1837    for {set row 0} {$row < $numcommits} {incr row} {
1838        set id [commitonrow $row]
1839        if {$id ne $nullid && $id ne $nullid2} {
1840            break
1841        }
1842    }
1843    return $row
1844}
1845
1846# update things for a head moved to a child of its previous location
1847proc movehead {id name} {
1848    global headids idheads
1849
1850    removehead $headids($name) $name
1851    set headids($name) $id
1852    lappend idheads($id) $name
1853}
1854
1855# update things when a head has been removed
1856proc removehead {id name} {
1857    global headids idheads
1858
1859    if {$idheads($id) eq $name} {
1860        unset idheads($id)
1861    } else {
1862        set i [lsearch -exact $idheads($id) $name]
1863        if {$i >= 0} {
1864            set idheads($id) [lreplace $idheads($id) $i $i]
1865        }
1866    }
1867    unset headids($name)
1868}
1869
1870proc ttk_toplevel {w args} {
1871    global use_ttk
1872    eval [linsert $args 0 ::toplevel $w]
1873    if {$use_ttk} {
1874        place [ttk::frame $w._toplevel_background] -x 0 -y 0 -relwidth 1 -relheight 1
1875    }
1876    return $w
1877}
1878
1879proc make_transient {window origin} {
1880    global have_tk85
1881
1882    # In MacOS Tk 8.4 transient appears to work by setting
1883    # overrideredirect, which is utterly useless, since the
1884    # windows get no border, and are not even kept above
1885    # the parent.
1886    if {!$have_tk85 && [tk windowingsystem] eq {aqua}} return
1887
1888    wm transient $window $origin
1889
1890    # Windows fails to place transient windows normally, so
1891    # schedule a callback to center them on the parent.
1892    if {[tk windowingsystem] eq {win32}} {
1893        after idle [list tk::PlaceWindow $window widget $origin]
1894    }
1895}
1896
1897proc show_error {w top msg} {
1898    global NS
1899    if {![info exists NS]} {set NS ""}
1900    if {[wm state $top] eq "withdrawn"} { wm deiconify $top }
1901    message $w.m -text $msg -justify center -aspect 400
1902    pack $w.m -side top -fill x -padx 20 -pady 20
1903    ${NS}::button $w.ok -default active -text [mc OK] -command "destroy $top"
1904    pack $w.ok -side bottom -fill x
1905    bind $top <Visibility> "grab $top; focus $top"
1906    bind $top <Key-Return> "destroy $top"
1907    bind $top <Key-space>  "destroy $top"
1908    bind $top <Key-Escape> "destroy $top"
1909    tkwait window $top
1910}
1911
1912proc error_popup {msg {owner .}} {
1913    if {[tk windowingsystem] eq "win32"} {
1914        tk_messageBox -icon error -type ok -title [wm title .] \
1915            -parent $owner -message $msg
1916    } else {
1917        set w .error
1918        ttk_toplevel $w
1919        make_transient $w $owner
1920        show_error $w $w $msg
1921    }
1922}
1923
1924proc confirm_popup {msg {owner .}} {
1925    global confirm_ok NS
1926    set confirm_ok 0
1927    set w .confirm
1928    ttk_toplevel $w
1929    make_transient $w $owner
1930    message $w.m -text $msg -justify center -aspect 400
1931    pack $w.m -side top -fill x -padx 20 -pady 20
1932    ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
1933    pack $w.ok -side left -fill x
1934    ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
1935    pack $w.cancel -side right -fill x
1936    bind $w <Visibility> "grab $w; focus $w"
1937    bind $w <Key-Return> "set confirm_ok 1; destroy $w"
1938    bind $w <Key-space>  "set confirm_ok 1; destroy $w"
1939    bind $w <Key-Escape> "destroy $w"
1940    tk::PlaceWindow $w widget $owner
1941    tkwait window $w
1942    return $confirm_ok
1943}
1944
1945proc setoptions {} {
1946    global use_ttk
1947
1948    if {[tk windowingsystem] ne "win32"} {
1949        option add *Panedwindow.showHandle 1 startupFile
1950        option add *Panedwindow.sashRelief raised startupFile
1951        if {[tk windowingsystem] ne "aqua"} {
1952            option add *Menu.font uifont startupFile
1953        }
1954    } else {
1955        option add *Menu.TearOff 0 startupFile
1956    }
1957    option add *Button.font uifont startupFile
1958    option add *Checkbutton.font uifont startupFile
1959    option add *Radiobutton.font uifont startupFile
1960    option add *Menubutton.font uifont startupFile
1961    option add *Label.font uifont startupFile
1962    option add *Message.font uifont startupFile
1963    option add *Entry.font textfont startupFile
1964    option add *Text.font textfont startupFile
1965    option add *Labelframe.font uifont startupFile
1966    option add *Spinbox.font textfont startupFile
1967    option add *Listbox.font mainfont startupFile
1968}
1969
1970proc setttkstyle {} {
1971    eval font configure TkDefaultFont [fontflags mainfont]
1972    eval font configure TkTextFont [fontflags textfont]
1973    eval font configure TkHeadingFont [fontflags mainfont]
1974    eval font configure TkCaptionFont [fontflags mainfont] -weight bold
1975    eval font configure TkTooltipFont [fontflags uifont]
1976    eval font configure TkFixedFont   [fontflags textfont]
1977    eval font configure TkIconFont    [fontflags uifont]
1978    eval font configure TkMenuFont    [fontflags uifont]
1979    eval font configure TkSmallCaptionFont [fontflags uifont]
1980}
1981
1982# Make a menu and submenus.
1983# m is the window name for the menu, items is the list of menu items to add.
1984# Each item is a list {mc label type description options...}
1985# mc is ignored; it's so we can put mc there to alert xgettext
1986# label is the string that appears in the menu
1987# type is cascade, command or radiobutton (should add checkbutton)
1988# description depends on type; it's the sublist for cascade, the
1989# command to invoke for command, or {variable value} for radiobutton
1990proc makemenu {m items} {
1991    menu $m
1992    if {[tk windowingsystem] eq {aqua}} {
1993        set Meta1 Cmd
1994    } else {
1995        set Meta1 Ctrl
1996    }
1997    foreach i $items {
1998        set name [mc [lindex $i 1]]
1999        set type [lindex $i 2]
2000        set thing [lindex $i 3]
2001        set params [list $type]
2002        if {$name ne {}} {
2003            set u [string first "&" [string map {&& x} $name]]
2004            lappend params -label [string map {&& & & {}} $name]
2005            if {$u >= 0} {
2006                lappend params -underline $u
2007            }
2008        }
2009        switch -- $type {
2010            "cascade" {
2011                set submenu [string tolower [string map {& ""} [lindex $i 1]]]
2012                lappend params -menu $m.$submenu
2013            }
2014            "command" {
2015                lappend params -command $thing
2016            }
2017            "radiobutton" {
2018                lappend params -variable [lindex $thing 0] \
2019                    -value [lindex $thing 1]
2020            }
2021        }
2022        set tail [lrange $i 4 end]
2023        regsub -all {\yMeta1\y} $tail $Meta1 tail
2024        eval $m add $params $tail
2025        if {$type eq "cascade"} {
2026            makemenu $m.$submenu $thing
2027        }
2028    }
2029}
2030
2031# translate string and remove ampersands
2032proc mca {str} {
2033    return [string map {&& & & {}} [mc $str]]
2034}
2035
2036proc cleardropsel {w} {
2037    $w selection clear
2038}
2039proc makedroplist {w varname args} {
2040    global use_ttk
2041    if {$use_ttk} {
2042        set width 0
2043        foreach label $args {
2044            set cx [string length $label]
2045            if {$cx > $width} {set width $cx}
2046        }
2047        set gm [ttk::combobox $w -width $width -state readonly\
2048                    -textvariable $varname -values $args \
2049                    -exportselection false]
2050        bind $gm <<ComboboxSelected>> [list $gm selection clear]
2051    } else {
2052        set gm [eval [linsert $args 0 tk_optionMenu $w $varname]]
2053    }
2054    return $gm
2055}
2056
2057proc makewindow {} {
2058    global canv canv2 canv3 linespc charspc ctext cflist cscroll
2059    global tabstop
2060    global findtype findtypemenu findloc findstring fstring geometry
2061    global entries sha1entry sha1string sha1but
2062    global diffcontextstring diffcontext
2063    global ignorespace
2064    global maincursor textcursor curtextcursor
2065    global rowctxmenu fakerowmenu mergemax wrapcomment
2066    global highlight_files gdttype
2067    global searchstring sstring
2068    global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
2069    global uifgcolor uifgdisabledcolor
2070    global filesepbgcolor filesepfgcolor
2071    global mergecolors foundbgcolor currentsearchhitbgcolor
2072    global headctxmenu progresscanv progressitem progresscoords statusw
2073    global fprogitem fprogcoord lastprogupdate progupdatepending
2074    global rprogitem rprogcoord rownumsel numcommits
2075    global have_tk85 use_ttk NS
2076    global git_version
2077    global worddiff
2078
2079    # The "mc" arguments here are purely so that xgettext
2080    # sees the following string as needing to be translated
2081    set file {
2082        mc "&File" cascade {
2083            {mc "&Update" command updatecommits -accelerator F5}
2084            {mc "&Reload" command reloadcommits -accelerator Shift-F5}
2085            {mc "Reread re&ferences" command rereadrefs}
2086            {mc "&List references" command showrefs -accelerator F2}
2087            {xx "" separator}
2088            {mc "Start git &gui" command {exec git gui &}}
2089            {xx "" separator}
2090            {mc "&Quit" command doquit -accelerator Meta1-Q}
2091        }}
2092    set edit {
2093        mc "&Edit" cascade {
2094            {mc "&Preferences" command doprefs}
2095        }}
2096    set view {
2097        mc "&View" cascade {
2098            {mc "&New view..." command {newview 0} -accelerator Shift-F4}
2099            {mc "&Edit view..." command editview -state disabled -accelerator F4}
2100            {mc "&Delete view" command delview -state disabled}
2101            {xx "" separator}
2102            {mc "&All files" radiobutton {selectedview 0} -command {showview 0}}
2103        }}
2104    if {[tk windowingsystem] ne "aqua"} {
2105        set help {
2106        mc "&Help" cascade {
2107            {mc "&About gitk" command about}
2108            {mc "&Key bindings" command keys}
2109        }}
2110        set bar [list $file $edit $view $help]
2111    } else {
2112        proc ::tk::mac::ShowPreferences {} {doprefs}
2113        proc ::tk::mac::Quit {} {doquit}
2114        lset file end [lreplace [lindex $file end] end-1 end]
2115        set apple {
2116        xx "&Apple" cascade {
2117            {mc "&About gitk" command about}
2118            {xx "" separator}
2119        }}
2120        set help {
2121        mc "&Help" cascade {
2122            {mc "&Key bindings" command keys}
2123        }}
2124        set bar [list $apple $file $view $help]
2125    }
2126    makemenu .bar $bar
2127    . configure -menu .bar
2128
2129    if {$use_ttk} {
2130        # cover the non-themed toplevel with a themed frame.
2131        place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1
2132    }
2133
2134    # the gui has upper and lower half, parts of a paned window.
2135    ${NS}::panedwindow .ctop -orient vertical
2136
2137    # possibly use assumed geometry
2138    if {![info exists geometry(pwsash0)]} {
2139        set geometry(topheight) [expr {15 * $linespc}]
2140        set geometry(topwidth) [expr {80 * $charspc}]
2141        set geometry(botheight) [expr {15 * $linespc}]
2142        set geometry(botwidth) [expr {50 * $charspc}]
2143        set geometry(pwsash0) [list [expr {40 * $charspc}] 2]
2144        set geometry(pwsash1) [list [expr {60 * $charspc}] 2]
2145    }
2146
2147    # the upper half will have a paned window, a scroll bar to the right, and some stuff below
2148    ${NS}::frame .tf -height $geometry(topheight) -width $geometry(topwidth)
2149    ${NS}::frame .tf.histframe
2150    ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal
2151    if {!$use_ttk} {
2152        .tf.histframe.pwclist configure -sashpad 0 -handlesize 4
2153    }
2154
2155    # create three canvases
2156    set cscroll .tf.histframe.csb
2157    set canv .tf.histframe.pwclist.canv
2158    canvas $canv \
2159        -selectbackground $selectbgcolor \
2160        -background $bgcolor -bd 0 \
2161        -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
2162    .tf.histframe.pwclist add $canv
2163    set canv2 .tf.histframe.pwclist.canv2
2164    canvas $canv2 \
2165        -selectbackground $selectbgcolor \
2166        -background $bgcolor -bd 0 -yscrollincr $linespc
2167    .tf.histframe.pwclist add $canv2
2168    set canv3 .tf.histframe.pwclist.canv3
2169    canvas $canv3 \
2170        -selectbackground $selectbgcolor \
2171        -background $bgcolor -bd 0 -yscrollincr $linespc
2172    .tf.histframe.pwclist add $canv3
2173    if {$use_ttk} {
2174        bind .tf.histframe.pwclist <Map> {
2175            bind %W <Map> {}
2176            .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0]
2177            .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0]
2178        }
2179    } else {
2180        eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
2181        eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
2182    }
2183
2184    # a scroll bar to rule them
2185    ${NS}::scrollbar $cscroll -command {allcanvs yview}
2186    if {!$use_ttk} {$cscroll configure -highlightthickness 0}
2187    pack $cscroll -side right -fill y
2188    bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
2189    lappend bglist $canv $canv2 $canv3
2190    pack .tf.histframe.pwclist -fill both -expand 1 -side left
2191
2192    # we have two button bars at bottom of top frame. Bar 1
2193    ${NS}::frame .tf.bar
2194    ${NS}::frame .tf.lbar -height 15
2195
2196    set sha1entry .tf.bar.sha1
2197    set entries $sha1entry
2198    set sha1but .tf.bar.sha1label
2199    button $sha1but -text "[mc "SHA1 ID:"] " -state disabled -relief flat \
2200        -command gotocommit -width 8
2201    $sha1but conf -disabledforeground [$sha1but cget -foreground]
2202    pack .tf.bar.sha1label -side left
2203    ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string
2204    trace add variable sha1string write sha1change
2205    pack $sha1entry -side left -pady 2
2206
2207    set bm_left_data {
2208        #define left_width 16
2209        #define left_height 16
2210        static unsigned char left_bits[] = {
2211        0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
2212        0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
2213        0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
2214    }
2215    set bm_right_data {
2216        #define right_width 16
2217        #define right_height 16
2218        static unsigned char right_bits[] = {
2219        0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
2220        0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
2221        0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
2222    }
2223    image create bitmap bm-left -data $bm_left_data -foreground $uifgcolor
2224    image create bitmap bm-left-gray -data $bm_left_data -foreground $uifgdisabledcolor
2225    image create bitmap bm-right -data $bm_right_data -foreground $uifgcolor
2226    image create bitmap bm-right-gray -data $bm_right_data -foreground $uifgdisabledcolor
2227
2228    ${NS}::button .tf.bar.leftbut -command goback -state disabled -width 26
2229    if {$use_ttk} {
2230        .tf.bar.leftbut configure -image [list bm-left disabled bm-left-gray]
2231    } else {
2232        .tf.bar.leftbut configure -image bm-left
2233    }
2234    pack .tf.bar.leftbut -side left -fill y
2235    ${NS}::button .tf.bar.rightbut -command goforw -state disabled -width 26
2236    if {$use_ttk} {
2237        .tf.bar.rightbut configure -image [list bm-right disabled bm-right-gray]
2238    } else {
2239        .tf.bar.rightbut configure -image bm-right
2240    }
2241    pack .tf.bar.rightbut -side left -fill y
2242
2243    ${NS}::label .tf.bar.rowlabel -text [mc "Row"]
2244    set rownumsel {}
2245    ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \
2246        -relief sunken -anchor e
2247    ${NS}::label .tf.bar.rowlabel2 -text "/"
2248    ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \
2249        -relief sunken -anchor e
2250    pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
2251        -side left
2252    if {!$use_ttk} {
2253        foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont}
2254    }
2255    global selectedline
2256    trace add variable selectedline write selectedline_change
2257
2258    # Status label and progress bar
2259    set statusw .tf.bar.status
2260    ${NS}::label $statusw -width 15 -relief sunken
2261    pack $statusw -side left -padx 5
2262    if {$use_ttk} {
2263        set progresscanv [ttk::progressbar .tf.bar.progress]
2264    } else {
2265        set h [expr {[font metrics uifont -linespace] + 2}]
2266        set progresscanv .tf.bar.progress
2267        canvas $progresscanv -relief sunken -height $h -borderwidth 2
2268        set progressitem [$progresscanv create rect -1 0 0 $h -fill lime]
2269        set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
2270        set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
2271    }
2272    pack $progresscanv -side right -expand 1 -fill x -padx {0 2}
2273    set progresscoords {0 0}
2274    set fprogcoord 0
2275    set rprogcoord 0
2276    bind $progresscanv <Configure> adjustprogress
2277    set lastprogupdate [clock clicks -milliseconds]
2278    set progupdatepending 0
2279
2280    # build up the bottom bar of upper window
2281    ${NS}::label .tf.lbar.flabel -text "[mc "Find"] "
2282
2283    set bm_down_data {
2284        #define down_width 16
2285        #define down_height 16
2286        static unsigned char down_bits[] = {
2287        0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2288        0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2289        0x87, 0xe1, 0x8e, 0x71, 0x9c, 0x39, 0xb8, 0x1d,
2290        0xf0, 0x0f, 0xe0, 0x07, 0xc0, 0x03, 0x80, 0x01};
2291    }
2292    image create bitmap bm-down -data $bm_down_data -foreground $uifgcolor
2293    ${NS}::button .tf.lbar.fnext -width 26 -command {dofind 1 1}
2294    .tf.lbar.fnext configure -image bm-down
2295
2296    set bm_up_data {
2297        #define up_width 16
2298        #define up_height 16
2299        static unsigned char up_bits[] = {
2300        0x80, 0x01, 0xc0, 0x03, 0xe0, 0x07, 0xf0, 0x0f,
2301        0xb8, 0x1d, 0x9c, 0x39, 0x8e, 0x71, 0x87, 0xe1,
2302        0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2303        0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01};
2304    }
2305    image create bitmap bm-up -data $bm_up_data -foreground $uifgcolor
2306    ${NS}::button .tf.lbar.fprev -width 26 -command {dofind -1 1}
2307    .tf.lbar.fprev configure -image bm-up
2308
2309    ${NS}::label .tf.lbar.flab2 -text " [mc "commit"] "
2310
2311    pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
2312        -side left -fill y
2313    set gdttype [mc "containing:"]
2314    set gm [makedroplist .tf.lbar.gdttype gdttype \
2315                [mc "containing:"] \
2316                [mc "touching paths:"] \
2317                [mc "adding/removing string:"] \
2318                [mc "changing lines matching:"]]
2319    trace add variable gdttype write gdttype_change
2320    pack .tf.lbar.gdttype -side left -fill y
2321
2322    set findstring {}
2323    set fstring .tf.lbar.findstring
2324    lappend entries $fstring
2325    ${NS}::entry $fstring -width 30 -textvariable findstring
2326    trace add variable findstring write find_change
2327    set findtype [mc "Exact"]
2328    set findtypemenu [makedroplist .tf.lbar.findtype \
2329                          findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
2330    trace add variable findtype write findcom_change
2331    set findloc [mc "All fields"]
2332    makedroplist .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
2333        [mc "Comments"] [mc "Author"] [mc "Committer"]
2334    trace add variable findloc write find_change
2335    pack .tf.lbar.findloc -side right
2336    pack .tf.lbar.findtype -side right
2337    pack $fstring -side left -expand 1 -fill x
2338
2339    # Finish putting the upper half of the viewer together
2340    pack .tf.lbar -in .tf -side bottom -fill x
2341    pack .tf.bar -in .tf -side bottom -fill x
2342    pack .tf.histframe -fill both -side top -expand 1
2343    .ctop add .tf
2344    if {!$use_ttk} {
2345        .ctop paneconfigure .tf -height $geometry(topheight)
2346        .ctop paneconfigure .tf -width $geometry(topwidth)
2347    }
2348
2349    # now build up the bottom
2350    ${NS}::panedwindow .pwbottom -orient horizontal
2351
2352    # lower left, a text box over search bar, scroll bar to the right
2353    # if we know window height, then that will set the lower text height, otherwise
2354    # we set lower text height which will drive window height
2355    if {[info exists geometry(main)]} {
2356        ${NS}::frame .bleft -width $geometry(botwidth)
2357    } else {
2358        ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
2359    }
2360    ${NS}::frame .bleft.top
2361    ${NS}::frame .bleft.mid
2362    ${NS}::frame .bleft.bottom
2363
2364    # gap between sub-widgets
2365    set wgap [font measure uifont "i"]
2366
2367    ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch
2368    pack .bleft.top.search -side left -padx 5
2369    set sstring .bleft.top.sstring
2370    set searchstring ""
2371    ${NS}::entry $sstring -width 20 -textvariable searchstring
2372    lappend entries $sstring
2373    trace add variable searchstring write incrsearch
2374    pack $sstring -side left -expand 1 -fill x
2375    ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \
2376        -command changediffdisp -variable diffelide -value {0 0}
2377    ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \
2378        -command changediffdisp -variable diffelide -value {0 1}
2379    ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \
2380        -command changediffdisp -variable diffelide -value {1 0}
2381
2382    ${NS}::label .bleft.mid.labeldiffcontext -text "      [mc "Lines of context"]: "
2383    pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left -ipadx $wgap
2384    spinbox .bleft.mid.diffcontext -width 5 \
2385        -from 0 -increment 1 -to 10000000 \
2386        -validate all -validatecommand "diffcontextvalidate %P" \
2387        -textvariable diffcontextstring
2388    .bleft.mid.diffcontext set $diffcontext
2389    trace add variable diffcontextstring write diffcontextchange
2390    lappend entries .bleft.mid.diffcontext
2391    pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left -ipadx $wgap
2392    ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
2393        -command changeignorespace -variable ignorespace
2394    pack .bleft.mid.ignspace -side left -padx 5
2395
2396    set worddiff [mc "Line diff"]
2397    if {[package vcompare $git_version "1.7.2"] >= 0} {
2398        makedroplist .bleft.mid.worddiff worddiff [mc "Line diff"] \
2399            [mc "Markup words"] [mc "Color words"]
2400        trace add variable worddiff write changeworddiff
2401        pack .bleft.mid.worddiff -side left -padx 5
2402    }
2403
2404    set ctext .bleft.bottom.ctext
2405    text $ctext -background $bgcolor -foreground $fgcolor \
2406        -state disabled -font textfont \
2407        -yscrollcommand scrolltext -wrap none \
2408        -xscrollcommand ".bleft.bottom.sbhorizontal set"
2409    if {$have_tk85} {
2410        $ctext conf -tabstyle wordprocessor
2411    }
2412    ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview"
2413    ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h
2414    pack .bleft.top -side top -fill x
2415    pack .bleft.mid -side top -fill x
2416    grid $ctext .bleft.bottom.sb -sticky nsew
2417    grid .bleft.bottom.sbhorizontal -sticky ew
2418    grid columnconfigure .bleft.bottom 0 -weight 1
2419    grid rowconfigure .bleft.bottom 0 -weight 1
2420    grid rowconfigure .bleft.bottom 1 -weight 0
2421    pack .bleft.bottom -side top -fill both -expand 1
2422    lappend bglist $ctext
2423    lappend fglist $ctext
2424
2425    $ctext tag conf comment -wrap $wrapcomment
2426    $ctext tag conf filesep -font textfontbold -fore $filesepfgcolor -back $filesepbgcolor
2427    $ctext tag conf hunksep -fore [lindex $diffcolors 2]
2428    $ctext tag conf d0 -fore [lindex $diffcolors 0]
2429    $ctext tag conf dresult -fore [lindex $diffcolors 1]
2430    $ctext tag conf m0 -fore [lindex $mergecolors 0]
2431    $ctext tag conf m1 -fore [lindex $mergecolors 1]
2432    $ctext tag conf m2 -fore [lindex $mergecolors 2]
2433    $ctext tag conf m3 -fore [lindex $mergecolors 3]
2434    $ctext tag conf m4 -fore [lindex $mergecolors 4]
2435    $ctext tag conf m5 -fore [lindex $mergecolors 5]
2436    $ctext tag conf m6 -fore [lindex $mergecolors 6]
2437    $ctext tag conf m7 -fore [lindex $mergecolors 7]
2438    $ctext tag conf m8 -fore [lindex $mergecolors 8]
2439    $ctext tag conf m9 -fore [lindex $mergecolors 9]
2440    $ctext tag conf m10 -fore [lindex $mergecolors 10]
2441    $ctext tag conf m11 -fore [lindex $mergecolors 11]
2442    $ctext tag conf m12 -fore [lindex $mergecolors 12]
2443    $ctext tag conf m13 -fore [lindex $mergecolors 13]
2444    $ctext tag conf m14 -fore [lindex $mergecolors 14]
2445    $ctext tag conf m15 -fore [lindex $mergecolors 15]
2446    $ctext tag conf mmax -fore darkgrey
2447    set mergemax 16
2448    $ctext tag conf mresult -font textfontbold
2449    $ctext tag conf msep -font textfontbold
2450    $ctext tag conf found -back $foundbgcolor
2451    $ctext tag conf currentsearchhit -back $currentsearchhitbgcolor
2452    $ctext tag conf wwrap -wrap word -lmargin2 1c
2453    $ctext tag conf bold -font textfontbold
2454
2455    .pwbottom add .bleft
2456    if {!$use_ttk} {
2457        .pwbottom paneconfigure .bleft -width $geometry(botwidth)
2458    }
2459
2460    # lower right
2461    ${NS}::frame .bright
2462    ${NS}::frame .bright.mode
2463    ${NS}::radiobutton .bright.mode.patch -text [mc "Patch"] \
2464        -command reselectline -variable cmitmode -value "patch"
2465    ${NS}::radiobutton .bright.mode.tree -text [mc "Tree"] \
2466        -command reselectline -variable cmitmode -value "tree"
2467    grid .bright.mode.patch .bright.mode.tree -sticky ew
2468    pack .bright.mode -side top -fill x
2469    set cflist .bright.cfiles
2470    set indent [font measure mainfont "nn"]
2471    text $cflist \
2472        -selectbackground $selectbgcolor \
2473        -background $bgcolor -foreground $fgcolor \
2474        -font mainfont \
2475        -tabs [list $indent [expr {2 * $indent}]] \
2476        -yscrollcommand ".bright.sb set" \
2477        -cursor [. cget -cursor] \
2478        -spacing1 1 -spacing3 1
2479    lappend bglist $cflist
2480    lappend fglist $cflist
2481    ${NS}::scrollbar .bright.sb -command "$cflist yview"
2482    pack .bright.sb -side right -fill y
2483    pack $cflist -side left -fill both -expand 1
2484    $cflist tag configure highlight \
2485        -background [$cflist cget -selectbackground]
2486    $cflist tag configure bold -font mainfontbold
2487
2488    .pwbottom add .bright
2489    .ctop add .pwbottom
2490
2491    # restore window width & height if known
2492    if {[info exists geometry(main)]} {
2493        if {[scan $geometry(main) "%dx%d" w h] >= 2} {
2494            if {$w > [winfo screenwidth .]} {
2495                set w [winfo screenwidth .]
2496            }
2497            if {$h > [winfo screenheight .]} {
2498                set h [winfo screenheight .]
2499            }
2500            wm geometry . "${w}x$h"
2501        }
2502    }
2503
2504    if {[info exists geometry(state)] && $geometry(state) eq "zoomed"} {
2505        wm state . $geometry(state)
2506    }
2507
2508    if {[tk windowingsystem] eq {aqua}} {
2509        set M1B M1
2510        set ::BM "3"
2511    } else {
2512        set M1B Control
2513        set ::BM "2"
2514    }
2515
2516    if {$use_ttk} {
2517        bind .ctop <Map> {
2518            bind %W <Map> {}
2519            %W sashpos 0 $::geometry(topheight)
2520        }
2521        bind .pwbottom <Map> {
2522            bind %W <Map> {}
2523            %W sashpos 0 $::geometry(botwidth)
2524        }
2525    }
2526
2527    bind .pwbottom <Configure> {resizecdetpanes %W %w}
2528    pack .ctop -fill both -expand 1
2529    bindall <1> {selcanvline %W %x %y}
2530    #bindall <B1-Motion> {selcanvline %W %x %y}
2531    if {[tk windowingsystem] == "win32"} {
2532        bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
2533        bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
2534    } else {
2535        bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
2536        bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
2537        bind $ctext <Button> {
2538            if {"%b" eq 6} {
2539                $ctext xview scroll -5 units
2540            } elseif {"%b" eq 7} {
2541                $ctext xview scroll 5 units
2542            }
2543        }
2544        if {[tk windowingsystem] eq "aqua"} {
2545            bindall <MouseWheel> {
2546                set delta [expr {- (%D)}]
2547                allcanvs yview scroll $delta units
2548            }
2549            bindall <Shift-MouseWheel> {
2550                set delta [expr {- (%D)}]
2551                $canv xview scroll $delta units
2552            }
2553        }
2554    }
2555    bindall <$::BM> "canvscan mark %W %x %y"
2556    bindall <B$::BM-Motion> "canvscan dragto %W %x %y"
2557    bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2558    bind . <$M1B-Key-w> doquit
2559    bindkey <Home> selfirstline
2560    bindkey <End> sellastline
2561    bind . <Key-Up> "selnextline -1"
2562    bind . <Key-Down> "selnextline 1"
2563    bind . <Shift-Key-Up> "dofind -1 0"
2564    bind . <Shift-Key-Down> "dofind 1 0"
2565    bindkey <Key-Right> "goforw"
2566    bindkey <Key-Left> "goback"
2567    bind . <Key-Prior> "selnextpage -1"
2568    bind . <Key-Next> "selnextpage 1"
2569    bind . <$M1B-Home> "allcanvs yview moveto 0.0"
2570    bind . <$M1B-End> "allcanvs yview moveto 1.0"
2571    bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
2572    bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
2573    bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2574    bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
2575    bindkey <Key-Delete> "$ctext yview scroll -1 pages"
2576    bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
2577    bindkey <Key-space> "$ctext yview scroll 1 pages"
2578    bindkey p "selnextline -1"
2579    bindkey n "selnextline 1"
2580    bindkey z "goback"
2581    bindkey x "goforw"
2582    bindkey k "selnextline -1"
2583    bindkey j "selnextline 1"
2584    bindkey h "goback"
2585    bindkey l "goforw"
2586    bindkey b prevfile
2587    bindkey d "$ctext yview scroll 18 units"
2588    bindkey u "$ctext yview scroll -18 units"
2589    bindkey g {$sha1entry delete 0 end; focus $sha1entry}
2590    bindkey / {focus $fstring}
2591    bindkey <Key-KP_Divide> {focus $fstring}
2592    bindkey <Key-Return> {dofind 1 1}
2593    bindkey ? {dofind -1 1}
2594    bindkey f nextfile
2595    bind . <F5> updatecommits
2596    bindmodfunctionkey Shift 5 reloadcommits
2597    bind . <F2> showrefs
2598    bindmodfunctionkey Shift 4 {newview 0}
2599    bind . <F4> edit_or_newview
2600    bind . <$M1B-q> doquit
2601    bind . <$M1B-f> {dofind 1 1}
2602    bind . <$M1B-g> {dofind 1 0}
2603    bind . <$M1B-r> dosearchback
2604    bind . <$M1B-s> dosearch
2605    bind . <$M1B-equal> {incrfont 1}
2606    bind . <$M1B-plus> {incrfont 1}
2607    bind . <$M1B-KP_Add> {incrfont 1}
2608    bind . <$M1B-minus> {incrfont -1}
2609    bind . <$M1B-KP_Subtract> {incrfont -1}
2610    wm protocol . WM_DELETE_WINDOW doquit
2611    bind . <Destroy> {stop_backends}
2612    bind . <Button-1> "click %W"
2613    bind $fstring <Key-Return> {dofind 1 1}
2614    bind $sha1entry <Key-Return> {gotocommit; break}
2615    bind $sha1entry <<PasteSelection>> clearsha1
2616    bind $sha1entry <<Paste>> clearsha1
2617    bind $cflist <1> {sel_flist %W %x %y; break}
2618    bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
2619    bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
2620    global ctxbut
2621    bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
2622    bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
2623    bind $ctext <Button-1> {focus %W}
2624    bind $ctext <<Selection>> rehighlight_search_results
2625    for {set i 1} {$i < 10} {incr i} {
2626        bind . <$M1B-Key-$i> [list go_to_parent $i]
2627    }
2628
2629    set maincursor [. cget -cursor]
2630    set textcursor [$ctext cget -cursor]
2631    set curtextcursor $textcursor
2632
2633    set rowctxmenu .rowctxmenu
2634    makemenu $rowctxmenu {
2635        {mc "Diff this -> selected" command {diffvssel 0}}
2636        {mc "Diff selected -> this" command {diffvssel 1}}
2637        {mc "Make patch" command mkpatch}
2638        {mc "Create tag" command mktag}
2639        {mc "Copy commit summary" command copysummary}
2640        {mc "Write commit to file" command writecommit}
2641        {mc "Create new branch" command mkbranch}
2642        {mc "Cherry-pick this commit" command cherrypick}
2643        {mc "Reset HEAD branch to here" command resethead}
2644        {mc "Mark this commit" command markhere}
2645        {mc "Return to mark" command gotomark}
2646        {mc "Find descendant of this and mark" command find_common_desc}
2647        {mc "Compare with marked commit" command compare_commits}
2648        {mc "Diff this -> marked commit" command {diffvsmark 0}}
2649        {mc "Diff marked commit -> this" command {diffvsmark 1}}
2650        {mc "Revert this commit" command revert}
2651    }
2652    $rowctxmenu configure -tearoff 0
2653
2654    set fakerowmenu .fakerowmenu
2655    makemenu $fakerowmenu {
2656        {mc "Diff this -> selected" command {diffvssel 0}}
2657        {mc "Diff selected -> this" command {diffvssel 1}}
2658        {mc "Make patch" command mkpatch}
2659        {mc "Diff this -> marked commit" command {diffvsmark 0}}
2660        {mc "Diff marked commit -> this" command {diffvsmark 1}}
2661    }
2662    $fakerowmenu configure -tearoff 0
2663
2664    set headctxmenu .headctxmenu
2665    makemenu $headctxmenu {
2666        {mc "Check out this branch" command cobranch}
2667        {mc "Remove this branch" command rmbranch}
2668        {mc "Copy branch name" command {clipboard clear; clipboard append $headmenuhead}}
2669    }
2670    $headctxmenu configure -tearoff 0
2671
2672    global flist_menu
2673    set flist_menu .flistctxmenu
2674    makemenu $flist_menu {
2675        {mc "Highlight this too" command {flist_hl 0}}
2676        {mc "Highlight this only" command {flist_hl 1}}
2677        {mc "External diff" command {external_diff}}
2678        {mc "Blame parent commit" command {external_blame 1}}
2679        {mc "Copy path" command {clipboard clear; clipboard append $flist_menu_file}}
2680    }
2681    $flist_menu configure -tearoff 0
2682
2683    global diff_menu
2684    set diff_menu .diffctxmenu
2685    makemenu $diff_menu {
2686        {mc "Show origin of this line" command show_line_source}
2687        {mc "Run git gui blame on this line" command {external_blame_diff}}
2688    }
2689    $diff_menu configure -tearoff 0
2690}
2691
2692# Windows sends all mouse wheel events to the current focused window, not
2693# the one where the mouse hovers, so bind those events here and redirect
2694# to the correct window
2695proc windows_mousewheel_redirector {W X Y D} {
2696    global canv canv2 canv3
2697    set w [winfo containing -displayof $W $X $Y]
2698    if {$w ne ""} {
2699        set u [expr {$D < 0 ? 5 : -5}]
2700        if {$w == $canv || $w == $canv2 || $w == $canv3} {
2701            allcanvs yview scroll $u units
2702        } else {
2703            catch {
2704                $w yview scroll $u units
2705            }
2706        }
2707    }
2708}
2709
2710# Update row number label when selectedline changes
2711proc selectedline_change {n1 n2 op} {
2712    global selectedline rownumsel
2713
2714    if {$selectedline eq {}} {
2715        set rownumsel {}
2716    } else {
2717        set rownumsel [expr {$selectedline + 1}]
2718    }
2719}
2720
2721# mouse-2 makes all windows scan vertically, but only the one
2722# the cursor is in scans horizontally
2723proc canvscan {op w x y} {
2724    global canv canv2 canv3
2725    foreach c [list $canv $canv2 $canv3] {
2726        if {$c == $w} {
2727            $c scan $op $x $y
2728        } else {
2729            $c scan $op 0 $y
2730        }
2731    }
2732}
2733
2734proc scrollcanv {cscroll f0 f1} {
2735    $cscroll set $f0 $f1
2736    drawvisible
2737    flushhighlights
2738}
2739
2740# when we make a key binding for the toplevel, make sure
2741# it doesn't get triggered when that key is pressed in the
2742# find string entry widget.
2743proc bindkey {ev script} {
2744    global entries
2745    bind . $ev $script
2746    set escript [bind Entry $ev]
2747    if {$escript == {}} {
2748        set escript [bind Entry <Key>]
2749    }
2750    foreach e $entries {
2751        bind $e $ev "$escript; break"
2752    }
2753}
2754
2755proc bindmodfunctionkey {mod n script} {
2756    bind . <$mod-F$n> $script
2757    catch { bind . <$mod-XF86_Switch_VT_$n> $script }
2758}
2759
2760# set the focus back to the toplevel for any click outside
2761# the entry widgets
2762proc click {w} {
2763    global ctext entries
2764    foreach e [concat $entries $ctext] {
2765        if {$w == $e} return
2766    }
2767    focus .
2768}
2769
2770# Adjust the progress bar for a change in requested extent or canvas size
2771proc adjustprogress {} {
2772    global progresscanv progressitem progresscoords
2773    global fprogitem fprogcoord lastprogupdate progupdatepending
2774    global rprogitem rprogcoord use_ttk
2775
2776    if {$use_ttk} {
2777        $progresscanv configure -value [expr {int($fprogcoord * 100)}]
2778        return
2779    }
2780
2781    set w [expr {[winfo width $progresscanv] - 4}]
2782    set x0 [expr {$w * [lindex $progresscoords 0]}]
2783    set x1 [expr {$w * [lindex $progresscoords 1]}]
2784    set h [winfo height $progresscanv]
2785    $progresscanv coords $progressitem $x0 0 $x1 $h
2786    $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2787    $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2788    set now [clock clicks -milliseconds]
2789    if {$now >= $lastprogupdate + 100} {
2790        set progupdatepending 0
2791        update
2792    } elseif {!$progupdatepending} {
2793        set progupdatepending 1
2794        after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2795    }
2796}
2797
2798proc doprogupdate {} {
2799    global lastprogupdate progupdatepending
2800
2801    if {$progupdatepending} {
2802        set progupdatepending 0
2803        set lastprogupdate [clock clicks -milliseconds]
2804        update
2805    }
2806}
2807
2808proc config_check_tmp_exists {tries_left} {
2809    global config_file_tmp
2810
2811    if {[file exists $config_file_tmp]} {
2812        incr tries_left -1
2813        if {$tries_left > 0} {
2814            after 100 [list config_check_tmp_exists $tries_left]
2815        } else {
2816            error_popup "There appears to be a stale $config_file_tmp\
2817 file, which will prevent gitk from saving its configuration on exit.\
2818 Please remove it if it is not being used by any existing gitk process."
2819        }
2820    }
2821}
2822
2823proc config_init_trace {name} {
2824    global config_variable_changed config_variable_original
2825
2826    upvar #0 $name var
2827    set config_variable_changed($name) 0
2828    set config_variable_original($name) $var
2829}
2830
2831proc config_variable_change_cb {name name2 op} {
2832    global config_variable_changed config_variable_original
2833
2834    upvar #0 $name var
2835    if {$op eq "write" &&
2836        (![info exists config_variable_original($name)] ||
2837         $config_variable_original($name) ne $var)} {
2838        set config_variable_changed($name) 1
2839    }
2840}
2841
2842proc savestuff {w} {
2843    global stuffsaved
2844    global config_file config_file_tmp
2845    global config_variables config_variable_changed
2846    global viewchanged
2847
2848    upvar #0 viewname current_viewname
2849    upvar #0 viewfiles current_viewfiles
2850    upvar #0 viewargs current_viewargs
2851    upvar #0 viewargscmd current_viewargscmd
2852    upvar #0 viewperm current_viewperm
2853    upvar #0 nextviewnum current_nextviewnum
2854    upvar #0 use_ttk current_use_ttk
2855
2856    if {$stuffsaved} return
2857    if {![winfo viewable .]} return
2858    set remove_tmp 0
2859    if {[catch {
2860        set try_count 0
2861        while {[catch {set f [open $config_file_tmp {WRONLY CREAT EXCL}]}]} {
2862            if {[incr try_count] > 50} {
2863                error "Unable to write config file: $config_file_tmp exists"
2864            }
2865            after 100
2866        }
2867        set remove_tmp 1
2868        if {$::tcl_platform(platform) eq {windows}} {
2869            file attributes $config_file_tmp -hidden true
2870        }
2871        if {[file exists $config_file]} {
2872            source $config_file
2873        }
2874        foreach var_name $config_variables {
2875            upvar #0 $var_name var
2876            upvar 0 $var_name old_var
2877            if {!$config_variable_changed($var_name) && [info exists old_var]} {
2878                puts $f [list set $var_name $old_var]
2879            } else {
2880                puts $f [list set $var_name $var]
2881            }
2882        }
2883
2884        puts $f "set geometry(main) [wm geometry .]"
2885        puts $f "set geometry(state) [wm state .]"
2886        puts $f "set geometry(topwidth) [winfo width .tf]"
2887        puts $f "set geometry(topheight) [winfo height .tf]"
2888        if {$current_use_ttk} {
2889            puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
2890            puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
2891        } else {
2892            puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2893            puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2894        }
2895        puts $f "set geometry(botwidth) [winfo width .bleft]"
2896        puts $f "set geometry(botheight) [winfo height .bleft]"
2897
2898        array set view_save {}
2899        array set views {}
2900        if {![info exists permviews]} { set permviews {} }
2901        foreach view $permviews {
2902            set view_save([lindex $view 0]) 1
2903            set views([lindex $view 0]) $view
2904        }
2905        puts -nonewline $f "set permviews {"
2906        for {set v 1} {$v < $current_nextviewnum} {incr v} {
2907            if {$viewchanged($v)} {
2908                if {$current_viewperm($v)} {
2909                    set views($current_viewname($v)) [list $current_viewname($v) $current_viewfiles($v) $current_viewargs($v) $current_viewargscmd($v)]
2910                } else {
2911                    set view_save($current_viewname($v)) 0
2912                }
2913            }
2914        }
2915        # write old and updated view to their places and append remaining to the end
2916        foreach view $permviews {
2917            set view_name [lindex $view 0]
2918            if {$view_save($view_name)} {
2919                puts $f "{$views($view_name)}"
2920            }
2921            unset views($view_name)
2922        }
2923        foreach view_name [array names views] {
2924            puts $f "{$views($view_name)}"
2925        }
2926        puts $f "}"
2927        close $f
2928        file rename -force $config_file_tmp $config_file
2929        set remove_tmp 0
2930    } err]} {
2931        puts "Error saving config: $err"
2932    }
2933    if {$remove_tmp} {
2934        file delete -force $config_file_tmp
2935    }
2936    set stuffsaved 1
2937}
2938
2939proc resizeclistpanes {win w} {
2940    global oldwidth use_ttk
2941    if {[info exists oldwidth($win)]} {
2942        if {$use_ttk} {
2943            set s0 [$win sashpos 0]
2944            set s1 [$win sashpos 1]
2945        } else {
2946            set s0 [$win sash coord 0]
2947            set s1 [$win sash coord 1]
2948        }
2949        if {$w < 60} {
2950            set sash0 [expr {int($w/2 - 2)}]
2951            set sash1 [expr {int($w*5/6 - 2)}]
2952        } else {
2953            set factor [expr {1.0 * $w / $oldwidth($win)}]
2954            set sash0 [expr {int($factor * [lindex $s0 0])}]
2955            set sash1 [expr {int($factor * [lindex $s1 0])}]
2956            if {$sash0 < 30} {
2957                set sash0 30
2958            }
2959            if {$sash1 < $sash0 + 20} {
2960                set sash1 [expr {$sash0 + 20}]
2961            }
2962            if {$sash1 > $w - 10} {
2963                set sash1 [expr {$w - 10}]
2964                if {$sash0 > $sash1 - 20} {
2965                    set sash0 [expr {$sash1 - 20}]
2966                }
2967            }
2968        }
2969        if {$use_ttk} {
2970            $win sashpos 0 $sash0
2971            $win sashpos 1 $sash1
2972        } else {
2973            $win sash place 0 $sash0 [lindex $s0 1]
2974            $win sash place 1 $sash1 [lindex $s1 1]
2975        }
2976    }
2977    set oldwidth($win) $w
2978}
2979
2980proc resizecdetpanes {win w} {
2981    global oldwidth use_ttk
2982    if {[info exists oldwidth($win)]} {
2983        if {$use_ttk} {
2984            set s0 [$win sashpos 0]
2985        } else {
2986            set s0 [$win sash coord 0]
2987        }
2988        if {$w < 60} {
2989            set sash0 [expr {int($w*3/4 - 2)}]
2990        } else {
2991            set factor [expr {1.0 * $w / $oldwidth($win)}]
2992            set sash0 [expr {int($factor * [lindex $s0 0])}]
2993            if {$sash0 < 45} {
2994                set sash0 45
2995            }
2996            if {$sash0 > $w - 15} {
2997                set sash0 [expr {$w - 15}]
2998            }
2999        }
3000        if {$use_ttk} {
3001            $win sashpos 0 $sash0
3002        } else {
3003            $win sash place 0 $sash0 [lindex $s0 1]
3004        }
3005    }
3006    set oldwidth($win) $w
3007}
3008
3009proc allcanvs args {
3010    global canv canv2 canv3
3011    eval $canv $args
3012    eval $canv2 $args
3013    eval $canv3 $args
3014}
3015
3016proc bindall {event action} {
3017    global canv canv2 canv3
3018    bind $canv $event $action
3019    bind $canv2 $event $action
3020    bind $canv3 $event $action
3021}
3022
3023proc about {} {
3024    global bgcolor NS
3025    set w .about
3026    if {[winfo exists $w]} {
3027        raise $w
3028        return
3029    }
3030    ttk_toplevel $w
3031    wm title $w [mc "About gitk"]
3032    make_transient $w .
3033    message $w.m -text [mc "
3034Gitk - a commit viewer for git
3035
3036Copyright \u00a9 2005-2014 Paul Mackerras
3037
3038Use and redistribute under the terms of the GNU General Public License"] \
3039            -justify center -aspect 400 -border 2 -bg $bgcolor -relief groove
3040    pack $w.m -side top -fill x -padx 2 -pady 2
3041    ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
3042    pack $w.ok -side bottom
3043    bind $w <Visibility> "focus $w.ok"
3044    bind $w <Key-Escape> "destroy $w"
3045    bind $w <Key-Return> "destroy $w"
3046    tk::PlaceWindow $w widget .
3047}
3048
3049proc keys {} {
3050    global bgcolor NS
3051    set w .keys
3052    if {[winfo exists $w]} {
3053        raise $w
3054        return
3055    }
3056    if {[tk windowingsystem] eq {aqua}} {
3057        set M1T Cmd
3058    } else {
3059        set M1T Ctrl
3060    }
3061    ttk_toplevel $w
3062    wm title $w [mc "Gitk key bindings"]
3063    make_transient $w .
3064    message $w.m -text "
3065[mc "Gitk key bindings:"]
3066
3067[mc "<%s-Q>             Quit" $M1T]
3068[mc "<%s-W>             Close window" $M1T]
3069[mc "<Home>             Move to first commit"]
3070[mc "<End>              Move to last commit"]
3071[mc "<Up>, p, k Move up one commit"]
3072[mc "<Down>, n, j       Move down one commit"]
3073[mc "<Left>, z, h       Go back in history list"]
3074[mc "<Right>, x, l      Go forward in history list"]
3075[mc "<%s-n>     Go to n-th parent of current commit in history list" $M1T]
3076[mc "<PageUp>   Move up one page in commit list"]
3077[mc "<PageDown> Move down one page in commit list"]
3078[mc "<%s-Home>  Scroll to top of commit list" $M1T]
3079[mc "<%s-End>   Scroll to bottom of commit list" $M1T]
3080[mc "<%s-Up>    Scroll commit list up one line" $M1T]
3081[mc "<%s-Down>  Scroll commit list down one line" $M1T]
3082[mc "<%s-PageUp>        Scroll commit list up one page" $M1T]
3083[mc "<%s-PageDown>      Scroll commit list down one page" $M1T]
3084[mc "<Shift-Up> Find backwards (upwards, later commits)"]
3085[mc "<Shift-Down>       Find forwards (downwards, earlier commits)"]
3086[mc "<Delete>, b        Scroll diff view up one page"]
3087[mc "<Backspace>        Scroll diff view up one page"]
3088[mc "<Space>            Scroll diff view down one page"]
3089[mc "u          Scroll diff view up 18 lines"]
3090[mc "d          Scroll diff view down 18 lines"]
3091[mc "<%s-F>             Find" $M1T]
3092[mc "<%s-G>             Move to next find hit" $M1T]
3093[mc "<Return>   Move to next find hit"]
3094[mc "g          Go to commit"]
3095[mc "/          Focus the search box"]
3096[mc "?          Move to previous find hit"]
3097[mc "f          Scroll diff view to next file"]
3098[mc "<%s-S>             Search for next hit in diff view" $M1T]
3099[mc "<%s-R>             Search for previous hit in diff view" $M1T]
3100[mc "<%s-KP+>   Increase font size" $M1T]
3101[mc "<%s-plus>  Increase font size" $M1T]
3102[mc "<%s-KP->   Decrease font size" $M1T]
3103[mc "<%s-minus> Decrease font size" $M1T]
3104[mc "<F5>               Update"]
3105" \
3106            -justify left -bg $bgcolor -border 2 -relief groove
3107    pack $w.m -side top -fill both -padx 2 -pady 2
3108    ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
3109    bind $w <Key-Escape> [list destroy $w]
3110    pack $w.ok -side bottom
3111    bind $w <Visibility> "focus $w.ok"
3112    bind $w <Key-Escape> "destroy $w"
3113    bind $w <Key-Return> "destroy $w"
3114}
3115
3116# Procedures for manipulating the file list window at the
3117# bottom right of the overall window.
3118
3119proc treeview {w l openlevs} {
3120    global treecontents treediropen treeheight treeparent treeindex
3121
3122    set ix 0
3123    set treeindex() 0
3124    set lev 0
3125    set prefix {}
3126    set prefixend -1
3127    set prefendstack {}
3128    set htstack {}
3129    set ht 0
3130    set treecontents() {}
3131    $w conf -state normal
3132    foreach f $l {
3133        while {[string range $f 0 $prefixend] ne $prefix} {
3134            if {$lev <= $openlevs} {
3135                $w mark set e:$treeindex($prefix) "end -1c"
3136                $w mark gravity e:$treeindex($prefix) left
3137            }
3138            set treeheight($prefix) $ht
3139            incr ht [lindex $htstack end]
3140            set htstack [lreplace $htstack end end]
3141            set prefixend [lindex $prefendstack end]
3142            set prefendstack [lreplace $prefendstack end end]
3143            set prefix [string range $prefix 0 $prefixend]
3144            incr lev -1
3145        }
3146        set tail [string range $f [expr {$prefixend+1}] end]
3147        while {[set slash [string first "/" $tail]] >= 0} {
3148            lappend htstack $ht
3149            set ht 0
3150            lappend prefendstack $prefixend
3151            incr prefixend [expr {$slash + 1}]
3152            set d [string range $tail 0 $slash]
3153            lappend treecontents($prefix) $d
3154            set oldprefix $prefix
3155            append prefix $d
3156            set treecontents($prefix) {}
3157            set treeindex($prefix) [incr ix]
3158            set treeparent($prefix) $oldprefix
3159            set tail [string range $tail [expr {$slash+1}] end]
3160            if {$lev <= $openlevs} {
3161                set ht 1
3162                set treediropen($prefix) [expr {$lev < $openlevs}]
3163                set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
3164                $w mark set d:$ix "end -1c"
3165                $w mark gravity d:$ix left
3166                set str "\n"
3167                for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3168                $w insert end $str
3169                $w image create end -align center -image $bm -padx 1 \
3170                    -name a:$ix
3171                $w insert end $d [highlight_tag $prefix]
3172                $w mark set s:$ix "end -1c"
3173                $w mark gravity s:$ix left
3174            }
3175            incr lev
3176        }
3177        if {$tail ne {}} {
3178            if {$lev <= $openlevs} {
3179                incr ht
3180                set str "\n"
3181                for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3182                $w insert end $str
3183                $w insert end $tail [highlight_tag $f]
3184            }
3185            lappend treecontents($prefix) $tail
3186        }
3187    }
3188    while {$htstack ne {}} {
3189        set treeheight($prefix) $ht
3190        incr ht [lindex $htstack end]
3191        set htstack [lreplace $htstack end end]
3192        set prefixend [lindex $prefendstack end]
3193        set prefendstack [lreplace $prefendstack end end]
3194        set prefix [string range $prefix 0 $prefixend]
3195    }
3196    $w conf -state disabled
3197}
3198
3199proc linetoelt {l} {
3200    global treeheight treecontents
3201
3202    set y 2
3203    set prefix {}
3204    while {1} {
3205        foreach e $treecontents($prefix) {
3206            if {$y == $l} {
3207                return "$prefix$e"
3208            }
3209            set n 1
3210            if {[string index $e end] eq "/"} {
3211                set n $treeheight($prefix$e)
3212                if {$y + $n > $l} {
3213                    append prefix $e
3214                    incr y
3215                    break
3216                }
3217            }
3218            incr y $n
3219        }
3220    }
3221}
3222
3223proc highlight_tree {y prefix} {
3224    global treeheight treecontents cflist
3225
3226    foreach e $treecontents($prefix) {
3227        set path $prefix$e
3228        if {[highlight_tag $path] ne {}} {
3229            $cflist tag add bold $y.0 "$y.0 lineend"
3230        }
3231        incr y
3232        if {[string index $e end] eq "/" && $treeheight($path) > 1} {
3233            set y [highlight_tree $y $path]
3234        }
3235    }
3236    return $y
3237}
3238
3239proc treeclosedir {w dir} {
3240    global treediropen treeheight treeparent treeindex
3241
3242    set ix $treeindex($dir)
3243    $w conf -state normal
3244    $w delete s:$ix e:$ix
3245    set treediropen($dir) 0
3246    $w image configure a:$ix -image tri-rt
3247    $w conf -state disabled
3248    set n [expr {1 - $treeheight($dir)}]
3249    while {$dir ne {}} {
3250        incr treeheight($dir) $n
3251        set dir $treeparent($dir)
3252    }
3253}
3254
3255proc treeopendir {w dir} {
3256    global treediropen treeheight treeparent treecontents treeindex
3257
3258    set ix $treeindex($dir)
3259    $w conf -state normal
3260    $w image configure a:$ix -image tri-dn
3261    $w mark set e:$ix s:$ix
3262    $w mark gravity e:$ix right
3263    set lev 0
3264    set str "\n"
3265    set n [llength $treecontents($dir)]
3266    for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
3267        incr lev
3268        append str "\t"
3269        incr treeheight($x) $n
3270    }
3271    foreach e $treecontents($dir) {
3272        set de $dir$e
3273        if {[string index $e end] eq "/"} {
3274            set iy $treeindex($de)
3275            $w mark set d:$iy e:$ix
3276            $w mark gravity d:$iy left
3277            $w insert e:$ix $str
3278            set treediropen($de) 0
3279            $w image create e:$ix -align center -image tri-rt -padx 1 \
3280                -name a:$iy
3281            $w insert e:$ix $e [highlight_tag $de]
3282            $w mark set s:$iy e:$ix
3283            $w mark gravity s:$iy left
3284            set treeheight($de) 1
3285        } else {
3286            $w insert e:$ix $str
3287            $w insert e:$ix $e [highlight_tag $de]
3288        }
3289    }
3290    $w mark gravity e:$ix right
3291    $w conf -state disabled
3292    set treediropen($dir) 1
3293    set top [lindex [split [$w index @0,0] .] 0]
3294    set ht [$w cget -height]
3295    set l [lindex [split [$w index s:$ix] .] 0]
3296    if {$l < $top} {
3297        $w yview $l.0
3298    } elseif {$l + $n + 1 > $top + $ht} {
3299        set top [expr {$l + $n + 2 - $ht}]
3300        if {$l < $top} {
3301            set top $l
3302        }
3303        $w yview $top.0
3304    }
3305}
3306
3307proc treeclick {w x y} {
3308    global treediropen cmitmode ctext cflist cflist_top
3309
3310    if {$cmitmode ne "tree"} return
3311    if {![info exists cflist_top]} return
3312    set l [lindex [split [$w index "@$x,$y"] "."] 0]
3313    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3314    $cflist tag add highlight $l.0 "$l.0 lineend"
3315    set cflist_top $l
3316    if {$l == 1} {
3317        $ctext yview 1.0
3318        return
3319    }
3320    set e [linetoelt $l]
3321    if {[string index $e end] ne "/"} {
3322        showfile $e
3323    } elseif {$treediropen($e)} {
3324        treeclosedir $w $e
3325    } else {
3326        treeopendir $w $e
3327    }
3328}
3329
3330proc setfilelist {id} {
3331    global treefilelist cflist jump_to_here
3332
3333    treeview $cflist $treefilelist($id) 0
3334    if {$jump_to_here ne {}} {
3335        set f [lindex $jump_to_here 0]
3336        if {[lsearch -exact $treefilelist($id) $f] >= 0} {
3337            showfile $f
3338        }
3339    }
3340}
3341
3342image create bitmap tri-rt -background black -foreground blue -data {
3343    #define tri-rt_width 13
3344    #define tri-rt_height 13
3345    static unsigned char tri-rt_bits[] = {
3346       0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
3347       0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
3348       0x00, 0x00};
3349} -maskdata {
3350    #define tri-rt-mask_width 13
3351    #define tri-rt-mask_height 13
3352    static unsigned char tri-rt-mask_bits[] = {
3353       0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
3354       0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
3355       0x08, 0x00};
3356}
3357image create bitmap tri-dn -background black -foreground blue -data {
3358    #define tri-dn_width 13
3359    #define tri-dn_height 13
3360    static unsigned char tri-dn_bits[] = {
3361       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
3362       0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3363       0x00, 0x00};
3364} -maskdata {
3365    #define tri-dn-mask_width 13
3366    #define tri-dn-mask_height 13
3367    static unsigned char tri-dn-mask_bits[] = {
3368       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
3369       0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
3370       0x00, 0x00};
3371}
3372
3373image create bitmap reficon-T -background black -foreground yellow -data {
3374    #define tagicon_width 13
3375    #define tagicon_height 9
3376    static unsigned char tagicon_bits[] = {
3377       0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
3378       0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
3379} -maskdata {
3380    #define tagicon-mask_width 13
3381    #define tagicon-mask_height 9
3382    static unsigned char tagicon-mask_bits[] = {
3383       0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
3384       0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
3385}
3386set rectdata {
3387    #define headicon_width 13
3388    #define headicon_height 9
3389    static unsigned char headicon_bits[] = {
3390       0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3391       0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3392}
3393set rectmask {
3394    #define headicon-mask_width 13
3395    #define headicon-mask_height 9
3396    static unsigned char headicon-mask_bits[] = {
3397       0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3398       0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3399}
3400image create bitmap reficon-H -background black -foreground lime \
3401    -data $rectdata -maskdata $rectmask
3402image create bitmap reficon-o -background black -foreground "#ddddff" \
3403    -data $rectdata -maskdata $rectmask
3404
3405proc init_flist {first} {
3406    global cflist cflist_top difffilestart
3407
3408    $cflist conf -state normal
3409    $cflist delete 0.0 end
3410    if {$first ne {}} {
3411        $cflist insert end $first
3412        set cflist_top 1
3413        $cflist tag add highlight 1.0 "1.0 lineend"
3414    } else {
3415        unset -nocomplain cflist_top
3416    }
3417    $cflist conf -state disabled
3418    set difffilestart {}
3419}
3420
3421proc highlight_tag {f} {
3422    global highlight_paths
3423
3424    foreach p $highlight_paths {
3425        if {[string match $p $f]} {
3426            return "bold"
3427        }
3428    }
3429    return {}
3430}
3431
3432proc highlight_filelist {} {
3433    global cmitmode cflist
3434
3435    $cflist conf -state normal
3436    if {$cmitmode ne "tree"} {
3437        set end [lindex [split [$cflist index end] .] 0]
3438        for {set l 2} {$l < $end} {incr l} {
3439            set line [$cflist get $l.0 "$l.0 lineend"]
3440            if {[highlight_tag $line] ne {}} {
3441                $cflist tag add bold $l.0 "$l.0 lineend"
3442            }
3443        }
3444    } else {
3445        highlight_tree 2 {}
3446    }
3447    $cflist conf -state disabled
3448}
3449
3450proc unhighlight_filelist {} {
3451    global cflist
3452
3453    $cflist conf -state normal
3454    $cflist tag remove bold 1.0 end
3455    $cflist conf -state disabled
3456}
3457
3458proc add_flist {fl} {
3459    global cflist
3460
3461    $cflist conf -state normal
3462    foreach f $fl {
3463        $cflist insert end "\n"
3464        $cflist insert end $f [highlight_tag $f]
3465    }
3466    $cflist conf -state disabled
3467}
3468
3469proc sel_flist {w x y} {
3470    global ctext difffilestart cflist cflist_top cmitmode
3471
3472    if {$cmitmode eq "tree"} return
3473    if {![info exists cflist_top]} return
3474    set l [lindex [split [$w index "@$x,$y"] "."] 0]
3475    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3476    $cflist tag add highlight $l.0 "$l.0 lineend"
3477    set cflist_top $l
3478    if {$l == 1} {
3479        $ctext yview 1.0
3480    } else {
3481        catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
3482    }
3483    suppress_highlighting_file_for_current_scrollpos
3484}
3485
3486proc pop_flist_menu {w X Y x y} {
3487    global ctext cflist cmitmode flist_menu flist_menu_file
3488    global treediffs diffids
3489
3490    stopfinding
3491    set l [lindex [split [$w index "@$x,$y"] "."] 0]
3492    if {$l <= 1} return
3493    if {$cmitmode eq "tree"} {
3494        set e [linetoelt $l]
3495        if {[string index $e end] eq "/"} return
3496    } else {
3497        set e [lindex $treediffs($diffids) [expr {$l-2}]]
3498    }
3499    set flist_menu_file $e
3500    set xdiffstate "normal"
3501    if {$cmitmode eq "tree"} {
3502        set xdiffstate "disabled"
3503    }
3504    # Disable "External diff" item in tree mode
3505    $flist_menu entryconf 2 -state $xdiffstate
3506    tk_popup $flist_menu $X $Y
3507}
3508
3509proc find_ctext_fileinfo {line} {
3510    global ctext_file_names ctext_file_lines
3511
3512    set ok [bsearch $ctext_file_lines $line]
3513    set tline [lindex $ctext_file_lines $ok]
3514
3515    if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3516        return {}
3517    } else {
3518        return [list [lindex $ctext_file_names $ok] $tline]
3519    }
3520}
3521
3522proc pop_diff_menu {w X Y x y} {
3523    global ctext diff_menu flist_menu_file
3524    global diff_menu_txtpos diff_menu_line
3525    global diff_menu_filebase
3526
3527    set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3528    set diff_menu_line [lindex $diff_menu_txtpos 0]
3529    # don't pop up the menu on hunk-separator or file-separator lines
3530    if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3531        return
3532    }
3533    stopfinding
3534    set f [find_ctext_fileinfo $diff_menu_line]
3535    if {$f eq {}} return
3536    set flist_menu_file [lindex $f 0]
3537    set diff_menu_filebase [lindex $f 1]
3538    tk_popup $diff_menu $X $Y
3539}
3540
3541proc flist_hl {only} {
3542    global flist_menu_file findstring gdttype
3543
3544    set x [shellquote $flist_menu_file]
3545    if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
3546        set findstring $x
3547    } else {
3548        append findstring " " $x
3549    }
3550    set gdttype [mc "touching paths:"]
3551}
3552
3553proc gitknewtmpdir {} {
3554    global diffnum gitktmpdir gitdir env
3555
3556    if {![info exists gitktmpdir]} {
3557        if {[info exists env(GITK_TMPDIR)]} {
3558            set tmpdir $env(GITK_TMPDIR)
3559        } elseif {[info exists env(TMPDIR)]} {
3560            set tmpdir $env(TMPDIR)
3561        } else {
3562            set tmpdir $gitdir
3563        }
3564        set gitktmpformat [file join $tmpdir ".gitk-tmp.XXXXXX"]
3565        if {[catch {set gitktmpdir [exec mktemp -d $gitktmpformat]}]} {
3566            set gitktmpdir [file join $gitdir [format ".gitk-tmp.%s" [pid]]]
3567        }
3568        if {[catch {file mkdir $gitktmpdir} err]} {
3569            error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3570            unset gitktmpdir
3571            return {}
3572        }
3573        set diffnum 0
3574    }
3575    incr diffnum
3576    set diffdir [file join $gitktmpdir $diffnum]
3577    if {[catch {file mkdir $diffdir} err]} {
3578        error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3579        return {}
3580    }
3581    return $diffdir
3582}
3583
3584proc save_file_from_commit {filename output what} {
3585    global nullfile
3586
3587    if {[catch {exec git show $filename -- > $output} err]} {
3588        if {[string match "fatal: bad revision *" $err]} {
3589            return $nullfile
3590        }
3591        error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
3592        return {}
3593    }
3594    return $output
3595}
3596
3597proc external_diff_get_one_file {diffid filename diffdir} {
3598    global nullid nullid2 nullfile
3599    global worktree
3600
3601    if {$diffid == $nullid} {
3602        set difffile [file join $worktree $filename]
3603        if {[file exists $difffile]} {
3604            return $difffile
3605        }
3606        return $nullfile
3607    }
3608    if {$diffid == $nullid2} {
3609        set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3610        return [save_file_from_commit :$filename $difffile index]
3611    }
3612    set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3613    return [save_file_from_commit $diffid:$filename $difffile \
3614               "revision $diffid"]
3615}
3616
3617proc external_diff {} {
3618    global nullid nullid2
3619    global flist_menu_file
3620    global diffids
3621    global extdifftool
3622
3623    if {[llength $diffids] == 1} {
3624        # no reference commit given
3625        set diffidto [lindex $diffids 0]
3626        if {$diffidto eq $nullid} {
3627            # diffing working copy with index
3628            set diffidfrom $nullid2
3629        } elseif {$diffidto eq $nullid2} {
3630            # diffing index with HEAD
3631            set diffidfrom "HEAD"
3632        } else {
3633            # use first parent commit
3634            global parentlist selectedline
3635            set diffidfrom [lindex $parentlist $selectedline 0]
3636        }
3637    } else {
3638        set diffidfrom [lindex $diffids 0]
3639        set diffidto [lindex $diffids 1]
3640    }
3641
3642    # make sure that several diffs wont collide
3643    set diffdir [gitknewtmpdir]
3644    if {$diffdir eq {}} return
3645
3646    # gather files to diff
3647    set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3648    set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3649
3650    if {$difffromfile ne {} && $difftofile ne {}} {
3651        set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
3652        if {[catch {set fl [open |$cmd r]} err]} {
3653            file delete -force $diffdir
3654            error_popup "$extdifftool: [mc "command failed:"] $err"
3655        } else {
3656            fconfigure $fl -blocking 0
3657            filerun $fl [list delete_at_eof $fl $diffdir]
3658        }
3659    }
3660}
3661
3662proc find_hunk_blamespec {base line} {
3663    global ctext
3664
3665    # Find and parse the hunk header
3666    set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3667    if {$s_lix eq {}} return
3668
3669    set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3670    if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3671            s_line old_specs osz osz1 new_line nsz]} {
3672        return
3673    }
3674
3675    # base lines for the parents
3676    set base_lines [list $new_line]
3677    foreach old_spec [lrange [split $old_specs " "] 1 end] {
3678        if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3679                old_spec old_line osz]} {
3680            return
3681        }
3682        lappend base_lines $old_line
3683    }
3684
3685    # Now scan the lines to determine offset within the hunk
3686    set max_parent [expr {[llength $base_lines]-2}]
3687    set dline 0
3688    set s_lno [lindex [split $s_lix "."] 0]
3689
3690    # Determine if the line is removed
3691    set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3692    if {[string match {[-+ ]*} $chunk]} {
3693        set removed_idx [string first "-" $chunk]
3694        # Choose a parent index
3695        if {$removed_idx >= 0} {
3696            set parent $removed_idx
3697        } else {
3698            set unchanged_idx [string first " " $chunk]
3699            if {$unchanged_idx >= 0} {
3700                set parent $unchanged_idx
3701            } else {
3702                # blame the current commit
3703                set parent -1
3704            }
3705        }
3706        # then count other lines that belong to it
3707        for {set i $line} {[incr i -1] > $s_lno} {} {
3708            set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3709            # Determine if the line is removed
3710            set removed_idx [string first "-" $chunk]
3711            if {$parent >= 0} {
3712                set code [string index $chunk $parent]
3713                if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3714                    incr dline
3715                }
3716            } else {
3717                if {$removed_idx < 0} {
3718                    incr dline
3719                }
3720            }
3721        }
3722        incr parent
3723    } else {
3724        set parent 0
3725    }
3726
3727    incr dline [lindex $base_lines $parent]
3728    return [list $parent $dline]
3729}
3730
3731proc external_blame_diff {} {
3732    global currentid cmitmode
3733    global diff_menu_txtpos diff_menu_line
3734    global diff_menu_filebase flist_menu_file
3735
3736    if {$cmitmode eq "tree"} {
3737        set parent_idx 0
3738        set line [expr {$diff_menu_line - $diff_menu_filebase}]
3739    } else {
3740        set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3741        if {$hinfo ne {}} {
3742            set parent_idx [lindex $hinfo 0]
3743            set line [lindex $hinfo 1]
3744        } else {
3745            set parent_idx 0
3746            set line 0
3747        }
3748    }
3749
3750    external_blame $parent_idx $line
3751}
3752
3753# Find the SHA1 ID of the blob for file $fname in the index
3754# at stage 0 or 2
3755proc index_sha1 {fname} {
3756    set f [open [list | git ls-files -s $fname] r]
3757    while {[gets $f line] >= 0} {
3758        set info [lindex [split $line "\t"] 0]
3759        set stage [lindex $info 2]
3760        if {$stage eq "0" || $stage eq "2"} {
3761            close $f
3762            return [lindex $info 1]
3763        }
3764    }
3765    close $f
3766    return {}
3767}
3768
3769# Turn an absolute path into one relative to the current directory
3770proc make_relative {f} {
3771    if {[file pathtype $f] eq "relative"} {
3772        return $f
3773    }
3774    set elts [file split $f]
3775    set here [file split [pwd]]
3776    set ei 0
3777    set hi 0
3778    set res {}
3779    foreach d $here {
3780        if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3781            lappend res ".."
3782        } else {
3783            incr ei
3784        }
3785        incr hi
3786    }
3787    set elts [concat $res [lrange $elts $ei end]]
3788    return [eval file join $elts]
3789}
3790
3791proc external_blame {parent_idx {line {}}} {
3792    global flist_menu_file cdup
3793    global nullid nullid2
3794    global parentlist selectedline currentid
3795
3796    if {$parent_idx > 0} {
3797        set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3798    } else {
3799        set base_commit $currentid
3800    }
3801
3802    if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3803        error_popup [mc "No such commit"]
3804        return
3805    }
3806
3807    set cmdline [list git gui blame]
3808    if {$line ne {} && $line > 1} {
3809        lappend cmdline "--line=$line"
3810    }
3811    set f [file join $cdup $flist_menu_file]
3812    # Unfortunately it seems git gui blame doesn't like
3813    # being given an absolute path...
3814    set f [make_relative $f]
3815    lappend cmdline $base_commit $f
3816    if {[catch {eval exec $cmdline &} err]} {
3817        error_popup "[mc "git gui blame: command failed:"] $err"
3818    }
3819}
3820
3821proc show_line_source {} {
3822    global cmitmode currentid parents curview blamestuff blameinst
3823    global diff_menu_line diff_menu_filebase flist_menu_file
3824    global nullid nullid2 gitdir cdup
3825
3826    set from_index {}
3827    if {$cmitmode eq "tree"} {
3828        set id $currentid
3829        set line [expr {$diff_menu_line - $diff_menu_filebase}]
3830    } else {
3831        set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3832        if {$h eq {}} return
3833        set pi [lindex $h 0]
3834        if {$pi == 0} {
3835            mark_ctext_line $diff_menu_line
3836            return
3837        }
3838        incr pi -1
3839        if {$currentid eq $nullid} {
3840            if {$pi > 0} {
3841                # must be a merge in progress...
3842                if {[catch {
3843                    # get the last line from .git/MERGE_HEAD
3844                    set f [open [file join $gitdir MERGE_HEAD] r]
3845                    set id [lindex [split [read $f] "\n"] end-1]
3846                    close $f
3847                } err]} {
3848                    error_popup [mc "Couldn't read merge head: %s" $err]
3849                    return
3850                }
3851            } elseif {$parents($curview,$currentid) eq $nullid2} {
3852                # need to do the blame from the index
3853                if {[catch {
3854                    set from_index [index_sha1 $flist_menu_file]
3855                } err]} {
3856                    error_popup [mc "Error reading index: %s" $err]
3857                    return
3858                }
3859            } else {
3860                set id $parents($curview,$currentid)
3861            }
3862        } else {
3863            set id [lindex $parents($curview,$currentid) $pi]
3864        }
3865        set line [lindex $h 1]
3866    }
3867    set blameargs {}
3868    if {$from_index ne {}} {
3869        lappend blameargs | git cat-file blob $from_index
3870    }
3871    lappend blameargs | git blame -p -L$line,+1
3872    if {$from_index ne {}} {
3873        lappend blameargs --contents -
3874    } else {
3875        lappend blameargs $id
3876    }
3877    lappend blameargs -- [file join $cdup $flist_menu_file]
3878    if {[catch {
3879        set f [open $blameargs r]
3880    } err]} {
3881        error_popup [mc "Couldn't start git blame: %s" $err]
3882        return
3883    }
3884    nowbusy blaming [mc "Searching"]
3885    fconfigure $f -blocking 0
3886    set i [reg_instance $f]
3887    set blamestuff($i) {}
3888    set blameinst $i
3889    filerun $f [list read_line_source $f $i]
3890}
3891
3892proc stopblaming {} {
3893    global blameinst
3894
3895    if {[info exists blameinst]} {
3896        stop_instance $blameinst
3897        unset blameinst
3898        notbusy blaming
3899    }
3900}
3901
3902proc read_line_source {fd inst} {
3903    global blamestuff curview commfd blameinst nullid nullid2
3904
3905    while {[gets $fd line] >= 0} {
3906        lappend blamestuff($inst) $line
3907    }
3908    if {![eof $fd]} {
3909        return 1
3910    }
3911    unset commfd($inst)
3912    unset blameinst
3913    notbusy blaming
3914    fconfigure $fd -blocking 1
3915    if {[catch {close $fd} err]} {
3916        error_popup [mc "Error running git blame: %s" $err]
3917        return 0
3918    }
3919
3920    set fname {}
3921    set line [split [lindex $blamestuff($inst) 0] " "]
3922    set id [lindex $line 0]
3923    set lnum [lindex $line 1]
3924    if {[string length $id] == 40 && [string is xdigit $id] &&
3925        [string is digit -strict $lnum]} {
3926        # look for "filename" line
3927        foreach l $blamestuff($inst) {
3928            if {[string match "filename *" $l]} {
3929                set fname [string range $l 9 end]
3930                break
3931            }
3932        }
3933    }
3934    if {$fname ne {}} {
3935        # all looks good, select it
3936        if {$id eq $nullid} {
3937            # blame uses all-zeroes to mean not committed,
3938            # which would mean a change in the index
3939            set id $nullid2
3940        }
3941        if {[commitinview $id $curview]} {
3942            selectline [rowofcommit $id] 1 [list $fname $lnum] 1
3943        } else {
3944            error_popup [mc "That line comes from commit %s, \
3945                             which is not in this view" [shortids $id]]
3946        }
3947    } else {
3948        puts "oops couldn't parse git blame output"
3949    }
3950    return 0
3951}
3952
3953# delete $dir when we see eof on $f (presumably because the child has exited)
3954proc delete_at_eof {f dir} {
3955    while {[gets $f line] >= 0} {}
3956    if {[eof $f]} {
3957        if {[catch {close $f} err]} {
3958            error_popup "[mc "External diff viewer failed:"] $err"
3959        }
3960        file delete -force $dir
3961        return 0
3962    }
3963    return 1
3964}
3965
3966# Functions for adding and removing shell-type quoting
3967
3968proc shellquote {str} {
3969    if {![string match "*\['\"\\ \t]*" $str]} {
3970        return $str
3971    }
3972    if {![string match "*\['\"\\]*" $str]} {
3973        return "\"$str\""
3974    }
3975    if {![string match "*'*" $str]} {
3976        return "'$str'"
3977    }
3978    return "\"[string map {\" \\\" \\ \\\\} $str]\""
3979}
3980
3981proc shellarglist {l} {
3982    set str {}
3983    foreach a $l {
3984        if {$str ne {}} {
3985            append str " "
3986        }
3987        append str [shellquote $a]
3988    }
3989    return $str
3990}
3991
3992proc shelldequote {str} {
3993    set ret {}
3994    set used -1
3995    while {1} {
3996        incr used
3997        if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
3998            append ret [string range $str $used end]
3999            set used [string length $str]
4000            break
4001        }
4002        set first [lindex $first 0]
4003        set ch [string index $str $first]
4004        if {$first > $used} {
4005            append ret [string range $str $used [expr {$first - 1}]]
4006            set used $first
4007        }
4008        if {$ch eq " " || $ch eq "\t"} break
4009        incr used
4010        if {$ch eq "'"} {
4011            set first [string first "'" $str $used]
4012            if {$first < 0} {
4013                error "unmatched single-quote"
4014            }
4015            append ret [string range $str $used [expr {$first - 1}]]
4016            set used $first
4017            continue
4018        }
4019        if {$ch eq "\\"} {
4020            if {$used >= [string length $str]} {
4021                error "trailing backslash"
4022            }
4023            append ret [string index $str $used]
4024            continue
4025        }
4026        # here ch == "\""
4027        while {1} {
4028            if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
4029                error "unmatched double-quote"
4030            }
4031            set first [lindex $first 0]
4032            set ch [string index $str $first]
4033            if {$first > $used} {
4034                append ret [string range $str $used [expr {$first - 1}]]
4035                set used $first
4036            }
4037            if {$ch eq "\""} break
4038            incr used
4039            append ret [string index $str $used]
4040            incr used
4041        }
4042    }
4043    return [list $used $ret]
4044}
4045
4046proc shellsplit {str} {
4047    set l {}
4048    while {1} {
4049        set str [string trimleft $str]
4050        if {$str eq {}} break
4051        set dq [shelldequote $str]
4052        set n [lindex $dq 0]
4053        set word [lindex $dq 1]
4054        set str [string range $str $n end]
4055        lappend l $word
4056    }
4057    return $l
4058}
4059
4060proc set_window_title {} {
4061    global appname curview viewname vrevs
4062    set rev [mc "All files"]
4063    if {$curview ne 0} {
4064        if {$viewname($curview) eq [mc "Command line"]} {
4065            set rev [string map {"--gitk-symmetric-diff-marker" "--merge"} $vrevs($curview)]
4066        } else {
4067            set rev $viewname($curview)
4068        }
4069    }
4070    wm title . "[reponame]: $rev - $appname"
4071}
4072
4073# Code to implement multiple views
4074
4075proc newview {ishighlight} {
4076    global nextviewnum newviewname newishighlight
4077    global revtreeargs viewargscmd newviewopts curview
4078
4079    set newishighlight $ishighlight
4080    set top .gitkview
4081    if {[winfo exists $top]} {
4082        raise $top
4083        return
4084    }
4085    decode_view_opts $nextviewnum $revtreeargs
4086    set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
4087    set newviewopts($nextviewnum,perm) 0
4088    set newviewopts($nextviewnum,cmd)  $viewargscmd($curview)
4089    vieweditor $top $nextviewnum [mc "Gitk view definition"]
4090}
4091
4092set known_view_options {
4093    {perm      b    .  {}               {mc "Remember this view"}}
4094    {reflabel  l    +  {}               {mc "References (space separated list):"}}
4095    {refs      t15  .. {}               {mc "Branches & tags:"}}
4096    {allrefs   b    *. "--all"          {mc "All refs"}}
4097    {branches  b    .  "--branches"     {mc "All (local) branches"}}
4098    {tags      b    .  "--tags"         {mc "All tags"}}
4099    {remotes   b    .  "--remotes"      {mc "All remote-tracking branches"}}
4100    {commitlbl l    +  {}               {mc "Commit Info (regular expressions):"}}
4101    {author    t15  .. "--author=*"     {mc "Author:"}}
4102    {committer t15  .  "--committer=*"  {mc "Committer:"}}
4103    {loginfo   t15  .. "--grep=*"       {mc "Commit Message:"}}
4104    {allmatch  b    .. "--all-match"    {mc "Matches all Commit Info criteria"}}
4105    {igrep     b    .. "--invert-grep"  {mc "Matches no Commit Info criteria"}}
4106    {changes_l l    +  {}               {mc "Changes to Files:"}}
4107    {pickaxe_s r0   .  {}               {mc "Fixed String"}}
4108    {pickaxe_t r1   .  "--pickaxe-regex"  {mc "Regular Expression"}}
4109    {pickaxe   t15  .. "-S*"            {mc "Search string:"}}
4110    {datelabel l    +  {}               {mc "Commit Dates (\"2 weeks ago\", \"2009-03-17 15:27:38\", \"March 17, 2009 15:27:38\"):"}}
4111    {since     t15  ..  {"--since=*" "--after=*"}  {mc "Since:"}}
4112    {until     t15  .   {"--until=*" "--before=*"} {mc "Until:"}}
4113    {limit_lbl l    +  {}               {mc "Limit and/or skip a number of revisions (positive integer):"}}
4114    {limit     t10  *. "--max-count=*"  {mc "Number to show:"}}
4115    {skip      t10  .  "--skip=*"       {mc "Number to skip:"}}
4116    {misc_lbl  l    +  {}               {mc "Miscellaneous options:"}}
4117    {dorder    b    *. {"--date-order" "-d"}      {mc "Strictly sort by date"}}
4118    {lright    b    .  "--left-right"   {mc "Mark branch sides"}}
4119    {first     b    .  "--first-parent" {mc "Limit to first parent"}}
4120    {smplhst   b    .  "--simplify-by-decoration"   {mc "Simple history"}}
4121    {args      t50  *. {}               {mc "Additional arguments to git log:"}}
4122    {allpaths  path +  {}               {mc "Enter files and directories to include, one per line:"}}
4123    {cmd       t50= +  {}               {mc "Command to generate more commits to include:"}}
4124    }
4125
4126# Convert $newviewopts($n, ...) into args for git log.
4127proc encode_view_opts {n} {
4128    global known_view_options newviewopts
4129
4130    set rargs [list]
4131    foreach opt $known_view_options {
4132        set patterns [lindex $opt 3]
4133        if {$patterns eq {}} continue
4134        set pattern [lindex $patterns 0]
4135
4136        if {[lindex $opt 1] eq "b"} {
4137            set val $newviewopts($n,[lindex $opt 0])
4138            if {$val} {
4139                lappend rargs $pattern
4140            }
4141        } elseif {[regexp {^r(\d+)$} [lindex $opt 1] type value]} {
4142            regexp {^(.*_)} [lindex $opt 0] uselessvar button_id
4143            set val $newviewopts($n,$button_id)
4144            if {$val eq $value} {
4145                lappend rargs $pattern
4146            }
4147        } else {
4148            set val $newviewopts($n,[lindex $opt 0])
4149            set val [string trim $val]
4150            if {$val ne {}} {
4151                set pfix [string range $pattern 0 end-1]
4152                lappend rargs $pfix$val
4153            }
4154        }
4155    }
4156    set rargs [concat $rargs [shellsplit $newviewopts($n,refs)]]
4157    return [concat $rargs [shellsplit $newviewopts($n,args)]]
4158}
4159
4160# Fill $newviewopts($n, ...) based on args for git log.
4161proc decode_view_opts {n view_args} {
4162    global known_view_options newviewopts
4163
4164    foreach opt $known_view_options {
4165        set id [lindex $opt 0]
4166        if {[lindex $opt 1] eq "b"} {
4167            # Checkboxes
4168            set val 0
4169        } elseif {[regexp {^r(\d+)$} [lindex $opt 1]]} {
4170            # Radiobuttons
4171            regexp {^(.*_)} $id uselessvar id
4172            set val 0
4173        } else {
4174            # Text fields
4175            set val {}
4176        }
4177        set newviewopts($n,$id) $val
4178    }
4179    set oargs [list]
4180    set refargs [list]
4181    foreach arg $view_args {
4182        if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
4183            && ![info exists found(limit)]} {
4184            set newviewopts($n,limit) $cnt
4185            set found(limit) 1
4186            continue
4187        }
4188        catch { unset val }
4189        foreach opt $known_view_options {
4190            set id [lindex $opt 0]
4191            if {[info exists found($id)]} continue
4192            foreach pattern [lindex $opt 3] {
4193                if {![string match $pattern $arg]} continue
4194                if {[lindex $opt 1] eq "b"} {
4195                    # Check buttons
4196                    set val 1
4197                } elseif {[regexp {^r(\d+)$} [lindex $opt 1] match num]} {
4198                    # Radio buttons
4199                    regexp {^(.*_)} $id uselessvar id
4200                    set val $num
4201                } else {
4202                    # Text input fields
4203                    set size [string length $pattern]
4204                    set val [string range $arg [expr {$size-1}] end]
4205                }
4206                set newviewopts($n,$id) $val
4207                set found($id) 1
4208                break
4209            }
4210            if {[info exists val]} break
4211        }
4212        if {[info exists val]} continue
4213        if {[regexp {^-} $arg]} {
4214            lappend oargs $arg
4215        } else {
4216            lappend refargs $arg
4217        }
4218    }
4219    set newviewopts($n,refs) [shellarglist $refargs]
4220    set newviewopts($n,args) [shellarglist $oargs]
4221}
4222
4223proc edit_or_newview {} {
4224    global curview
4225
4226    if {$curview > 0} {
4227        editview
4228    } else {
4229        newview 0
4230    }
4231}
4232
4233proc editview {} {
4234    global curview
4235    global viewname viewperm newviewname newviewopts
4236    global viewargs viewargscmd
4237
4238    set top .gitkvedit-$curview
4239    if {[winfo exists $top]} {
4240        raise $top
4241        return
4242    }
4243    decode_view_opts $curview $viewargs($curview)
4244    set newviewname($curview)      $viewname($curview)
4245    set newviewopts($curview,perm) $viewperm($curview)
4246    set newviewopts($curview,cmd)  $viewargscmd($curview)
4247    vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
4248}
4249
4250proc vieweditor {top n title} {
4251    global newviewname newviewopts viewfiles bgcolor
4252    global known_view_options NS
4253
4254    ttk_toplevel $top
4255    wm title $top [concat $title [mc "-- criteria for selecting revisions"]]
4256    make_transient $top .
4257
4258    # View name
4259    ${NS}::frame $top.nfr
4260    ${NS}::label $top.nl -text [mc "View Name"]
4261    ${NS}::entry $top.name -width 20 -textvariable newviewname($n)
4262    pack $top.nfr -in $top -fill x -pady 5 -padx 3
4263    pack $top.nl -in $top.nfr -side left -padx {0 5}
4264    pack $top.name -in $top.nfr -side left -padx {0 25}
4265
4266    # View options
4267    set cframe $top.nfr
4268    set cexpand 0
4269    set cnt 0
4270    foreach opt $known_view_options {
4271        set id [lindex $opt 0]
4272        set type [lindex $opt 1]
4273        set flags [lindex $opt 2]
4274        set title [eval [lindex $opt 4]]
4275        set lxpad 0
4276
4277        if {$flags eq "+" || $flags eq "*"} {
4278            set cframe $top.fr$cnt
4279            incr cnt
4280            ${NS}::frame $cframe
4281            pack $cframe -in $top -fill x -pady 3 -padx 3
4282            set cexpand [expr {$flags eq "*"}]
4283        } elseif {$flags eq ".." || $flags eq "*."} {
4284            set cframe $top.fr$cnt
4285            incr cnt
4286            ${NS}::frame $cframe
4287            pack $cframe -in $top -fill x -pady 3 -padx [list 15 3]
4288            set cexpand [expr {$flags eq "*."}]
4289        } else {
4290            set lxpad 5
4291        }
4292
4293        if {$type eq "l"} {
4294            ${NS}::label $cframe.l_$id -text $title
4295            pack $cframe.l_$id -in $cframe -side left -pady [list 3 0] -anchor w
4296        } elseif {$type eq "b"} {
4297            ${NS}::checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
4298            pack $cframe.c_$id -in $cframe -side left \
4299                -padx [list $lxpad 0] -expand $cexpand -anchor w
4300        } elseif {[regexp {^r(\d+)$} $type type sz]} {
4301            regexp {^(.*_)} $id uselessvar button_id
4302            ${NS}::radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz
4303            pack $cframe.c_$id -in $cframe -side left \
4304                -padx [list $lxpad 0] -expand $cexpand -anchor w
4305        } elseif {[regexp {^t(\d+)$} $type type sz]} {
4306            ${NS}::label $cframe.l_$id -text $title
4307            ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4308                -textvariable newviewopts($n,$id)
4309            pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
4310            pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
4311        } elseif {[regexp {^t(\d+)=$} $type type sz]} {
4312            ${NS}::label $cframe.l_$id -text $title
4313            ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4314                -textvariable newviewopts($n,$id)
4315            pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
4316            pack $cframe.e_$id -in $cframe -side top -fill x
4317        } elseif {$type eq "path"} {
4318            ${NS}::label $top.l -text $title
4319            pack $top.l -in $top -side top -pady [list 3 0] -anchor w -padx 3
4320            text $top.t -width 40 -height 5 -background $bgcolor
4321            if {[info exists viewfiles($n)]} {
4322                foreach f $viewfiles($n) {
4323                    $top.t insert end $f
4324                    $top.t insert end "\n"
4325                }
4326                $top.t delete {end - 1c} end
4327                $top.t mark set insert 0.0
4328            }
4329            pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
4330        }
4331    }
4332
4333    ${NS}::frame $top.buts
4334    ${NS}::button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
4335    ${NS}::button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
4336    ${NS}::button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
4337    bind $top <Control-Return> [list newviewok $top $n]
4338    bind $top <F5> [list newviewok $top $n 1]
4339    bind $top <Escape> [list destroy $top]
4340    grid $top.buts.ok $top.buts.apply $top.buts.can
4341    grid columnconfigure $top.buts 0 -weight 1 -uniform a
4342    grid columnconfigure $top.buts 1 -weight 1 -uniform a
4343    grid columnconfigure $top.buts 2 -weight 1 -uniform a
4344    pack $top.buts -in $top -side top -fill x
4345    focus $top.t
4346}
4347
4348proc doviewmenu {m first cmd op argv} {
4349    set nmenu [$m index end]
4350    for {set i $first} {$i <= $nmenu} {incr i} {
4351        if {[$m entrycget $i -command] eq $cmd} {
4352            eval $m $op $i $argv
4353            break
4354        }
4355    }
4356}
4357
4358proc allviewmenus {n op args} {
4359    # global viewhlmenu
4360
4361    doviewmenu .bar.view 5 [list showview $n] $op $args
4362    # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
4363}
4364
4365proc newviewok {top n {apply 0}} {
4366    global nextviewnum newviewperm newviewname newishighlight
4367    global viewname viewfiles viewperm viewchanged selectedview curview
4368    global viewargs viewargscmd newviewopts viewhlmenu
4369
4370    if {[catch {
4371        set newargs [encode_view_opts $n]
4372    } err]} {
4373        error_popup "[mc "Error in commit selection arguments:"] $err" $top
4374        return
4375    }
4376    set files {}
4377    foreach f [split [$top.t get 0.0 end] "\n"] {
4378        set ft [string trim $f]
4379        if {$ft ne {}} {
4380            lappend files $ft
4381        }
4382    }
4383    if {![info exists viewfiles($n)]} {
4384        # creating a new view
4385        incr nextviewnum
4386        set viewname($n) $newviewname($n)
4387        set viewperm($n) $newviewopts($n,perm)
4388        set viewchanged($n) 1
4389        set viewfiles($n) $files
4390        set viewargs($n) $newargs
4391        set viewargscmd($n) $newviewopts($n,cmd)
4392        addviewmenu $n
4393        if {!$newishighlight} {
4394            run showview $n
4395        } else {
4396            run addvhighlight $n
4397        }
4398    } else {
4399        # editing an existing view
4400        set viewperm($n) $newviewopts($n,perm)
4401        set viewchanged($n) 1
4402        if {$newviewname($n) ne $viewname($n)} {
4403            set viewname($n) $newviewname($n)
4404            doviewmenu .bar.view 5 [list showview $n] \
4405                entryconf [list -label $viewname($n)]
4406            # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
4407                # entryconf [list -label $viewname($n) -value $viewname($n)]
4408        }
4409        if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
4410                $newviewopts($n,cmd) ne $viewargscmd($n)} {
4411            set viewfiles($n) $files
4412            set viewargs($n) $newargs
4413            set viewargscmd($n) $newviewopts($n,cmd)
4414            if {$curview == $n} {
4415                run reloadcommits
4416            }
4417        }
4418    }
4419    if {$apply} return
4420    catch {destroy $top}
4421}
4422
4423proc delview {} {
4424    global curview viewperm hlview selectedhlview viewchanged
4425
4426    if {$curview == 0} return
4427    if {[info exists hlview] && $hlview == $curview} {
4428        set selectedhlview [mc "None"]
4429        unset hlview
4430    }
4431    allviewmenus $curview delete
4432    set viewperm($curview) 0
4433    set viewchanged($curview) 1
4434    showview 0
4435}
4436
4437proc addviewmenu {n} {
4438    global viewname viewhlmenu
4439
4440    .bar.view add radiobutton -label $viewname($n) \
4441        -command [list showview $n] -variable selectedview -value $n
4442    #$viewhlmenu add radiobutton -label $viewname($n) \
4443    #   -command [list addvhighlight $n] -variable selectedhlview
4444}
4445
4446proc showview {n} {
4447    global curview cached_commitrow ordertok
4448    global displayorder parentlist rowidlist rowisopt rowfinal
4449    global colormap rowtextx nextcolor canvxmax
4450    global numcommits viewcomplete
4451    global selectedline currentid canv canvy0
4452    global treediffs
4453    global pending_select mainheadid
4454    global commitidx
4455    global selectedview
4456    global hlview selectedhlview commitinterest
4457
4458    if {$n == $curview} return
4459    set selid {}
4460    set ymax [lindex [$canv cget -scrollregion] 3]
4461    set span [$canv yview]
4462    set ytop [expr {[lindex $span 0] * $ymax}]
4463    set ybot [expr {[lindex $span 1] * $ymax}]
4464    set yscreen [expr {($ybot - $ytop) / 2}]
4465    if {$selectedline ne {}} {
4466        set selid $currentid
4467        set y [yc $selectedline]
4468        if {$ytop < $y && $y < $ybot} {
4469            set yscreen [expr {$y - $ytop}]
4470        }
4471    } elseif {[info exists pending_select]} {
4472        set selid $pending_select
4473        unset pending_select
4474    }
4475    unselectline
4476    normalline
4477    unset -nocomplain treediffs
4478    clear_display
4479    if {[info exists hlview] && $hlview == $n} {
4480        unset hlview
4481        set selectedhlview [mc "None"]
4482    }
4483    unset -nocomplain commitinterest
4484    unset -nocomplain cached_commitrow
4485    unset -nocomplain ordertok
4486
4487    set curview $n
4488    set selectedview $n
4489    .bar.view entryconf [mca "&Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
4490    .bar.view entryconf [mca "&Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
4491
4492    run refill_reflist
4493    if {![info exists viewcomplete($n)]} {
4494        getcommits $selid
4495        return
4496    }
4497
4498    set displayorder {}
4499    set parentlist {}
4500    set rowidlist {}
4501    set rowisopt {}
4502    set rowfinal {}
4503    set numcommits $commitidx($n)
4504
4505    unset -nocomplain colormap
4506    unset -nocomplain rowtextx
4507    set nextcolor 0
4508    set canvxmax [$canv cget -width]
4509    set curview $n
4510    set row 0
4511    setcanvscroll
4512    set yf 0
4513    set row {}
4514    if {$selid ne {} && [commitinview $selid $n]} {
4515        set row [rowofcommit $selid]
4516        # try to get the selected row in the same position on the screen
4517        set ymax [lindex [$canv cget -scrollregion] 3]
4518        set ytop [expr {[yc $row] - $yscreen}]
4519        if {$ytop < 0} {
4520            set ytop 0
4521        }
4522        set yf [expr {$ytop * 1.0 / $ymax}]
4523    }
4524    allcanvs yview moveto $yf
4525    drawvisible
4526    if {$row ne {}} {
4527        selectline $row 0
4528    } elseif {!$viewcomplete($n)} {
4529        reset_pending_select $selid
4530    } else {
4531        reset_pending_select {}
4532
4533        if {[commitinview $pending_select $curview]} {
4534            selectline [rowofcommit $pending_select] 1
4535        } else {
4536            set row [first_real_row]
4537            if {$row < $numcommits} {
4538                selectline $row 0
4539            }
4540        }
4541    }
4542    if {!$viewcomplete($n)} {
4543        if {$numcommits == 0} {
4544            show_status [mc "Reading commits..."]
4545        }
4546    } elseif {$numcommits == 0} {
4547        show_status [mc "No commits selected"]
4548    }
4549    set_window_title
4550}
4551
4552# Stuff relating to the highlighting facility
4553
4554proc ishighlighted {id} {
4555    global vhighlights fhighlights nhighlights rhighlights
4556
4557    if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
4558        return $nhighlights($id)
4559    }
4560    if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
4561        return $vhighlights($id)
4562    }
4563    if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
4564        return $fhighlights($id)
4565    }
4566    if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4567        return $rhighlights($id)
4568    }
4569    return 0
4570}
4571
4572proc bolden {id font} {
4573    global canv linehtag currentid boldids need_redisplay markedid
4574
4575    # need_redisplay = 1 means the display is stale and about to be redrawn
4576    if {$need_redisplay} return
4577    lappend boldids $id
4578    $canv itemconf $linehtag($id) -font $font
4579    if {[info exists currentid] && $id eq $currentid} {
4580        $canv delete secsel
4581        set t [eval $canv create rect [$canv bbox $linehtag($id)] \
4582                   -outline {{}} -tags secsel \
4583                   -fill [$canv cget -selectbackground]]
4584        $canv lower $t
4585    }
4586    if {[info exists markedid] && $id eq $markedid} {
4587        make_idmark $id
4588    }
4589}
4590
4591proc bolden_name {id font} {
4592    global canv2 linentag currentid boldnameids need_redisplay
4593
4594    if {$need_redisplay} return
4595    lappend boldnameids $id
4596    $canv2 itemconf $linentag($id) -font $font
4597    if {[info exists currentid] && $id eq $currentid} {
4598        $canv2 delete secsel
4599        set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
4600                   -outline {{}} -tags secsel \
4601                   -fill [$canv2 cget -selectbackground]]
4602        $canv2 lower $t
4603    }
4604}
4605
4606proc unbolden {} {
4607    global boldids
4608
4609    set stillbold {}
4610    foreach id $boldids {
4611        if {![ishighlighted $id]} {
4612            bolden $id mainfont
4613        } else {
4614            lappend stillbold $id
4615        }
4616    }
4617    set boldids $stillbold
4618}
4619
4620proc addvhighlight {n} {
4621    global hlview viewcomplete curview vhl_done commitidx
4622
4623    if {[info exists hlview]} {
4624        delvhighlight
4625    }
4626    set hlview $n
4627    if {$n != $curview && ![info exists viewcomplete($n)]} {
4628        start_rev_list $n
4629    }
4630    set vhl_done $commitidx($hlview)
4631    if {$vhl_done > 0} {
4632        drawvisible
4633    }
4634}
4635
4636proc delvhighlight {} {
4637    global hlview vhighlights
4638
4639    if {![info exists hlview]} return
4640    unset hlview
4641    unset -nocomplain vhighlights
4642    unbolden
4643}
4644
4645proc vhighlightmore {} {
4646    global hlview vhl_done commitidx vhighlights curview
4647
4648    set max $commitidx($hlview)
4649    set vr [visiblerows]
4650    set r0 [lindex $vr 0]
4651    set r1 [lindex $vr 1]
4652    for {set i $vhl_done} {$i < $max} {incr i} {
4653        set id [commitonrow $i $hlview]
4654        if {[commitinview $id $curview]} {
4655            set row [rowofcommit $id]
4656            if {$r0 <= $row && $row <= $r1} {
4657                if {![highlighted $row]} {
4658                    bolden $id mainfontbold
4659                }
4660                set vhighlights($id) 1
4661            }
4662        }
4663    }
4664    set vhl_done $max
4665    return 0
4666}
4667
4668proc askvhighlight {row id} {
4669    global hlview vhighlights iddrawn
4670
4671    if {[commitinview $id $hlview]} {
4672        if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
4673            bolden $id mainfontbold
4674        }
4675        set vhighlights($id) 1
4676    } else {
4677        set vhighlights($id) 0
4678    }
4679}
4680
4681proc hfiles_change {} {
4682    global highlight_files filehighlight fhighlights fh_serial
4683    global highlight_paths
4684
4685    if {[info exists filehighlight]} {
4686        # delete previous highlights
4687        catch {close $filehighlight}
4688        unset filehighlight
4689        unset -nocomplain fhighlights
4690        unbolden
4691        unhighlight_filelist
4692    }
4693    set highlight_paths {}
4694    after cancel do_file_hl $fh_serial
4695    incr fh_serial
4696    if {$highlight_files ne {}} {
4697        after 300 do_file_hl $fh_serial
4698    }
4699}
4700
4701proc gdttype_change {name ix op} {
4702    global gdttype highlight_files findstring findpattern
4703
4704    stopfinding
4705    if {$findstring ne {}} {
4706        if {$gdttype eq [mc "containing:"]} {
4707            if {$highlight_files ne {}} {
4708                set highlight_files {}
4709                hfiles_change
4710            }
4711            findcom_change
4712        } else {
4713            if {$findpattern ne {}} {
4714                set findpattern {}
4715                findcom_change
4716            }
4717            set highlight_files $findstring
4718            hfiles_change
4719        }
4720        drawvisible
4721    }
4722    # enable/disable findtype/findloc menus too
4723}
4724
4725proc find_change {name ix op} {
4726    global gdttype findstring highlight_files
4727
4728    stopfinding
4729    if {$gdttype eq [mc "containing:"]} {
4730        findcom_change
4731    } else {
4732        if {$highlight_files ne $findstring} {
4733            set highlight_files $findstring
4734            hfiles_change
4735        }
4736    }
4737    drawvisible
4738}
4739
4740proc findcom_change args {
4741    global nhighlights boldnameids
4742    global findpattern findtype findstring gdttype
4743
4744    stopfinding
4745    # delete previous highlights, if any
4746    foreach id $boldnameids {
4747        bolden_name $id mainfont
4748    }
4749    set boldnameids {}
4750    unset -nocomplain nhighlights
4751    unbolden
4752    unmarkmatches
4753    if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
4754        set findpattern {}
4755    } elseif {$findtype eq [mc "Regexp"]} {
4756        set findpattern $findstring
4757    } else {
4758        set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4759                   $findstring]
4760        set findpattern "*$e*"
4761    }
4762}
4763
4764proc makepatterns {l} {
4765    set ret {}
4766    foreach e $l {
4767        set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4768        if {[string index $ee end] eq "/"} {
4769            lappend ret "$ee*"
4770        } else {
4771            lappend ret $ee
4772            lappend ret "$ee/*"
4773        }
4774    }
4775    return $ret
4776}
4777
4778proc do_file_hl {serial} {
4779    global highlight_files filehighlight highlight_paths gdttype fhl_list
4780    global cdup findtype
4781
4782    if {$gdttype eq [mc "touching paths:"]} {
4783        # If "exact" match then convert backslashes to forward slashes.
4784        # Most useful to support Windows-flavoured file paths.
4785        if {$findtype eq [mc "Exact"]} {
4786            set highlight_files [string map {"\\" "/"} $highlight_files]
4787        }
4788        if {[catch {set paths [shellsplit $highlight_files]}]} return
4789        set highlight_paths [makepatterns $paths]
4790        highlight_filelist
4791        set relative_paths {}
4792        foreach path $paths {
4793            lappend relative_paths [file join $cdup $path]
4794        }
4795        set gdtargs [concat -- $relative_paths]
4796    } elseif {$gdttype eq [mc "adding/removing string:"]} {
4797        set gdtargs [list "-S$highlight_files"]
4798    } elseif {$gdttype eq [mc "changing lines matching:"]} {
4799        set gdtargs [list "-G$highlight_files"]
4800    } else {
4801        # must be "containing:", i.e. we're searching commit info
4802        return
4803    }
4804    set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
4805    set filehighlight [open $cmd r+]
4806    fconfigure $filehighlight -blocking 0
4807    filerun $filehighlight readfhighlight
4808    set fhl_list {}
4809    drawvisible
4810    flushhighlights
4811}
4812
4813proc flushhighlights {} {
4814    global filehighlight fhl_list
4815
4816    if {[info exists filehighlight]} {
4817        lappend fhl_list {}
4818        puts $filehighlight ""
4819        flush $filehighlight
4820    }
4821}
4822
4823proc askfilehighlight {row id} {
4824    global filehighlight fhighlights fhl_list
4825
4826    lappend fhl_list $id
4827    set fhighlights($id) -1
4828    puts $filehighlight $id
4829}
4830
4831proc readfhighlight {} {
4832    global filehighlight fhighlights curview iddrawn
4833    global fhl_list find_dirn
4834
4835    if {![info exists filehighlight]} {
4836        return 0
4837    }
4838    set nr 0
4839    while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4840        set line [string trim $line]
4841        set i [lsearch -exact $fhl_list $line]
4842        if {$i < 0} continue
4843        for {set j 0} {$j < $i} {incr j} {
4844            set id [lindex $fhl_list $j]
4845            set fhighlights($id) 0
4846        }
4847        set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4848        if {$line eq {}} continue
4849        if {![commitinview $line $curview]} continue
4850        if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4851            bolden $line mainfontbold
4852        }
4853        set fhighlights($line) 1
4854    }
4855    if {[eof $filehighlight]} {
4856        # strange...
4857        puts "oops, git diff-tree died"
4858        catch {close $filehighlight}
4859        unset filehighlight
4860        return 0
4861    }
4862    if {[info exists find_dirn]} {
4863        run findmore
4864    }
4865    return 1
4866}
4867
4868proc doesmatch {f} {
4869    global findtype findpattern
4870
4871    if {$findtype eq [mc "Regexp"]} {
4872        return [regexp $findpattern $f]
4873    } elseif {$findtype eq [mc "IgnCase"]} {
4874        return [string match -nocase $findpattern $f]
4875    } else {
4876        return [string match $findpattern $f]
4877    }
4878}
4879
4880proc askfindhighlight {row id} {
4881    global nhighlights commitinfo iddrawn
4882    global findloc
4883    global markingmatches
4884
4885    if {![info exists commitinfo($id)]} {
4886        getcommit $id
4887    }
4888    set info $commitinfo($id)
4889    set isbold 0
4890    set fldtypes [list [mc Headline] [mc Author] "" [mc Committer] "" [mc Comments]]
4891    foreach f $info ty $fldtypes {
4892        if {$ty eq ""} continue
4893        if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4894            [doesmatch $f]} {
4895            if {$ty eq [mc "Author"]} {
4896                set isbold 2
4897                break
4898            }
4899            set isbold 1
4900        }
4901    }
4902    if {$isbold && [info exists iddrawn($id)]} {
4903        if {![ishighlighted $id]} {
4904            bolden $id mainfontbold
4905            if {$isbold > 1} {
4906                bolden_name $id mainfontbold
4907            }
4908        }
4909        if {$markingmatches} {
4910            markrowmatches $row $id
4911        }
4912    }
4913    set nhighlights($id) $isbold
4914}
4915
4916proc markrowmatches {row id} {
4917    global canv canv2 linehtag linentag commitinfo findloc
4918
4919    set headline [lindex $commitinfo($id) 0]
4920    set author [lindex $commitinfo($id) 1]
4921    $canv delete match$row
4922    $canv2 delete match$row
4923    if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4924        set m [findmatches $headline]
4925        if {$m ne {}} {
4926            markmatches $canv $row $headline $linehtag($id) $m \
4927                [$canv itemcget $linehtag($id) -font] $row
4928        }
4929    }
4930    if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4931        set m [findmatches $author]
4932        if {$m ne {}} {
4933            markmatches $canv2 $row $author $linentag($id) $m \
4934                [$canv2 itemcget $linentag($id) -font] $row
4935        }
4936    }
4937}
4938
4939proc vrel_change {name ix op} {
4940    global highlight_related
4941
4942    rhighlight_none
4943    if {$highlight_related ne [mc "None"]} {
4944        run drawvisible
4945    }
4946}
4947
4948# prepare for testing whether commits are descendents or ancestors of a
4949proc rhighlight_sel {a} {
4950    global descendent desc_todo ancestor anc_todo
4951    global highlight_related
4952
4953    unset -nocomplain descendent
4954    set desc_todo [list $a]
4955    unset -nocomplain ancestor
4956    set anc_todo [list $a]
4957    if {$highlight_related ne [mc "None"]} {
4958        rhighlight_none
4959        run drawvisible
4960    }
4961}
4962
4963proc rhighlight_none {} {
4964    global rhighlights
4965
4966    unset -nocomplain rhighlights
4967    unbolden
4968}
4969
4970proc is_descendent {a} {
4971    global curview children descendent desc_todo
4972
4973    set v $curview
4974    set la [rowofcommit $a]
4975    set todo $desc_todo
4976    set leftover {}
4977    set done 0
4978    for {set i 0} {$i < [llength $todo]} {incr i} {
4979        set do [lindex $todo $i]
4980        if {[rowofcommit $do] < $la} {
4981            lappend leftover $do
4982            continue
4983        }
4984        foreach nk $children($v,$do) {
4985            if {![info exists descendent($nk)]} {
4986                set descendent($nk) 1
4987                lappend todo $nk
4988                if {$nk eq $a} {
4989                    set done 1
4990                }
4991            }
4992        }
4993        if {$done} {
4994            set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4995            return
4996        }
4997    }
4998    set descendent($a) 0
4999    set desc_todo $leftover
5000}
5001
5002proc is_ancestor {a} {
5003    global curview parents ancestor anc_todo
5004
5005    set v $curview
5006    set la [rowofcommit $a]
5007    set todo $anc_todo
5008    set leftover {}
5009    set done 0
5010    for {set i 0} {$i < [llength $todo]} {incr i} {
5011        set do [lindex $todo $i]
5012        if {![commitinview $do $v] || [rowofcommit $do] > $la} {
5013            lappend leftover $do
5014            continue
5015        }
5016        foreach np $parents($v,$do) {
5017            if {![info exists ancestor($np)]} {
5018                set ancestor($np) 1
5019                lappend todo $np
5020                if {$np eq $a} {
5021                    set done 1
5022                }
5023            }
5024        }
5025        if {$done} {
5026            set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
5027            return
5028        }
5029    }
5030    set ancestor($a) 0
5031    set anc_todo $leftover
5032}
5033
5034proc askrelhighlight {row id} {
5035    global descendent highlight_related iddrawn rhighlights
5036    global selectedline ancestor
5037
5038    if {$selectedline eq {}} return
5039    set isbold 0
5040    if {$highlight_related eq [mc "Descendant"] ||
5041        $highlight_related eq [mc "Not descendant"]} {
5042        if {![info exists descendent($id)]} {
5043            is_descendent $id
5044        }
5045        if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
5046            set isbold 1
5047        }
5048    } elseif {$highlight_related eq [mc "Ancestor"] ||
5049              $highlight_related eq [mc "Not ancestor"]} {
5050        if {![info exists ancestor($id)]} {
5051            is_ancestor $id
5052        }
5053        if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
5054            set isbold 1
5055        }
5056    }
5057    if {[info exists iddrawn($id)]} {
5058        if {$isbold && ![ishighlighted $id]} {
5059            bolden $id mainfontbold
5060        }
5061    }
5062    set rhighlights($id) $isbold
5063}
5064
5065# Graph layout functions
5066
5067proc shortids {ids} {
5068    set res {}
5069    foreach id $ids {
5070        if {[llength $id] > 1} {
5071            lappend res [shortids $id]
5072        } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
5073            lappend res [string range $id 0 7]
5074        } else {
5075            lappend res $id
5076        }
5077    }
5078    return $res
5079}
5080
5081proc ntimes {n o} {
5082    set ret {}
5083    set o [list $o]
5084    for {set mask 1} {$mask <= $n} {incr mask $mask} {
5085        if {($n & $mask) != 0} {
5086            set ret [concat $ret $o]
5087        }
5088        set o [concat $o $o]
5089    }
5090    return $ret
5091}
5092
5093proc ordertoken {id} {
5094    global ordertok curview varcid varcstart varctok curview parents children
5095    global nullid nullid2
5096
5097    if {[info exists ordertok($id)]} {
5098        return $ordertok($id)
5099    }
5100    set origid $id
5101    set todo {}
5102    while {1} {
5103        if {[info exists varcid($curview,$id)]} {
5104            set a $varcid($curview,$id)
5105            set p [lindex $varcstart($curview) $a]
5106        } else {
5107            set p [lindex $children($curview,$id) 0]
5108        }
5109        if {[info exists ordertok($p)]} {
5110            set tok $ordertok($p)
5111            break
5112        }
5113        set id [first_real_child $curview,$p]
5114        if {$id eq {}} {
5115            # it's a root
5116            set tok [lindex $varctok($curview) $varcid($curview,$p)]
5117            break
5118        }
5119        if {[llength $parents($curview,$id)] == 1} {
5120            lappend todo [list $p {}]
5121        } else {
5122            set j [lsearch -exact $parents($curview,$id) $p]
5123            if {$j < 0} {
5124                puts "oops didn't find [shortids $p] in parents of [shortids $id]"
5125            }
5126            lappend todo [list $p [strrep $j]]
5127        }
5128    }
5129    for {set i [llength $todo]} {[incr i -1] >= 0} {} {
5130        set p [lindex $todo $i 0]
5131        append tok [lindex $todo $i 1]
5132        set ordertok($p) $tok
5133    }
5134    set ordertok($origid) $tok
5135    return $tok
5136}
5137
5138# Work out where id should go in idlist so that order-token
5139# values increase from left to right
5140proc idcol {idlist id {i 0}} {
5141    set t [ordertoken $id]
5142    if {$i < 0} {
5143        set i 0
5144    }
5145    if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
5146        if {$i > [llength $idlist]} {
5147            set i [llength $idlist]
5148        }
5149        while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
5150        incr i
5151    } else {
5152        if {$t > [ordertoken [lindex $idlist $i]]} {
5153            while {[incr i] < [llength $idlist] &&
5154                   $t >= [ordertoken [lindex $idlist $i]]} {}
5155        }
5156    }
5157    return $i
5158}
5159
5160proc initlayout {} {
5161    global rowidlist rowisopt rowfinal displayorder parentlist
5162    global numcommits canvxmax canv
5163    global nextcolor
5164    global colormap rowtextx
5165
5166    set numcommits 0
5167    set displayorder {}
5168    set parentlist {}
5169    set nextcolor 0
5170    set rowidlist {}
5171    set rowisopt {}
5172    set rowfinal {}
5173    set canvxmax [$canv cget -width]
5174    unset -nocomplain colormap
5175    unset -nocomplain rowtextx
5176    setcanvscroll
5177}
5178
5179proc setcanvscroll {} {
5180    global canv canv2 canv3 numcommits linespc canvxmax canvy0
5181    global lastscrollset lastscrollrows
5182
5183    set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
5184    $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
5185    $canv2 conf -scrollregion [list 0 0 0 $ymax]
5186    $canv3 conf -scrollregion [list 0 0 0 $ymax]
5187    set lastscrollset [clock clicks -milliseconds]
5188    set lastscrollrows $numcommits
5189}
5190
5191proc visiblerows {} {
5192    global canv numcommits linespc
5193
5194    set ymax [lindex [$canv cget -scrollregion] 3]
5195    if {$ymax eq {} || $ymax == 0} return
5196    set f [$canv yview]
5197    set y0 [expr {int([lindex $f 0] * $ymax)}]
5198    set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
5199    if {$r0 < 0} {
5200        set r0 0
5201    }
5202    set y1 [expr {int([lindex $f 1] * $ymax)}]
5203    set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
5204    if {$r1 >= $numcommits} {
5205        set r1 [expr {$numcommits - 1}]
5206    }
5207    return [list $r0 $r1]
5208}
5209
5210proc layoutmore {} {
5211    global commitidx viewcomplete curview
5212    global numcommits pending_select curview
5213    global lastscrollset lastscrollrows
5214
5215    if {$lastscrollrows < 100 || $viewcomplete($curview) ||
5216        [clock clicks -milliseconds] - $lastscrollset > 500} {
5217        setcanvscroll
5218    }
5219    if {[info exists pending_select] &&
5220        [commitinview $pending_select $curview]} {
5221        update
5222        selectline [rowofcommit $pending_select] 1
5223    }
5224    drawvisible
5225}
5226
5227# With path limiting, we mightn't get the actual HEAD commit,
5228# so ask git rev-list what is the first ancestor of HEAD that
5229# touches a file in the path limit.
5230proc get_viewmainhead {view} {
5231    global viewmainheadid vfilelimit viewinstances mainheadid
5232
5233    catch {
5234        set rfd [open [concat | git rev-list -1 $mainheadid \
5235                           -- $vfilelimit($view)] r]
5236        set j [reg_instance $rfd]
5237        lappend viewinstances($view) $j
5238        fconfigure $rfd -blocking 0
5239        filerun $rfd [list getviewhead $rfd $j $view]
5240        set viewmainheadid($curview) {}
5241    }
5242}
5243
5244# git rev-list should give us just 1 line to use as viewmainheadid($view)
5245proc getviewhead {fd inst view} {
5246    global viewmainheadid commfd curview viewinstances showlocalchanges
5247
5248    set id {}
5249    if {[gets $fd line] < 0} {
5250        if {![eof $fd]} {
5251            return 1
5252        }
5253    } elseif {[string length $line] == 40 && [string is xdigit $line]} {
5254        set id $line
5255    }
5256    set viewmainheadid($view) $id
5257    close $fd
5258    unset commfd($inst)
5259    set i [lsearch -exact $viewinstances($view) $inst]
5260    if {$i >= 0} {
5261        set viewinstances($view) [lreplace $viewinstances($view) $i $i]
5262    }
5263    if {$showlocalchanges && $id ne {} && $view == $curview} {
5264        doshowlocalchanges
5265    }
5266    return 0
5267}
5268
5269proc doshowlocalchanges {} {
5270    global curview viewmainheadid
5271
5272    if {$viewmainheadid($curview) eq {}} return
5273    if {[commitinview $viewmainheadid($curview) $curview]} {
5274        dodiffindex
5275    } else {
5276        interestedin $viewmainheadid($curview) dodiffindex
5277    }
5278}
5279
5280proc dohidelocalchanges {} {
5281    global nullid nullid2 lserial curview
5282
5283    if {[commitinview $nullid $curview]} {
5284        removefakerow $nullid
5285    }
5286    if {[commitinview $nullid2 $curview]} {
5287        removefakerow $nullid2
5288    }
5289    incr lserial
5290}
5291
5292# spawn off a process to do git diff-index --cached HEAD
5293proc dodiffindex {} {
5294    global lserial showlocalchanges vfilelimit curview
5295    global hasworktree git_version
5296
5297    if {!$showlocalchanges || !$hasworktree} return
5298    incr lserial
5299    if {[package vcompare $git_version "1.7.2"] >= 0} {
5300        set cmd "|git diff-index --cached --ignore-submodules=dirty HEAD"
5301    } else {
5302        set cmd "|git diff-index --cached HEAD"
5303    }
5304    if {$vfilelimit($curview) ne {}} {
5305        set cmd [concat $cmd -- $vfilelimit($curview)]
5306    }
5307    set fd [open $cmd r]
5308    fconfigure $fd -blocking 0
5309    set i [reg_instance $fd]
5310    filerun $fd [list readdiffindex $fd $lserial $i]
5311}
5312
5313proc readdiffindex {fd serial inst} {
5314    global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
5315    global vfilelimit
5316
5317    set isdiff 1
5318    if {[gets $fd line] < 0} {
5319        if {![eof $fd]} {
5320            return 1
5321        }
5322        set isdiff 0
5323    }
5324    # we only need to see one line and we don't really care what it says...
5325    stop_instance $inst
5326
5327    if {$serial != $lserial} {
5328        return 0
5329    }
5330
5331    # now see if there are any local changes not checked in to the index
5332    set cmd "|git diff-files"
5333    if {$vfilelimit($curview) ne {}} {
5334        set cmd [concat $cmd -- $vfilelimit($curview)]
5335    }
5336    set fd [open $cmd r]
5337    fconfigure $fd -blocking 0
5338    set i [reg_instance $fd]
5339    filerun $fd [list readdifffiles $fd $serial $i]
5340
5341    if {$isdiff && ![commitinview $nullid2 $curview]} {
5342        # add the line for the changes in the index to the graph
5343        set hl [mc "Local changes checked in to index but not committed"]
5344        set commitinfo($nullid2) [list  $hl {} {} {} {} "    $hl\n"]
5345        set commitdata($nullid2) "\n    $hl\n"
5346        if {[commitinview $nullid $curview]} {
5347            removefakerow $nullid
5348        }
5349        insertfakerow $nullid2 $viewmainheadid($curview)
5350    } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
5351        if {[commitinview $nullid $curview]} {
5352            removefakerow $nullid
5353        }
5354        removefakerow $nullid2
5355    }
5356    return 0
5357}
5358
5359proc readdifffiles {fd serial inst} {
5360    global viewmainheadid nullid nullid2 curview
5361    global commitinfo commitdata lserial
5362
5363    set isdiff 1
5364    if {[gets $fd line] < 0} {
5365        if {![eof $fd]} {
5366            return 1
5367        }
5368        set isdiff 0
5369    }
5370    # we only need to see one line and we don't really care what it says...
5371    stop_instance $inst
5372
5373    if {$serial != $lserial} {
5374        return 0
5375    }
5376
5377    if {$isdiff && ![commitinview $nullid $curview]} {
5378        # add the line for the local diff to the graph
5379        set hl [mc "Local uncommitted changes, not checked in to index"]
5380        set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
5381        set commitdata($nullid) "\n    $hl\n"
5382        if {[commitinview $nullid2 $curview]} {
5383            set p $nullid2
5384        } else {
5385            set p $viewmainheadid($curview)
5386        }
5387        insertfakerow $nullid $p
5388    } elseif {!$isdiff && [commitinview $nullid $curview]} {
5389        removefakerow $nullid
5390    }
5391    return 0
5392}
5393
5394proc nextuse {id row} {
5395    global curview children
5396
5397    if {[info exists children($curview,$id)]} {
5398        foreach kid $children($curview,$id) {
5399            if {![commitinview $kid $curview]} {
5400                return -1
5401            }
5402            if {[rowofcommit $kid] > $row} {
5403                return [rowofcommit $kid]
5404            }
5405        }
5406    }
5407    if {[commitinview $id $curview]} {
5408        return [rowofcommit $id]
5409    }
5410    return -1
5411}
5412
5413proc prevuse {id row} {
5414    global curview children
5415
5416    set ret -1
5417    if {[info exists children($curview,$id)]} {
5418        foreach kid $children($curview,$id) {
5419            if {![commitinview $kid $curview]} break
5420            if {[rowofcommit $kid] < $row} {
5421                set ret [rowofcommit $kid]
5422            }
5423        }
5424    }
5425    return $ret
5426}
5427
5428proc make_idlist {row} {
5429    global displayorder parentlist uparrowlen downarrowlen mingaplen
5430    global commitidx curview children
5431
5432    set r [expr {$row - $mingaplen - $downarrowlen - 1}]
5433    if {$r < 0} {
5434        set r 0
5435    }
5436    set ra [expr {$row - $downarrowlen}]
5437    if {$ra < 0} {
5438        set ra 0
5439    }
5440    set rb [expr {$row + $uparrowlen}]
5441    if {$rb > $commitidx($curview)} {
5442        set rb $commitidx($curview)
5443    }
5444    make_disporder $r [expr {$rb + 1}]
5445    set ids {}
5446    for {} {$r < $ra} {incr r} {
5447        set nextid [lindex $displayorder [expr {$r + 1}]]
5448        foreach p [lindex $parentlist $r] {
5449            if {$p eq $nextid} continue
5450            set rn [nextuse $p $r]
5451            if {$rn >= $row &&
5452                $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
5453                lappend ids [list [ordertoken $p] $p]
5454            }
5455        }
5456    }
5457    for {} {$r < $row} {incr r} {
5458        set nextid [lindex $displayorder [expr {$r + 1}]]
5459        foreach p [lindex $parentlist $r] {
5460            if {$p eq $nextid} continue
5461            set rn [nextuse $p $r]
5462            if {$rn < 0 || $rn >= $row} {
5463                lappend ids [list [ordertoken $p] $p]
5464            }
5465        }
5466    }
5467    set id [lindex $displayorder $row]
5468    lappend ids [list [ordertoken $id] $id]
5469    while {$r < $rb} {
5470        foreach p [lindex $parentlist $r] {
5471            set firstkid [lindex $children($curview,$p) 0]
5472            if {[rowofcommit $firstkid] < $row} {
5473                lappend ids [list [ordertoken $p] $p]
5474            }
5475        }
5476        incr r
5477        set id [lindex $displayorder $r]
5478        if {$id ne {}} {
5479            set firstkid [lindex $children($curview,$id) 0]
5480            if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
5481                lappend ids [list [ordertoken $id] $id]
5482            }
5483        }
5484    }
5485    set idlist {}
5486    foreach idx [lsort -unique $ids] {
5487        lappend idlist [lindex $idx 1]
5488    }
5489    return $idlist
5490}
5491
5492proc rowsequal {a b} {
5493    while {[set i [lsearch -exact $a {}]] >= 0} {
5494        set a [lreplace $a $i $i]
5495    }
5496    while {[set i [lsearch -exact $b {}]] >= 0} {
5497        set b [lreplace $b $i $i]
5498    }
5499    return [expr {$a eq $b}]
5500}
5501
5502proc makeupline {id row rend col} {
5503    global rowidlist uparrowlen downarrowlen mingaplen
5504
5505    for {set r $rend} {1} {set r $rstart} {
5506        set rstart [prevuse $id $r]
5507        if {$rstart < 0} return
5508        if {$rstart < $row} break
5509    }
5510    if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5511        set rstart [expr {$rend - $uparrowlen - 1}]
5512    }
5513    for {set r $rstart} {[incr r] <= $row} {} {
5514        set idlist [lindex $rowidlist $r]
5515        if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5516            set col [idcol $idlist $id $col]
5517            lset rowidlist $r [linsert $idlist $col $id]
5518            changedrow $r
5519        }
5520    }
5521}
5522
5523proc layoutrows {row endrow} {
5524    global rowidlist rowisopt rowfinal displayorder
5525    global uparrowlen downarrowlen maxwidth mingaplen
5526    global children parentlist
5527    global commitidx viewcomplete curview
5528
5529    make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
5530    set idlist {}
5531    if {$row > 0} {
5532        set rm1 [expr {$row - 1}]
5533        foreach id [lindex $rowidlist $rm1] {
5534            if {$id ne {}} {
5535                lappend idlist $id
5536            }
5537        }
5538        set final [lindex $rowfinal $rm1]
5539    }
5540    for {} {$row < $endrow} {incr row} {
5541        set rm1 [expr {$row - 1}]
5542        if {$rm1 < 0 || $idlist eq {}} {
5543            set idlist [make_idlist $row]
5544            set final 1
5545        } else {
5546            set id [lindex $displayorder $rm1]
5547            set col [lsearch -exact $idlist $id]
5548            set idlist [lreplace $idlist $col $col]
5549            foreach p [lindex $parentlist $rm1] {
5550                if {[lsearch -exact $idlist $p] < 0} {
5551                    set col [idcol $idlist $p $col]
5552                    set idlist [linsert $idlist $col $p]
5553                    # if not the first child, we have to insert a line going up
5554                    if {$id ne [lindex $children($curview,$p) 0]} {
5555                        makeupline $p $rm1 $row $col
5556                    }
5557                }
5558            }
5559            set id [lindex $displayorder $row]
5560            if {$row > $downarrowlen} {
5561                set termrow [expr {$row - $downarrowlen - 1}]
5562                foreach p [lindex $parentlist $termrow] {
5563                    set i [lsearch -exact $idlist $p]
5564                    if {$i < 0} continue
5565                    set nr [nextuse $p $termrow]
5566                    if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5567                        set idlist [lreplace $idlist $i $i]
5568                    }
5569                }
5570            }
5571            set col [lsearch -exact $idlist $id]
5572            if {$col < 0} {
5573                set col [idcol $idlist $id]
5574                set idlist [linsert $idlist $col $id]
5575                if {$children($curview,$id) ne {}} {
5576                    makeupline $id $rm1 $row $col
5577                }
5578            }
5579            set r [expr {$row + $uparrowlen - 1}]
5580            if {$r < $commitidx($curview)} {
5581                set x $col
5582                foreach p [lindex $parentlist $r] {
5583                    if {[lsearch -exact $idlist $p] >= 0} continue
5584                    set fk [lindex $children($curview,$p) 0]
5585                    if {[rowofcommit $fk] < $row} {
5586                        set x [idcol $idlist $p $x]
5587                        set idlist [linsert $idlist $x $p]
5588                    }
5589                }
5590                if {[incr r] < $commitidx($curview)} {
5591                    set p [lindex $displayorder $r]
5592                    if {[lsearch -exact $idlist $p] < 0} {
5593                        set fk [lindex $children($curview,$p) 0]
5594                        if {$fk ne {} && [rowofcommit $fk] < $row} {
5595                            set x [idcol $idlist $p $x]
5596                            set idlist [linsert $idlist $x $p]
5597                        }
5598                    }
5599                }
5600            }
5601        }
5602        if {$final && !$viewcomplete($curview) &&
5603            $row + $uparrowlen + $mingaplen + $downarrowlen
5604                >= $commitidx($curview)} {
5605            set final 0
5606        }
5607        set l [llength $rowidlist]
5608        if {$row == $l} {
5609            lappend rowidlist $idlist
5610            lappend rowisopt 0
5611            lappend rowfinal $final
5612        } elseif {$row < $l} {
5613            if {![rowsequal $idlist [lindex $rowidlist $row]]} {
5614                lset rowidlist $row $idlist
5615                changedrow $row
5616            }
5617            lset rowfinal $row $final
5618        } else {
5619            set pad [ntimes [expr {$row - $l}] {}]
5620            set rowidlist [concat $rowidlist $pad]
5621            lappend rowidlist $idlist
5622            set rowfinal [concat $rowfinal $pad]
5623            lappend rowfinal $final
5624            set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5625        }
5626    }
5627    return $row
5628}
5629
5630proc changedrow {row} {
5631    global displayorder iddrawn rowisopt need_redisplay
5632
5633    set l [llength $rowisopt]
5634    if {$row < $l} {
5635        lset rowisopt $row 0
5636        if {$row + 1 < $l} {
5637            lset rowisopt [expr {$row + 1}] 0
5638            if {$row + 2 < $l} {
5639                lset rowisopt [expr {$row + 2}] 0
5640            }
5641        }
5642    }
5643    set id [lindex $displayorder $row]
5644    if {[info exists iddrawn($id)]} {
5645        set need_redisplay 1
5646    }
5647}
5648
5649proc insert_pad {row col npad} {
5650    global rowidlist
5651
5652    set pad [ntimes $npad {}]
5653    set idlist [lindex $rowidlist $row]
5654    set bef [lrange $idlist 0 [expr {$col - 1}]]
5655    set aft [lrange $idlist $col end]
5656    set i [lsearch -exact $aft {}]
5657    if {$i > 0} {
5658        set aft [lreplace $aft $i $i]
5659    }
5660    lset rowidlist $row [concat $bef $pad $aft]
5661    changedrow $row
5662}
5663
5664proc optimize_rows {row col endrow} {
5665    global rowidlist rowisopt displayorder curview children
5666
5667    if {$row < 1} {
5668        set row 1
5669    }
5670    for {} {$row < $endrow} {incr row; set col 0} {
5671        if {[lindex $rowisopt $row]} continue
5672        set haspad 0
5673        set y0 [expr {$row - 1}]
5674        set ym [expr {$row - 2}]
5675        set idlist [lindex $rowidlist $row]
5676        set previdlist [lindex $rowidlist $y0]
5677        if {$idlist eq {} || $previdlist eq {}} continue
5678        if {$ym >= 0} {
5679            set pprevidlist [lindex $rowidlist $ym]
5680            if {$pprevidlist eq {}} continue
5681        } else {
5682            set pprevidlist {}
5683        }
5684        set x0 -1
5685        set xm -1
5686        for {} {$col < [llength $idlist]} {incr col} {
5687            set id [lindex $idlist $col]
5688            if {[lindex $previdlist $col] eq $id} continue
5689            if {$id eq {}} {
5690                set haspad 1
5691                continue
5692            }
5693            set x0 [lsearch -exact $previdlist $id]
5694            if {$x0 < 0} continue
5695            set z [expr {$x0 - $col}]
5696            set isarrow 0
5697            set z0 {}
5698            if {$ym >= 0} {
5699                set xm [lsearch -exact $pprevidlist $id]
5700                if {$xm >= 0} {
5701                    set z0 [expr {$xm - $x0}]
5702                }
5703            }
5704            if {$z0 eq {}} {
5705                # if row y0 is the first child of $id then it's not an arrow
5706                if {[lindex $children($curview,$id) 0] ne
5707                    [lindex $displayorder $y0]} {
5708                    set isarrow 1
5709                }
5710            }
5711            if {!$isarrow && $id ne [lindex $displayorder $row] &&
5712                [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5713                set isarrow 1
5714            }
5715            # Looking at lines from this row to the previous row,
5716            # make them go straight up if they end in an arrow on
5717            # the previous row; otherwise make them go straight up
5718            # or at 45 degrees.
5719            if {$z < -1 || ($z < 0 && $isarrow)} {
5720                # Line currently goes left too much;
5721                # insert pads in the previous row, then optimize it
5722                set npad [expr {-1 - $z + $isarrow}]
5723                insert_pad $y0 $x0 $npad
5724                if {$y0 > 0} {
5725                    optimize_rows $y0 $x0 $row
5726                }
5727                set previdlist [lindex $rowidlist $y0]
5728                set x0 [lsearch -exact $previdlist $id]
5729                set z [expr {$x0 - $col}]
5730                if {$z0 ne {}} {
5731                    set pprevidlist [lindex $rowidlist $ym]
5732                    set xm [lsearch -exact $pprevidlist $id]
5733                    set z0 [expr {$xm - $x0}]
5734                }
5735            } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5736                # Line currently goes right too much;
5737                # insert pads in this line
5738                set npad [expr {$z - 1 + $isarrow}]
5739                insert_pad $row $col $npad
5740                set idlist [lindex $rowidlist $row]
5741                incr col $npad
5742                set z [expr {$x0 - $col}]
5743                set haspad 1
5744            }
5745            if {$z0 eq {} && !$isarrow && $ym >= 0} {
5746                # this line links to its first child on row $row-2
5747                set id [lindex $displayorder $ym]
5748                set xc [lsearch -exact $pprevidlist $id]
5749                if {$xc >= 0} {
5750                    set z0 [expr {$xc - $x0}]
5751                }
5752            }
5753            # avoid lines jigging left then immediately right
5754            if {$z0 ne {} && $z < 0 && $z0 > 0} {
5755                insert_pad $y0 $x0 1
5756                incr x0
5757                optimize_rows $y0 $x0 $row
5758                set previdlist [lindex $rowidlist $y0]
5759            }
5760        }
5761        if {!$haspad} {
5762            # Find the first column that doesn't have a line going right
5763            for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5764                set id [lindex $idlist $col]
5765                if {$id eq {}} break
5766                set x0 [lsearch -exact $previdlist $id]
5767                if {$x0 < 0} {
5768                    # check if this is the link to the first child
5769                    set kid [lindex $displayorder $y0]
5770                    if {[lindex $children($curview,$id) 0] eq $kid} {
5771                        # it is, work out offset to child
5772                        set x0 [lsearch -exact $previdlist $kid]
5773                    }
5774                }
5775                if {$x0 <= $col} break
5776            }
5777            # Insert a pad at that column as long as it has a line and
5778            # isn't the last column
5779            if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5780                set idlist [linsert $idlist $col {}]
5781                lset rowidlist $row $idlist
5782                changedrow $row
5783            }
5784        }
5785    }
5786}
5787
5788proc xc {row col} {
5789    global canvx0 linespc
5790    return [expr {$canvx0 + $col * $linespc}]
5791}
5792
5793proc yc {row} {
5794    global canvy0 linespc
5795    return [expr {$canvy0 + $row * $linespc}]
5796}
5797
5798proc linewidth {id} {
5799    global thickerline lthickness
5800
5801    set wid $lthickness
5802    if {[info exists thickerline] && $id eq $thickerline} {
5803        set wid [expr {2 * $lthickness}]
5804    }
5805    return $wid
5806}
5807
5808proc rowranges {id} {
5809    global curview children uparrowlen downarrowlen
5810    global rowidlist
5811
5812    set kids $children($curview,$id)
5813    if {$kids eq {}} {
5814        return {}
5815    }
5816    set ret {}
5817    lappend kids $id
5818    foreach child $kids {
5819        if {![commitinview $child $curview]} break
5820        set row [rowofcommit $child]
5821        if {![info exists prev]} {
5822            lappend ret [expr {$row + 1}]
5823        } else {
5824            if {$row <= $prevrow} {
5825                puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5826            }
5827            # see if the line extends the whole way from prevrow to row
5828            if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5829                [lsearch -exact [lindex $rowidlist \
5830                            [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5831                # it doesn't, see where it ends
5832                set r [expr {$prevrow + $downarrowlen}]
5833                if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5834                    while {[incr r -1] > $prevrow &&
5835                           [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5836                } else {
5837                    while {[incr r] <= $row &&
5838                           [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5839                    incr r -1
5840                }
5841                lappend ret $r
5842                # see where it starts up again
5843                set r [expr {$row - $uparrowlen}]
5844                if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5845                    while {[incr r] < $row &&
5846                           [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5847                } else {
5848                    while {[incr r -1] >= $prevrow &&
5849                           [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5850                    incr r
5851                }
5852                lappend ret $r
5853            }
5854        }
5855        if {$child eq $id} {
5856            lappend ret $row
5857        }
5858        set prev $child
5859        set prevrow $row
5860    }
5861    return $ret
5862}
5863
5864proc drawlineseg {id row endrow arrowlow} {
5865    global rowidlist displayorder iddrawn linesegs
5866    global canv colormap linespc curview maxlinelen parentlist
5867
5868    set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5869    set le [expr {$row + 1}]
5870    set arrowhigh 1
5871    while {1} {
5872        set c [lsearch -exact [lindex $rowidlist $le] $id]
5873        if {$c < 0} {
5874            incr le -1
5875            break
5876        }
5877        lappend cols $c
5878        set x [lindex $displayorder $le]
5879        if {$x eq $id} {
5880            set arrowhigh 0
5881            break
5882        }
5883        if {[info exists iddrawn($x)] || $le == $endrow} {
5884            set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5885            if {$c >= 0} {
5886                lappend cols $c
5887                set arrowhigh 0
5888            }
5889            break
5890        }
5891        incr le
5892    }
5893    if {$le <= $row} {
5894        return $row
5895    }
5896
5897    set lines {}
5898    set i 0
5899    set joinhigh 0
5900    if {[info exists linesegs($id)]} {
5901        set lines $linesegs($id)
5902        foreach li $lines {
5903            set r0 [lindex $li 0]
5904            if {$r0 > $row} {
5905                if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5906                    set joinhigh 1
5907                }
5908                break
5909            }
5910            incr i
5911        }
5912    }
5913    set joinlow 0
5914    if {$i > 0} {
5915        set li [lindex $lines [expr {$i-1}]]
5916        set r1 [lindex $li 1]
5917        if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5918            set joinlow 1
5919        }
5920    }
5921
5922    set x [lindex $cols [expr {$le - $row}]]
5923    set xp [lindex $cols [expr {$le - 1 - $row}]]
5924    set dir [expr {$xp - $x}]
5925    if {$joinhigh} {
5926        set ith [lindex $lines $i 2]
5927        set coords [$canv coords $ith]
5928        set ah [$canv itemcget $ith -arrow]
5929        set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5930        set x2 [lindex $cols [expr {$le + 1 - $row}]]
5931        if {$x2 ne {} && $x - $x2 == $dir} {
5932            set coords [lrange $coords 0 end-2]
5933        }
5934    } else {
5935        set coords [list [xc $le $x] [yc $le]]
5936    }
5937    if {$joinlow} {
5938        set itl [lindex $lines [expr {$i-1}] 2]
5939        set al [$canv itemcget $itl -arrow]
5940        set arrowlow [expr {$al eq "last" || $al eq "both"}]
5941    } elseif {$arrowlow} {
5942        if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5943            [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5944            set arrowlow 0
5945        }
5946    }
5947    set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5948    for {set y $le} {[incr y -1] > $row} {} {
5949        set x $xp
5950        set xp [lindex $cols [expr {$y - 1 - $row}]]
5951        set ndir [expr {$xp - $x}]
5952        if {$dir != $ndir || $xp < 0} {
5953            lappend coords [xc $y $x] [yc $y]
5954        }
5955        set dir $ndir
5956    }
5957    if {!$joinlow} {
5958        if {$xp < 0} {
5959            # join parent line to first child
5960            set ch [lindex $displayorder $row]
5961            set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5962            if {$xc < 0} {
5963                puts "oops: drawlineseg: child $ch not on row $row"
5964            } elseif {$xc != $x} {
5965                if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5966                    set d [expr {int(0.5 * $linespc)}]
5967                    set x1 [xc $row $x]
5968                    if {$xc < $x} {
5969                        set x2 [expr {$x1 - $d}]
5970                    } else {
5971                        set x2 [expr {$x1 + $d}]
5972                    }
5973                    set y2 [yc $row]
5974                    set y1 [expr {$y2 + $d}]
5975                    lappend coords $x1 $y1 $x2 $y2
5976                } elseif {$xc < $x - 1} {
5977                    lappend coords [xc $row [expr {$x-1}]] [yc $row]
5978                } elseif {$xc > $x + 1} {
5979                    lappend coords [xc $row [expr {$x+1}]] [yc $row]
5980                }
5981                set x $xc
5982            }
5983            lappend coords [xc $row $x] [yc $row]
5984        } else {
5985            set xn [xc $row $xp]
5986            set yn [yc $row]
5987            lappend coords $xn $yn
5988        }
5989        if {!$joinhigh} {
5990            assigncolor $id
5991            set t [$canv create line $coords -width [linewidth $id] \
5992                       -fill $colormap($id) -tags lines.$id -arrow $arrow]
5993            $canv lower $t
5994            bindline $t $id
5995            set lines [linsert $lines $i [list $row $le $t]]
5996        } else {
5997            $canv coords $ith $coords
5998            if {$arrow ne $ah} {
5999                $canv itemconf $ith -arrow $arrow
6000            }
6001            lset lines $i 0 $row
6002        }
6003    } else {
6004        set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
6005        set ndir [expr {$xo - $xp}]
6006        set clow [$canv coords $itl]
6007        if {$dir == $ndir} {
6008            set clow [lrange $clow 2 end]
6009        }
6010        set coords [concat $coords $clow]
6011        if {!$joinhigh} {
6012            lset lines [expr {$i-1}] 1 $le
6013        } else {
6014            # coalesce two pieces
6015            $canv delete $ith
6016            set b [lindex $lines [expr {$i-1}] 0]
6017            set e [lindex $lines $i 1]
6018            set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
6019        }
6020        $canv coords $itl $coords
6021        if {$arrow ne $al} {
6022            $canv itemconf $itl -arrow $arrow
6023        }
6024    }
6025
6026    set linesegs($id) $lines
6027    return $le
6028}
6029
6030proc drawparentlinks {id row} {
6031    global rowidlist canv colormap curview parentlist
6032    global idpos linespc
6033
6034    set rowids [lindex $rowidlist $row]
6035    set col [lsearch -exact $rowids $id]
6036    if {$col < 0} return
6037    set olds [lindex $parentlist $row]
6038    set row2 [expr {$row + 1}]
6039    set x [xc $row $col]
6040    set y [yc $row]
6041    set y2 [yc $row2]
6042    set d [expr {int(0.5 * $linespc)}]
6043    set ymid [expr {$y + $d}]
6044    set ids [lindex $rowidlist $row2]
6045    # rmx = right-most X coord used
6046    set rmx 0
6047    foreach p $olds {
6048        set i [lsearch -exact $ids $p]
6049        if {$i < 0} {
6050            puts "oops, parent $p of $id not in list"
6051            continue
6052        }
6053        set x2 [xc $row2 $i]
6054        if {$x2 > $rmx} {
6055            set rmx $x2
6056        }
6057        set j [lsearch -exact $rowids $p]
6058        if {$j < 0} {
6059            # drawlineseg will do this one for us
6060            continue
6061        }
6062        assigncolor $p
6063        # should handle duplicated parents here...
6064        set coords [list $x $y]
6065        if {$i != $col} {
6066            # if attaching to a vertical segment, draw a smaller
6067            # slant for visual distinctness
6068            if {$i == $j} {
6069                if {$i < $col} {
6070                    lappend coords [expr {$x2 + $d}] $y $x2 $ymid
6071                } else {
6072                    lappend coords [expr {$x2 - $d}] $y $x2 $ymid
6073                }
6074            } elseif {$i < $col && $i < $j} {
6075                # segment slants towards us already
6076                lappend coords [xc $row $j] $y
6077            } else {
6078                if {$i < $col - 1} {
6079                    lappend coords [expr {$x2 + $linespc}] $y
6080                } elseif {$i > $col + 1} {
6081                    lappend coords [expr {$x2 - $linespc}] $y
6082                }
6083                lappend coords $x2 $y2
6084            }
6085        } else {
6086            lappend coords $x2 $y2
6087        }
6088        set t [$canv create line $coords -width [linewidth $p] \
6089                   -fill $colormap($p) -tags lines.$p]
6090        $canv lower $t
6091        bindline $t $p
6092    }
6093    if {$rmx > [lindex $idpos($id) 1]} {
6094        lset idpos($id) 1 $rmx
6095        redrawtags $id
6096    }
6097}
6098
6099proc drawlines {id} {
6100    global canv
6101
6102    $canv itemconf lines.$id -width [linewidth $id]
6103}
6104
6105proc drawcmittext {id row col} {
6106    global linespc canv canv2 canv3 fgcolor curview
6107    global cmitlisted commitinfo rowidlist parentlist
6108    global rowtextx idpos idtags idheads idotherrefs
6109    global linehtag linentag linedtag selectedline
6110    global canvxmax boldids boldnameids fgcolor markedid
6111    global mainheadid nullid nullid2 circleitem circlecolors ctxbut
6112    global mainheadcirclecolor workingfilescirclecolor indexcirclecolor
6113    global circleoutlinecolor
6114
6115    # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
6116    set listed $cmitlisted($curview,$id)
6117    if {$id eq $nullid} {
6118        set ofill $workingfilescirclecolor
6119    } elseif {$id eq $nullid2} {
6120        set ofill $indexcirclecolor
6121    } elseif {$id eq $mainheadid} {
6122        set ofill $mainheadcirclecolor
6123    } else {
6124        set ofill [lindex $circlecolors $listed]
6125    }
6126    set x [xc $row $col]
6127    set y [yc $row]
6128    set orad [expr {$linespc / 3}]
6129    if {$listed <= 2} {
6130        set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
6131                   [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6132                   -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6133    } elseif {$listed == 3} {
6134        # triangle pointing left for left-side commits
6135        set t [$canv create polygon \
6136                   [expr {$x - $orad}] $y \
6137                   [expr {$x + $orad - 1}] [expr {$y - $orad}] \
6138                   [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6139                   -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6140    } else {
6141        # triangle pointing right for right-side commits
6142        set t [$canv create polygon \
6143                   [expr {$x + $orad - 1}] $y \
6144                   [expr {$x - $orad}] [expr {$y - $orad}] \
6145                   [expr {$x - $orad}] [expr {$y + $orad - 1}] \
6146                   -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6147    }
6148    set circleitem($row) $t
6149    $canv raise $t
6150    $canv bind $t <1> {selcanvline {} %x %y}
6151    set rmx [llength [lindex $rowidlist $row]]
6152    set olds [lindex $parentlist $row]
6153    if {$olds ne {}} {
6154        set nextids [lindex $rowidlist [expr {$row + 1}]]
6155        foreach p $olds {
6156            set i [lsearch -exact $nextids $p]
6157            if {$i > $rmx} {
6158                set rmx $i
6159            }
6160        }
6161    }
6162    set xt [xc $row $rmx]
6163    set rowtextx($row) $xt
6164    set idpos($id) [list $x $xt $y]
6165    if {[info exists idtags($id)] || [info exists idheads($id)]
6166        || [info exists idotherrefs($id)]} {
6167        set xt [drawtags $id $x $xt $y]
6168    }
6169    if {[lindex $commitinfo($id) 6] > 0} {
6170        set xt [drawnotesign $xt $y]
6171    }
6172    set headline [lindex $commitinfo($id) 0]
6173    set name [lindex $commitinfo($id) 1]
6174    set date [lindex $commitinfo($id) 2]
6175    set date [formatdate $date]
6176    set font mainfont
6177    set nfont mainfont
6178    set isbold [ishighlighted $id]
6179    if {$isbold > 0} {
6180        lappend boldids $id
6181        set font mainfontbold
6182        if {$isbold > 1} {
6183            lappend boldnameids $id
6184            set nfont mainfontbold
6185        }
6186    }
6187    set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
6188                           -text $headline -font $font -tags text]
6189    $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
6190    set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
6191                           -text $name -font $nfont -tags text]
6192    set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
6193                           -text $date -font mainfont -tags text]
6194    if {$selectedline == $row} {
6195        make_secsel $id
6196    }
6197    if {[info exists markedid] && $markedid eq $id} {
6198        make_idmark $id
6199    }
6200    set xr [expr {$xt + [font measure $font $headline]}]
6201    if {$xr > $canvxmax} {
6202        set canvxmax $xr
6203        setcanvscroll
6204    }
6205}
6206
6207proc drawcmitrow {row} {
6208    global displayorder rowidlist nrows_drawn
6209    global iddrawn markingmatches
6210    global commitinfo numcommits
6211    global filehighlight fhighlights findpattern nhighlights
6212    global hlview vhighlights
6213    global highlight_related rhighlights
6214
6215    if {$row >= $numcommits} return
6216
6217    set id [lindex $displayorder $row]
6218    if {[info exists hlview] && ![info exists vhighlights($id)]} {
6219        askvhighlight $row $id
6220    }
6221    if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
6222        askfilehighlight $row $id
6223    }
6224    if {$findpattern ne {} && ![info exists nhighlights($id)]} {
6225        askfindhighlight $row $id
6226    }
6227    if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
6228        askrelhighlight $row $id
6229    }
6230    if {![info exists iddrawn($id)]} {
6231        set col [lsearch -exact [lindex $rowidlist $row] $id]
6232        if {$col < 0} {
6233            puts "oops, row $row id $id not in list"
6234            return
6235        }
6236        if {![info exists commitinfo($id)]} {
6237            getcommit $id
6238        }
6239        assigncolor $id
6240        drawcmittext $id $row $col
6241        set iddrawn($id) 1
6242        incr nrows_drawn
6243    }
6244    if {$markingmatches} {
6245        markrowmatches $row $id
6246    }
6247}
6248
6249proc drawcommits {row {endrow {}}} {
6250    global numcommits iddrawn displayorder curview need_redisplay
6251    global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
6252
6253    if {$row < 0} {
6254        set row 0
6255    }
6256    if {$endrow eq {}} {
6257        set endrow $row
6258    }
6259    if {$endrow >= $numcommits} {
6260        set endrow [expr {$numcommits - 1}]
6261    }
6262
6263    set rl1 [expr {$row - $downarrowlen - 3}]
6264    if {$rl1 < 0} {
6265        set rl1 0
6266    }
6267    set ro1 [expr {$row - 3}]
6268    if {$ro1 < 0} {
6269        set ro1 0
6270    }
6271    set r2 [expr {$endrow + $uparrowlen + 3}]
6272    if {$r2 > $numcommits} {
6273        set r2 $numcommits
6274    }
6275    for {set r $rl1} {$r < $r2} {incr r} {
6276        if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
6277            if {$rl1 < $r} {
6278                layoutrows $rl1 $r
6279            }
6280            set rl1 [expr {$r + 1}]
6281        }
6282    }
6283    if {$rl1 < $r} {
6284        layoutrows $rl1 $r
6285    }
6286    optimize_rows $ro1 0 $r2
6287    if {$need_redisplay || $nrows_drawn > 2000} {
6288        clear_display
6289    }
6290
6291    # make the lines join to already-drawn rows either side
6292    set r [expr {$row - 1}]
6293    if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
6294        set r $row
6295    }
6296    set er [expr {$endrow + 1}]
6297    if {$er >= $numcommits ||
6298        ![info exists iddrawn([lindex $displayorder $er])]} {
6299        set er $endrow
6300    }
6301    for {} {$r <= $er} {incr r} {
6302        set id [lindex $displayorder $r]
6303        set wasdrawn [info exists iddrawn($id)]
6304        drawcmitrow $r
6305        if {$r == $er} break
6306        set nextid [lindex $displayorder [expr {$r + 1}]]
6307        if {$wasdrawn && [info exists iddrawn($nextid)]} continue
6308        drawparentlinks $id $r
6309
6310        set rowids [lindex $rowidlist $r]
6311        foreach lid $rowids {
6312            if {$lid eq {}} continue
6313            if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
6314            if {$lid eq $id} {
6315                # see if this is the first child of any of its parents
6316                foreach p [lindex $parentlist $r] {
6317                    if {[lsearch -exact $rowids $p] < 0} {
6318                        # make this line extend up to the child
6319                        set lineend($p) [drawlineseg $p $r $er 0]
6320                    }
6321                }
6322            } else {
6323                set lineend($lid) [drawlineseg $lid $r $er 1]
6324            }
6325        }
6326    }
6327}
6328
6329proc undolayout {row} {
6330    global uparrowlen mingaplen downarrowlen
6331    global rowidlist rowisopt rowfinal need_redisplay
6332
6333    set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
6334    if {$r < 0} {
6335        set r 0
6336    }
6337    if {[llength $rowidlist] > $r} {
6338        incr r -1
6339        set rowidlist [lrange $rowidlist 0 $r]
6340        set rowfinal [lrange $rowfinal 0 $r]
6341        set rowisopt [lrange $rowisopt 0 $r]
6342        set need_redisplay 1
6343        run drawvisible
6344    }
6345}
6346
6347proc drawvisible {} {
6348    global canv linespc curview vrowmod selectedline targetrow targetid
6349    global need_redisplay cscroll numcommits
6350
6351    set fs [$canv yview]
6352    set ymax [lindex [$canv cget -scrollregion] 3]
6353    if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
6354    set f0 [lindex $fs 0]
6355    set f1 [lindex $fs 1]
6356    set y0 [expr {int($f0 * $ymax)}]
6357    set y1 [expr {int($f1 * $ymax)}]
6358
6359    if {[info exists targetid]} {
6360        if {[commitinview $targetid $curview]} {
6361            set r [rowofcommit $targetid]
6362            if {$r != $targetrow} {
6363                # Fix up the scrollregion and change the scrolling position
6364                # now that our target row has moved.
6365                set diff [expr {($r - $targetrow) * $linespc}]
6366                set targetrow $r
6367                setcanvscroll
6368                set ymax [lindex [$canv cget -scrollregion] 3]
6369                incr y0 $diff
6370                incr y1 $diff
6371                set f0 [expr {$y0 / $ymax}]
6372                set f1 [expr {$y1 / $ymax}]
6373                allcanvs yview moveto $f0
6374                $cscroll set $f0 $f1
6375                set need_redisplay 1
6376            }
6377        } else {
6378            unset targetid
6379        }
6380    }
6381
6382    set row [expr {int(($y0 - 3) / $linespc) - 1}]
6383    set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
6384    if {$endrow >= $vrowmod($curview)} {
6385        update_arcrows $curview
6386    }
6387    if {$selectedline ne {} &&
6388        $row <= $selectedline && $selectedline <= $endrow} {
6389        set targetrow $selectedline
6390    } elseif {[info exists targetid]} {
6391        set targetrow [expr {int(($row + $endrow) / 2)}]
6392    }
6393    if {[info exists targetrow]} {
6394        if {$targetrow >= $numcommits} {
6395            set targetrow [expr {$numcommits - 1}]
6396        }
6397        set targetid [commitonrow $targetrow]
6398    }
6399    drawcommits $row $endrow
6400}
6401
6402proc clear_display {} {
6403    global iddrawn linesegs need_redisplay nrows_drawn
6404    global vhighlights fhighlights nhighlights rhighlights
6405    global linehtag linentag linedtag boldids boldnameids
6406
6407    allcanvs delete all
6408    unset -nocomplain iddrawn
6409    unset -nocomplain linesegs
6410    unset -nocomplain linehtag
6411    unset -nocomplain linentag
6412    unset -nocomplain linedtag
6413    set boldids {}
6414    set boldnameids {}
6415    unset -nocomplain vhighlights
6416    unset -nocomplain fhighlights
6417    unset -nocomplain nhighlights
6418    unset -nocomplain rhighlights
6419    set need_redisplay 0
6420    set nrows_drawn 0
6421}
6422
6423proc findcrossings {id} {
6424    global rowidlist parentlist numcommits displayorder
6425
6426    set cross {}
6427    set ccross {}
6428    foreach {s e} [rowranges $id] {
6429        if {$e >= $numcommits} {
6430            set e [expr {$numcommits - 1}]
6431        }
6432        if {$e <= $s} continue
6433        for {set row $e} {[incr row -1] >= $s} {} {
6434            set x [lsearch -exact [lindex $rowidlist $row] $id]
6435            if {$x < 0} break
6436            set olds [lindex $parentlist $row]
6437            set kid [lindex $displayorder $row]
6438            set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
6439            if {$kidx < 0} continue
6440            set nextrow [lindex $rowidlist [expr {$row + 1}]]
6441            foreach p $olds {
6442                set px [lsearch -exact $nextrow $p]
6443                if {$px < 0} continue
6444                if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
6445                    if {[lsearch -exact $ccross $p] >= 0} continue
6446                    if {$x == $px + ($kidx < $px? -1: 1)} {
6447                        lappend ccross $p
6448                    } elseif {[lsearch -exact $cross $p] < 0} {
6449                        lappend cross $p
6450                    }
6451                }
6452            }
6453        }
6454    }
6455    return [concat $ccross {{}} $cross]
6456}
6457
6458proc assigncolor {id} {
6459    global colormap colors nextcolor
6460    global parents children children curview
6461
6462    if {[info exists colormap($id)]} return
6463    set ncolors [llength $colors]
6464    if {[info exists children($curview,$id)]} {
6465        set kids $children($curview,$id)
6466    } else {
6467        set kids {}
6468    }
6469    if {[llength $kids] == 1} {
6470        set child [lindex $kids 0]
6471        if {[info exists colormap($child)]
6472            && [llength $parents($curview,$child)] == 1} {
6473            set colormap($id) $colormap($child)
6474            return
6475        }
6476    }
6477    set badcolors {}
6478    set origbad {}
6479    foreach x [findcrossings $id] {
6480        if {$x eq {}} {
6481            # delimiter between corner crossings and other crossings
6482            if {[llength $badcolors] >= $ncolors - 1} break
6483            set origbad $badcolors
6484        }
6485        if {[info exists colormap($x)]
6486            && [lsearch -exact $badcolors $colormap($x)] < 0} {
6487            lappend badcolors $colormap($x)
6488        }
6489    }
6490    if {[llength $badcolors] >= $ncolors} {
6491        set badcolors $origbad
6492    }
6493    set origbad $badcolors
6494    if {[llength $badcolors] < $ncolors - 1} {
6495        foreach child $kids {
6496            if {[info exists colormap($child)]
6497                && [lsearch -exact $badcolors $colormap($child)] < 0} {
6498                lappend badcolors $colormap($child)
6499            }
6500            foreach p $parents($curview,$child) {
6501                if {[info exists colormap($p)]
6502                    && [lsearch -exact $badcolors $colormap($p)] < 0} {
6503                    lappend badcolors $colormap($p)
6504                }
6505            }
6506        }
6507        if {[llength $badcolors] >= $ncolors} {
6508            set badcolors $origbad
6509        }
6510    }
6511    for {set i 0} {$i <= $ncolors} {incr i} {
6512        set c [lindex $colors $nextcolor]
6513        if {[incr nextcolor] >= $ncolors} {
6514            set nextcolor 0
6515        }
6516        if {[lsearch -exact $badcolors $c]} break
6517    }
6518    set colormap($id) $c
6519}
6520
6521proc bindline {t id} {
6522    global canv
6523
6524    $canv bind $t <Enter> "lineenter %x %y $id"
6525    $canv bind $t <Motion> "linemotion %x %y $id"
6526    $canv bind $t <Leave> "lineleave $id"
6527    $canv bind $t <Button-1> "lineclick %x %y $id 1"
6528}
6529
6530proc graph_pane_width {} {
6531    global use_ttk
6532
6533    if {$use_ttk} {
6534        set g [.tf.histframe.pwclist sashpos 0]
6535    } else {
6536        set g [.tf.histframe.pwclist sash coord 0]
6537    }
6538    return [lindex $g 0]
6539}
6540
6541proc totalwidth {l font extra} {
6542    set tot 0
6543    foreach str $l {
6544        set tot [expr {$tot + [font measure $font $str] + $extra}]
6545    }
6546    return $tot
6547}
6548
6549proc drawtags {id x xt y1} {
6550    global idtags idheads idotherrefs mainhead
6551    global linespc lthickness
6552    global canv rowtextx curview fgcolor bgcolor ctxbut
6553    global headbgcolor headfgcolor headoutlinecolor remotebgcolor
6554    global tagbgcolor tagfgcolor tagoutlinecolor
6555    global reflinecolor
6556
6557    set marks {}
6558    set ntags 0
6559    set nheads 0
6560    set singletag 0
6561    set maxtags 3
6562    set maxtagpct 25
6563    set maxwidth [expr {[graph_pane_width] * $maxtagpct / 100}]
6564    set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6565    set extra [expr {$delta + $lthickness + $linespc}]
6566
6567    if {[info exists idtags($id)]} {
6568        set marks $idtags($id)
6569        set ntags [llength $marks]
6570        if {$ntags > $maxtags ||
6571            [totalwidth $marks mainfont $extra] > $maxwidth} {
6572            # show just a single "n tags..." tag
6573            set singletag 1
6574            if {$ntags == 1} {
6575                set marks [list "tag..."]
6576            } else {
6577                set marks [list [format "%d tags..." $ntags]]
6578            }
6579            set ntags 1
6580        }
6581    }
6582    if {[info exists idheads($id)]} {
6583        set marks [concat $marks $idheads($id)]
6584        set nheads [llength $idheads($id)]
6585    }
6586    if {[info exists idotherrefs($id)]} {
6587        set marks [concat $marks $idotherrefs($id)]
6588    }
6589    if {$marks eq {}} {
6590        return $xt
6591    }
6592
6593    set yt [expr {$y1 - 0.5 * $linespc}]
6594    set yb [expr {$yt + $linespc - 1}]
6595    set xvals {}
6596    set wvals {}
6597    set i -1
6598    foreach tag $marks {
6599        incr i
6600        if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
6601            set wid [font measure mainfontbold $tag]
6602        } else {
6603            set wid [font measure mainfont $tag]
6604        }
6605        lappend xvals $xt
6606        lappend wvals $wid
6607        set xt [expr {$xt + $wid + $extra}]
6608    }
6609    set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
6610               -width $lthickness -fill $reflinecolor -tags tag.$id]
6611    $canv lower $t
6612    foreach tag $marks x $xvals wid $wvals {
6613        set tag_quoted [string map {% %%} $tag]
6614        set xl [expr {$x + $delta}]
6615        set xr [expr {$x + $delta + $wid + $lthickness}]
6616        set font mainfont
6617        if {[incr ntags -1] >= 0} {
6618            # draw a tag
6619            set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6620                       $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
6621                       -width 1 -outline $tagoutlinecolor -fill $tagbgcolor \
6622                       -tags tag.$id]
6623            if {$singletag} {
6624                set tagclick [list showtags $id 1]
6625            } else {
6626                set tagclick [list showtag $tag_quoted 1]
6627            }
6628            $canv bind $t <1> $tagclick
6629            set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
6630        } else {
6631            # draw a head or other ref
6632            if {[incr nheads -1] >= 0} {
6633                set col $headbgcolor
6634                if {$tag eq $mainhead} {
6635                    set font mainfontbold
6636                }
6637            } else {
6638                set col "#ddddff"
6639            }
6640            set xl [expr {$xl - $delta/2}]
6641            $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
6642                -width 1 -outline black -fill $col -tags tag.$id
6643            if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
6644                set rwid [font measure mainfont $remoteprefix]
6645                set xi [expr {$x + 1}]
6646                set yti [expr {$yt + 1}]
6647                set xri [expr {$x + $rwid}]
6648                $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6649                        -width 0 -fill $remotebgcolor -tags tag.$id
6650            }
6651        }
6652        set t [$canv create text $xl $y1 -anchor w -text $tag -fill $headfgcolor \
6653                   -font $font -tags [list tag.$id text]]
6654        if {$ntags >= 0} {
6655            $canv bind $t <1> $tagclick
6656        } elseif {$nheads >= 0} {
6657            $canv bind $t $ctxbut [list headmenu %X %Y $id $tag_quoted]
6658        }
6659    }
6660    return $xt
6661}
6662
6663proc drawnotesign {xt y} {
6664    global linespc canv fgcolor
6665
6666    set orad [expr {$linespc / 3}]
6667    set t [$canv create rectangle [expr {$xt - $orad}] [expr {$y - $orad}] \
6668               [expr {$xt + $orad - 1}] [expr {$y + $orad - 1}] \
6669               -fill yellow -outline $fgcolor -width 1 -tags circle]
6670    set xt [expr {$xt + $orad * 3}]
6671    return $xt
6672}
6673
6674proc xcoord {i level ln} {
6675    global canvx0 xspc1 xspc2
6676
6677    set x [expr {$canvx0 + $i * $xspc1($ln)}]
6678    if {$i > 0 && $i == $level} {
6679        set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6680    } elseif {$i > $level} {
6681        set x [expr {$x + $xspc2 - $xspc1($ln)}]
6682    }
6683    return $x
6684}
6685
6686proc show_status {msg} {
6687    global canv fgcolor
6688
6689    clear_display
6690    set_window_title
6691    $canv create text 3 3 -anchor nw -text $msg -font mainfont \
6692        -tags text -fill $fgcolor
6693}
6694
6695# Don't change the text pane cursor if it is currently the hand cursor,
6696# showing that we are over a sha1 ID link.
6697proc settextcursor {c} {
6698    global ctext curtextcursor
6699
6700    if {[$ctext cget -cursor] == $curtextcursor} {
6701        $ctext config -cursor $c
6702    }
6703    set curtextcursor $c
6704}
6705
6706proc nowbusy {what {name {}}} {
6707    global isbusy busyname statusw
6708
6709    if {[array names isbusy] eq {}} {
6710        . config -cursor watch
6711        settextcursor watch
6712    }
6713    set isbusy($what) 1
6714    set busyname($what) $name
6715    if {$name ne {}} {
6716        $statusw conf -text $name
6717    }
6718}
6719
6720proc notbusy {what} {
6721    global isbusy maincursor textcursor busyname statusw
6722
6723    catch {
6724        unset isbusy($what)
6725        if {$busyname($what) ne {} &&
6726            [$statusw cget -text] eq $busyname($what)} {
6727            $statusw conf -text {}
6728        }
6729    }
6730    if {[array names isbusy] eq {}} {
6731        . config -cursor $maincursor
6732        settextcursor $textcursor
6733    }
6734}
6735
6736proc findmatches {f} {
6737    global findtype findstring
6738    if {$findtype == [mc "Regexp"]} {
6739        set matches [regexp -indices -all -inline $findstring $f]
6740    } else {
6741        set fs $findstring
6742        if {$findtype == [mc "IgnCase"]} {
6743            set f [string tolower $f]
6744            set fs [string tolower $fs]
6745        }
6746        set matches {}
6747        set i 0
6748        set l [string length $fs]
6749        while {[set j [string first $fs $f $i]] >= 0} {
6750            lappend matches [list $j [expr {$j+$l-1}]]
6751            set i [expr {$j + $l}]
6752        }
6753    }
6754    return $matches
6755}
6756
6757proc dofind {{dirn 1} {wrap 1}} {
6758    global findstring findstartline findcurline selectedline numcommits
6759    global gdttype filehighlight fh_serial find_dirn findallowwrap
6760
6761    if {[info exists find_dirn]} {
6762        if {$find_dirn == $dirn} return
6763        stopfinding
6764    }
6765    focus .
6766    if {$findstring eq {} || $numcommits == 0} return
6767    if {$selectedline eq {}} {
6768        set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6769    } else {
6770        set findstartline $selectedline
6771    }
6772    set findcurline $findstartline
6773    nowbusy finding [mc "Searching"]
6774    if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6775        after cancel do_file_hl $fh_serial
6776        do_file_hl $fh_serial
6777    }
6778    set find_dirn $dirn
6779    set findallowwrap $wrap
6780    run findmore
6781}
6782
6783proc stopfinding {} {
6784    global find_dirn findcurline fprogcoord
6785
6786    if {[info exists find_dirn]} {
6787        unset find_dirn
6788        unset findcurline
6789        notbusy finding
6790        set fprogcoord 0
6791        adjustprogress
6792    }
6793    stopblaming
6794}
6795
6796proc findmore {} {
6797    global commitdata commitinfo numcommits findpattern findloc
6798    global findstartline findcurline findallowwrap
6799    global find_dirn gdttype fhighlights fprogcoord
6800    global curview varcorder vrownum varccommits vrowmod
6801
6802    if {![info exists find_dirn]} {
6803        return 0
6804    }
6805    set fldtypes [list [mc "Headline"] [mc "Author"] "" [mc "Committer"] "" [mc "Comments"]]
6806    set l $findcurline
6807    set moretodo 0
6808    if {$find_dirn > 0} {
6809        incr l
6810        if {$l >= $numcommits} {
6811            set l 0
6812        }
6813        if {$l <= $findstartline} {
6814            set lim [expr {$findstartline + 1}]
6815        } else {
6816            set lim $numcommits
6817            set moretodo $findallowwrap
6818        }
6819    } else {
6820        if {$l == 0} {
6821            set l $numcommits
6822        }
6823        incr l -1
6824        if {$l >= $findstartline} {
6825            set lim [expr {$findstartline - 1}]
6826        } else {
6827            set lim -1
6828            set moretodo $findallowwrap
6829        }
6830    }
6831    set n [expr {($lim - $l) * $find_dirn}]
6832    if {$n > 500} {
6833        set n 500
6834        set moretodo 1
6835    }
6836    if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6837        update_arcrows $curview
6838    }
6839    set found 0
6840    set domore 1
6841    set ai [bsearch $vrownum($curview) $l]
6842    set a [lindex $varcorder($curview) $ai]
6843    set arow [lindex $vrownum($curview) $ai]
6844    set ids [lindex $varccommits($curview,$a)]
6845    set arowend [expr {$arow + [llength $ids]}]
6846    if {$gdttype eq [mc "containing:"]} {
6847        for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6848            if {$l < $arow || $l >= $arowend} {
6849                incr ai $find_dirn
6850                set a [lindex $varcorder($curview) $ai]
6851                set arow [lindex $vrownum($curview) $ai]
6852                set ids [lindex $varccommits($curview,$a)]
6853                set arowend [expr {$arow + [llength $ids]}]
6854            }
6855            set id [lindex $ids [expr {$l - $arow}]]
6856            # shouldn't happen unless git log doesn't give all the commits...
6857            if {![info exists commitdata($id)] ||
6858                ![doesmatch $commitdata($id)]} {
6859                continue
6860            }
6861            if {![info exists commitinfo($id)]} {
6862                getcommit $id
6863            }
6864            set info $commitinfo($id)
6865            foreach f $info ty $fldtypes {
6866                if {$ty eq ""} continue
6867                if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6868                    [doesmatch $f]} {
6869                    set found 1
6870                    break
6871                }
6872            }
6873            if {$found} break
6874        }
6875    } else {
6876        for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6877            if {$l < $arow || $l >= $arowend} {
6878                incr ai $find_dirn
6879                set a [lindex $varcorder($curview) $ai]
6880                set arow [lindex $vrownum($curview) $ai]
6881                set ids [lindex $varccommits($curview,$a)]
6882                set arowend [expr {$arow + [llength $ids]}]
6883            }
6884            set id [lindex $ids [expr {$l - $arow}]]
6885            if {![info exists fhighlights($id)]} {
6886                # this sets fhighlights($id) to -1
6887                askfilehighlight $l $id
6888            }
6889            if {$fhighlights($id) > 0} {
6890                set found $domore
6891                break
6892            }
6893            if {$fhighlights($id) < 0} {
6894                if {$domore} {
6895                    set domore 0
6896                    set findcurline [expr {$l - $find_dirn}]
6897                }
6898            }
6899        }
6900    }
6901    if {$found || ($domore && !$moretodo)} {
6902        unset findcurline
6903        unset find_dirn
6904        notbusy finding
6905        set fprogcoord 0
6906        adjustprogress
6907        if {$found} {
6908            findselectline $l
6909        } else {
6910            bell
6911        }
6912        return 0
6913    }
6914    if {!$domore} {
6915        flushhighlights
6916    } else {
6917        set findcurline [expr {$l - $find_dirn}]
6918    }
6919    set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6920    if {$n < 0} {
6921        incr n $numcommits
6922    }
6923    set fprogcoord [expr {$n * 1.0 / $numcommits}]
6924    adjustprogress
6925    return $domore
6926}
6927
6928proc findselectline {l} {
6929    global findloc commentend ctext findcurline markingmatches gdttype
6930
6931    set markingmatches [expr {$gdttype eq [mc "containing:"]}]
6932    set findcurline $l
6933    selectline $l 1
6934    if {$markingmatches &&
6935        ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
6936        # highlight the matches in the comments
6937        set f [$ctext get 1.0 $commentend]
6938        set matches [findmatches $f]
6939        foreach match $matches {
6940            set start [lindex $match 0]
6941            set end [expr {[lindex $match 1] + 1}]
6942            $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6943        }
6944    }
6945    drawvisible
6946}
6947
6948# mark the bits of a headline or author that match a find string
6949proc markmatches {canv l str tag matches font row} {
6950    global selectedline
6951
6952    set bbox [$canv bbox $tag]
6953    set x0 [lindex $bbox 0]
6954    set y0 [lindex $bbox 1]
6955    set y1 [lindex $bbox 3]
6956    foreach match $matches {
6957        set start [lindex $match 0]
6958        set end [lindex $match 1]
6959        if {$start > $end} continue
6960        set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6961        set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6962        set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6963                   [expr {$x0+$xlen+2}] $y1 \
6964                   -outline {} -tags [list match$l matches] -fill yellow]
6965        $canv lower $t
6966        if {$row == $selectedline} {
6967            $canv raise $t secsel
6968        }
6969    }
6970}
6971
6972proc unmarkmatches {} {
6973    global markingmatches
6974
6975    allcanvs delete matches
6976    set markingmatches 0
6977    stopfinding
6978}
6979
6980proc selcanvline {w x y} {
6981    global canv canvy0 ctext linespc
6982    global rowtextx
6983    set ymax [lindex [$canv cget -scrollregion] 3]
6984    if {$ymax == {}} return
6985    set yfrac [lindex [$canv yview] 0]
6986    set y [expr {$y + $yfrac * $ymax}]
6987    set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6988    if {$l < 0} {
6989        set l 0
6990    }
6991    if {$w eq $canv} {
6992        set xmax [lindex [$canv cget -scrollregion] 2]
6993        set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6994        if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
6995    }
6996    unmarkmatches
6997    selectline $l 1
6998}
6999
7000proc commit_descriptor {p} {
7001    global commitinfo
7002    if {![info exists commitinfo($p)]} {
7003        getcommit $p
7004    }
7005    set l "..."
7006    if {[llength $commitinfo($p)] > 1} {
7007        set l [lindex $commitinfo($p) 0]
7008    }
7009    return "$p ($l)\n"
7010}
7011
7012# append some text to the ctext widget, and make any SHA1 ID
7013# that we know about be a clickable link.
7014proc appendwithlinks {text tags} {
7015    global ctext linknum curview
7016
7017    set start [$ctext index "end - 1c"]
7018    $ctext insert end $text $tags
7019    set links [regexp -indices -all -inline {(?:\m|-g)[0-9a-f]{6,40}\M} $text]
7020    foreach l $links {
7021        set s [lindex $l 0]
7022        set e [lindex $l 1]
7023        set linkid [string range $text $s $e]
7024        incr e
7025        $ctext tag delete link$linknum
7026        $ctext tag add link$linknum "$start + $s c" "$start + $e c"
7027        setlink $linkid link$linknum
7028        incr linknum
7029    }
7030}
7031
7032proc setlink {id lk} {
7033    global curview ctext pendinglinks
7034    global linkfgcolor
7035
7036    if {[string range $id 0 1] eq "-g"} {
7037      set id [string range $id 2 end]
7038    }
7039
7040    set known 0
7041    if {[string length $id] < 40} {
7042        set matches [longid $id]
7043        if {[llength $matches] > 0} {
7044            if {[llength $matches] > 1} return
7045            set known 1
7046            set id [lindex $matches 0]
7047        }
7048    } else {
7049        set known [commitinview $id $curview]
7050    }
7051    if {$known} {
7052        $ctext tag conf $lk -foreground $linkfgcolor -underline 1
7053        $ctext tag bind $lk <1> [list selbyid $id]
7054        $ctext tag bind $lk <Enter> {linkcursor %W 1}
7055        $ctext tag bind $lk <Leave> {linkcursor %W -1}
7056    } else {
7057        lappend pendinglinks($id) $lk
7058        interestedin $id {makelink %P}
7059    }
7060}
7061
7062proc appendshortlink {id {pre {}} {post {}}} {
7063    global ctext linknum
7064
7065    $ctext insert end $pre
7066    $ctext tag delete link$linknum
7067    $ctext insert end [string range $id 0 7] link$linknum
7068    $ctext insert end $post
7069    setlink $id link$linknum
7070    incr linknum
7071}
7072
7073proc makelink {id} {
7074    global pendinglinks
7075
7076    if {![info exists pendinglinks($id)]} return
7077    foreach lk $pendinglinks($id) {
7078        setlink $id $lk
7079    }
7080    unset pendinglinks($id)
7081}
7082
7083proc linkcursor {w inc} {
7084    global linkentercount curtextcursor
7085
7086    if {[incr linkentercount $inc] > 0} {
7087        $w configure -cursor hand2
7088    } else {
7089        $w configure -cursor $curtextcursor
7090        if {$linkentercount < 0} {
7091            set linkentercount 0
7092        }
7093    }
7094}
7095
7096proc viewnextline {dir} {
7097    global canv linespc
7098
7099    $canv delete hover
7100    set ymax [lindex [$canv cget -scrollregion] 3]
7101    set wnow [$canv yview]
7102    set wtop [expr {[lindex $wnow 0] * $ymax}]
7103    set newtop [expr {$wtop + $dir * $linespc}]
7104    if {$newtop < 0} {
7105        set newtop 0
7106    } elseif {$newtop > $ymax} {
7107        set newtop $ymax
7108    }
7109    allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7110}
7111
7112# add a list of tag or branch names at position pos
7113# returns the number of names inserted
7114proc appendrefs {pos ids var} {
7115    global ctext linknum curview $var maxrefs visiblerefs mainheadid
7116
7117    if {[catch {$ctext index $pos}]} {
7118        return 0
7119    }
7120    $ctext conf -state normal
7121    $ctext delete $pos "$pos lineend"
7122    set tags {}
7123    foreach id $ids {
7124        foreach tag [set $var\($id\)] {
7125            lappend tags [list $tag $id]
7126        }
7127    }
7128
7129    set sep {}
7130    set tags [lsort -index 0 -decreasing $tags]
7131    set nutags 0
7132
7133    if {[llength $tags] > $maxrefs} {
7134        # If we are displaying heads, and there are too many,
7135        # see if there are some important heads to display.
7136        # Currently that are the current head and heads listed in $visiblerefs option
7137        set itags {}
7138        if {$var eq "idheads"} {
7139            set utags {}
7140            foreach ti $tags {
7141                set hname [lindex $ti 0]
7142                set id [lindex $ti 1]
7143                if {([lsearch -exact $visiblerefs $hname] != -1 || $id eq $mainheadid) &&
7144                    [llength $itags] < $maxrefs} {
7145                    lappend itags $ti
7146                } else {
7147                    lappend utags $ti
7148                }
7149            }
7150            set tags $utags
7151        }
7152        if {$itags ne {}} {
7153            set str [mc "and many more"]
7154            set sep " "
7155        } else {
7156            set str [mc "many"]
7157        }
7158        $ctext insert $pos "$str ([llength $tags])"
7159        set nutags [llength $tags]
7160        set tags $itags
7161    }
7162
7163    foreach ti $tags {
7164        set id [lindex $ti 1]
7165        set lk link$linknum
7166        incr linknum
7167        $ctext tag delete $lk
7168        $ctext insert $pos $sep
7169        $ctext insert $pos [lindex $ti 0] $lk
7170        setlink $id $lk
7171        set sep ", "
7172    }
7173    $ctext tag add wwrap "$pos linestart" "$pos lineend"
7174    $ctext conf -state disabled
7175    return [expr {[llength $tags] + $nutags}]
7176}
7177
7178# called when we have finished computing the nearby tags
7179proc dispneartags {delay} {
7180    global selectedline currentid showneartags tagphase
7181
7182    if {$selectedline eq {} || !$showneartags} return
7183    after cancel dispnexttag
7184    if {$delay} {
7185        after 200 dispnexttag
7186        set tagphase -1
7187    } else {
7188        after idle dispnexttag
7189        set tagphase 0
7190    }
7191}
7192
7193proc dispnexttag {} {
7194    global selectedline currentid showneartags tagphase ctext
7195
7196    if {$selectedline eq {} || !$showneartags} return
7197    switch -- $tagphase {
7198        0 {
7199            set dtags [desctags $currentid]
7200            if {$dtags ne {}} {
7201                appendrefs precedes $dtags idtags
7202            }
7203        }
7204        1 {
7205            set atags [anctags $currentid]
7206            if {$atags ne {}} {
7207                appendrefs follows $atags idtags
7208            }
7209        }
7210        2 {
7211            set dheads [descheads $currentid]
7212            if {$dheads ne {}} {
7213                if {[appendrefs branch $dheads idheads] > 1
7214                    && [$ctext get "branch -3c"] eq "h"} {
7215                    # turn "Branch" into "Branches"
7216                    $ctext conf -state normal
7217                    $ctext insert "branch -2c" "es"
7218                    $ctext conf -state disabled
7219                }
7220            }
7221        }
7222    }
7223    if {[incr tagphase] <= 2} {
7224        after idle dispnexttag
7225    }
7226}
7227
7228proc make_secsel {id} {
7229    global linehtag linentag linedtag canv canv2 canv3
7230
7231    if {![info exists linehtag($id)]} return
7232    $canv delete secsel
7233    set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
7234               -tags secsel -fill [$canv cget -selectbackground]]
7235    $canv lower $t
7236    $canv2 delete secsel
7237    set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
7238               -tags secsel -fill [$canv2 cget -selectbackground]]
7239    $canv2 lower $t
7240    $canv3 delete secsel
7241    set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
7242               -tags secsel -fill [$canv3 cget -selectbackground]]
7243    $canv3 lower $t
7244}
7245
7246proc make_idmark {id} {
7247    global linehtag canv fgcolor
7248
7249    if {![info exists linehtag($id)]} return
7250    $canv delete markid
7251    set t [eval $canv create rect [$canv bbox $linehtag($id)] \
7252               -tags markid -outline $fgcolor]
7253    $canv raise $t
7254}
7255
7256proc selectline {l isnew {desired_loc {}} {switch_to_patch 0}} {
7257    global canv ctext commitinfo selectedline
7258    global canvy0 linespc parents children curview
7259    global currentid sha1entry
7260    global commentend idtags linknum
7261    global mergemax numcommits pending_select
7262    global cmitmode showneartags allcommits
7263    global targetrow targetid lastscrollrows
7264    global autoselect autosellen jump_to_here
7265    global vinlinediff
7266
7267    unset -nocomplain pending_select
7268    $canv delete hover
7269    normalline
7270    unsel_reflist
7271    stopfinding
7272    if {$l < 0 || $l >= $numcommits} return
7273    set id [commitonrow $l]
7274    set targetid $id
7275    set targetrow $l
7276    set selectedline $l
7277    set currentid $id
7278    if {$lastscrollrows < $numcommits} {
7279        setcanvscroll
7280    }
7281
7282    if {$cmitmode ne "patch" && $switch_to_patch} {
7283        set cmitmode "patch"
7284    }
7285
7286    set y [expr {$canvy0 + $l * $linespc}]
7287    set ymax [lindex [$canv cget -scrollregion] 3]
7288    set ytop [expr {$y - $linespc - 1}]
7289    set ybot [expr {$y + $linespc + 1}]
7290    set wnow [$canv yview]
7291    set wtop [expr {[lindex $wnow 0] * $ymax}]
7292    set wbot [expr {[lindex $wnow 1] * $ymax}]
7293    set wh [expr {$wbot - $wtop}]
7294    set newtop $wtop
7295    if {$ytop < $wtop} {
7296        if {$ybot < $wtop} {
7297            set newtop [expr {$y - $wh / 2.0}]
7298        } else {
7299            set newtop $ytop
7300            if {$newtop > $wtop - $linespc} {
7301                set newtop [expr {$wtop - $linespc}]
7302            }
7303        }
7304    } elseif {$ybot > $wbot} {
7305        if {$ytop > $wbot} {
7306            set newtop [expr {$y - $wh / 2.0}]
7307        } else {
7308            set newtop [expr {$ybot - $wh}]
7309            if {$newtop < $wtop + $linespc} {
7310                set newtop [expr {$wtop + $linespc}]
7311            }
7312        }
7313    }
7314    if {$newtop != $wtop} {
7315        if {$newtop < 0} {
7316            set newtop 0
7317        }
7318        allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7319        drawvisible
7320    }
7321
7322    make_secsel $id
7323
7324    if {$isnew} {
7325        addtohistory [list selbyid $id 0] savecmitpos
7326    }
7327
7328    $sha1entry delete 0 end
7329    $sha1entry insert 0 $id
7330    if {$autoselect} {
7331        $sha1entry selection range 0 $autosellen
7332    }
7333    rhighlight_sel $id
7334
7335    $ctext conf -state normal
7336    clear_ctext
7337    set linknum 0
7338    if {![info exists commitinfo($id)]} {
7339        getcommit $id
7340    }
7341    set info $commitinfo($id)
7342    set date [formatdate [lindex $info 2]]
7343    $ctext insert end "[mc "Author"]: [lindex $info 1]  $date\n"
7344    set date [formatdate [lindex $info 4]]
7345    $ctext insert end "[mc "Committer"]: [lindex $info 3]  $date\n"
7346    if {[info exists idtags($id)]} {
7347        $ctext insert end [mc "Tags:"]
7348        foreach tag $idtags($id) {
7349            $ctext insert end " $tag"
7350        }
7351        $ctext insert end "\n"
7352    }
7353
7354    set headers {}
7355    set olds $parents($curview,$id)
7356    if {[llength $olds] > 1} {
7357        set np 0
7358        foreach p $olds {
7359            if {$np >= $mergemax} {
7360                set tag mmax
7361            } else {
7362                set tag m$np
7363            }
7364            $ctext insert end "[mc "Parent"]: " $tag
7365            appendwithlinks [commit_descriptor $p] {}
7366            incr np
7367        }
7368    } else {
7369        foreach p $olds {
7370            append headers "[mc "Parent"]: [commit_descriptor $p]"
7371        }
7372    }
7373
7374    foreach c $children($curview,$id) {
7375        append headers "[mc "Child"]:  [commit_descriptor $c]"
7376    }
7377
7378    # make anything that looks like a SHA1 ID be a clickable link
7379    appendwithlinks $headers {}
7380    if {$showneartags} {
7381        if {![info exists allcommits]} {
7382            getallcommits
7383        }
7384        $ctext insert end "[mc "Branch"]: "
7385        $ctext mark set branch "end -1c"
7386        $ctext mark gravity branch left
7387        $ctext insert end "\n[mc "Follows"]: "
7388        $ctext mark set follows "end -1c"
7389        $ctext mark gravity follows left
7390        $ctext insert end "\n[mc "Precedes"]: "
7391        $ctext mark set precedes "end -1c"
7392        $ctext mark gravity precedes left
7393        $ctext insert end "\n"
7394        dispneartags 1
7395    }
7396    $ctext insert end "\n"
7397    set comment [lindex $info 5]
7398    if {[string first "\r" $comment] >= 0} {
7399        set comment [string map {"\r" "\n    "} $comment]
7400    }
7401    appendwithlinks $comment {comment}
7402
7403    $ctext tag remove found 1.0 end
7404    $ctext conf -state disabled
7405    set commentend [$ctext index "end - 1c"]
7406
7407    set jump_to_here $desired_loc
7408    init_flist [mc "Comments"]
7409    if {$cmitmode eq "tree"} {
7410        gettree $id
7411    } elseif {$vinlinediff($curview) == 1} {
7412        showinlinediff $id
7413    } elseif {[llength $olds] <= 1} {
7414        startdiff $id
7415    } else {
7416        mergediff $id
7417    }
7418}
7419
7420proc selfirstline {} {
7421    unmarkmatches
7422    selectline 0 1
7423}
7424
7425proc sellastline {} {
7426    global numcommits
7427    unmarkmatches
7428    set l [expr {$numcommits - 1}]
7429    selectline $l 1
7430}
7431
7432proc selnextline {dir} {
7433    global selectedline
7434    focus .
7435    if {$selectedline eq {}} return
7436    set l [expr {$selectedline + $dir}]
7437    unmarkmatches
7438    selectline $l 1
7439}
7440
7441proc selnextpage {dir} {
7442    global canv linespc selectedline numcommits
7443
7444    set lpp [expr {([winfo height $canv] - 2) / $linespc}]
7445    if {$lpp < 1} {
7446        set lpp 1
7447    }
7448    allcanvs yview scroll [expr {$dir * $lpp}] units
7449    drawvisible
7450    if {$selectedline eq {}} return
7451    set l [expr {$selectedline + $dir * $lpp}]
7452    if {$l < 0} {
7453        set l 0
7454    } elseif {$l >= $numcommits} {
7455        set l [expr $numcommits - 1]
7456    }
7457    unmarkmatches
7458    selectline $l 1
7459}
7460
7461proc unselectline {} {
7462    global selectedline currentid
7463
7464    set selectedline {}
7465    unset -nocomplain currentid
7466    allcanvs delete secsel
7467    rhighlight_none
7468}
7469
7470proc reselectline {} {
7471    global selectedline
7472
7473    if {$selectedline ne {}} {
7474        selectline $selectedline 0
7475    }
7476}
7477
7478proc addtohistory {cmd {saveproc {}}} {
7479    global history historyindex curview
7480
7481    unset_posvars
7482    save_position
7483    set elt [list $curview $cmd $saveproc {}]
7484    if {$historyindex > 0
7485        && [lindex $history [expr {$historyindex - 1}]] == $elt} {
7486        return
7487    }
7488
7489    if {$historyindex < [llength $history]} {
7490        set history [lreplace $history $historyindex end $elt]
7491    } else {
7492        lappend history $elt
7493    }
7494    incr historyindex
7495    if {$historyindex > 1} {
7496        .tf.bar.leftbut conf -state normal
7497    } else {
7498        .tf.bar.leftbut conf -state disabled
7499    }
7500    .tf.bar.rightbut conf -state disabled
7501}
7502
7503# save the scrolling position of the diff display pane
7504proc save_position {} {
7505    global historyindex history
7506
7507    if {$historyindex < 1} return
7508    set hi [expr {$historyindex - 1}]
7509    set fn [lindex $history $hi 2]
7510    if {$fn ne {}} {
7511        lset history $hi 3 [eval $fn]
7512    }
7513}
7514
7515proc unset_posvars {} {
7516    global last_posvars
7517
7518    if {[info exists last_posvars]} {
7519        foreach {var val} $last_posvars {
7520            global $var
7521            unset -nocomplain $var
7522        }
7523        unset last_posvars
7524    }
7525}
7526
7527proc godo {elt} {
7528    global curview last_posvars
7529
7530    set view [lindex $elt 0]
7531    set cmd [lindex $elt 1]
7532    set pv [lindex $elt 3]
7533    if {$curview != $view} {
7534        showview $view
7535    }
7536    unset_posvars
7537    foreach {var val} $pv {
7538        global $var
7539        set $var $val
7540    }
7541    set last_posvars $pv
7542    eval $cmd
7543}
7544
7545proc goback {} {
7546    global history historyindex
7547    focus .
7548
7549    if {$historyindex > 1} {
7550        save_position
7551        incr historyindex -1
7552        godo [lindex $history [expr {$historyindex - 1}]]
7553        .tf.bar.rightbut conf -state normal
7554    }
7555    if {$historyindex <= 1} {
7556        .tf.bar.leftbut conf -state disabled
7557    }
7558}
7559
7560proc goforw {} {
7561    global history historyindex
7562    focus .
7563
7564    if {$historyindex < [llength $history]} {
7565        save_position
7566        set cmd [lindex $history $historyindex]
7567        incr historyindex
7568        godo $cmd
7569        .tf.bar.leftbut conf -state normal
7570    }
7571    if {$historyindex >= [llength $history]} {
7572        .tf.bar.rightbut conf -state disabled
7573    }
7574}
7575
7576proc go_to_parent {i} {
7577    global parents curview targetid
7578    set ps $parents($curview,$targetid)
7579    if {[llength $ps] >= $i} {
7580        selbyid [lindex $ps [expr $i - 1]]
7581    }
7582}
7583
7584proc gettree {id} {
7585    global treefilelist treeidlist diffids diffmergeid treepending
7586    global nullid nullid2
7587
7588    set diffids $id
7589    unset -nocomplain diffmergeid
7590    if {![info exists treefilelist($id)]} {
7591        if {![info exists treepending]} {
7592            if {$id eq $nullid} {
7593                set cmd [list | git ls-files]
7594            } elseif {$id eq $nullid2} {
7595                set cmd [list | git ls-files --stage -t]
7596            } else {
7597                set cmd [list | git ls-tree -r $id]
7598            }
7599            if {[catch {set gtf [open $cmd r]}]} {
7600                return
7601            }
7602            set treepending $id
7603            set treefilelist($id) {}
7604            set treeidlist($id) {}
7605            fconfigure $gtf -blocking 0 -encoding binary
7606            filerun $gtf [list gettreeline $gtf $id]
7607        }
7608    } else {
7609        setfilelist $id
7610    }
7611}
7612
7613proc gettreeline {gtf id} {
7614    global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
7615
7616    set nl 0
7617    while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
7618        if {$diffids eq $nullid} {
7619            set fname $line
7620        } else {
7621            set i [string first "\t" $line]
7622            if {$i < 0} continue
7623            set fname [string range $line [expr {$i+1}] end]
7624            set line [string range $line 0 [expr {$i-1}]]
7625            if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7626            set sha1 [lindex $line 2]
7627            lappend treeidlist($id) $sha1
7628        }
7629        if {[string index $fname 0] eq "\""} {
7630            set fname [lindex $fname 0]
7631        }
7632        set fname [encoding convertfrom $fname]
7633        lappend treefilelist($id) $fname
7634    }
7635    if {![eof $gtf]} {
7636        return [expr {$nl >= 1000? 2: 1}]
7637    }
7638    close $gtf
7639    unset treepending
7640    if {$cmitmode ne "tree"} {
7641        if {![info exists diffmergeid]} {
7642            gettreediffs $diffids
7643        }
7644    } elseif {$id ne $diffids} {
7645        gettree $diffids
7646    } else {
7647        setfilelist $id
7648    }
7649    return 0
7650}
7651
7652proc showfile {f} {
7653    global treefilelist treeidlist diffids nullid nullid2
7654    global ctext_file_names ctext_file_lines
7655    global ctext commentend
7656
7657    set i [lsearch -exact $treefilelist($diffids) $f]
7658    if {$i < 0} {
7659        puts "oops, $f not in list for id $diffids"
7660        return
7661    }
7662    if {$diffids eq $nullid} {
7663        if {[catch {set bf [open $f r]} err]} {
7664            puts "oops, can't read $f: $err"
7665            return
7666        }
7667    } else {
7668        set blob [lindex $treeidlist($diffids) $i]
7669        if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7670            puts "oops, error reading blob $blob: $err"
7671            return
7672        }
7673    }
7674    fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7675    filerun $bf [list getblobline $bf $diffids]
7676    $ctext config -state normal
7677    clear_ctext $commentend
7678    lappend ctext_file_names $f
7679    lappend ctext_file_lines [lindex [split $commentend "."] 0]
7680    $ctext insert end "\n"
7681    $ctext insert end "$f\n" filesep
7682    $ctext config -state disabled
7683    $ctext yview $commentend
7684    settabs 0
7685}
7686
7687proc getblobline {bf id} {
7688    global diffids cmitmode ctext
7689
7690    if {$id ne $diffids || $cmitmode ne "tree"} {
7691        catch {close $bf}
7692        return 0
7693    }
7694    $ctext config -state normal
7695    set nl 0
7696    while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7697        $ctext insert end "$line\n"
7698    }
7699    if {[eof $bf]} {
7700        global jump_to_here ctext_file_names commentend
7701
7702        # delete last newline
7703        $ctext delete "end - 2c" "end - 1c"
7704        close $bf
7705        if {$jump_to_here ne {} &&
7706            [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7707            set lnum [expr {[lindex $jump_to_here 1] +
7708                            [lindex [split $commentend .] 0]}]
7709            mark_ctext_line $lnum
7710        }
7711        $ctext config -state disabled
7712        return 0
7713    }
7714    $ctext config -state disabled
7715    return [expr {$nl >= 1000? 2: 1}]
7716}
7717
7718proc mark_ctext_line {lnum} {
7719    global ctext markbgcolor
7720
7721    $ctext tag delete omark
7722    $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7723    $ctext tag conf omark -background $markbgcolor
7724    $ctext see $lnum.0
7725}
7726
7727proc mergediff {id} {
7728    global diffmergeid
7729    global diffids treediffs
7730    global parents curview
7731
7732    set diffmergeid $id
7733    set diffids $id
7734    set treediffs($id) {}
7735    set np [llength $parents($curview,$id)]
7736    settabs $np
7737    getblobdiffs $id
7738}
7739
7740proc startdiff {ids} {
7741    global treediffs diffids treepending diffmergeid nullid nullid2
7742
7743    settabs 1
7744    set diffids $ids
7745    unset -nocomplain diffmergeid
7746    if {![info exists treediffs($ids)] ||
7747        [lsearch -exact $ids $nullid] >= 0 ||
7748        [lsearch -exact $ids $nullid2] >= 0} {
7749        if {![info exists treepending]} {
7750            gettreediffs $ids
7751        }
7752    } else {
7753        addtocflist $ids
7754    }
7755}
7756
7757proc showinlinediff {ids} {
7758    global commitinfo commitdata ctext
7759    global treediffs
7760
7761    set info $commitinfo($ids)
7762    set diff [lindex $info 7]
7763    set difflines [split $diff "\n"]
7764
7765    initblobdiffvars
7766    set treediff {}
7767
7768    set inhdr 0
7769    foreach line $difflines {
7770        if {![string compare -length 5 "diff " $line]} {
7771            set inhdr 1
7772        } elseif {$inhdr && ![string compare -length 4 "+++ " $line]} {
7773            # offset also accounts for the b/ prefix
7774            lappend treediff [string range $line 6 end]
7775            set inhdr 0
7776        }
7777    }
7778
7779    set treediffs($ids) $treediff
7780    add_flist $treediff
7781
7782    $ctext conf -state normal
7783    foreach line $difflines {
7784        parseblobdiffline $ids $line
7785    }
7786    maybe_scroll_ctext 1
7787    $ctext conf -state disabled
7788}
7789
7790# If the filename (name) is under any of the passed filter paths
7791# then return true to include the file in the listing.
7792proc path_filter {filter name} {
7793    set worktree [gitworktree]
7794    foreach p $filter {
7795        set fq_p [file normalize $p]
7796        set fq_n [file normalize [file join $worktree $name]]
7797        if {[string match [file normalize $fq_p]* $fq_n]} {
7798            return 1
7799        }
7800    }
7801    return 0
7802}
7803
7804proc addtocflist {ids} {
7805    global treediffs
7806
7807    add_flist $treediffs($ids)
7808    getblobdiffs $ids
7809}
7810
7811proc diffcmd {ids flags} {
7812    global log_showroot nullid nullid2 git_version
7813
7814    set i [lsearch -exact $ids $nullid]
7815    set j [lsearch -exact $ids $nullid2]
7816    if {$i >= 0} {
7817        if {[llength $ids] > 1 && $j < 0} {
7818            # comparing working directory with some specific revision
7819            set cmd [concat | git diff-index $flags]
7820            if {$i == 0} {
7821                lappend cmd -R [lindex $ids 1]
7822            } else {
7823                lappend cmd [lindex $ids 0]
7824            }
7825        } else {
7826            # comparing working directory with index
7827            set cmd [concat | git diff-files $flags]
7828            if {$j == 1} {
7829                lappend cmd -R
7830            }
7831        }
7832    } elseif {$j >= 0} {
7833        if {[package vcompare $git_version "1.7.2"] >= 0} {
7834            set flags "$flags --ignore-submodules=dirty"
7835        }
7836        set cmd [concat | git diff-index --cached $flags]
7837        if {[llength $ids] > 1} {
7838            # comparing index with specific revision
7839            if {$j == 0} {
7840                lappend cmd -R [lindex $ids 1]
7841            } else {
7842                lappend cmd [lindex $ids 0]
7843            }
7844        } else {
7845            # comparing index with HEAD
7846            lappend cmd HEAD
7847        }
7848    } else {
7849        if {$log_showroot} {
7850            lappend flags --root
7851        }
7852        set cmd [concat | git diff-tree -r $flags $ids]
7853    }
7854    return $cmd
7855}
7856
7857proc gettreediffs {ids} {
7858    global treediff treepending limitdiffs vfilelimit curview
7859
7860    set cmd [diffcmd $ids {--no-commit-id}]
7861    if {$limitdiffs && $vfilelimit($curview) ne {}} {
7862            set cmd [concat $cmd -- $vfilelimit($curview)]
7863    }
7864    if {[catch {set gdtf [open $cmd r]}]} return
7865
7866    set treepending $ids
7867    set treediff {}
7868    fconfigure $gdtf -blocking 0 -encoding binary
7869    filerun $gdtf [list gettreediffline $gdtf $ids]
7870}
7871
7872proc gettreediffline {gdtf ids} {
7873    global treediff treediffs treepending diffids diffmergeid
7874    global cmitmode vfilelimit curview limitdiffs perfile_attrs
7875
7876    set nr 0
7877    set sublist {}
7878    set max 1000
7879    if {$perfile_attrs} {
7880        # cache_gitattr is slow, and even slower on win32 where we
7881        # have to invoke it for only about 30 paths at a time
7882        set max 500
7883        if {[tk windowingsystem] == "win32"} {
7884            set max 120
7885        }
7886    }
7887    while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7888        set i [string first "\t" $line]
7889        if {$i >= 0} {
7890            set file [string range $line [expr {$i+1}] end]
7891            if {[string index $file 0] eq "\""} {
7892                set file [lindex $file 0]
7893            }
7894            set file [encoding convertfrom $file]
7895            if {$file ne [lindex $treediff end]} {
7896                lappend treediff $file
7897                lappend sublist $file
7898            }
7899        }
7900    }
7901    if {$perfile_attrs} {
7902        cache_gitattr encoding $sublist
7903    }
7904    if {![eof $gdtf]} {
7905        return [expr {$nr >= $max? 2: 1}]
7906    }
7907    close $gdtf
7908    set treediffs($ids) $treediff
7909    unset treepending
7910    if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7911        gettree $diffids
7912    } elseif {$ids != $diffids} {
7913        if {![info exists diffmergeid]} {
7914            gettreediffs $diffids
7915        }
7916    } else {
7917        addtocflist $ids
7918    }
7919    return 0
7920}
7921
7922# empty string or positive integer
7923proc diffcontextvalidate {v} {
7924    return [regexp {^(|[1-9][0-9]*)$} $v]
7925}
7926
7927proc diffcontextchange {n1 n2 op} {
7928    global diffcontextstring diffcontext
7929
7930    if {[string is integer -strict $diffcontextstring]} {
7931        if {$diffcontextstring >= 0} {
7932            set diffcontext $diffcontextstring
7933            reselectline
7934        }
7935    }
7936}
7937
7938proc changeignorespace {} {
7939    reselectline
7940}
7941
7942proc changeworddiff {name ix op} {
7943    reselectline
7944}
7945
7946proc initblobdiffvars {} {
7947    global diffencoding targetline diffnparents
7948    global diffinhdr currdiffsubmod diffseehere
7949    set targetline {}
7950    set diffnparents 0
7951    set diffinhdr 0
7952    set diffencoding [get_path_encoding {}]
7953    set currdiffsubmod ""
7954    set diffseehere -1
7955}
7956
7957proc getblobdiffs {ids} {
7958    global blobdifffd diffids env
7959    global treediffs
7960    global diffcontext
7961    global ignorespace
7962    global worddiff
7963    global limitdiffs vfilelimit curview
7964    global git_version
7965
7966    set textconv {}
7967    if {[package vcompare $git_version "1.6.1"] >= 0} {
7968        set textconv "--textconv"
7969    }
7970    set submodule {}
7971    if {[package vcompare $git_version "1.6.6"] >= 0} {
7972        set submodule "--submodule"
7973    }
7974    set cmd [diffcmd $ids "-p $textconv $submodule  -C --cc --no-commit-id -U$diffcontext"]
7975    if {$ignorespace} {
7976        append cmd " -w"
7977    }
7978    if {$worddiff ne [mc "Line diff"]} {
7979        append cmd " --word-diff=porcelain"
7980    }
7981    if {$limitdiffs && $vfilelimit($curview) ne {}} {
7982        set cmd [concat $cmd -- $vfilelimit($curview)]
7983    }
7984    if {[catch {set bdf [open $cmd r]} err]} {
7985        error_popup [mc "Error getting diffs: %s" $err]
7986        return
7987    }
7988    fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
7989    set blobdifffd($ids) $bdf
7990    initblobdiffvars
7991    filerun $bdf [list getblobdiffline $bdf $diffids]
7992}
7993
7994proc savecmitpos {} {
7995    global ctext cmitmode
7996
7997    if {$cmitmode eq "tree"} {
7998        return {}
7999    }
8000    return [list target_scrollpos [$ctext index @0,0]]
8001}
8002
8003proc savectextpos {} {
8004    global ctext
8005
8006    return [list target_scrollpos [$ctext index @0,0]]
8007}
8008
8009proc maybe_scroll_ctext {ateof} {
8010    global ctext target_scrollpos
8011
8012    if {![info exists target_scrollpos]} return
8013    if {!$ateof} {
8014        set nlines [expr {[winfo height $ctext]
8015                          / [font metrics textfont -linespace]}]
8016        if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
8017    }
8018    $ctext yview $target_scrollpos
8019    unset target_scrollpos
8020}
8021
8022proc setinlist {var i val} {
8023    global $var
8024
8025    while {[llength [set $var]] < $i} {
8026        lappend $var {}
8027    }
8028    if {[llength [set $var]] == $i} {
8029        lappend $var $val
8030    } else {
8031        lset $var $i $val
8032    }
8033}
8034
8035proc makediffhdr {fname ids} {
8036    global ctext curdiffstart treediffs diffencoding
8037    global ctext_file_names jump_to_here targetline diffline
8038
8039    set fname [encoding convertfrom $fname]
8040    set diffencoding [get_path_encoding $fname]
8041    set i [lsearch -exact $treediffs($ids) $fname]
8042    if {$i >= 0} {
8043        setinlist difffilestart $i $curdiffstart
8044    }
8045    lset ctext_file_names end $fname
8046    set l [expr {(78 - [string length $fname]) / 2}]
8047    set pad [string range "----------------------------------------" 1 $l]
8048    $ctext insert $curdiffstart "$pad $fname $pad" filesep
8049    set targetline {}
8050    if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
8051        set targetline [lindex $jump_to_here 1]
8052    }
8053    set diffline 0
8054}
8055
8056proc blobdiffmaybeseehere {ateof} {
8057    global diffseehere
8058    if {$diffseehere >= 0} {
8059        mark_ctext_line [lindex [split $diffseehere .] 0]
8060    }
8061    maybe_scroll_ctext $ateof
8062}
8063
8064proc getblobdiffline {bdf ids} {
8065    global diffids blobdifffd
8066    global ctext
8067
8068    set nr 0
8069    $ctext conf -state normal
8070    while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
8071        if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
8072            catch {close $bdf}
8073            return 0
8074        }
8075        parseblobdiffline $ids $line
8076    }
8077    $ctext conf -state disabled
8078    blobdiffmaybeseehere [eof $bdf]
8079    if {[eof $bdf]} {
8080        catch {close $bdf}
8081        return 0
8082    }
8083    return [expr {$nr >= 1000? 2: 1}]
8084}
8085
8086proc parseblobdiffline {ids line} {
8087    global ctext curdiffstart
8088    global diffnexthead diffnextnote difffilestart
8089    global ctext_file_names ctext_file_lines
8090    global diffinhdr treediffs mergemax diffnparents
8091    global diffencoding jump_to_here targetline diffline currdiffsubmod
8092    global worddiff diffseehere
8093
8094    if {![string compare -length 5 "diff " $line]} {
8095        if {![regexp {^diff (--cc|--git) } $line m type]} {
8096            set line [encoding convertfrom $line]
8097            $ctext insert end "$line\n" hunksep
8098            continue
8099        }
8100        # start of a new file
8101        set diffinhdr 1
8102        $ctext insert end "\n"
8103        set curdiffstart [$ctext index "end - 1c"]
8104        lappend ctext_file_names ""
8105        lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8106        $ctext insert end "\n" filesep
8107
8108        if {$type eq "--cc"} {
8109            # start of a new file in a merge diff
8110            set fname [string range $line 10 end]
8111            if {[lsearch -exact $treediffs($ids) $fname] < 0} {
8112                lappend treediffs($ids) $fname
8113                add_flist [list $fname]
8114            }
8115
8116        } else {
8117            set line [string range $line 11 end]
8118            # If the name hasn't changed the length will be odd,
8119            # the middle char will be a space, and the two bits either
8120            # side will be a/name and b/name, or "a/name" and "b/name".
8121            # If the name has changed we'll get "rename from" and
8122            # "rename to" or "copy from" and "copy to" lines following
8123            # this, and we'll use them to get the filenames.
8124            # This complexity is necessary because spaces in the
8125            # filename(s) don't get escaped.
8126            set l [string length $line]
8127            set i [expr {$l / 2}]
8128            if {!(($l & 1) && [string index $line $i] eq " " &&
8129                  [string range $line 2 [expr {$i - 1}]] eq \
8130                      [string range $line [expr {$i + 3}] end])} {
8131                return
8132            }
8133            # unescape if quoted and chop off the a/ from the front
8134            if {[string index $line 0] eq "\""} {
8135                set fname [string range [lindex $line 0] 2 end]
8136            } else {
8137                set fname [string range $line 2 [expr {$i - 1}]]
8138            }
8139        }
8140        makediffhdr $fname $ids
8141
8142    } elseif {![string compare -length 16 "* Unmerged path " $line]} {
8143        set fname [encoding convertfrom [string range $line 16 end]]
8144        $ctext insert end "\n"
8145        set curdiffstart [$ctext index "end - 1c"]
8146        lappend ctext_file_names $fname
8147        lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8148        $ctext insert end "$line\n" filesep
8149        set i [lsearch -exact $treediffs($ids) $fname]
8150        if {$i >= 0} {
8151            setinlist difffilestart $i $curdiffstart
8152        }
8153
8154    } elseif {![string compare -length 2 "@@" $line]} {
8155        regexp {^@@+} $line ats
8156        set line [encoding convertfrom $diffencoding $line]
8157        $ctext insert end "$line\n" hunksep
8158        if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
8159            set diffline $nl
8160        }
8161        set diffnparents [expr {[string length $ats] - 1}]
8162        set diffinhdr 0
8163
8164    } elseif {![string compare -length 10 "Submodule " $line]} {
8165        # start of a new submodule
8166        if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
8167            set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
8168        } else {
8169            set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
8170        }
8171        if {$currdiffsubmod != $fname} {
8172            $ctext insert end "\n";     # Add newline after commit message
8173        }
8174        set curdiffstart [$ctext index "end - 1c"]
8175        lappend ctext_file_names ""
8176        if {$currdiffsubmod != $fname} {
8177            lappend ctext_file_lines $fname
8178            makediffhdr $fname $ids
8179            set currdiffsubmod $fname
8180            $ctext insert end "\n$line\n" filesep
8181        } else {
8182            $ctext insert end "$line\n" filesep
8183        }
8184    } elseif {![string compare -length 3 "  >" $line]} {
8185        set $currdiffsubmod ""
8186        set line [encoding convertfrom $diffencoding $line]
8187        $ctext insert end "$line\n" dresult
8188    } elseif {![string compare -length 3 "  <" $line]} {
8189        set $currdiffsubmod ""
8190        set line [encoding convertfrom $diffencoding $line]
8191        $ctext insert end "$line\n" d0
8192    } elseif {$diffinhdr} {
8193        if {![string compare -length 12 "rename from " $line]} {
8194            set fname [string range $line [expr 6 + [string first " from " $line] ] end]
8195            if {[string index $fname 0] eq "\""} {
8196                set fname [lindex $fname 0]
8197            }
8198            set fname [encoding convertfrom $fname]
8199            set i [lsearch -exact $treediffs($ids) $fname]
8200            if {$i >= 0} {
8201                setinlist difffilestart $i $curdiffstart
8202            }
8203        } elseif {![string compare -length 10 $line "rename to "] ||
8204                  ![string compare -length 8 $line "copy to "]} {
8205            set fname [string range $line [expr 4 + [string first " to " $line] ] end]
8206            if {[string index $fname 0] eq "\""} {
8207                set fname [lindex $fname 0]
8208            }
8209            makediffhdr $fname $ids
8210        } elseif {[string compare -length 3 $line "---"] == 0} {
8211            # do nothing
8212            return
8213        } elseif {[string compare -length 3 $line "+++"] == 0} {
8214            set diffinhdr 0
8215            return
8216        }
8217        $ctext insert end "$line\n" filesep
8218
8219    } else {
8220        set line [string map {\x1A ^Z} \
8221                      [encoding convertfrom $diffencoding $line]]
8222        # parse the prefix - one ' ', '-' or '+' for each parent
8223        set prefix [string range $line 0 [expr {$diffnparents - 1}]]
8224        set tag [expr {$diffnparents > 1? "m": "d"}]
8225        set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
8226        set words_pre_markup ""
8227        set words_post_markup ""
8228        if {[string trim $prefix " -+"] eq {}} {
8229            # prefix only has " ", "-" and "+" in it: normal diff line
8230            set num [string first "-" $prefix]
8231            if {$dowords} {
8232                set line [string range $line 1 end]
8233            }
8234            if {$num >= 0} {
8235                # removed line, first parent with line is $num
8236                if {$num >= $mergemax} {
8237                    set num "max"
8238                }
8239                if {$dowords && $worddiff eq [mc "Markup words"]} {
8240                    $ctext insert end "\[-$line-\]" $tag$num
8241                } else {
8242                    $ctext insert end "$line" $tag$num
8243                }
8244                if {!$dowords} {
8245                    $ctext insert end "\n" $tag$num
8246                }
8247            } else {
8248                set tags {}
8249                if {[string first "+" $prefix] >= 0} {
8250                    # added line
8251                    lappend tags ${tag}result
8252                    if {$diffnparents > 1} {
8253                        set num [string first " " $prefix]
8254                        if {$num >= 0} {
8255                            if {$num >= $mergemax} {
8256                                set num "max"
8257                            }
8258                            lappend tags m$num
8259                        }
8260                    }
8261                    set words_pre_markup "{+"
8262                    set words_post_markup "+}"
8263                }
8264                if {$targetline ne {}} {
8265                    if {$diffline == $targetline} {
8266                        set diffseehere [$ctext index "end - 1 chars"]
8267                        set targetline {}
8268                    } else {
8269                        incr diffline
8270                    }
8271                }
8272                if {$dowords && $worddiff eq [mc "Markup words"]} {
8273                    $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
8274                } else {
8275                    $ctext insert end "$line" $tags
8276                }
8277                if {!$dowords} {
8278                    $ctext insert end "\n" $tags
8279                }
8280            }
8281        } elseif {$dowords && $prefix eq "~"} {
8282            $ctext insert end "\n" {}
8283        } else {
8284            # "\ No newline at end of file",
8285            # or something else we don't recognize
8286            $ctext insert end "$line\n" hunksep
8287        }
8288    }
8289}
8290
8291proc changediffdisp {} {
8292    global ctext diffelide
8293
8294    $ctext tag conf d0 -elide [lindex $diffelide 0]
8295    $ctext tag conf dresult -elide [lindex $diffelide 1]
8296}
8297
8298proc highlightfile {cline} {
8299    global cflist cflist_top
8300
8301    if {![info exists cflist_top]} return
8302
8303    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
8304    $cflist tag add highlight $cline.0 "$cline.0 lineend"
8305    $cflist see $cline.0
8306    set cflist_top $cline
8307}
8308
8309proc highlightfile_for_scrollpos {topidx} {
8310    global cmitmode difffilestart
8311
8312    if {$cmitmode eq "tree"} return
8313    if {![info exists difffilestart]} return
8314
8315    set top [lindex [split $topidx .] 0]
8316    if {$difffilestart eq {} || $top < [lindex $difffilestart 0]} {
8317        highlightfile 0
8318    } else {
8319        highlightfile [expr {[bsearch $difffilestart $top] + 2}]
8320    }
8321}
8322
8323proc prevfile {} {
8324    global difffilestart ctext cmitmode
8325
8326    if {$cmitmode eq "tree"} return
8327    set prev 0.0
8328    set here [$ctext index @0,0]
8329    foreach loc $difffilestart {
8330        if {[$ctext compare $loc >= $here]} {
8331            $ctext yview $prev
8332            return
8333        }
8334        set prev $loc
8335    }
8336    $ctext yview $prev
8337}
8338
8339proc nextfile {} {
8340    global difffilestart ctext cmitmode
8341
8342    if {$cmitmode eq "tree"} return
8343    set here [$ctext index @0,0]
8344    foreach loc $difffilestart {
8345        if {[$ctext compare $loc > $here]} {
8346            $ctext yview $loc
8347            return
8348        }
8349    }
8350}
8351
8352proc clear_ctext {{first 1.0}} {
8353    global ctext smarktop smarkbot
8354    global ctext_file_names ctext_file_lines
8355    global pendinglinks
8356
8357    set l [lindex [split $first .] 0]
8358    if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
8359        set smarktop $l
8360    }
8361    if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
8362        set smarkbot $l
8363    }
8364    $ctext delete $first end
8365    if {$first eq "1.0"} {
8366        unset -nocomplain pendinglinks
8367    }
8368    set ctext_file_names {}
8369    set ctext_file_lines {}
8370}
8371
8372proc settabs {{firstab {}}} {
8373    global firsttabstop tabstop ctext have_tk85
8374
8375    if {$firstab ne {} && $have_tk85} {
8376        set firsttabstop $firstab
8377    }
8378    set w [font measure textfont "0"]
8379    if {$firsttabstop != 0} {
8380        $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
8381                               [expr {($firsttabstop + 2 * $tabstop) * $w}]]
8382    } elseif {$have_tk85 || $tabstop != 8} {
8383        $ctext conf -tabs [expr {$tabstop * $w}]
8384    } else {
8385        $ctext conf -tabs {}
8386    }
8387}
8388
8389proc incrsearch {name ix op} {
8390    global ctext searchstring searchdirn
8391
8392    if {[catch {$ctext index anchor}]} {
8393        # no anchor set, use start of selection, or of visible area
8394        set sel [$ctext tag ranges sel]
8395        if {$sel ne {}} {
8396            $ctext mark set anchor [lindex $sel 0]
8397        } elseif {$searchdirn eq "-forwards"} {
8398            $ctext mark set anchor @0,0
8399        } else {
8400            $ctext mark set anchor @0,[winfo height $ctext]
8401        }
8402    }
8403    if {$searchstring ne {}} {
8404        set here [$ctext search -count mlen $searchdirn -- $searchstring anchor]
8405        if {$here ne {}} {
8406            $ctext see $here
8407            set mend "$here + $mlen c"
8408            $ctext tag remove sel 1.0 end
8409            $ctext tag add sel $here $mend
8410            suppress_highlighting_file_for_current_scrollpos
8411            highlightfile_for_scrollpos $here
8412        }
8413    }
8414    rehighlight_search_results
8415}
8416
8417proc dosearch {} {
8418    global sstring ctext searchstring searchdirn
8419
8420    focus $sstring
8421    $sstring icursor end
8422    set searchdirn -forwards
8423    if {$searchstring ne {}} {
8424        set sel [$ctext tag ranges sel]
8425        if {$sel ne {}} {
8426            set start "[lindex $sel 0] + 1c"
8427        } elseif {[catch {set start [$ctext index anchor]}]} {
8428            set start "@0,0"
8429        }
8430        set match [$ctext search -count mlen -- $searchstring $start]
8431        $ctext tag remove sel 1.0 end
8432        if {$match eq {}} {
8433            bell
8434            return
8435        }
8436        $ctext see $match
8437        suppress_highlighting_file_for_current_scrollpos
8438        highlightfile_for_scrollpos $match
8439        set mend "$match + $mlen c"
8440        $ctext tag add sel $match $mend
8441        $ctext mark unset anchor
8442        rehighlight_search_results
8443    }
8444}
8445
8446proc dosearchback {} {
8447    global sstring ctext searchstring searchdirn
8448
8449    focus $sstring
8450    $sstring icursor end
8451    set searchdirn -backwards
8452    if {$searchstring ne {}} {
8453        set sel [$ctext tag ranges sel]
8454        if {$sel ne {}} {
8455            set start [lindex $sel 0]
8456        } elseif {[catch {set start [$ctext index anchor]}]} {
8457            set start @0,[winfo height $ctext]
8458        }
8459        set match [$ctext search -backwards -count ml -- $searchstring $start]
8460        $ctext tag remove sel 1.0 end
8461        if {$match eq {}} {
8462            bell
8463            return
8464        }
8465        $ctext see $match
8466        suppress_highlighting_file_for_current_scrollpos
8467        highlightfile_for_scrollpos $match
8468        set mend "$match + $ml c"
8469        $ctext tag add sel $match $mend
8470        $ctext mark unset anchor
8471        rehighlight_search_results
8472    }
8473}
8474
8475proc rehighlight_search_results {} {
8476    global ctext searchstring
8477
8478    $ctext tag remove found 1.0 end
8479    $ctext tag remove currentsearchhit 1.0 end
8480
8481    if {$searchstring ne {}} {
8482        searchmarkvisible 1
8483    }
8484}
8485
8486proc searchmark {first last} {
8487    global ctext searchstring
8488
8489    set sel [$ctext tag ranges sel]
8490
8491    set mend $first.0
8492    while {1} {
8493        set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8494        if {$match eq {}} break
8495        set mend "$match + $mlen c"
8496        if {$sel ne {} && [$ctext compare $match == [lindex $sel 0]]} {
8497            $ctext tag add currentsearchhit $match $mend
8498        } else {
8499            $ctext tag add found $match $mend
8500        }
8501    }
8502}
8503
8504proc searchmarkvisible {doall} {
8505    global ctext smarktop smarkbot
8506
8507    set topline [lindex [split [$ctext index @0,0] .] 0]
8508    set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8509    if {$doall || $botline < $smarktop || $topline > $smarkbot} {
8510        # no overlap with previous
8511        searchmark $topline $botline
8512        set smarktop $topline
8513        set smarkbot $botline
8514    } else {
8515        if {$topline < $smarktop} {
8516            searchmark $topline [expr {$smarktop-1}]
8517            set smarktop $topline
8518        }
8519        if {$botline > $smarkbot} {
8520            searchmark [expr {$smarkbot+1}] $botline
8521            set smarkbot $botline
8522        }
8523    }
8524}
8525
8526proc suppress_highlighting_file_for_current_scrollpos {} {
8527    global ctext suppress_highlighting_file_for_this_scrollpos
8528
8529    set suppress_highlighting_file_for_this_scrollpos [$ctext index @0,0]
8530}
8531
8532proc scrolltext {f0 f1} {
8533    global searchstring cmitmode ctext
8534    global suppress_highlighting_file_for_this_scrollpos
8535
8536    set topidx [$ctext index @0,0]
8537    if {![info exists suppress_highlighting_file_for_this_scrollpos]
8538        || $topidx ne $suppress_highlighting_file_for_this_scrollpos} {
8539        highlightfile_for_scrollpos $topidx
8540    }
8541
8542    unset -nocomplain suppress_highlighting_file_for_this_scrollpos
8543
8544    .bleft.bottom.sb set $f0 $f1
8545    if {$searchstring ne {}} {
8546        searchmarkvisible 0
8547    }
8548}
8549
8550proc setcoords {} {
8551    global linespc charspc canvx0 canvy0
8552    global xspc1 xspc2 lthickness
8553
8554    set linespc [font metrics mainfont -linespace]
8555    set charspc [font measure mainfont "m"]
8556    set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8557    set canvx0 [expr {int(3 + 0.5 * $linespc)}]
8558    set lthickness [expr {int($linespc / 9) + 1}]
8559    set xspc1(0) $linespc
8560    set xspc2 $linespc
8561}
8562
8563proc redisplay {} {
8564    global canv
8565    global selectedline
8566
8567    set ymax [lindex [$canv cget -scrollregion] 3]
8568    if {$ymax eq {} || $ymax == 0} return
8569    set span [$canv yview]
8570    clear_display
8571    setcanvscroll
8572    allcanvs yview moveto [lindex $span 0]
8573    drawvisible
8574    if {$selectedline ne {}} {
8575        selectline $selectedline 0
8576        allcanvs yview moveto [lindex $span 0]
8577    }
8578}
8579
8580proc parsefont {f n} {
8581    global fontattr
8582
8583    set fontattr($f,family) [lindex $n 0]
8584    set s [lindex $n 1]
8585    if {$s eq {} || $s == 0} {
8586        set s 10
8587    } elseif {$s < 0} {
8588        set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
8589    }
8590    set fontattr($f,size) $s
8591    set fontattr($f,weight) normal
8592    set fontattr($f,slant) roman
8593    foreach style [lrange $n 2 end] {
8594        switch -- $style {
8595            "normal" -
8596            "bold"   {set fontattr($f,weight) $style}
8597            "roman" -
8598            "italic" {set fontattr($f,slant) $style}
8599        }
8600    }
8601}
8602
8603proc fontflags {f {isbold 0}} {
8604    global fontattr
8605
8606    return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8607                -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8608                -slant $fontattr($f,slant)]
8609}
8610
8611proc fontname {f} {
8612    global fontattr
8613
8614    set n [list $fontattr($f,family) $fontattr($f,size)]
8615    if {$fontattr($f,weight) eq "bold"} {
8616        lappend n "bold"
8617    }
8618    if {$fontattr($f,slant) eq "italic"} {
8619        lappend n "italic"
8620    }
8621    return $n
8622}
8623
8624proc incrfont {inc} {
8625    global mainfont textfont ctext canv cflist showrefstop
8626    global stopped entries fontattr
8627
8628    unmarkmatches
8629    set s $fontattr(mainfont,size)
8630    incr s $inc
8631    if {$s < 1} {
8632        set s 1
8633    }
8634    set fontattr(mainfont,size) $s
8635    font config mainfont -size $s
8636    font config mainfontbold -size $s
8637    set mainfont [fontname mainfont]
8638    set s $fontattr(textfont,size)
8639    incr s $inc
8640    if {$s < 1} {
8641        set s 1
8642    }
8643    set fontattr(textfont,size) $s
8644    font config textfont -size $s
8645    font config textfontbold -size $s
8646    set textfont [fontname textfont]
8647    setcoords
8648    settabs
8649    redisplay
8650}
8651
8652proc clearsha1 {} {
8653    global sha1entry sha1string
8654    if {[string length $sha1string] == 40} {
8655        $sha1entry delete 0 end
8656    }
8657}
8658
8659proc sha1change {n1 n2 op} {
8660    global sha1string currentid sha1but
8661    if {$sha1string == {}
8662        || ([info exists currentid] && $sha1string == $currentid)} {
8663        set state disabled
8664    } else {
8665        set state normal
8666    }
8667    if {[$sha1but cget -state] == $state} return
8668    if {$state == "normal"} {
8669        $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
8670    } else {
8671        $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
8672    }
8673}
8674
8675proc gotocommit {} {
8676    global sha1string tagids headids curview varcid
8677
8678    if {$sha1string == {}
8679        || ([info exists currentid] && $sha1string == $currentid)} return
8680    if {[info exists tagids($sha1string)]} {
8681        set id $tagids($sha1string)
8682    } elseif {[info exists headids($sha1string)]} {
8683        set id $headids($sha1string)
8684    } else {
8685        set id [string tolower $sha1string]
8686        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
8687            set matches [longid $id]
8688            if {$matches ne {}} {
8689                if {[llength $matches] > 1} {
8690                    error_popup [mc "Short SHA1 id %s is ambiguous" $id]
8691                    return
8692                }
8693                set id [lindex $matches 0]
8694            }
8695        } else {
8696            if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8697                error_popup [mc "Revision %s is not known" $sha1string]
8698                return
8699            }
8700        }
8701    }
8702    if {[commitinview $id $curview]} {
8703        selectline [rowofcommit $id] 1
8704        return
8705    }
8706    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
8707        set msg [mc "SHA1 id %s is not known" $sha1string]
8708    } else {
8709        set msg [mc "Revision %s is not in the current view" $sha1string]
8710    }
8711    error_popup $msg
8712}
8713
8714proc lineenter {x y id} {
8715    global hoverx hovery hoverid hovertimer
8716    global commitinfo canv
8717
8718    if {![info exists commitinfo($id)] && ![getcommit $id]} return
8719    set hoverx $x
8720    set hovery $y
8721    set hoverid $id
8722    if {[info exists hovertimer]} {
8723        after cancel $hovertimer
8724    }
8725    set hovertimer [after 500 linehover]
8726    $canv delete hover
8727}
8728
8729proc linemotion {x y id} {
8730    global hoverx hovery hoverid hovertimer
8731
8732    if {[info exists hoverid] && $id == $hoverid} {
8733        set hoverx $x
8734        set hovery $y
8735        if {[info exists hovertimer]} {
8736            after cancel $hovertimer
8737        }
8738        set hovertimer [after 500 linehover]
8739    }
8740}
8741
8742proc lineleave {id} {
8743    global hoverid hovertimer canv
8744
8745    if {[info exists hoverid] && $id == $hoverid} {
8746        $canv delete hover
8747        if {[info exists hovertimer]} {
8748            after cancel $hovertimer
8749            unset hovertimer
8750        }
8751        unset hoverid
8752    }
8753}
8754
8755proc linehover {} {
8756    global hoverx hovery hoverid hovertimer
8757    global canv linespc lthickness
8758    global linehoverbgcolor linehoverfgcolor linehoveroutlinecolor
8759
8760    global commitinfo
8761
8762    set text [lindex $commitinfo($hoverid) 0]
8763    set ymax [lindex [$canv cget -scrollregion] 3]
8764    if {$ymax == {}} return
8765    set yfrac [lindex [$canv yview] 0]
8766    set x [expr {$hoverx + 2 * $linespc}]
8767    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8768    set x0 [expr {$x - 2 * $lthickness}]
8769    set y0 [expr {$y - 2 * $lthickness}]
8770    set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
8771    set y1 [expr {$y + $linespc + 2 * $lthickness}]
8772    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8773               -fill $linehoverbgcolor -outline $linehoveroutlinecolor \
8774               -width 1 -tags hover]
8775    $canv raise $t
8776    set t [$canv create text $x $y -anchor nw -text $text -tags hover \
8777               -font mainfont -fill $linehoverfgcolor]
8778    $canv raise $t
8779}
8780
8781proc clickisonarrow {id y} {
8782    global lthickness
8783
8784    set ranges [rowranges $id]
8785    set thresh [expr {2 * $lthickness + 6}]
8786    set n [expr {[llength $ranges] - 1}]
8787    for {set i 1} {$i < $n} {incr i} {
8788        set row [lindex $ranges $i]
8789        if {abs([yc $row] - $y) < $thresh} {
8790            return $i
8791        }
8792    }
8793    return {}
8794}
8795
8796proc arrowjump {id n y} {
8797    global canv
8798
8799    # 1 <-> 2, 3 <-> 4, etc...
8800    set n [expr {(($n - 1) ^ 1) + 1}]
8801    set row [lindex [rowranges $id] $n]
8802    set yt [yc $row]
8803    set ymax [lindex [$canv cget -scrollregion] 3]
8804    if {$ymax eq {} || $ymax <= 0} return
8805    set view [$canv yview]
8806    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8807    set yfrac [expr {$yt / $ymax - $yspan / 2}]
8808    if {$yfrac < 0} {
8809        set yfrac 0
8810    }
8811    allcanvs yview moveto $yfrac
8812}
8813
8814proc lineclick {x y id isnew} {
8815    global ctext commitinfo children canv thickerline curview
8816
8817    if {![info exists commitinfo($id)] && ![getcommit $id]} return
8818    unmarkmatches
8819    unselectline
8820    normalline
8821    $canv delete hover
8822    # draw this line thicker than normal
8823    set thickerline $id
8824    drawlines $id
8825    if {$isnew} {
8826        set ymax [lindex [$canv cget -scrollregion] 3]
8827        if {$ymax eq {}} return
8828        set yfrac [lindex [$canv yview] 0]
8829        set y [expr {$y + $yfrac * $ymax}]
8830    }
8831    set dirn [clickisonarrow $id $y]
8832    if {$dirn ne {}} {
8833        arrowjump $id $dirn $y
8834        return
8835    }
8836
8837    if {$isnew} {
8838        addtohistory [list lineclick $x $y $id 0] savectextpos
8839    }
8840    # fill the details pane with info about this line
8841    $ctext conf -state normal
8842    clear_ctext
8843    settabs 0
8844    $ctext insert end "[mc "Parent"]:\t"
8845    $ctext insert end $id link0
8846    setlink $id link0
8847    set info $commitinfo($id)
8848    $ctext insert end "\n\t[lindex $info 0]\n"
8849    $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8850    set date [formatdate [lindex $info 2]]
8851    $ctext insert end "\t[mc "Date"]:\t$date\n"
8852    set kids $children($curview,$id)
8853    if {$kids ne {}} {
8854        $ctext insert end "\n[mc "Children"]:"
8855        set i 0
8856        foreach child $kids {
8857            incr i
8858            if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8859            set info $commitinfo($child)
8860            $ctext insert end "\n\t"
8861            $ctext insert end $child link$i
8862            setlink $child link$i
8863            $ctext insert end "\n\t[lindex $info 0]"
8864            $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8865            set date [formatdate [lindex $info 2]]
8866            $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8867        }
8868    }
8869    maybe_scroll_ctext 1
8870    $ctext conf -state disabled
8871    init_flist {}
8872}
8873
8874proc normalline {} {
8875    global thickerline
8876    if {[info exists thickerline]} {
8877        set id $thickerline
8878        unset thickerline
8879        drawlines $id
8880    }
8881}
8882
8883proc selbyid {id {isnew 1}} {
8884    global curview
8885    if {[commitinview $id $curview]} {
8886        selectline [rowofcommit $id] $isnew
8887    }
8888}
8889
8890proc mstime {} {
8891    global startmstime
8892    if {![info exists startmstime]} {
8893        set startmstime [clock clicks -milliseconds]
8894    }
8895    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8896}
8897
8898proc rowmenu {x y id} {
8899    global rowctxmenu selectedline rowmenuid curview
8900    global nullid nullid2 fakerowmenu mainhead markedid
8901
8902    stopfinding
8903    set rowmenuid $id
8904    if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8905        set state disabled
8906    } else {
8907        set state normal
8908    }
8909    if {[info exists markedid] && $markedid ne $id} {
8910        set mstate normal
8911    } else {
8912        set mstate disabled
8913    }
8914    if {$id ne $nullid && $id ne $nullid2} {
8915        set menu $rowctxmenu
8916        if {$mainhead ne {}} {
8917            $menu entryconfigure 8 -label [mc "Reset %s branch to here" $mainhead] -state normal
8918        } else {
8919            $menu entryconfigure 8 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8920        }
8921        $menu entryconfigure 10 -state $mstate
8922        $menu entryconfigure 11 -state $mstate
8923        $menu entryconfigure 12 -state $mstate
8924    } else {
8925        set menu $fakerowmenu
8926    }
8927    $menu entryconfigure [mca "Diff this -> selected"] -state $state
8928    $menu entryconfigure [mca "Diff selected -> this"] -state $state
8929    $menu entryconfigure [mca "Make patch"] -state $state
8930    $menu entryconfigure [mca "Diff this -> marked commit"] -state $mstate
8931    $menu entryconfigure [mca "Diff marked commit -> this"] -state $mstate
8932    tk_popup $menu $x $y
8933}
8934
8935proc markhere {} {
8936    global rowmenuid markedid canv
8937
8938    set markedid $rowmenuid
8939    make_idmark $markedid
8940}
8941
8942proc gotomark {} {
8943    global markedid
8944
8945    if {[info exists markedid]} {
8946        selbyid $markedid
8947    }
8948}
8949
8950proc replace_by_kids {l r} {
8951    global curview children
8952
8953    set id [commitonrow $r]
8954    set l [lreplace $l 0 0]
8955    foreach kid $children($curview,$id) {
8956        lappend l [rowofcommit $kid]
8957    }
8958    return [lsort -integer -decreasing -unique $l]
8959}
8960
8961proc find_common_desc {} {
8962    global markedid rowmenuid curview children
8963
8964    if {![info exists markedid]} return
8965    if {![commitinview $markedid $curview] ||
8966        ![commitinview $rowmenuid $curview]} return
8967    #set t1 [clock clicks -milliseconds]
8968    set l1 [list [rowofcommit $markedid]]
8969    set l2 [list [rowofcommit $rowmenuid]]
8970    while 1 {
8971        set r1 [lindex $l1 0]
8972        set r2 [lindex $l2 0]
8973        if {$r1 eq {} || $r2 eq {}} break
8974        if {$r1 == $r2} {
8975            selectline $r1 1
8976            break
8977        }
8978        if {$r1 > $r2} {
8979            set l1 [replace_by_kids $l1 $r1]
8980        } else {
8981            set l2 [replace_by_kids $l2 $r2]
8982        }
8983    }
8984    #set t2 [clock clicks -milliseconds]
8985    #puts "took [expr {$t2-$t1}]ms"
8986}
8987
8988proc compare_commits {} {
8989    global markedid rowmenuid curview children
8990
8991    if {![info exists markedid]} return
8992    if {![commitinview $markedid $curview]} return
8993    addtohistory [list do_cmp_commits $markedid $rowmenuid]
8994    do_cmp_commits $markedid $rowmenuid
8995}
8996
8997proc getpatchid {id} {
8998    global patchids
8999
9000    if {![info exists patchids($id)]} {
9001        set cmd [diffcmd [list $id] {-p --root}]
9002        # trim off the initial "|"
9003        set cmd [lrange $cmd 1 end]
9004        if {[catch {
9005            set x [eval exec $cmd | git patch-id]
9006            set patchids($id) [lindex $x 0]
9007        }]} {
9008            set patchids($id) "error"
9009        }
9010    }
9011    return $patchids($id)
9012}
9013
9014proc do_cmp_commits {a b} {
9015    global ctext curview parents children patchids commitinfo
9016
9017    $ctext conf -state normal
9018    clear_ctext
9019    init_flist {}
9020    for {set i 0} {$i < 100} {incr i} {
9021        set skipa 0
9022        set skipb 0
9023        if {[llength $parents($curview,$a)] > 1} {
9024            appendshortlink $a [mc "Skipping merge commit "] "\n"
9025            set skipa 1
9026        } else {
9027            set patcha [getpatchid $a]
9028        }
9029        if {[llength $parents($curview,$b)] > 1} {
9030            appendshortlink $b [mc "Skipping merge commit "] "\n"
9031            set skipb 1
9032        } else {
9033            set patchb [getpatchid $b]
9034        }
9035        if {!$skipa && !$skipb} {
9036            set heada [lindex $commitinfo($a) 0]
9037            set headb [lindex $commitinfo($b) 0]
9038            if {$patcha eq "error"} {
9039                appendshortlink $a [mc "Error getting patch ID for "] \
9040                    [mc " - stopping\n"]
9041                break
9042            }
9043            if {$patchb eq "error"} {
9044                appendshortlink $b [mc "Error getting patch ID for "] \
9045                    [mc " - stopping\n"]
9046                break
9047            }
9048            if {$patcha eq $patchb} {
9049                if {$heada eq $headb} {
9050                    appendshortlink $a [mc "Commit "]
9051                    appendshortlink $b " == " "  $heada\n"
9052                } else {
9053                    appendshortlink $a [mc "Commit "] "  $heada\n"
9054                    appendshortlink $b [mc " is the same patch as\n       "] \
9055                        "  $headb\n"
9056                }
9057                set skipa 1
9058                set skipb 1
9059            } else {
9060                $ctext insert end "\n"
9061                appendshortlink $a [mc "Commit "] "  $heada\n"
9062                appendshortlink $b [mc " differs from\n       "] \
9063                    "  $headb\n"
9064                $ctext insert end [mc "Diff of commits:\n\n"]
9065                $ctext conf -state disabled
9066                update
9067                diffcommits $a $b
9068                return
9069            }
9070        }
9071        if {$skipa} {
9072            set kids [real_children $curview,$a]
9073            if {[llength $kids] != 1} {
9074                $ctext insert end "\n"
9075                appendshortlink $a [mc "Commit "] \
9076                    [mc " has %s children - stopping\n" [llength $kids]]
9077                break
9078            }
9079            set a [lindex $kids 0]
9080        }
9081        if {$skipb} {
9082            set kids [real_children $curview,$b]
9083            if {[llength $kids] != 1} {
9084                appendshortlink $b [mc "Commit "] \
9085                    [mc " has %s children - stopping\n" [llength $kids]]
9086                break
9087            }
9088            set b [lindex $kids 0]
9089        }
9090    }
9091    $ctext conf -state disabled
9092}
9093
9094proc diffcommits {a b} {
9095    global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
9096
9097    set tmpdir [gitknewtmpdir]
9098    set fna [file join $tmpdir "commit-[string range $a 0 7]"]
9099    set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
9100    if {[catch {
9101        exec git diff-tree -p --pretty $a >$fna
9102        exec git diff-tree -p --pretty $b >$fnb
9103    } err]} {
9104        error_popup [mc "Error writing commit to file: %s" $err]
9105        return
9106    }
9107    if {[catch {
9108        set fd [open "| diff -U$diffcontext $fna $fnb" r]
9109    } err]} {
9110        error_popup [mc "Error diffing commits: %s" $err]
9111        return
9112    }
9113    set diffids [list commits $a $b]
9114    set blobdifffd($diffids) $fd
9115    set diffinhdr 0
9116    set currdiffsubmod ""
9117    filerun $fd [list getblobdiffline $fd $diffids]
9118}
9119
9120proc diffvssel {dirn} {
9121    global rowmenuid selectedline
9122
9123    if {$selectedline eq {}} return
9124    if {$dirn} {
9125        set oldid [commitonrow $selectedline]
9126        set newid $rowmenuid
9127    } else {
9128        set oldid $rowmenuid
9129        set newid [commitonrow $selectedline]
9130    }
9131    addtohistory [list doseldiff $oldid $newid] savectextpos
9132    doseldiff $oldid $newid
9133}
9134
9135proc diffvsmark {dirn} {
9136    global rowmenuid markedid
9137
9138    if {![info exists markedid]} return
9139    if {$dirn} {
9140        set oldid $markedid
9141        set newid $rowmenuid
9142    } else {
9143        set oldid $rowmenuid
9144        set newid $markedid
9145    }
9146    addtohistory [list doseldiff $oldid $newid] savectextpos
9147    doseldiff $oldid $newid
9148}
9149
9150proc doseldiff {oldid newid} {
9151    global ctext
9152    global commitinfo
9153
9154    $ctext conf -state normal
9155    clear_ctext
9156    init_flist [mc "Top"]
9157    $ctext insert end "[mc "From"] "
9158    $ctext insert end $oldid link0
9159    setlink $oldid link0
9160    $ctext insert end "\n     "
9161    $ctext insert end [lindex $commitinfo($oldid) 0]
9162    $ctext insert end "\n\n[mc "To"]   "
9163    $ctext insert end $newid link1
9164    setlink $newid link1
9165    $ctext insert end "\n     "
9166    $ctext insert end [lindex $commitinfo($newid) 0]
9167    $ctext insert end "\n"
9168    $ctext conf -state disabled
9169    $ctext tag remove found 1.0 end
9170    startdiff [list $oldid $newid]
9171}
9172
9173proc mkpatch {} {
9174    global rowmenuid currentid commitinfo patchtop patchnum NS
9175
9176    if {![info exists currentid]} return
9177    set oldid $currentid
9178    set oldhead [lindex $commitinfo($oldid) 0]
9179    set newid $rowmenuid
9180    set newhead [lindex $commitinfo($newid) 0]
9181    set top .patch
9182    set patchtop $top
9183    catch {destroy $top}
9184    ttk_toplevel $top
9185    make_transient $top .
9186    ${NS}::label $top.title -text [mc "Generate patch"]
9187    grid $top.title - -pady 10
9188    ${NS}::label $top.from -text [mc "From:"]
9189    ${NS}::entry $top.fromsha1 -width 40
9190    $top.fromsha1 insert 0 $oldid
9191    $top.fromsha1 conf -state readonly
9192    grid $top.from $top.fromsha1 -sticky w
9193    ${NS}::entry $top.fromhead -width 60
9194    $top.fromhead insert 0 $oldhead
9195    $top.fromhead conf -state readonly
9196    grid x $top.fromhead -sticky w
9197    ${NS}::label $top.to -text [mc "To:"]
9198    ${NS}::entry $top.tosha1 -width 40
9199    $top.tosha1 insert 0 $newid
9200    $top.tosha1 conf -state readonly
9201    grid $top.to $top.tosha1 -sticky w
9202    ${NS}::entry $top.tohead -width 60
9203    $top.tohead insert 0 $newhead
9204    $top.tohead conf -state readonly
9205    grid x $top.tohead -sticky w
9206    ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
9207    grid $top.rev x -pady 10 -padx 5
9208    ${NS}::label $top.flab -text [mc "Output file:"]
9209    ${NS}::entry $top.fname -width 60
9210    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
9211    incr patchnum
9212    grid $top.flab $top.fname -sticky w
9213    ${NS}::frame $top.buts
9214    ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
9215    ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
9216    bind $top <Key-Return> mkpatchgo
9217    bind $top <Key-Escape> mkpatchcan
9218    grid $top.buts.gen $top.buts.can
9219    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9220    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9221    grid $top.buts - -pady 10 -sticky ew
9222    focus $top.fname
9223}
9224
9225proc mkpatchrev {} {
9226    global patchtop
9227
9228    set oldid [$patchtop.fromsha1 get]
9229    set oldhead [$patchtop.fromhead get]
9230    set newid [$patchtop.tosha1 get]
9231    set newhead [$patchtop.tohead get]
9232    foreach e [list fromsha1 fromhead tosha1 tohead] \
9233            v [list $newid $newhead $oldid $oldhead] {
9234        $patchtop.$e conf -state normal
9235        $patchtop.$e delete 0 end
9236        $patchtop.$e insert 0 $v
9237        $patchtop.$e conf -state readonly
9238    }
9239}
9240
9241proc mkpatchgo {} {
9242    global patchtop nullid nullid2
9243
9244    set oldid [$patchtop.fromsha1 get]
9245    set newid [$patchtop.tosha1 get]
9246    set fname [$patchtop.fname get]
9247    set cmd [diffcmd [list $oldid $newid] -p]
9248    # trim off the initial "|"
9249    set cmd [lrange $cmd 1 end]
9250    lappend cmd >$fname &
9251    if {[catch {eval exec $cmd} err]} {
9252        error_popup "[mc "Error creating patch:"] $err" $patchtop
9253    }
9254    catch {destroy $patchtop}
9255    unset patchtop
9256}
9257
9258proc mkpatchcan {} {
9259    global patchtop
9260
9261    catch {destroy $patchtop}
9262    unset patchtop
9263}
9264
9265proc mktag {} {
9266    global rowmenuid mktagtop commitinfo NS
9267
9268    set top .maketag
9269    set mktagtop $top
9270    catch {destroy $top}
9271    ttk_toplevel $top
9272    make_transient $top .
9273    ${NS}::label $top.title -text [mc "Create tag"]
9274    grid $top.title - -pady 10
9275    ${NS}::label $top.id -text [mc "ID:"]
9276    ${NS}::entry $top.sha1 -width 40
9277    $top.sha1 insert 0 $rowmenuid
9278    $top.sha1 conf -state readonly
9279    grid $top.id $top.sha1 -sticky w
9280    ${NS}::entry $top.head -width 60
9281    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9282    $top.head conf -state readonly
9283    grid x $top.head -sticky w
9284    ${NS}::label $top.tlab -text [mc "Tag name:"]
9285    ${NS}::entry $top.tag -width 60
9286    grid $top.tlab $top.tag -sticky w
9287    ${NS}::label $top.op -text [mc "Tag message is optional"]
9288    grid $top.op -columnspan 2 -sticky we
9289    ${NS}::label $top.mlab -text [mc "Tag message:"]
9290    ${NS}::entry $top.msg -width 60
9291    grid $top.mlab $top.msg -sticky w
9292    ${NS}::frame $top.buts
9293    ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
9294    ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
9295    bind $top <Key-Return> mktaggo
9296    bind $top <Key-Escape> mktagcan
9297    grid $top.buts.gen $top.buts.can
9298    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9299    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9300    grid $top.buts - -pady 10 -sticky ew
9301    focus $top.tag
9302}
9303
9304proc domktag {} {
9305    global mktagtop env tagids idtags
9306
9307    set id [$mktagtop.sha1 get]
9308    set tag [$mktagtop.tag get]
9309    set msg [$mktagtop.msg get]
9310    if {$tag == {}} {
9311        error_popup [mc "No tag name specified"] $mktagtop
9312        return 0
9313    }
9314    if {[info exists tagids($tag)]} {
9315        error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
9316        return 0
9317    }
9318    if {[catch {
9319        if {$msg != {}} {
9320            exec git tag -a -m $msg $tag $id
9321        } else {
9322            exec git tag $tag $id
9323        }
9324    } err]} {
9325        error_popup "[mc "Error creating tag:"] $err" $mktagtop
9326        return 0
9327    }
9328
9329    set tagids($tag) $id
9330    lappend idtags($id) $tag
9331    redrawtags $id
9332    addedtag $id
9333    dispneartags 0
9334    run refill_reflist
9335    return 1
9336}
9337
9338proc redrawtags {id} {
9339    global canv linehtag idpos currentid curview cmitlisted markedid
9340    global canvxmax iddrawn circleitem mainheadid circlecolors
9341    global mainheadcirclecolor
9342
9343    if {![commitinview $id $curview]} return
9344    if {![info exists iddrawn($id)]} return
9345    set row [rowofcommit $id]
9346    if {$id eq $mainheadid} {
9347        set ofill $mainheadcirclecolor
9348    } else {
9349        set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
9350    }
9351    $canv itemconf $circleitem($row) -fill $ofill
9352    $canv delete tag.$id
9353    set xt [eval drawtags $id $idpos($id)]
9354    $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
9355    set text [$canv itemcget $linehtag($id) -text]
9356    set font [$canv itemcget $linehtag($id) -font]
9357    set xr [expr {$xt + [font measure $font $text]}]
9358    if {$xr > $canvxmax} {
9359        set canvxmax $xr
9360        setcanvscroll
9361    }
9362    if {[info exists currentid] && $currentid == $id} {
9363        make_secsel $id
9364    }
9365    if {[info exists markedid] && $markedid eq $id} {
9366        make_idmark $id
9367    }
9368}
9369
9370proc mktagcan {} {
9371    global mktagtop
9372
9373    catch {destroy $mktagtop}
9374    unset mktagtop
9375}
9376
9377proc mktaggo {} {
9378    if {![domktag]} return
9379    mktagcan
9380}
9381
9382proc copysummary {} {
9383    global rowmenuid autosellen
9384
9385    set format "%h (\"%s\", %ad)"
9386    set cmd [list git show -s --pretty=format:$format --date=short]
9387    if {$autosellen < 40} {
9388        lappend cmd --abbrev=$autosellen
9389    }
9390    set summary [eval exec $cmd $rowmenuid]
9391
9392    clipboard clear
9393    clipboard append $summary
9394}
9395
9396proc writecommit {} {
9397    global rowmenuid wrcomtop commitinfo wrcomcmd NS
9398
9399    set top .writecommit
9400    set wrcomtop $top
9401    catch {destroy $top}
9402    ttk_toplevel $top
9403    make_transient $top .
9404    ${NS}::label $top.title -text [mc "Write commit to file"]
9405    grid $top.title - -pady 10
9406    ${NS}::label $top.id -text [mc "ID:"]
9407    ${NS}::entry $top.sha1 -width 40
9408    $top.sha1 insert 0 $rowmenuid
9409    $top.sha1 conf -state readonly
9410    grid $top.id $top.sha1 -sticky w
9411    ${NS}::entry $top.head -width 60
9412    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9413    $top.head conf -state readonly
9414    grid x $top.head -sticky w
9415    ${NS}::label $top.clab -text [mc "Command:"]
9416    ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
9417    grid $top.clab $top.cmd -sticky w -pady 10
9418    ${NS}::label $top.flab -text [mc "Output file:"]
9419    ${NS}::entry $top.fname -width 60
9420    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
9421    grid $top.flab $top.fname -sticky w
9422    ${NS}::frame $top.buts
9423    ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
9424    ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
9425    bind $top <Key-Return> wrcomgo
9426    bind $top <Key-Escape> wrcomcan
9427    grid $top.buts.gen $top.buts.can
9428    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9429    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9430    grid $top.buts - -pady 10 -sticky ew
9431    focus $top.fname
9432}
9433
9434proc wrcomgo {} {
9435    global wrcomtop
9436
9437    set id [$wrcomtop.sha1 get]
9438    set cmd "echo $id | [$wrcomtop.cmd get]"
9439    set fname [$wrcomtop.fname get]
9440    if {[catch {exec sh -c $cmd >$fname &} err]} {
9441        error_popup "[mc "Error writing commit:"] $err" $wrcomtop
9442    }
9443    catch {destroy $wrcomtop}
9444    unset wrcomtop
9445}
9446
9447proc wrcomcan {} {
9448    global wrcomtop
9449
9450    catch {destroy $wrcomtop}
9451    unset wrcomtop
9452}
9453
9454proc mkbranch {} {
9455    global rowmenuid mkbrtop NS
9456
9457    set top .makebranch
9458    catch {destroy $top}
9459    ttk_toplevel $top
9460    make_transient $top .
9461    ${NS}::label $top.title -text [mc "Create new branch"]
9462    grid $top.title - -pady 10
9463    ${NS}::label $top.id -text [mc "ID:"]
9464    ${NS}::entry $top.sha1 -width 40
9465    $top.sha1 insert 0 $rowmenuid
9466    $top.sha1 conf -state readonly
9467    grid $top.id $top.sha1 -sticky w
9468    ${NS}::label $top.nlab -text [mc "Name:"]
9469    ${NS}::entry $top.name -width 40
9470    grid $top.nlab $top.name -sticky w
9471    ${NS}::frame $top.buts
9472    ${NS}::button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
9473    ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
9474    bind $top <Key-Return> [list mkbrgo $top]
9475    bind $top <Key-Escape> "catch {destroy $top}"
9476    grid $top.buts.go $top.buts.can
9477    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9478    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9479    grid $top.buts - -pady 10 -sticky ew
9480    focus $top.name
9481}
9482
9483proc mkbrgo {top} {
9484    global headids idheads
9485
9486    set name [$top.name get]
9487    set id [$top.sha1 get]
9488    set cmdargs {}
9489    set old_id {}
9490    if {$name eq {}} {
9491        error_popup [mc "Please specify a name for the new branch"] $top
9492        return
9493    }
9494    if {[info exists headids($name)]} {
9495        if {![confirm_popup [mc \
9496                "Branch '%s' already exists. Overwrite?" $name] $top]} {
9497            return
9498        }
9499        set old_id $headids($name)
9500        lappend cmdargs -f
9501    }
9502    catch {destroy $top}
9503    lappend cmdargs $name $id
9504    nowbusy newbranch
9505    update
9506    if {[catch {
9507        eval exec git branch $cmdargs
9508    } err]} {
9509        notbusy newbranch
9510        error_popup $err
9511    } else {
9512        notbusy newbranch
9513        if {$old_id ne {}} {
9514            movehead $id $name
9515            movedhead $id $name
9516            redrawtags $old_id
9517            redrawtags $id
9518        } else {
9519            set headids($name) $id
9520            lappend idheads($id) $name
9521            addedhead $id $name
9522            redrawtags $id
9523        }
9524        dispneartags 0
9525        run refill_reflist
9526    }
9527}
9528
9529proc exec_citool {tool_args {baseid {}}} {
9530    global commitinfo env
9531
9532    set save_env [array get env GIT_AUTHOR_*]
9533
9534    if {$baseid ne {}} {
9535        if {![info exists commitinfo($baseid)]} {
9536            getcommit $baseid
9537        }
9538        set author [lindex $commitinfo($baseid) 1]
9539        set date [lindex $commitinfo($baseid) 2]
9540        if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9541                    $author author name email]
9542            && $date ne {}} {
9543            set env(GIT_AUTHOR_NAME) $name
9544            set env(GIT_AUTHOR_EMAIL) $email
9545            set env(GIT_AUTHOR_DATE) $date
9546        }
9547    }
9548
9549    eval exec git citool $tool_args &
9550
9551    array unset env GIT_AUTHOR_*
9552    array set env $save_env
9553}
9554
9555proc cherrypick {} {
9556    global rowmenuid curview
9557    global mainhead mainheadid
9558    global gitdir
9559
9560    set oldhead [exec git rev-parse HEAD]
9561    set dheads [descheads $rowmenuid]
9562    if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
9563        set ok [confirm_popup [mc "Commit %s is already\
9564                included in branch %s -- really re-apply it?" \
9565                                   [string range $rowmenuid 0 7] $mainhead]]
9566        if {!$ok} return
9567    }
9568    nowbusy cherrypick [mc "Cherry-picking"]
9569    update
9570    # Unfortunately git-cherry-pick writes stuff to stderr even when
9571    # no error occurs, and exec takes that as an indication of error...
9572    if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9573        notbusy cherrypick
9574        if {[regexp -line \
9575                 {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9576                 $err msg fname]} {
9577            error_popup [mc "Cherry-pick failed because of local changes\
9578                        to file '%s'.\nPlease commit, reset or stash\
9579                        your changes and try again." $fname]
9580        } elseif {[regexp -line \
9581                       {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
9582                       $err]} {
9583            if {[confirm_popup [mc "Cherry-pick failed because of merge\
9584                        conflict.\nDo you wish to run git citool to\
9585                        resolve it?"]]} {
9586                # Force citool to read MERGE_MSG
9587                file delete [file join $gitdir "GITGUI_MSG"]
9588                exec_citool {} $rowmenuid
9589            }
9590        } else {
9591            error_popup $err
9592        }
9593        run updatecommits
9594        return
9595    }
9596    set newhead [exec git rev-parse HEAD]
9597    if {$newhead eq $oldhead} {
9598        notbusy cherrypick
9599        error_popup [mc "No changes committed"]
9600        return
9601    }
9602    addnewchild $newhead $oldhead
9603    if {[commitinview $oldhead $curview]} {
9604        # XXX this isn't right if we have a path limit...
9605        insertrow $newhead $oldhead $curview
9606        if {$mainhead ne {}} {
9607            movehead $newhead $mainhead
9608            movedhead $newhead $mainhead
9609        }
9610        set mainheadid $newhead
9611        redrawtags $oldhead
9612        redrawtags $newhead
9613        selbyid $newhead
9614    }
9615    notbusy cherrypick
9616}
9617
9618proc revert {} {
9619    global rowmenuid curview
9620    global mainhead mainheadid
9621    global gitdir
9622
9623    set oldhead [exec git rev-parse HEAD]
9624    set dheads [descheads $rowmenuid]
9625    if { $dheads eq {} || [lsearch -exact $dheads $oldhead] == -1 } {
9626       set ok [confirm_popup [mc "Commit %s is not\
9627           included in branch %s -- really revert it?" \
9628                      [string range $rowmenuid 0 7] $mainhead]]
9629       if {!$ok} return
9630    }
9631    nowbusy revert [mc "Reverting"]
9632    update
9633
9634    if [catch {exec git revert --no-edit $rowmenuid} err] {
9635        notbusy revert
9636        if [regexp {files would be overwritten by merge:(\n(( |\t)+[^\n]+\n)+)}\
9637                $err match files] {
9638            regsub {\n( |\t)+} $files "\n" files
9639            error_popup [mc "Revert failed because of local changes to\
9640                the following files:%s Please commit, reset or stash \
9641                your changes and try again." $files]
9642        } elseif [regexp {error: could not revert} $err] {
9643            if [confirm_popup [mc "Revert failed because of merge conflict.\n\
9644                Do you wish to run git citool to resolve it?"]] {
9645                # Force citool to read MERGE_MSG
9646                file delete [file join $gitdir "GITGUI_MSG"]
9647                exec_citool {} $rowmenuid
9648            }
9649        } else { error_popup $err }
9650        run updatecommits
9651        return
9652    }
9653
9654    set newhead [exec git rev-parse HEAD]
9655    if { $newhead eq $oldhead } {
9656        notbusy revert
9657        error_popup [mc "No changes committed"]
9658        return
9659    }
9660
9661    addnewchild $newhead $oldhead
9662
9663    if [commitinview $oldhead $curview] {
9664        # XXX this isn't right if we have a path limit...
9665        insertrow $newhead $oldhead $curview
9666        if {$mainhead ne {}} {
9667            movehead $newhead $mainhead
9668            movedhead $newhead $mainhead
9669        }
9670        set mainheadid $newhead
9671        redrawtags $oldhead
9672        redrawtags $newhead
9673        selbyid $newhead
9674    }
9675
9676    notbusy revert
9677}
9678
9679proc resethead {} {
9680    global mainhead rowmenuid confirm_ok resettype NS
9681
9682    set confirm_ok 0
9683    set w ".confirmreset"
9684    ttk_toplevel $w
9685    make_transient $w .
9686    wm title $w [mc "Confirm reset"]
9687    ${NS}::label $w.m -text \
9688        [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
9689    pack $w.m -side top -fill x -padx 20 -pady 20
9690    ${NS}::labelframe $w.f -text [mc "Reset type:"]
9691    set resettype mixed
9692    ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
9693        -text [mc "Soft: Leave working tree and index untouched"]
9694    grid $w.f.soft -sticky w
9695    ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
9696        -text [mc "Mixed: Leave working tree untouched, reset index"]
9697    grid $w.f.mixed -sticky w
9698    ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
9699        -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
9700    grid $w.f.hard -sticky w
9701    pack $w.f -side top -fill x -padx 4
9702    ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
9703    pack $w.ok -side left -fill x -padx 20 -pady 20
9704    ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
9705    bind $w <Key-Escape> [list destroy $w]
9706    pack $w.cancel -side right -fill x -padx 20 -pady 20
9707    bind $w <Visibility> "grab $w; focus $w"
9708    tkwait window $w
9709    if {!$confirm_ok} return
9710    if {[catch {set fd [open \
9711            [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
9712        error_popup $err
9713    } else {
9714        dohidelocalchanges
9715        filerun $fd [list readresetstat $fd]
9716        nowbusy reset [mc "Resetting"]
9717        selbyid $rowmenuid
9718    }
9719}
9720
9721proc readresetstat {fd} {
9722    global mainhead mainheadid showlocalchanges rprogcoord
9723
9724    if {[gets $fd line] >= 0} {
9725        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9726            set rprogcoord [expr {1.0 * $m / $n}]
9727            adjustprogress
9728        }
9729        return 1
9730    }
9731    set rprogcoord 0
9732    adjustprogress
9733    notbusy reset
9734    if {[catch {close $fd} err]} {
9735        error_popup $err
9736    }
9737    set oldhead $mainheadid
9738    set newhead [exec git rev-parse HEAD]
9739    if {$newhead ne $oldhead} {
9740        movehead $newhead $mainhead
9741        movedhead $newhead $mainhead
9742        set mainheadid $newhead
9743        redrawtags $oldhead
9744        redrawtags $newhead
9745    }
9746    if {$showlocalchanges} {
9747        doshowlocalchanges
9748    }
9749    return 0
9750}
9751
9752# context menu for a head
9753proc headmenu {x y id head} {
9754    global headmenuid headmenuhead headctxmenu mainhead
9755
9756    stopfinding
9757    set headmenuid $id
9758    set headmenuhead $head
9759    set state normal
9760    if {[string match "remotes/*" $head]} {
9761        set state disabled
9762    }
9763    if {$head eq $mainhead} {
9764        set state disabled
9765    }
9766    $headctxmenu entryconfigure 0 -state $state
9767    $headctxmenu entryconfigure 1 -state $state
9768    tk_popup $headctxmenu $x $y
9769}
9770
9771proc cobranch {} {
9772    global headmenuid headmenuhead headids
9773    global showlocalchanges
9774
9775    # check the tree is clean first??
9776    nowbusy checkout [mc "Checking out"]
9777    update
9778    dohidelocalchanges
9779    if {[catch {
9780        set fd [open [list | git checkout $headmenuhead 2>@1] r]
9781    } err]} {
9782        notbusy checkout
9783        error_popup $err
9784        if {$showlocalchanges} {
9785            dodiffindex
9786        }
9787    } else {
9788        filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
9789    }
9790}
9791
9792proc readcheckoutstat {fd newhead newheadid} {
9793    global mainhead mainheadid headids showlocalchanges progresscoords
9794    global viewmainheadid curview
9795
9796    if {[gets $fd line] >= 0} {
9797        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9798            set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9799            adjustprogress
9800        }
9801        return 1
9802    }
9803    set progresscoords {0 0}
9804    adjustprogress
9805    notbusy checkout
9806    if {[catch {close $fd} err]} {
9807        error_popup $err
9808    }
9809    set oldmainid $mainheadid
9810    set mainhead $newhead
9811    set mainheadid $newheadid
9812    set viewmainheadid($curview) $newheadid
9813    redrawtags $oldmainid
9814    redrawtags $newheadid
9815    selbyid $newheadid
9816    if {$showlocalchanges} {
9817        dodiffindex
9818    }
9819}
9820
9821proc rmbranch {} {
9822    global headmenuid headmenuhead mainhead
9823    global idheads
9824
9825    set head $headmenuhead
9826    set id $headmenuid
9827    # this check shouldn't be needed any more...
9828    if {$head eq $mainhead} {
9829        error_popup [mc "Cannot delete the currently checked-out branch"]
9830        return
9831    }
9832    set dheads [descheads $id]
9833    if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
9834        # the stuff on this branch isn't on any other branch
9835        if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9836                        branch.\nReally delete branch %s?" $head $head]]} return
9837    }
9838    nowbusy rmbranch
9839    update
9840    if {[catch {exec git branch -D $head} err]} {
9841        notbusy rmbranch
9842        error_popup $err
9843        return
9844    }
9845    removehead $id $head
9846    removedhead $id $head
9847    redrawtags $id
9848    notbusy rmbranch
9849    dispneartags 0
9850    run refill_reflist
9851}
9852
9853# Display a list of tags and heads
9854proc showrefs {} {
9855    global showrefstop bgcolor fgcolor selectbgcolor NS
9856    global bglist fglist reflistfilter reflist maincursor
9857
9858    set top .showrefs
9859    set showrefstop $top
9860    if {[winfo exists $top]} {
9861        raise $top
9862        refill_reflist
9863        return
9864    }
9865    ttk_toplevel $top
9866    wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
9867    make_transient $top .
9868    text $top.list -background $bgcolor -foreground $fgcolor \
9869        -selectbackground $selectbgcolor -font mainfont \
9870        -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
9871        -width 30 -height 20 -cursor $maincursor \
9872        -spacing1 1 -spacing3 1 -state disabled
9873    $top.list tag configure highlight -background $selectbgcolor
9874    if {![lsearch -exact $bglist $top.list]} {
9875        lappend bglist $top.list
9876        lappend fglist $top.list
9877    }
9878    ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
9879    ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
9880    grid $top.list $top.ysb -sticky nsew
9881    grid $top.xsb x -sticky ew
9882    ${NS}::frame $top.f
9883    ${NS}::label $top.f.l -text "[mc "Filter"]: "
9884    ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
9885    set reflistfilter "*"
9886    trace add variable reflistfilter write reflistfilter_change
9887    pack $top.f.e -side right -fill x -expand 1
9888    pack $top.f.l -side left
9889    grid $top.f - -sticky ew -pady 2
9890    ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
9891    bind $top <Key-Escape> [list destroy $top]
9892    grid $top.close -
9893    grid columnconfigure $top 0 -weight 1
9894    grid rowconfigure $top 0 -weight 1
9895    bind $top.list <1> {break}
9896    bind $top.list <B1-Motion> {break}
9897    bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
9898    set reflist {}
9899    refill_reflist
9900}
9901
9902proc sel_reflist {w x y} {
9903    global showrefstop reflist headids tagids otherrefids
9904
9905    if {![winfo exists $showrefstop]} return
9906    set l [lindex [split [$w index "@$x,$y"] "."] 0]
9907    set ref [lindex $reflist [expr {$l-1}]]
9908    set n [lindex $ref 0]
9909    switch -- [lindex $ref 1] {
9910        "H" {selbyid $headids($n)}
9911        "T" {selbyid $tagids($n)}
9912        "o" {selbyid $otherrefids($n)}
9913    }
9914    $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
9915}
9916
9917proc unsel_reflist {} {
9918    global showrefstop
9919
9920    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9921    $showrefstop.list tag remove highlight 0.0 end
9922}
9923
9924proc reflistfilter_change {n1 n2 op} {
9925    global reflistfilter
9926
9927    after cancel refill_reflist
9928    after 200 refill_reflist
9929}
9930
9931proc refill_reflist {} {
9932    global reflist reflistfilter showrefstop headids tagids otherrefids
9933    global curview
9934
9935    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9936    set refs {}
9937    foreach n [array names headids] {
9938        if {[string match $reflistfilter $n]} {
9939            if {[commitinview $headids($n) $curview]} {
9940                lappend refs [list $n H]
9941            } else {
9942                interestedin $headids($n) {run refill_reflist}
9943            }
9944        }
9945    }
9946    foreach n [array names tagids] {
9947        if {[string match $reflistfilter $n]} {
9948            if {[commitinview $tagids($n) $curview]} {
9949                lappend refs [list $n T]
9950            } else {
9951                interestedin $tagids($n) {run refill_reflist}
9952            }
9953        }
9954    }
9955    foreach n [array names otherrefids] {
9956        if {[string match $reflistfilter $n]} {
9957            if {[commitinview $otherrefids($n) $curview]} {
9958                lappend refs [list $n o]
9959            } else {
9960                interestedin $otherrefids($n) {run refill_reflist}
9961            }
9962        }
9963    }
9964    set refs [lsort -index 0 $refs]
9965    if {$refs eq $reflist} return
9966
9967    # Update the contents of $showrefstop.list according to the
9968    # differences between $reflist (old) and $refs (new)
9969    $showrefstop.list conf -state normal
9970    $showrefstop.list insert end "\n"
9971    set i 0
9972    set j 0
9973    while {$i < [llength $reflist] || $j < [llength $refs]} {
9974        if {$i < [llength $reflist]} {
9975            if {$j < [llength $refs]} {
9976                set cmp [string compare [lindex $reflist $i 0] \
9977                             [lindex $refs $j 0]]
9978                if {$cmp == 0} {
9979                    set cmp [string compare [lindex $reflist $i 1] \
9980                                 [lindex $refs $j 1]]
9981                }
9982            } else {
9983                set cmp -1
9984            }
9985        } else {
9986            set cmp 1
9987        }
9988        switch -- $cmp {
9989            -1 {
9990                $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
9991                incr i
9992            }
9993            0 {
9994                incr i
9995                incr j
9996            }
9997            1 {
9998                set l [expr {$j + 1}]
9999                $showrefstop.list image create $l.0 -align baseline \
10000                    -image reficon-[lindex $refs $j 1] -padx 2
10001                $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
10002                incr j
10003            }
10004        }
10005    }
10006    set reflist $refs
10007    # delete last newline
10008    $showrefstop.list delete end-2c end-1c
10009    $showrefstop.list conf -state disabled
10010}
10011
10012# Stuff for finding nearby tags
10013proc getallcommits {} {
10014    global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
10015    global idheads idtags idotherrefs allparents tagobjid
10016    global gitdir
10017
10018    if {![info exists allcommits]} {
10019        set nextarc 0
10020        set allcommits 0
10021        set seeds {}
10022        set allcwait 0
10023        set cachedarcs 0
10024        set allccache [file join $gitdir "gitk.cache"]
10025        if {![catch {
10026            set f [open $allccache r]
10027            set allcwait 1
10028            getcache $f
10029        }]} return
10030    }
10031
10032    if {$allcwait} {
10033        return
10034    }
10035    set cmd [list | git rev-list --parents]
10036    set allcupdate [expr {$seeds ne {}}]
10037    if {!$allcupdate} {
10038        set ids "--all"
10039    } else {
10040        set refs [concat [array names idheads] [array names idtags] \
10041                      [array names idotherrefs]]
10042        set ids {}
10043        set tagobjs {}
10044        foreach name [array names tagobjid] {
10045            lappend tagobjs $tagobjid($name)
10046        }
10047        foreach id [lsort -unique $refs] {
10048            if {![info exists allparents($id)] &&
10049                [lsearch -exact $tagobjs $id] < 0} {
10050                lappend ids $id
10051            }
10052        }
10053        if {$ids ne {}} {
10054            foreach id $seeds {
10055                lappend ids "^$id"
10056            }
10057        }
10058    }
10059    if {$ids ne {}} {
10060        set fd [open [concat $cmd $ids] r]
10061        fconfigure $fd -blocking 0
10062        incr allcommits
10063        nowbusy allcommits
10064        filerun $fd [list getallclines $fd]
10065    } else {
10066        dispneartags 0
10067    }
10068}
10069
10070# Since most commits have 1 parent and 1 child, we group strings of
10071# such commits into "arcs" joining branch/merge points (BMPs), which
10072# are commits that either don't have 1 parent or don't have 1 child.
10073#
10074# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
10075# arcout(id) - outgoing arcs for BMP
10076# arcids(a) - list of IDs on arc including end but not start
10077# arcstart(a) - BMP ID at start of arc
10078# arcend(a) - BMP ID at end of arc
10079# growing(a) - arc a is still growing
10080# arctags(a) - IDs out of arcids (excluding end) that have tags
10081# archeads(a) - IDs out of arcids (excluding end) that have heads
10082# The start of an arc is at the descendent end, so "incoming" means
10083# coming from descendents, and "outgoing" means going towards ancestors.
10084
10085proc getallclines {fd} {
10086    global allparents allchildren idtags idheads nextarc
10087    global arcnos arcids arctags arcout arcend arcstart archeads growing
10088    global seeds allcommits cachedarcs allcupdate
10089
10090    set nid 0
10091    while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
10092        set id [lindex $line 0]
10093        if {[info exists allparents($id)]} {
10094            # seen it already
10095            continue
10096        }
10097        set cachedarcs 0
10098        set olds [lrange $line 1 end]
10099        set allparents($id) $olds
10100        if {![info exists allchildren($id)]} {
10101            set allchildren($id) {}
10102            set arcnos($id) {}
10103            lappend seeds $id
10104        } else {
10105            set a $arcnos($id)
10106            if {[llength $olds] == 1 && [llength $a] == 1} {
10107                lappend arcids($a) $id
10108                if {[info exists idtags($id)]} {
10109                    lappend arctags($a) $id
10110                }
10111                if {[info exists idheads($id)]} {
10112                    lappend archeads($a) $id
10113                }
10114                if {[info exists allparents($olds)]} {
10115                    # seen parent already
10116                    if {![info exists arcout($olds)]} {
10117                        splitarc $olds
10118                    }
10119                    lappend arcids($a) $olds
10120                    set arcend($a) $olds
10121                    unset growing($a)
10122                }
10123                lappend allchildren($olds) $id
10124                lappend arcnos($olds) $a
10125                continue
10126            }
10127        }
10128        foreach a $arcnos($id) {
10129            lappend arcids($a) $id
10130            set arcend($a) $id
10131            unset growing($a)
10132        }
10133
10134        set ao {}
10135        foreach p $olds {
10136            lappend allchildren($p) $id
10137            set a [incr nextarc]
10138            set arcstart($a) $id
10139            set archeads($a) {}
10140            set arctags($a) {}
10141            set archeads($a) {}
10142            set arcids($a) {}
10143            lappend ao $a
10144            set growing($a) 1
10145            if {[info exists allparents($p)]} {
10146                # seen it already, may need to make a new branch
10147                if {![info exists arcout($p)]} {
10148                    splitarc $p
10149                }
10150                lappend arcids($a) $p
10151                set arcend($a) $p
10152                unset growing($a)
10153            }
10154            lappend arcnos($p) $a
10155        }
10156        set arcout($id) $ao
10157    }
10158    if {$nid > 0} {
10159        global cached_dheads cached_dtags cached_atags
10160        unset -nocomplain cached_dheads
10161        unset -nocomplain cached_dtags
10162        unset -nocomplain cached_atags
10163    }
10164    if {![eof $fd]} {
10165        return [expr {$nid >= 1000? 2: 1}]
10166    }
10167    set cacheok 1
10168    if {[catch {
10169        fconfigure $fd -blocking 1
10170        close $fd
10171    } err]} {
10172        # got an error reading the list of commits
10173        # if we were updating, try rereading the whole thing again
10174        if {$allcupdate} {
10175            incr allcommits -1
10176            dropcache $err
10177            return
10178        }
10179        error_popup "[mc "Error reading commit topology information;\
10180                branch and preceding/following tag information\
10181                will be incomplete."]\n($err)"
10182        set cacheok 0
10183    }
10184    if {[incr allcommits -1] == 0} {
10185        notbusy allcommits
10186        if {$cacheok} {
10187            run savecache
10188        }
10189    }
10190    dispneartags 0
10191    return 0
10192}
10193
10194proc recalcarc {a} {
10195    global arctags archeads arcids idtags idheads
10196
10197    set at {}
10198    set ah {}
10199    foreach id [lrange $arcids($a) 0 end-1] {
10200        if {[info exists idtags($id)]} {
10201            lappend at $id
10202        }
10203        if {[info exists idheads($id)]} {
10204            lappend ah $id
10205        }
10206    }
10207    set arctags($a) $at
10208    set archeads($a) $ah
10209}
10210
10211proc splitarc {p} {
10212    global arcnos arcids nextarc arctags archeads idtags idheads
10213    global arcstart arcend arcout allparents growing
10214
10215    set a $arcnos($p)
10216    if {[llength $a] != 1} {
10217        puts "oops splitarc called but [llength $a] arcs already"
10218        return
10219    }
10220    set a [lindex $a 0]
10221    set i [lsearch -exact $arcids($a) $p]
10222    if {$i < 0} {
10223        puts "oops splitarc $p not in arc $a"
10224        return
10225    }
10226    set na [incr nextarc]
10227    if {[info exists arcend($a)]} {
10228        set arcend($na) $arcend($a)
10229    } else {
10230        set l [lindex $allparents([lindex $arcids($a) end]) 0]
10231        set j [lsearch -exact $arcnos($l) $a]
10232        set arcnos($l) [lreplace $arcnos($l) $j $j $na]
10233    }
10234    set tail [lrange $arcids($a) [expr {$i+1}] end]
10235    set arcids($a) [lrange $arcids($a) 0 $i]
10236    set arcend($a) $p
10237    set arcstart($na) $p
10238    set arcout($p) $na
10239    set arcids($na) $tail
10240    if {[info exists growing($a)]} {
10241        set growing($na) 1
10242        unset growing($a)
10243    }
10244
10245    foreach id $tail {
10246        if {[llength $arcnos($id)] == 1} {
10247            set arcnos($id) $na
10248        } else {
10249            set j [lsearch -exact $arcnos($id) $a]
10250            set arcnos($id) [lreplace $arcnos($id) $j $j $na]
10251        }
10252    }
10253
10254    # reconstruct tags and heads lists
10255    if {$arctags($a) ne {} || $archeads($a) ne {}} {
10256        recalcarc $a
10257        recalcarc $na
10258    } else {
10259        set arctags($na) {}
10260        set archeads($na) {}
10261    }
10262}
10263
10264# Update things for a new commit added that is a child of one
10265# existing commit.  Used when cherry-picking.
10266proc addnewchild {id p} {
10267    global allparents allchildren idtags nextarc
10268    global arcnos arcids arctags arcout arcend arcstart archeads growing
10269    global seeds allcommits
10270
10271    if {![info exists allcommits] || ![info exists arcnos($p)]} return
10272    set allparents($id) [list $p]
10273    set allchildren($id) {}
10274    set arcnos($id) {}
10275    lappend seeds $id
10276    lappend allchildren($p) $id
10277    set a [incr nextarc]
10278    set arcstart($a) $id
10279    set archeads($a) {}
10280    set arctags($a) {}
10281    set arcids($a) [list $p]
10282    set arcend($a) $p
10283    if {![info exists arcout($p)]} {
10284        splitarc $p
10285    }
10286    lappend arcnos($p) $a
10287    set arcout($id) [list $a]
10288}
10289
10290# This implements a cache for the topology information.
10291# The cache saves, for each arc, the start and end of the arc,
10292# the ids on the arc, and the outgoing arcs from the end.
10293proc readcache {f} {
10294    global arcnos arcids arcout arcstart arcend arctags archeads nextarc
10295    global idtags idheads allparents cachedarcs possible_seeds seeds growing
10296    global allcwait
10297
10298    set a $nextarc
10299    set lim $cachedarcs
10300    if {$lim - $a > 500} {
10301        set lim [expr {$a + 500}]
10302    }
10303    if {[catch {
10304        if {$a == $lim} {
10305            # finish reading the cache and setting up arctags, etc.
10306            set line [gets $f]
10307            if {$line ne "1"} {error "bad final version"}
10308            close $f
10309            foreach id [array names idtags] {
10310                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10311                    [llength $allparents($id)] == 1} {
10312                    set a [lindex $arcnos($id) 0]
10313                    if {$arctags($a) eq {}} {
10314                        recalcarc $a
10315                    }
10316                }
10317            }
10318            foreach id [array names idheads] {
10319                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10320                    [llength $allparents($id)] == 1} {
10321                    set a [lindex $arcnos($id) 0]
10322                    if {$archeads($a) eq {}} {
10323                        recalcarc $a
10324                    }
10325                }
10326            }
10327            foreach id [lsort -unique $possible_seeds] {
10328                if {$arcnos($id) eq {}} {
10329                    lappend seeds $id
10330                }
10331            }
10332            set allcwait 0
10333        } else {
10334            while {[incr a] <= $lim} {
10335                set line [gets $f]
10336                if {[llength $line] != 3} {error "bad line"}
10337                set s [lindex $line 0]
10338                set arcstart($a) $s
10339                lappend arcout($s) $a
10340                if {![info exists arcnos($s)]} {
10341                    lappend possible_seeds $s
10342                    set arcnos($s) {}
10343                }
10344                set e [lindex $line 1]
10345                if {$e eq {}} {
10346                    set growing($a) 1
10347                } else {
10348                    set arcend($a) $e
10349                    if {![info exists arcout($e)]} {
10350                        set arcout($e) {}
10351                    }
10352                }
10353                set arcids($a) [lindex $line 2]
10354                foreach id $arcids($a) {
10355                    lappend allparents($s) $id
10356                    set s $id
10357                    lappend arcnos($id) $a
10358                }
10359                if {![info exists allparents($s)]} {
10360                    set allparents($s) {}
10361                }
10362                set arctags($a) {}
10363                set archeads($a) {}
10364            }
10365            set nextarc [expr {$a - 1}]
10366        }
10367    } err]} {
10368        dropcache $err
10369        return 0
10370    }
10371    if {!$allcwait} {
10372        getallcommits
10373    }
10374    return $allcwait
10375}
10376
10377proc getcache {f} {
10378    global nextarc cachedarcs possible_seeds
10379
10380    if {[catch {
10381        set line [gets $f]
10382        if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
10383        # make sure it's an integer
10384        set cachedarcs [expr {int([lindex $line 1])}]
10385        if {$cachedarcs < 0} {error "bad number of arcs"}
10386        set nextarc 0
10387        set possible_seeds {}
10388        run readcache $f
10389    } err]} {
10390        dropcache $err
10391    }
10392    return 0
10393}
10394
10395proc dropcache {err} {
10396    global allcwait nextarc cachedarcs seeds
10397
10398    #puts "dropping cache ($err)"
10399    foreach v {arcnos arcout arcids arcstart arcend growing \
10400                   arctags archeads allparents allchildren} {
10401        global $v
10402        unset -nocomplain $v
10403    }
10404    set allcwait 0
10405    set nextarc 0
10406    set cachedarcs 0
10407    set seeds {}
10408    getallcommits
10409}
10410
10411proc writecache {f} {
10412    global cachearc cachedarcs allccache
10413    global arcstart arcend arcnos arcids arcout
10414
10415    set a $cachearc
10416    set lim $cachedarcs
10417    if {$lim - $a > 1000} {
10418        set lim [expr {$a + 1000}]
10419    }
10420    if {[catch {
10421        while {[incr a] <= $lim} {
10422            if {[info exists arcend($a)]} {
10423                puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
10424            } else {
10425                puts $f [list $arcstart($a) {} $arcids($a)]
10426            }
10427        }
10428    } err]} {
10429        catch {close $f}
10430        catch {file delete $allccache}
10431        #puts "writing cache failed ($err)"
10432        return 0
10433    }
10434    set cachearc [expr {$a - 1}]
10435    if {$a > $cachedarcs} {
10436        puts $f "1"
10437        close $f
10438        return 0
10439    }
10440    return 1
10441}
10442
10443proc savecache {} {
10444    global nextarc cachedarcs cachearc allccache
10445
10446    if {$nextarc == $cachedarcs} return
10447    set cachearc 0
10448    set cachedarcs $nextarc
10449    catch {
10450        set f [open $allccache w]
10451        puts $f [list 1 $cachedarcs]
10452        run writecache $f
10453    }
10454}
10455
10456# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
10457# or 0 if neither is true.
10458proc anc_or_desc {a b} {
10459    global arcout arcstart arcend arcnos cached_isanc
10460
10461    if {$arcnos($a) eq $arcnos($b)} {
10462        # Both are on the same arc(s); either both are the same BMP,
10463        # or if one is not a BMP, the other is also not a BMP or is
10464        # the BMP at end of the arc (and it only has 1 incoming arc).
10465        # Or both can be BMPs with no incoming arcs.
10466        if {$a eq $b || $arcnos($a) eq {}} {
10467            return 0
10468        }
10469        # assert {[llength $arcnos($a)] == 1}
10470        set arc [lindex $arcnos($a) 0]
10471        set i [lsearch -exact $arcids($arc) $a]
10472        set j [lsearch -exact $arcids($arc) $b]
10473        if {$i < 0 || $i > $j} {
10474            return 1
10475        } else {
10476            return -1
10477        }
10478    }
10479
10480    if {![info exists arcout($a)]} {
10481        set arc [lindex $arcnos($a) 0]
10482        if {[info exists arcend($arc)]} {
10483            set aend $arcend($arc)
10484        } else {
10485            set aend {}
10486        }
10487        set a $arcstart($arc)
10488    } else {
10489        set aend $a
10490    }
10491    if {![info exists arcout($b)]} {
10492        set arc [lindex $arcnos($b) 0]
10493        if {[info exists arcend($arc)]} {
10494            set bend $arcend($arc)
10495        } else {
10496            set bend {}
10497        }
10498        set b $arcstart($arc)
10499    } else {
10500        set bend $b
10501    }
10502    if {$a eq $bend} {
10503        return 1
10504    }
10505    if {$b eq $aend} {
10506        return -1
10507    }
10508    if {[info exists cached_isanc($a,$bend)]} {
10509        if {$cached_isanc($a,$bend)} {
10510            return 1
10511        }
10512    }
10513    if {[info exists cached_isanc($b,$aend)]} {
10514        if {$cached_isanc($b,$aend)} {
10515            return -1
10516        }
10517        if {[info exists cached_isanc($a,$bend)]} {
10518            return 0
10519        }
10520    }
10521
10522    set todo [list $a $b]
10523    set anc($a) a
10524    set anc($b) b
10525    for {set i 0} {$i < [llength $todo]} {incr i} {
10526        set x [lindex $todo $i]
10527        if {$anc($x) eq {}} {
10528            continue
10529        }
10530        foreach arc $arcnos($x) {
10531            set xd $arcstart($arc)
10532            if {$xd eq $bend} {
10533                set cached_isanc($a,$bend) 1
10534                set cached_isanc($b,$aend) 0
10535                return 1
10536            } elseif {$xd eq $aend} {
10537                set cached_isanc($b,$aend) 1
10538                set cached_isanc($a,$bend) 0
10539                return -1
10540            }
10541            if {![info exists anc($xd)]} {
10542                set anc($xd) $anc($x)
10543                lappend todo $xd
10544            } elseif {$anc($xd) ne $anc($x)} {
10545                set anc($xd) {}
10546            }
10547        }
10548    }
10549    set cached_isanc($a,$bend) 0
10550    set cached_isanc($b,$aend) 0
10551    return 0
10552}
10553
10554# This identifies whether $desc has an ancestor that is
10555# a growing tip of the graph and which is not an ancestor of $anc
10556# and returns 0 if so and 1 if not.
10557# If we subsequently discover a tag on such a growing tip, and that
10558# turns out to be a descendent of $anc (which it could, since we
10559# don't necessarily see children before parents), then $desc
10560# isn't a good choice to display as a descendent tag of
10561# $anc (since it is the descendent of another tag which is
10562# a descendent of $anc).  Similarly, $anc isn't a good choice to
10563# display as a ancestor tag of $desc.
10564#
10565proc is_certain {desc anc} {
10566    global arcnos arcout arcstart arcend growing problems
10567
10568    set certain {}
10569    if {[llength $arcnos($anc)] == 1} {
10570        # tags on the same arc are certain
10571        if {$arcnos($desc) eq $arcnos($anc)} {
10572            return 1
10573        }
10574        if {![info exists arcout($anc)]} {
10575            # if $anc is partway along an arc, use the start of the arc instead
10576            set a [lindex $arcnos($anc) 0]
10577            set anc $arcstart($a)
10578        }
10579    }
10580    if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
10581        set x $desc
10582    } else {
10583        set a [lindex $arcnos($desc) 0]
10584        set x $arcend($a)
10585    }
10586    if {$x == $anc} {
10587        return 1
10588    }
10589    set anclist [list $x]
10590    set dl($x) 1
10591    set nnh 1
10592    set ngrowanc 0
10593    for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
10594        set x [lindex $anclist $i]
10595        if {$dl($x)} {
10596            incr nnh -1
10597        }
10598        set done($x) 1
10599        foreach a $arcout($x) {
10600            if {[info exists growing($a)]} {
10601                if {![info exists growanc($x)] && $dl($x)} {
10602                    set growanc($x) 1
10603                    incr ngrowanc
10604                }
10605            } else {
10606                set y $arcend($a)
10607                if {[info exists dl($y)]} {
10608                    if {$dl($y)} {
10609                        if {!$dl($x)} {
10610                            set dl($y) 0
10611                            if {![info exists done($y)]} {
10612                                incr nnh -1
10613                            }
10614                            if {[info exists growanc($x)]} {
10615                                incr ngrowanc -1
10616                            }
10617                            set xl [list $y]
10618                            for {set k 0} {$k < [llength $xl]} {incr k} {
10619                                set z [lindex $xl $k]
10620                                foreach c $arcout($z) {
10621                                    if {[info exists arcend($c)]} {
10622                                        set v $arcend($c)
10623                                        if {[info exists dl($v)] && $dl($v)} {
10624                                            set dl($v) 0
10625                                            if {![info exists done($v)]} {
10626                                                incr nnh -1
10627                                            }
10628                                            if {[info exists growanc($v)]} {
10629                                                incr ngrowanc -1
10630                                            }
10631                                            lappend xl $v
10632                                        }
10633                                    }
10634                                }
10635                            }
10636                        }
10637                    }
10638                } elseif {$y eq $anc || !$dl($x)} {
10639                    set dl($y) 0
10640                    lappend anclist $y
10641                } else {
10642                    set dl($y) 1
10643                    lappend anclist $y
10644                    incr nnh
10645                }
10646            }
10647        }
10648    }
10649    foreach x [array names growanc] {
10650        if {$dl($x)} {
10651            return 0
10652        }
10653        return 0
10654    }
10655    return 1
10656}
10657
10658proc validate_arctags {a} {
10659    global arctags idtags
10660
10661    set i -1
10662    set na $arctags($a)
10663    foreach id $arctags($a) {
10664        incr i
10665        if {![info exists idtags($id)]} {
10666            set na [lreplace $na $i $i]
10667            incr i -1
10668        }
10669    }
10670    set arctags($a) $na
10671}
10672
10673proc validate_archeads {a} {
10674    global archeads idheads
10675
10676    set i -1
10677    set na $archeads($a)
10678    foreach id $archeads($a) {
10679        incr i
10680        if {![info exists idheads($id)]} {
10681            set na [lreplace $na $i $i]
10682            incr i -1
10683        }
10684    }
10685    set archeads($a) $na
10686}
10687
10688# Return the list of IDs that have tags that are descendents of id,
10689# ignoring IDs that are descendents of IDs already reported.
10690proc desctags {id} {
10691    global arcnos arcstart arcids arctags idtags allparents
10692    global growing cached_dtags
10693
10694    if {![info exists allparents($id)]} {
10695        return {}
10696    }
10697    set t1 [clock clicks -milliseconds]
10698    set argid $id
10699    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10700        # part-way along an arc; check that arc first
10701        set a [lindex $arcnos($id) 0]
10702        if {$arctags($a) ne {}} {
10703            validate_arctags $a
10704            set i [lsearch -exact $arcids($a) $id]
10705            set tid {}
10706            foreach t $arctags($a) {
10707                set j [lsearch -exact $arcids($a) $t]
10708                if {$j >= $i} break
10709                set tid $t
10710            }
10711            if {$tid ne {}} {
10712                return $tid
10713            }
10714        }
10715        set id $arcstart($a)
10716        if {[info exists idtags($id)]} {
10717            return $id
10718        }
10719    }
10720    if {[info exists cached_dtags($id)]} {
10721        return $cached_dtags($id)
10722    }
10723
10724    set origid $id
10725    set todo [list $id]
10726    set queued($id) 1
10727    set nc 1
10728    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10729        set id [lindex $todo $i]
10730        set done($id) 1
10731        set ta [info exists hastaggedancestor($id)]
10732        if {!$ta} {
10733            incr nc -1
10734        }
10735        # ignore tags on starting node
10736        if {!$ta && $i > 0} {
10737            if {[info exists idtags($id)]} {
10738                set tagloc($id) $id
10739                set ta 1
10740            } elseif {[info exists cached_dtags($id)]} {
10741                set tagloc($id) $cached_dtags($id)
10742                set ta 1
10743            }
10744        }
10745        foreach a $arcnos($id) {
10746            set d $arcstart($a)
10747            if {!$ta && $arctags($a) ne {}} {
10748                validate_arctags $a
10749                if {$arctags($a) ne {}} {
10750                    lappend tagloc($id) [lindex $arctags($a) end]
10751                }
10752            }
10753            if {$ta || $arctags($a) ne {}} {
10754                set tomark [list $d]
10755                for {set j 0} {$j < [llength $tomark]} {incr j} {
10756                    set dd [lindex $tomark $j]
10757                    if {![info exists hastaggedancestor($dd)]} {
10758                        if {[info exists done($dd)]} {
10759                            foreach b $arcnos($dd) {
10760                                lappend tomark $arcstart($b)
10761                            }
10762                            if {[info exists tagloc($dd)]} {
10763                                unset tagloc($dd)
10764                            }
10765                        } elseif {[info exists queued($dd)]} {
10766                            incr nc -1
10767                        }
10768                        set hastaggedancestor($dd) 1
10769                    }
10770                }
10771            }
10772            if {![info exists queued($d)]} {
10773                lappend todo $d
10774                set queued($d) 1
10775                if {![info exists hastaggedancestor($d)]} {
10776                    incr nc
10777                }
10778            }
10779        }
10780    }
10781    set tags {}
10782    foreach id [array names tagloc] {
10783        if {![info exists hastaggedancestor($id)]} {
10784            foreach t $tagloc($id) {
10785                if {[lsearch -exact $tags $t] < 0} {
10786                    lappend tags $t
10787                }
10788            }
10789        }
10790    }
10791    set t2 [clock clicks -milliseconds]
10792    set loopix $i
10793
10794    # remove tags that are descendents of other tags
10795    for {set i 0} {$i < [llength $tags]} {incr i} {
10796        set a [lindex $tags $i]
10797        for {set j 0} {$j < $i} {incr j} {
10798            set b [lindex $tags $j]
10799            set r [anc_or_desc $a $b]
10800            if {$r == 1} {
10801                set tags [lreplace $tags $j $j]
10802                incr j -1
10803                incr i -1
10804            } elseif {$r == -1} {
10805                set tags [lreplace $tags $i $i]
10806                incr i -1
10807                break
10808            }
10809        }
10810    }
10811
10812    if {[array names growing] ne {}} {
10813        # graph isn't finished, need to check if any tag could get
10814        # eclipsed by another tag coming later.  Simply ignore any
10815        # tags that could later get eclipsed.
10816        set ctags {}
10817        foreach t $tags {
10818            if {[is_certain $t $origid]} {
10819                lappend ctags $t
10820            }
10821        }
10822        if {$tags eq $ctags} {
10823            set cached_dtags($origid) $tags
10824        } else {
10825            set tags $ctags
10826        }
10827    } else {
10828        set cached_dtags($origid) $tags
10829    }
10830    set t3 [clock clicks -milliseconds]
10831    if {0 && $t3 - $t1 >= 100} {
10832        puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10833            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10834    }
10835    return $tags
10836}
10837
10838proc anctags {id} {
10839    global arcnos arcids arcout arcend arctags idtags allparents
10840    global growing cached_atags
10841
10842    if {![info exists allparents($id)]} {
10843        return {}
10844    }
10845    set t1 [clock clicks -milliseconds]
10846    set argid $id
10847    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10848        # part-way along an arc; check that arc first
10849        set a [lindex $arcnos($id) 0]
10850        if {$arctags($a) ne {}} {
10851            validate_arctags $a
10852            set i [lsearch -exact $arcids($a) $id]
10853            foreach t $arctags($a) {
10854                set j [lsearch -exact $arcids($a) $t]
10855                if {$j > $i} {
10856                    return $t
10857                }
10858            }
10859        }
10860        if {![info exists arcend($a)]} {
10861            return {}
10862        }
10863        set id $arcend($a)
10864        if {[info exists idtags($id)]} {
10865            return $id
10866        }
10867    }
10868    if {[info exists cached_atags($id)]} {
10869        return $cached_atags($id)
10870    }
10871
10872    set origid $id
10873    set todo [list $id]
10874    set queued($id) 1
10875    set taglist {}
10876    set nc 1
10877    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10878        set id [lindex $todo $i]
10879        set done($id) 1
10880        set td [info exists hastaggeddescendent($id)]
10881        if {!$td} {
10882            incr nc -1
10883        }
10884        # ignore tags on starting node
10885        if {!$td && $i > 0} {
10886            if {[info exists idtags($id)]} {
10887                set tagloc($id) $id
10888                set td 1
10889            } elseif {[info exists cached_atags($id)]} {
10890                set tagloc($id) $cached_atags($id)
10891                set td 1
10892            }
10893        }
10894        foreach a $arcout($id) {
10895            if {!$td && $arctags($a) ne {}} {
10896                validate_arctags $a
10897                if {$arctags($a) ne {}} {
10898                    lappend tagloc($id) [lindex $arctags($a) 0]
10899                }
10900            }
10901            if {![info exists arcend($a)]} continue
10902            set d $arcend($a)
10903            if {$td || $arctags($a) ne {}} {
10904                set tomark [list $d]
10905                for {set j 0} {$j < [llength $tomark]} {incr j} {
10906                    set dd [lindex $tomark $j]
10907                    if {![info exists hastaggeddescendent($dd)]} {
10908                        if {[info exists done($dd)]} {
10909                            foreach b $arcout($dd) {
10910                                if {[info exists arcend($b)]} {
10911                                    lappend tomark $arcend($b)
10912                                }
10913                            }
10914                            if {[info exists tagloc($dd)]} {
10915                                unset tagloc($dd)
10916                            }
10917                        } elseif {[info exists queued($dd)]} {
10918                            incr nc -1
10919                        }
10920                        set hastaggeddescendent($dd) 1
10921                    }
10922                }
10923            }
10924            if {![info exists queued($d)]} {
10925                lappend todo $d
10926                set queued($d) 1
10927                if {![info exists hastaggeddescendent($d)]} {
10928                    incr nc
10929                }
10930            }
10931        }
10932    }
10933    set t2 [clock clicks -milliseconds]
10934    set loopix $i
10935    set tags {}
10936    foreach id [array names tagloc] {
10937        if {![info exists hastaggeddescendent($id)]} {
10938            foreach t $tagloc($id) {
10939                if {[lsearch -exact $tags $t] < 0} {
10940                    lappend tags $t
10941                }
10942            }
10943        }
10944    }
10945
10946    # remove tags that are ancestors of other tags
10947    for {set i 0} {$i < [llength $tags]} {incr i} {
10948        set a [lindex $tags $i]
10949        for {set j 0} {$j < $i} {incr j} {
10950            set b [lindex $tags $j]
10951            set r [anc_or_desc $a $b]
10952            if {$r == -1} {
10953                set tags [lreplace $tags $j $j]
10954                incr j -1
10955                incr i -1
10956            } elseif {$r == 1} {
10957                set tags [lreplace $tags $i $i]
10958                incr i -1
10959                break
10960            }
10961        }
10962    }
10963
10964    if {[array names growing] ne {}} {
10965        # graph isn't finished, need to check if any tag could get
10966        # eclipsed by another tag coming later.  Simply ignore any
10967        # tags that could later get eclipsed.
10968        set ctags {}
10969        foreach t $tags {
10970            if {[is_certain $origid $t]} {
10971                lappend ctags $t
10972            }
10973        }
10974        if {$tags eq $ctags} {
10975            set cached_atags($origid) $tags
10976        } else {
10977            set tags $ctags
10978        }
10979    } else {
10980        set cached_atags($origid) $tags
10981    }
10982    set t3 [clock clicks -milliseconds]
10983    if {0 && $t3 - $t1 >= 100} {
10984        puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
10985            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10986    }
10987    return $tags
10988}
10989
10990# Return the list of IDs that have heads that are descendents of id,
10991# including id itself if it has a head.
10992proc descheads {id} {
10993    global arcnos arcstart arcids archeads idheads cached_dheads
10994    global allparents arcout
10995
10996    if {![info exists allparents($id)]} {
10997        return {}
10998    }
10999    set aret {}
11000    if {![info exists arcout($id)]} {
11001        # part-way along an arc; check it first
11002        set a [lindex $arcnos($id) 0]
11003        if {$archeads($a) ne {}} {
11004            validate_archeads $a
11005            set i [lsearch -exact $arcids($a) $id]
11006            foreach t $archeads($a) {
11007                set j [lsearch -exact $arcids($a) $t]
11008                if {$j > $i} break
11009                lappend aret $t
11010            }
11011        }
11012        set id $arcstart($a)
11013    }
11014    set origid $id
11015    set todo [list $id]
11016    set seen($id) 1
11017    set ret {}
11018    for {set i 0} {$i < [llength $todo]} {incr i} {
11019        set id [lindex $todo $i]
11020        if {[info exists cached_dheads($id)]} {
11021            set ret [concat $ret $cached_dheads($id)]
11022        } else {
11023            if {[info exists idheads($id)]} {
11024                lappend ret $id
11025            }
11026            foreach a $arcnos($id) {
11027                if {$archeads($a) ne {}} {
11028                    validate_archeads $a
11029                    if {$archeads($a) ne {}} {
11030                        set ret [concat $ret $archeads($a)]
11031                    }
11032                }
11033                set d $arcstart($a)
11034                if {![info exists seen($d)]} {
11035                    lappend todo $d
11036                    set seen($d) 1
11037                }
11038            }
11039        }
11040    }
11041    set ret [lsort -unique $ret]
11042    set cached_dheads($origid) $ret
11043    return [concat $ret $aret]
11044}
11045
11046proc addedtag {id} {
11047    global arcnos arcout cached_dtags cached_atags
11048
11049    if {![info exists arcnos($id)]} return
11050    if {![info exists arcout($id)]} {
11051        recalcarc [lindex $arcnos($id) 0]
11052    }
11053    unset -nocomplain cached_dtags
11054    unset -nocomplain cached_atags
11055}
11056
11057proc addedhead {hid head} {
11058    global arcnos arcout cached_dheads
11059
11060    if {![info exists arcnos($hid)]} return
11061    if {![info exists arcout($hid)]} {
11062        recalcarc [lindex $arcnos($hid) 0]
11063    }
11064    unset -nocomplain cached_dheads
11065}
11066
11067proc removedhead {hid head} {
11068    global cached_dheads
11069
11070    unset -nocomplain cached_dheads
11071}
11072
11073proc movedhead {hid head} {
11074    global arcnos arcout cached_dheads
11075
11076    if {![info exists arcnos($hid)]} return
11077    if {![info exists arcout($hid)]} {
11078        recalcarc [lindex $arcnos($hid) 0]
11079    }
11080    unset -nocomplain cached_dheads
11081}
11082
11083proc changedrefs {} {
11084    global cached_dheads cached_dtags cached_atags cached_tagcontent
11085    global arctags archeads arcnos arcout idheads idtags
11086
11087    foreach id [concat [array names idheads] [array names idtags]] {
11088        if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
11089            set a [lindex $arcnos($id) 0]
11090            if {![info exists donearc($a)]} {
11091                recalcarc $a
11092                set donearc($a) 1
11093            }
11094        }
11095    }
11096    unset -nocomplain cached_tagcontent
11097    unset -nocomplain cached_dtags
11098    unset -nocomplain cached_atags
11099    unset -nocomplain cached_dheads
11100}
11101
11102proc rereadrefs {} {
11103    global idtags idheads idotherrefs mainheadid
11104
11105    set refids [concat [array names idtags] \
11106                    [array names idheads] [array names idotherrefs]]
11107    foreach id $refids {
11108        if {![info exists ref($id)]} {
11109            set ref($id) [listrefs $id]
11110        }
11111    }
11112    set oldmainhead $mainheadid
11113    readrefs
11114    changedrefs
11115    set refids [lsort -unique [concat $refids [array names idtags] \
11116                        [array names idheads] [array names idotherrefs]]]
11117    foreach id $refids {
11118        set v [listrefs $id]
11119        if {![info exists ref($id)] || $ref($id) != $v} {
11120            redrawtags $id
11121        }
11122    }
11123    if {$oldmainhead ne $mainheadid} {
11124        redrawtags $oldmainhead
11125        redrawtags $mainheadid
11126    }
11127    run refill_reflist
11128}
11129
11130proc listrefs {id} {
11131    global idtags idheads idotherrefs
11132
11133    set x {}
11134    if {[info exists idtags($id)]} {
11135        set x $idtags($id)
11136    }
11137    set y {}
11138    if {[info exists idheads($id)]} {
11139        set y $idheads($id)
11140    }
11141    set z {}
11142    if {[info exists idotherrefs($id)]} {
11143        set z $idotherrefs($id)
11144    }
11145    return [list $x $y $z]
11146}
11147
11148proc add_tag_ctext {tag} {
11149    global ctext cached_tagcontent tagids
11150
11151    if {![info exists cached_tagcontent($tag)]} {
11152        catch {
11153            set cached_tagcontent($tag) [exec git cat-file -p $tag]
11154        }
11155    }
11156    $ctext insert end "[mc "Tag"]: $tag\n" bold
11157    if {[info exists cached_tagcontent($tag)]} {
11158        set text $cached_tagcontent($tag)
11159    } else {
11160        set text "[mc "Id"]:  $tagids($tag)"
11161    }
11162    appendwithlinks $text {}
11163}
11164
11165proc showtag {tag isnew} {
11166    global ctext cached_tagcontent tagids linknum tagobjid
11167
11168    if {$isnew} {
11169        addtohistory [list showtag $tag 0] savectextpos
11170    }
11171    $ctext conf -state normal
11172    clear_ctext
11173    settabs 0
11174    set linknum 0
11175    add_tag_ctext $tag
11176    maybe_scroll_ctext 1
11177    $ctext conf -state disabled
11178    init_flist {}
11179}
11180
11181proc showtags {id isnew} {
11182    global idtags ctext linknum
11183
11184    if {$isnew} {
11185        addtohistory [list showtags $id 0] savectextpos
11186    }
11187    $ctext conf -state normal
11188    clear_ctext
11189    settabs 0
11190    set linknum 0
11191    set sep {}
11192    foreach tag $idtags($id) {
11193        $ctext insert end $sep
11194        add_tag_ctext $tag
11195        set sep "\n\n"
11196    }
11197    maybe_scroll_ctext 1
11198    $ctext conf -state disabled
11199    init_flist {}
11200}
11201
11202proc doquit {} {
11203    global stopped
11204    global gitktmpdir
11205
11206    set stopped 100
11207    savestuff .
11208    destroy .
11209
11210    if {[info exists gitktmpdir]} {
11211        catch {file delete -force $gitktmpdir}
11212    }
11213}
11214
11215proc mkfontdisp {font top which} {
11216    global fontattr fontpref $font NS use_ttk
11217
11218    set fontpref($font) [set $font]
11219    ${NS}::button $top.${font}but -text $which \
11220        -command [list choosefont $font $which]
11221    ${NS}::label $top.$font -relief flat -font $font \
11222        -text $fontattr($font,family) -justify left
11223    grid x $top.${font}but $top.$font -sticky w
11224}
11225
11226proc choosefont {font which} {
11227    global fontparam fontlist fonttop fontattr
11228    global prefstop NS
11229
11230    set fontparam(which) $which
11231    set fontparam(font) $font
11232    set fontparam(family) [font actual $font -family]
11233    set fontparam(size) $fontattr($font,size)
11234    set fontparam(weight) $fontattr($font,weight)
11235    set fontparam(slant) $fontattr($font,slant)
11236    set top .gitkfont
11237    set fonttop $top
11238    if {![winfo exists $top]} {
11239        font create sample
11240        eval font config sample [font actual $font]
11241        ttk_toplevel $top
11242        make_transient $top $prefstop
11243        wm title $top [mc "Gitk font chooser"]
11244        ${NS}::label $top.l -textvariable fontparam(which)
11245        pack $top.l -side top
11246        set fontlist [lsort [font families]]
11247        ${NS}::frame $top.f
11248        listbox $top.f.fam -listvariable fontlist \
11249            -yscrollcommand [list $top.f.sb set]
11250        bind $top.f.fam <<ListboxSelect>> selfontfam
11251        ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
11252        pack $top.f.sb -side right -fill y
11253        pack $top.f.fam -side left -fill both -expand 1
11254        pack $top.f -side top -fill both -expand 1
11255        ${NS}::frame $top.g
11256        spinbox $top.g.size -from 4 -to 40 -width 4 \
11257            -textvariable fontparam(size) \
11258            -validatecommand {string is integer -strict %s}
11259        checkbutton $top.g.bold -padx 5 \
11260            -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
11261            -variable fontparam(weight) -onvalue bold -offvalue normal
11262        checkbutton $top.g.ital -padx 5 \
11263            -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
11264            -variable fontparam(slant) -onvalue italic -offvalue roman
11265        pack $top.g.size $top.g.bold $top.g.ital -side left
11266        pack $top.g -side top
11267        canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
11268            -background white
11269        $top.c create text 100 25 -anchor center -text $which -font sample \
11270            -fill black -tags text
11271        bind $top.c <Configure> [list centertext $top.c]
11272        pack $top.c -side top -fill x
11273        ${NS}::frame $top.buts
11274        ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
11275        ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
11276        bind $top <Key-Return> fontok
11277        bind $top <Key-Escape> fontcan
11278        grid $top.buts.ok $top.buts.can
11279        grid columnconfigure $top.buts 0 -weight 1 -uniform a
11280        grid columnconfigure $top.buts 1 -weight 1 -uniform a
11281        pack $top.buts -side bottom -fill x
11282        trace add variable fontparam write chg_fontparam
11283    } else {
11284        raise $top
11285        $top.c itemconf text -text $which
11286    }
11287    set i [lsearch -exact $fontlist $fontparam(family)]
11288    if {$i >= 0} {
11289        $top.f.fam selection set $i
11290        $top.f.fam see $i
11291    }
11292}
11293
11294proc centertext {w} {
11295    $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
11296}
11297
11298proc fontok {} {
11299    global fontparam fontpref prefstop
11300
11301    set f $fontparam(font)
11302    set fontpref($f) [list $fontparam(family) $fontparam(size)]
11303    if {$fontparam(weight) eq "bold"} {
11304        lappend fontpref($f) "bold"
11305    }
11306    if {$fontparam(slant) eq "italic"} {
11307        lappend fontpref($f) "italic"
11308    }
11309    set w $prefstop.notebook.fonts.$f
11310    $w conf -text $fontparam(family) -font $fontpref($f)
11311
11312    fontcan
11313}
11314
11315proc fontcan {} {
11316    global fonttop fontparam
11317
11318    if {[info exists fonttop]} {
11319        catch {destroy $fonttop}
11320        catch {font delete sample}
11321        unset fonttop
11322        unset fontparam
11323    }
11324}
11325
11326if {[package vsatisfies [package provide Tk] 8.6]} {
11327    # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
11328    # function to make use of it.
11329    proc choosefont {font which} {
11330        tk fontchooser configure -title $which -font $font \
11331            -command [list on_choosefont $font $which]
11332        tk fontchooser show
11333    }
11334    proc on_choosefont {font which newfont} {
11335        global fontparam
11336        puts stderr "$font $newfont"
11337        array set f [font actual $newfont]
11338        set fontparam(which) $which
11339        set fontparam(font) $font
11340        set fontparam(family) $f(-family)
11341        set fontparam(size) $f(-size)
11342        set fontparam(weight) $f(-weight)
11343        set fontparam(slant) $f(-slant)
11344        fontok
11345    }
11346}
11347
11348proc selfontfam {} {
11349    global fonttop fontparam
11350
11351    set i [$fonttop.f.fam curselection]
11352    if {$i ne {}} {
11353        set fontparam(family) [$fonttop.f.fam get $i]
11354    }
11355}
11356
11357proc chg_fontparam {v sub op} {
11358    global fontparam
11359
11360    font config sample -$sub $fontparam($sub)
11361}
11362
11363# Create a property sheet tab page
11364proc create_prefs_page {w} {
11365    global NS
11366    set parent [join [lrange [split $w .] 0 end-1] .]
11367    if {[winfo class $parent] eq "TNotebook"} {
11368        ${NS}::frame $w
11369    } else {
11370        ${NS}::labelframe $w
11371    }
11372}
11373
11374proc prefspage_general {notebook} {
11375    global NS maxwidth maxgraphpct showneartags showlocalchanges
11376    global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11377    global hideremotes want_ttk have_ttk maxrefs
11378
11379    set page [create_prefs_page $notebook.general]
11380
11381    ${NS}::label $page.ldisp -text [mc "Commit list display options"]
11382    grid $page.ldisp - -sticky w -pady 10
11383    ${NS}::label $page.spacer -text " "
11384    ${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
11385    spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
11386    grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w
11387                                         #xgettext:no-tcl-format
11388    ${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
11389    spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
11390    grid x $page.maxpctl $page.maxpct -sticky w
11391    ${NS}::checkbutton $page.showlocal -text [mc "Show local changes"] \
11392        -variable showlocalchanges
11393    grid x $page.showlocal -sticky w
11394    ${NS}::checkbutton $page.autoselect -text [mc "Auto-select SHA1 (length)"] \
11395        -variable autoselect
11396    spinbox $page.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
11397    grid x $page.autoselect $page.autosellen -sticky w
11398    ${NS}::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \
11399        -variable hideremotes
11400    grid x $page.hideremotes -sticky w
11401
11402    ${NS}::label $page.ddisp -text [mc "Diff display options"]
11403    grid $page.ddisp - -sticky w -pady 10
11404    ${NS}::label $page.tabstopl -text [mc "Tab spacing"]
11405    spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
11406    grid x $page.tabstopl $page.tabstop -sticky w
11407    ${NS}::checkbutton $page.ntag -text [mc "Display nearby tags/heads"] \
11408        -variable showneartags
11409    grid x $page.ntag -sticky w
11410    ${NS}::label $page.maxrefsl -text [mc "Maximum # tags/heads to show"]
11411    spinbox $page.maxrefs -from 1 -to 1000 -width 4 -textvariable maxrefs
11412    grid x $page.maxrefsl $page.maxrefs -sticky w
11413    ${NS}::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \
11414        -variable limitdiffs
11415    grid x $page.ldiff -sticky w
11416    ${NS}::checkbutton $page.lattr -text [mc "Support per-file encodings"] \
11417        -variable perfile_attrs
11418    grid x $page.lattr -sticky w
11419
11420    ${NS}::entry $page.extdifft -textvariable extdifftool
11421    ${NS}::frame $page.extdifff
11422    ${NS}::label $page.extdifff.l -text [mc "External diff tool" ]
11423    ${NS}::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff
11424    pack $page.extdifff.l $page.extdifff.b -side left
11425    pack configure $page.extdifff.l -padx 10
11426    grid x $page.extdifff $page.extdifft -sticky ew
11427
11428    ${NS}::label $page.lgen -text [mc "General options"]
11429    grid $page.lgen - -sticky w -pady 10
11430    ${NS}::checkbutton $page.want_ttk -variable want_ttk \
11431        -text [mc "Use themed widgets"]
11432    if {$have_ttk} {
11433        ${NS}::label $page.ttk_note -text [mc "(change requires restart)"]
11434    } else {
11435        ${NS}::label $page.ttk_note -text [mc "(currently unavailable)"]
11436    }
11437    grid x $page.want_ttk $page.ttk_note -sticky w
11438    return $page
11439}
11440
11441proc prefspage_colors {notebook} {
11442    global NS uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11443
11444    set page [create_prefs_page $notebook.colors]
11445
11446    ${NS}::label $page.cdisp -text [mc "Colors: press to choose"]
11447    grid $page.cdisp - -sticky w -pady 10
11448    label $page.ui -padx 40 -relief sunk -background $uicolor
11449    ${NS}::button $page.uibut -text [mc "Interface"] \
11450       -command [list choosecolor uicolor {} $page.ui [mc "interface"] setui]
11451    grid x $page.uibut $page.ui -sticky w
11452    label $page.bg -padx 40 -relief sunk -background $bgcolor
11453    ${NS}::button $page.bgbut -text [mc "Background"] \
11454        -command [list choosecolor bgcolor {} $page.bg [mc "background"] setbg]
11455    grid x $page.bgbut $page.bg -sticky w
11456    label $page.fg -padx 40 -relief sunk -background $fgcolor
11457    ${NS}::button $page.fgbut -text [mc "Foreground"] \
11458        -command [list choosecolor fgcolor {} $page.fg [mc "foreground"] setfg]
11459    grid x $page.fgbut $page.fg -sticky w
11460    label $page.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
11461    ${NS}::button $page.diffoldbut -text [mc "Diff: old lines"] \
11462        -command [list choosecolor diffcolors 0 $page.diffold [mc "diff old lines"] \
11463                      [list $ctext tag conf d0 -foreground]]
11464    grid x $page.diffoldbut $page.diffold -sticky w
11465    label $page.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
11466    ${NS}::button $page.diffnewbut -text [mc "Diff: new lines"] \
11467        -command [list choosecolor diffcolors 1 $page.diffnew [mc "diff new lines"] \
11468                      [list $ctext tag conf dresult -foreground]]
11469    grid x $page.diffnewbut $page.diffnew -sticky w
11470    label $page.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
11471    ${NS}::button $page.hunksepbut -text [mc "Diff: hunk header"] \
11472        -command [list choosecolor diffcolors 2 $page.hunksep \
11473                      [mc "diff hunk header"] \
11474                      [list $ctext tag conf hunksep -foreground]]
11475    grid x $page.hunksepbut $page.hunksep -sticky w
11476    label $page.markbgsep -padx 40 -relief sunk -background $markbgcolor
11477    ${NS}::button $page.markbgbut -text [mc "Marked line bg"] \
11478        -command [list choosecolor markbgcolor {} $page.markbgsep \
11479                      [mc "marked line background"] \
11480                      [list $ctext tag conf omark -background]]
11481    grid x $page.markbgbut $page.markbgsep -sticky w
11482    label $page.selbgsep -padx 40 -relief sunk -background $selectbgcolor
11483    ${NS}::button $page.selbgbut -text [mc "Select bg"] \
11484        -command [list choosecolor selectbgcolor {} $page.selbgsep [mc "background"] setselbg]
11485    grid x $page.selbgbut $page.selbgsep -sticky w
11486    return $page
11487}
11488
11489proc prefspage_fonts {notebook} {
11490    global NS
11491    set page [create_prefs_page $notebook.fonts]
11492    ${NS}::label $page.cfont -text [mc "Fonts: press to choose"]
11493    grid $page.cfont - -sticky w -pady 10
11494    mkfontdisp mainfont $page [mc "Main font"]
11495    mkfontdisp textfont $page [mc "Diff display font"]
11496    mkfontdisp uifont $page [mc "User interface font"]
11497    return $page
11498}
11499
11500proc doprefs {} {
11501    global maxwidth maxgraphpct use_ttk NS
11502    global oldprefs prefstop showneartags showlocalchanges
11503    global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11504    global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11505    global hideremotes want_ttk have_ttk
11506
11507    set top .gitkprefs
11508    set prefstop $top
11509    if {[winfo exists $top]} {
11510        raise $top
11511        return
11512    }
11513    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11514                   limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11515        set oldprefs($v) [set $v]
11516    }
11517    ttk_toplevel $top
11518    wm title $top [mc "Gitk preferences"]
11519    make_transient $top .
11520
11521    if {[set use_notebook [expr {$use_ttk && [info command ::ttk::notebook] ne ""}]]} {
11522        set notebook [ttk::notebook $top.notebook]
11523    } else {
11524        set notebook [${NS}::frame $top.notebook -borderwidth 0 -relief flat]
11525    }
11526
11527    lappend pages [prefspage_general $notebook] [mc "General"]
11528    lappend pages [prefspage_colors $notebook] [mc "Colors"]
11529    lappend pages [prefspage_fonts $notebook] [mc "Fonts"]
11530    set col 0
11531    foreach {page title} $pages {
11532        if {$use_notebook} {
11533            $notebook add $page -text $title
11534        } else {
11535            set btn [${NS}::button $notebook.b_[string map {. X} $page] \
11536                         -text $title -command [list raise $page]]
11537            $page configure -text $title
11538            grid $btn -row 0 -column [incr col] -sticky w
11539            grid $page -row 1 -column 0 -sticky news -columnspan 100
11540        }
11541    }
11542
11543    if {!$use_notebook} {
11544        grid columnconfigure $notebook 0 -weight 1
11545        grid rowconfigure $notebook 1 -weight 1
11546        raise [lindex $pages 0]
11547    }
11548
11549    grid $notebook -sticky news -padx 2 -pady 2
11550    grid rowconfigure $top 0 -weight 1
11551    grid columnconfigure $top 0 -weight 1
11552
11553    ${NS}::frame $top.buts
11554    ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
11555    ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
11556    bind $top <Key-Return> prefsok
11557    bind $top <Key-Escape> prefscan
11558    grid $top.buts.ok $top.buts.can
11559    grid columnconfigure $top.buts 0 -weight 1 -uniform a
11560    grid columnconfigure $top.buts 1 -weight 1 -uniform a
11561    grid $top.buts - - -pady 10 -sticky ew
11562    grid columnconfigure $top 2 -weight 1
11563    bind $top <Visibility> [list focus $top.buts.ok]
11564}
11565
11566proc choose_extdiff {} {
11567    global extdifftool
11568
11569    set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
11570    if {$prog ne {}} {
11571        set extdifftool $prog
11572    }
11573}
11574
11575proc choosecolor {v vi w x cmd} {
11576    global $v
11577
11578    set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
11579               -title [mc "Gitk: choose color for %s" $x]]
11580    if {$c eq {}} return
11581    $w conf -background $c
11582    lset $v $vi $c
11583    eval $cmd $c
11584}
11585
11586proc setselbg {c} {
11587    global bglist cflist
11588    foreach w $bglist {
11589        if {[winfo exists $w]} {
11590            $w configure -selectbackground $c
11591        }
11592    }
11593    $cflist tag configure highlight \
11594        -background [$cflist cget -selectbackground]
11595    allcanvs itemconf secsel -fill $c
11596}
11597
11598# This sets the background color and the color scheme for the whole UI.
11599# For some reason, tk_setPalette chooses a nasty dark red for selectColor
11600# if we don't specify one ourselves, which makes the checkbuttons and
11601# radiobuttons look bad.  This chooses white for selectColor if the
11602# background color is light, or black if it is dark.
11603proc setui {c} {
11604    if {[tk windowingsystem] eq "win32"} { return }
11605    set bg [winfo rgb . $c]
11606    set selc black
11607    if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
11608        set selc white
11609    }
11610    tk_setPalette background $c selectColor $selc
11611}
11612
11613proc setbg {c} {
11614    global bglist
11615
11616    foreach w $bglist {
11617        if {[winfo exists $w]} {
11618            $w conf -background $c
11619        }
11620    }
11621}
11622
11623proc setfg {c} {
11624    global fglist canv
11625
11626    foreach w $fglist {
11627        if {[winfo exists $w]} {
11628            $w conf -foreground $c
11629        }
11630    }
11631    allcanvs itemconf text -fill $c
11632    $canv itemconf circle -outline $c
11633    $canv itemconf markid -outline $c
11634}
11635
11636proc prefscan {} {
11637    global oldprefs prefstop
11638
11639    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11640                   limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11641        global $v
11642        set $v $oldprefs($v)
11643    }
11644    catch {destroy $prefstop}
11645    unset prefstop
11646    fontcan
11647}
11648
11649proc prefsok {} {
11650    global maxwidth maxgraphpct
11651    global oldprefs prefstop showneartags showlocalchanges
11652    global fontpref mainfont textfont uifont
11653    global limitdiffs treediffs perfile_attrs
11654    global hideremotes
11655
11656    catch {destroy $prefstop}
11657    unset prefstop
11658    fontcan
11659    set fontchanged 0
11660    if {$mainfont ne $fontpref(mainfont)} {
11661        set mainfont $fontpref(mainfont)
11662        parsefont mainfont $mainfont
11663        eval font configure mainfont [fontflags mainfont]
11664        eval font configure mainfontbold [fontflags mainfont 1]
11665        setcoords
11666        set fontchanged 1
11667    }
11668    if {$textfont ne $fontpref(textfont)} {
11669        set textfont $fontpref(textfont)
11670        parsefont textfont $textfont
11671        eval font configure textfont [fontflags textfont]
11672        eval font configure textfontbold [fontflags textfont 1]
11673    }
11674    if {$uifont ne $fontpref(uifont)} {
11675        set uifont $fontpref(uifont)
11676        parsefont uifont $uifont
11677        eval font configure uifont [fontflags uifont]
11678    }
11679    settabs
11680    if {$showlocalchanges != $oldprefs(showlocalchanges)} {
11681        if {$showlocalchanges} {
11682            doshowlocalchanges
11683        } else {
11684            dohidelocalchanges
11685        }
11686    }
11687    if {$limitdiffs != $oldprefs(limitdiffs) ||
11688        ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11689        # treediffs elements are limited by path;
11690        # won't have encodings cached if perfile_attrs was just turned on
11691        unset -nocomplain treediffs
11692    }
11693    if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
11694        || $maxgraphpct != $oldprefs(maxgraphpct)} {
11695        redisplay
11696    } elseif {$showneartags != $oldprefs(showneartags) ||
11697          $limitdiffs != $oldprefs(limitdiffs)} {
11698        reselectline
11699    }
11700    if {$hideremotes != $oldprefs(hideremotes)} {
11701        rereadrefs
11702    }
11703}
11704
11705proc formatdate {d} {
11706    global datetimeformat
11707    if {$d ne {}} {
11708        # If $datetimeformat includes a timezone, display in the
11709        # timezone of the argument.  Otherwise, display in local time.
11710        if {[string match {*%[zZ]*} $datetimeformat]} {
11711            if {[catch {set d [clock format [lindex $d 0] -timezone [lindex $d 1] -format $datetimeformat]}]} {
11712                # Tcl < 8.5 does not support -timezone.  Emulate it by
11713                # setting TZ (e.g. TZ=<-0430>+04:30).
11714                global env
11715                if {[info exists env(TZ)]} {
11716                    set savedTZ $env(TZ)
11717                }
11718                set zone [lindex $d 1]
11719                set sign [string map {+ - - +} [string index $zone 0]]
11720                set env(TZ) <$zone>$sign[string range $zone 1 2]:[string range $zone 3 4]
11721                set d [clock format [lindex $d 0] -format $datetimeformat]
11722                if {[info exists savedTZ]} {
11723                    set env(TZ) $savedTZ
11724                } else {
11725                    unset env(TZ)
11726                }
11727            }
11728        } else {
11729            set d [clock format [lindex $d 0] -format $datetimeformat]
11730        }
11731    }
11732    return $d
11733}
11734
11735# This list of encoding names and aliases is distilled from
11736# http://www.iana.org/assignments/character-sets.
11737# Not all of them are supported by Tcl.
11738set encoding_aliases {
11739    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11740      ISO646-US US-ASCII us IBM367 cp367 csASCII }
11741    { ISO-10646-UTF-1 csISO10646UTF1 }
11742    { ISO_646.basic:1983 ref csISO646basic1983 }
11743    { INVARIANT csINVARIANT }
11744    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11745    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11746    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11747    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11748    { NATS-DANO iso-ir-9-1 csNATSDANO }
11749    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11750    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11751    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11752    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11753    { ISO-2022-KR csISO2022KR }
11754    { EUC-KR csEUCKR }
11755    { ISO-2022-JP csISO2022JP }
11756    { ISO-2022-JP-2 csISO2022JP2 }
11757    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11758      csISO13JISC6220jp }
11759    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11760    { IT iso-ir-15 ISO646-IT csISO15Italian }
11761    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11762    { ES iso-ir-17 ISO646-ES csISO17Spanish }
11763    { greek7-old iso-ir-18 csISO18Greek7Old }
11764    { latin-greek iso-ir-19 csISO19LatinGreek }
11765    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11766    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11767    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11768    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11769    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11770    { BS_viewdata iso-ir-47 csISO47BSViewdata }
11771    { INIS iso-ir-49 csISO49INIS }
11772    { INIS-8 iso-ir-50 csISO50INIS8 }
11773    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11774    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11775    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11776    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11777    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11778    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11779      csISO60Norwegian1 }
11780    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11781    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11782    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11783    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11784    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11785    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11786    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11787    { greek7 iso-ir-88 csISO88Greek7 }
11788    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11789    { iso-ir-90 csISO90 }
11790    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11791    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11792      csISO92JISC62991984b }
11793    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11794    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11795    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11796      csISO95JIS62291984handadd }
11797    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11798    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11799    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11800    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11801      CP819 csISOLatin1 }
11802    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11803    { T.61-7bit iso-ir-102 csISO102T617bit }
11804    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11805    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
11806    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
11807    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
11808    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
11809    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
11810    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
11811    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
11812      arabic csISOLatinArabic }
11813    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
11814    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
11815    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
11816      greek greek8 csISOLatinGreek }
11817    { T.101-G2 iso-ir-128 csISO128T101G2 }
11818    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
11819      csISOLatinHebrew }
11820    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
11821    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
11822    { CSN_369103 iso-ir-139 csISO139CSN369103 }
11823    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
11824    { ISO_6937-2-add iso-ir-142 csISOTextComm }
11825    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
11826    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
11827      csISOLatinCyrillic }
11828    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
11829    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
11830    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
11831    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
11832    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
11833    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
11834    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
11835    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
11836    { ISO_10367-box iso-ir-155 csISO10367Box }
11837    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
11838    { latin-lap lap iso-ir-158 csISO158Lap }
11839    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
11840    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
11841    { us-dk csUSDK }
11842    { dk-us csDKUS }
11843    { JIS_X0201 X0201 csHalfWidthKatakana }
11844    { KSC5636 ISO646-KR csKSC5636 }
11845    { ISO-10646-UCS-2 csUnicode }
11846    { ISO-10646-UCS-4 csUCS4 }
11847    { DEC-MCS dec csDECMCS }
11848    { hp-roman8 roman8 r8 csHPRoman8 }
11849    { macintosh mac csMacintosh }
11850    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
11851      csIBM037 }
11852    { IBM038 EBCDIC-INT cp038 csIBM038 }
11853    { IBM273 CP273 csIBM273 }
11854    { IBM274 EBCDIC-BE CP274 csIBM274 }
11855    { IBM275 EBCDIC-BR cp275 csIBM275 }
11856    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
11857    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
11858    { IBM280 CP280 ebcdic-cp-it csIBM280 }
11859    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
11860    { IBM284 CP284 ebcdic-cp-es csIBM284 }
11861    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
11862    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
11863    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
11864    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
11865    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
11866    { IBM424 cp424 ebcdic-cp-he csIBM424 }
11867    { IBM437 cp437 437 csPC8CodePage437 }
11868    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
11869    { IBM775 cp775 csPC775Baltic }
11870    { IBM850 cp850 850 csPC850Multilingual }
11871    { IBM851 cp851 851 csIBM851 }
11872    { IBM852 cp852 852 csPCp852 }
11873    { IBM855 cp855 855 csIBM855 }
11874    { IBM857 cp857 857 csIBM857 }
11875    { IBM860 cp860 860 csIBM860 }
11876    { IBM861 cp861 861 cp-is csIBM861 }
11877    { IBM862 cp862 862 csPC862LatinHebrew }
11878    { IBM863 cp863 863 csIBM863 }
11879    { IBM864 cp864 csIBM864 }
11880    { IBM865 cp865 865 csIBM865 }
11881    { IBM866 cp866 866 csIBM866 }
11882    { IBM868 CP868 cp-ar csIBM868 }
11883    { IBM869 cp869 869 cp-gr csIBM869 }
11884    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
11885    { IBM871 CP871 ebcdic-cp-is csIBM871 }
11886    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
11887    { IBM891 cp891 csIBM891 }
11888    { IBM903 cp903 csIBM903 }
11889    { IBM904 cp904 904 csIBBM904 }
11890    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
11891    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
11892    { IBM1026 CP1026 csIBM1026 }
11893    { EBCDIC-AT-DE csIBMEBCDICATDE }
11894    { EBCDIC-AT-DE-A csEBCDICATDEA }
11895    { EBCDIC-CA-FR csEBCDICCAFR }
11896    { EBCDIC-DK-NO csEBCDICDKNO }
11897    { EBCDIC-DK-NO-A csEBCDICDKNOA }
11898    { EBCDIC-FI-SE csEBCDICFISE }
11899    { EBCDIC-FI-SE-A csEBCDICFISEA }
11900    { EBCDIC-FR csEBCDICFR }
11901    { EBCDIC-IT csEBCDICIT }
11902    { EBCDIC-PT csEBCDICPT }
11903    { EBCDIC-ES csEBCDICES }
11904    { EBCDIC-ES-A csEBCDICESA }
11905    { EBCDIC-ES-S csEBCDICESS }
11906    { EBCDIC-UK csEBCDICUK }
11907    { EBCDIC-US csEBCDICUS }
11908    { UNKNOWN-8BIT csUnknown8BiT }
11909    { MNEMONIC csMnemonic }
11910    { MNEM csMnem }
11911    { VISCII csVISCII }
11912    { VIQR csVIQR }
11913    { KOI8-R csKOI8R }
11914    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
11915    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
11916    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
11917    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
11918    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
11919    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
11920    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
11921    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
11922    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
11923    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
11924    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
11925    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
11926    { IBM1047 IBM-1047 }
11927    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
11928    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
11929    { UNICODE-1-1 csUnicode11 }
11930    { CESU-8 csCESU-8 }
11931    { BOCU-1 csBOCU-1 }
11932    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
11933    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
11934      l8 }
11935    { ISO-8859-15 ISO_8859-15 Latin-9 }
11936    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
11937    { GBK CP936 MS936 windows-936 }
11938    { JIS_Encoding csJISEncoding }
11939    { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
11940    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
11941      EUC-JP }
11942    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
11943    { ISO-10646-UCS-Basic csUnicodeASCII }
11944    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
11945    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
11946    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
11947    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
11948    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
11949    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
11950    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
11951    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
11952    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
11953    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
11954    { Adobe-Standard-Encoding csAdobeStandardEncoding }
11955    { Ventura-US csVenturaUS }
11956    { Ventura-International csVenturaInternational }
11957    { PC8-Danish-Norwegian csPC8DanishNorwegian }
11958    { PC8-Turkish csPC8Turkish }
11959    { IBM-Symbols csIBMSymbols }
11960    { IBM-Thai csIBMThai }
11961    { HP-Legal csHPLegal }
11962    { HP-Pi-font csHPPiFont }
11963    { HP-Math8 csHPMath8 }
11964    { Adobe-Symbol-Encoding csHPPSMath }
11965    { HP-DeskTop csHPDesktop }
11966    { Ventura-Math csVenturaMath }
11967    { Microsoft-Publishing csMicrosoftPublishing }
11968    { Windows-31J csWindows31J }
11969    { GB2312 csGB2312 }
11970    { Big5 csBig5 }
11971}
11972
11973proc tcl_encoding {enc} {
11974    global encoding_aliases tcl_encoding_cache
11975    if {[info exists tcl_encoding_cache($enc)]} {
11976        return $tcl_encoding_cache($enc)
11977    }
11978    set names [encoding names]
11979    set lcnames [string tolower $names]
11980    set enc [string tolower $enc]
11981    set i [lsearch -exact $lcnames $enc]
11982    if {$i < 0} {
11983        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
11984        if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
11985            set i [lsearch -exact $lcnames $encx]
11986        }
11987    }
11988    if {$i < 0} {
11989        foreach l $encoding_aliases {
11990            set ll [string tolower $l]
11991            if {[lsearch -exact $ll $enc] < 0} continue
11992            # look through the aliases for one that tcl knows about
11993            foreach e $ll {
11994                set i [lsearch -exact $lcnames $e]
11995                if {$i < 0} {
11996                    if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
11997                        set i [lsearch -exact $lcnames $ex]
11998                    }
11999                }
12000                if {$i >= 0} break
12001            }
12002            break
12003        }
12004    }
12005    set tclenc {}
12006    if {$i >= 0} {
12007        set tclenc [lindex $names $i]
12008    }
12009    set tcl_encoding_cache($enc) $tclenc
12010    return $tclenc
12011}
12012
12013proc gitattr {path attr default} {
12014    global path_attr_cache
12015    if {[info exists path_attr_cache($attr,$path)]} {
12016        set r $path_attr_cache($attr,$path)
12017    } else {
12018        set r "unspecified"
12019        if {![catch {set line [exec git check-attr $attr -- $path]}]} {
12020            regexp "(.*): $attr: (.*)" $line m f r
12021        }
12022        set path_attr_cache($attr,$path) $r
12023    }
12024    if {$r eq "unspecified"} {
12025        return $default
12026    }
12027    return $r
12028}
12029
12030proc cache_gitattr {attr pathlist} {
12031    global path_attr_cache
12032    set newlist {}
12033    foreach path $pathlist {
12034        if {![info exists path_attr_cache($attr,$path)]} {
12035            lappend newlist $path
12036        }
12037    }
12038    set lim 1000
12039    if {[tk windowingsystem] == "win32"} {
12040        # windows has a 32k limit on the arguments to a command...
12041        set lim 30
12042    }
12043    while {$newlist ne {}} {
12044        set head [lrange $newlist 0 [expr {$lim - 1}]]
12045        set newlist [lrange $newlist $lim end]
12046        if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
12047            foreach row [split $rlist "\n"] {
12048                if {[regexp "(.*): $attr: (.*)" $row m path value]} {
12049                    if {[string index $path 0] eq "\""} {
12050                        set path [encoding convertfrom [lindex $path 0]]
12051                    }
12052                    set path_attr_cache($attr,$path) $value
12053                }
12054            }
12055        }
12056    }
12057}
12058
12059proc get_path_encoding {path} {
12060    global gui_encoding perfile_attrs
12061    set tcl_enc $gui_encoding
12062    if {$path ne {} && $perfile_attrs} {
12063        set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
12064        if {$enc2 ne {}} {
12065            set tcl_enc $enc2
12066        }
12067    }
12068    return $tcl_enc
12069}
12070
12071## For msgcat loading, first locate the installation location.
12072if { [info exists ::env(GITK_MSGSDIR)] } {
12073    ## Msgsdir was manually set in the environment.
12074    set gitk_msgsdir $::env(GITK_MSGSDIR)
12075} else {
12076    ## Let's guess the prefix from argv0.
12077    set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
12078    set gitk_libdir [file join $gitk_prefix share gitk lib]
12079    set gitk_msgsdir [file join $gitk_libdir msgs]
12080    unset gitk_prefix
12081}
12082
12083## Internationalization (i18n) through msgcat and gettext. See
12084## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
12085package require msgcat
12086namespace import ::msgcat::mc
12087## And eventually load the actual message catalog
12088::msgcat::mcload $gitk_msgsdir
12089
12090# First check that Tcl/Tk is recent enough
12091if {[catch {package require Tk 8.4} err]} {
12092    show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
12093                         Gitk requires at least Tcl/Tk 8.4."]
12094    exit 1
12095}
12096
12097# on OSX bring the current Wish process window to front
12098if {[tk windowingsystem] eq "aqua"} {
12099    exec osascript -e [format {
12100        tell application "System Events"
12101            set frontmost of processes whose unix id is %d to true
12102        end tell
12103    } [pid] ]
12104}
12105
12106# Unset GIT_TRACE var if set
12107if { [info exists ::env(GIT_TRACE)] } {
12108    unset ::env(GIT_TRACE)
12109}
12110
12111# defaults...
12112set wrcomcmd "git diff-tree --stdin -p --pretty=email"
12113
12114set gitencoding {}
12115catch {
12116    set gitencoding [exec git config --get i18n.commitencoding]
12117}
12118catch {
12119    set gitencoding [exec git config --get i18n.logoutputencoding]
12120}
12121if {$gitencoding == ""} {
12122    set gitencoding "utf-8"
12123}
12124set tclencoding [tcl_encoding $gitencoding]
12125if {$tclencoding == {}} {
12126    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
12127}
12128
12129set gui_encoding [encoding system]
12130catch {
12131    set enc [exec git config --get gui.encoding]
12132    if {$enc ne {}} {
12133        set tclenc [tcl_encoding $enc]
12134        if {$tclenc ne {}} {
12135            set gui_encoding $tclenc
12136        } else {
12137            puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
12138        }
12139    }
12140}
12141
12142set log_showroot true
12143catch {
12144    set log_showroot [exec git config --bool --get log.showroot]
12145}
12146
12147if {[tk windowingsystem] eq "aqua"} {
12148    set mainfont {{Lucida Grande} 9}
12149    set textfont {Monaco 9}
12150    set uifont {{Lucida Grande} 9 bold}
12151} elseif {![catch {::tk::pkgconfig get fontsystem} xft] && $xft eq "xft"} {
12152    # fontconfig!
12153    set mainfont {sans 9}
12154    set textfont {monospace 9}
12155    set uifont {sans 9 bold}
12156} else {
12157    set mainfont {Helvetica 9}
12158    set textfont {Courier 9}
12159    set uifont {Helvetica 9 bold}
12160}
12161set tabstop 8
12162set findmergefiles 0
12163set maxgraphpct 50
12164set maxwidth 16
12165set revlistorder 0
12166set fastdate 0
12167set uparrowlen 5
12168set downarrowlen 5
12169set mingaplen 100
12170set cmitmode "patch"
12171set wrapcomment "none"
12172set showneartags 1
12173set hideremotes 0
12174set maxrefs 20
12175set visiblerefs {"master"}
12176set maxlinelen 200
12177set showlocalchanges 1
12178set limitdiffs 1
12179set datetimeformat "%Y-%m-%d %H:%M:%S"
12180set autoselect 1
12181set autosellen 40
12182set perfile_attrs 0
12183set want_ttk 1
12184
12185if {[tk windowingsystem] eq "aqua"} {
12186    set extdifftool "opendiff"
12187} else {
12188    set extdifftool "meld"
12189}
12190
12191set colors {lime red blue magenta darkgrey brown orange}
12192if {[tk windowingsystem] eq "win32"} {
12193    set uicolor SystemButtonFace
12194    set uifgcolor SystemButtonText
12195    set uifgdisabledcolor SystemDisabledText
12196    set bgcolor SystemWindow
12197    set fgcolor SystemWindowText
12198    set selectbgcolor SystemHighlight
12199} else {
12200    set uicolor grey85
12201    set uifgcolor black
12202    set uifgdisabledcolor "#999"
12203    set bgcolor white
12204    set fgcolor black
12205    set selectbgcolor gray85
12206}
12207set diffcolors {red "#00a000" blue}
12208set diffcontext 3
12209set mergecolors {red blue lime purple brown "#009090" magenta "#808000" "#009000" "#ff0080" cyan "#b07070" "#70b0f0" "#70f0b0" "#f0b070" "#ff70b0"}
12210set ignorespace 0
12211set worddiff ""
12212set markbgcolor "#e0e0ff"
12213
12214set headbgcolor lime
12215set headfgcolor black
12216set headoutlinecolor black
12217set remotebgcolor #ffddaa
12218set tagbgcolor yellow
12219set tagfgcolor black
12220set tagoutlinecolor black
12221set reflinecolor black
12222set filesepbgcolor #aaaaaa
12223set filesepfgcolor black
12224set linehoverbgcolor #ffff80
12225set linehoverfgcolor black
12226set linehoveroutlinecolor black
12227set mainheadcirclecolor yellow
12228set workingfilescirclecolor red
12229set indexcirclecolor lime
12230set circlecolors {white blue gray blue blue}
12231set linkfgcolor blue
12232set circleoutlinecolor $fgcolor
12233set foundbgcolor yellow
12234set currentsearchhitbgcolor orange
12235
12236# button for popping up context menus
12237if {[tk windowingsystem] eq "aqua"} {
12238    set ctxbut <Button-2>
12239} else {
12240    set ctxbut <Button-3>
12241}
12242
12243catch {
12244    # follow the XDG base directory specification by default. See
12245    # http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html
12246    if {[info exists env(XDG_CONFIG_HOME)] && $env(XDG_CONFIG_HOME) ne ""} {
12247        # XDG_CONFIG_HOME environment variable is set
12248        set config_file [file join $env(XDG_CONFIG_HOME) git gitk]
12249        set config_file_tmp [file join $env(XDG_CONFIG_HOME) git gitk-tmp]
12250    } else {
12251        # default XDG_CONFIG_HOME
12252        set config_file "~/.config/git/gitk"
12253        set config_file_tmp "~/.config/git/gitk-tmp"
12254    }
12255    if {![file exists $config_file]} {
12256        # for backward compatibility use the old config file if it exists
12257        if {[file exists "~/.gitk"]} {
12258            set config_file "~/.gitk"
12259            set config_file_tmp "~/.gitk-tmp"
12260        } elseif {![file exists [file dirname $config_file]]} {
12261            file mkdir [file dirname $config_file]
12262        }
12263    }
12264    source $config_file
12265}
12266config_check_tmp_exists 50
12267
12268set config_variables {
12269    mainfont textfont uifont tabstop findmergefiles maxgraphpct maxwidth
12270    cmitmode wrapcomment autoselect autosellen showneartags maxrefs visiblerefs
12271    hideremotes showlocalchanges datetimeformat limitdiffs uicolor want_ttk
12272    bgcolor fgcolor uifgcolor uifgdisabledcolor colors diffcolors mergecolors
12273    markbgcolor diffcontext selectbgcolor foundbgcolor currentsearchhitbgcolor
12274    extdifftool perfile_attrs headbgcolor headfgcolor headoutlinecolor
12275    remotebgcolor tagbgcolor tagfgcolor tagoutlinecolor reflinecolor
12276    filesepbgcolor filesepfgcolor linehoverbgcolor linehoverfgcolor
12277    linehoveroutlinecolor mainheadcirclecolor workingfilescirclecolor
12278    indexcirclecolor circlecolors linkfgcolor circleoutlinecolor
12279}
12280foreach var $config_variables {
12281    config_init_trace $var
12282    trace add variable $var write config_variable_change_cb
12283}
12284
12285parsefont mainfont $mainfont
12286eval font create mainfont [fontflags mainfont]
12287eval font create mainfontbold [fontflags mainfont 1]
12288
12289parsefont textfont $textfont
12290eval font create textfont [fontflags textfont]
12291eval font create textfontbold [fontflags textfont 1]
12292
12293parsefont uifont $uifont
12294eval font create uifont [fontflags uifont]
12295
12296setui $uicolor
12297
12298setoptions
12299
12300# check that we can find a .git directory somewhere...
12301if {[catch {set gitdir [exec git rev-parse --git-dir]}]} {
12302    show_error {} . [mc "Cannot find a git repository here."]
12303    exit 1
12304}
12305
12306set selecthead {}
12307set selectheadid {}
12308
12309set revtreeargs {}
12310set cmdline_files {}
12311set i 0
12312set revtreeargscmd {}
12313foreach arg $argv {
12314    switch -glob -- $arg {
12315        "" { }
12316        "--" {
12317            set cmdline_files [lrange $argv [expr {$i + 1}] end]
12318            break
12319        }
12320        "--select-commit=*" {
12321            set selecthead [string range $arg 16 end]
12322        }
12323        "--argscmd=*" {
12324            set revtreeargscmd [string range $arg 10 end]
12325        }
12326        default {
12327            lappend revtreeargs $arg
12328        }
12329    }
12330    incr i
12331}
12332
12333if {$selecthead eq "HEAD"} {
12334    set selecthead {}
12335}
12336
12337if {$i >= [llength $argv] && $revtreeargs ne {}} {
12338    # no -- on command line, but some arguments (other than --argscmd)
12339    if {[catch {
12340        set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
12341        set cmdline_files [split $f "\n"]
12342        set n [llength $cmdline_files]
12343        set revtreeargs [lrange $revtreeargs 0 end-$n]
12344        # Unfortunately git rev-parse doesn't produce an error when
12345        # something is both a revision and a filename.  To be consistent
12346        # with git log and git rev-list, check revtreeargs for filenames.
12347        foreach arg $revtreeargs {
12348            if {[file exists $arg]} {
12349                show_error {} . [mc "Ambiguous argument '%s': both revision\
12350                                 and filename" $arg]
12351                exit 1
12352            }
12353        }
12354    } err]} {
12355        # unfortunately we get both stdout and stderr in $err,
12356        # so look for "fatal:".
12357        set i [string first "fatal:" $err]
12358        if {$i > 0} {
12359            set err [string range $err [expr {$i + 6}] end]
12360        }
12361        show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
12362        exit 1
12363    }
12364}
12365
12366set nullid "0000000000000000000000000000000000000000"
12367set nullid2 "0000000000000000000000000000000000000001"
12368set nullfile "/dev/null"
12369
12370set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
12371if {![info exists have_ttk]} {
12372    set have_ttk [llength [info commands ::ttk::style]]
12373}
12374set use_ttk [expr {$have_ttk && $want_ttk}]
12375set NS [expr {$use_ttk ? "ttk" : ""}]
12376
12377if {$use_ttk} {
12378    setttkstyle
12379}
12380
12381regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
12382
12383set show_notes {}
12384if {[package vcompare $git_version "1.6.6.2"] >= 0} {
12385    set show_notes "--show-notes"
12386}
12387
12388set appname "gitk"
12389
12390set runq {}
12391set history {}
12392set historyindex 0
12393set fh_serial 0
12394set nhl_names {}
12395set highlight_paths {}
12396set findpattern {}
12397set searchdirn -forwards
12398set boldids {}
12399set boldnameids {}
12400set diffelide {0 0}
12401set markingmatches 0
12402set linkentercount 0
12403set need_redisplay 0
12404set nrows_drawn 0
12405set firsttabstop 0
12406
12407set nextviewnum 1
12408set curview 0
12409set selectedview 0
12410set selectedhlview [mc "None"]
12411set highlight_related [mc "None"]
12412set highlight_files {}
12413set viewfiles(0) {}
12414set viewperm(0) 0
12415set viewchanged(0) 0
12416set viewargs(0) {}
12417set viewargscmd(0) {}
12418
12419set selectedline {}
12420set numcommits 0
12421set loginstance 0
12422set cmdlineok 0
12423set stopped 0
12424set stuffsaved 0
12425set patchnum 0
12426set lserial 0
12427set hasworktree [hasworktree]
12428set cdup {}
12429if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} {
12430    set cdup [exec git rev-parse --show-cdup]
12431}
12432set worktree [exec git rev-parse --show-toplevel]
12433setcoords
12434makewindow
12435catch {
12436    image create photo gitlogo      -width 16 -height 16
12437
12438    image create photo gitlogominus -width  4 -height  2
12439    gitlogominus put #C00000 -to 0 0 4 2
12440    gitlogo copy gitlogominus -to  1 5
12441    gitlogo copy gitlogominus -to  6 5
12442    gitlogo copy gitlogominus -to 11 5
12443    image delete gitlogominus
12444
12445    image create photo gitlogoplus  -width  4 -height  4
12446    gitlogoplus  put #008000 -to 1 0 3 4
12447    gitlogoplus  put #008000 -to 0 1 4 3
12448    gitlogo copy gitlogoplus  -to  1 9
12449    gitlogo copy gitlogoplus  -to  6 9
12450    gitlogo copy gitlogoplus  -to 11 9
12451    image delete gitlogoplus
12452
12453    image create photo gitlogo32    -width 32 -height 32
12454    gitlogo32 copy gitlogo -zoom 2 2
12455
12456    wm iconphoto . -default gitlogo gitlogo32
12457}
12458# wait for the window to become visible
12459tkwait visibility .
12460set_window_title
12461update
12462readrefs
12463
12464if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
12465    # create a view for the files/dirs specified on the command line
12466    set curview 1
12467    set selectedview 1
12468    set nextviewnum 2
12469    set viewname(1) [mc "Command line"]
12470    set viewfiles(1) $cmdline_files
12471    set viewargs(1) $revtreeargs
12472    set viewargscmd(1) $revtreeargscmd
12473    set viewperm(1) 0
12474    set viewchanged(1) 0
12475    set vdatemode(1) 0
12476    addviewmenu 1
12477    .bar.view entryconf [mca "&Edit view..."] -state normal
12478    .bar.view entryconf [mca "&Delete view"] -state normal
12479}
12480
12481if {[info exists permviews]} {
12482    foreach v $permviews {
12483        set n $nextviewnum
12484        incr nextviewnum
12485        set viewname($n) [lindex $v 0]
12486        set viewfiles($n) [lindex $v 1]
12487        set viewargs($n) [lindex $v 2]
12488        set viewargscmd($n) [lindex $v 3]
12489        set viewperm($n) 1
12490        set viewchanged($n) 0
12491        addviewmenu $n
12492    }
12493}
12494
12495if {[tk windowingsystem] eq "win32"} {
12496    focus -force .
12497}
12498
12499getcommits {}
12500
12501# Local variables:
12502# mode: tcl
12503# indent-tabs-mode: t
12504# tab-width: 8
12505# End: