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