gitkon commit gitk: Include commit title in branch dialog (7f00f4c)
   1#!/bin/sh
   2# Tcl ignores the next line -*- tcl -*- \
   3exec wish "$0" -- "$@"
   4
   5# Copyright © 2005-2014 Paul Mackerras.  All rights reserved.
   6# This program is free software; it may be used, copied, modified
   7# and distributed under the terms of the GNU General Public Licence,
   8# either version 2, or (at your option) any later version.
   9
  10package require Tk
  11
  12proc hasworktree {} {
  13    return [expr {[exec git rev-parse --is-bare-repository] == "false" &&
  14                  [exec git rev-parse --is-inside-git-dir] == "false"}]
  15}
  16
  17proc reponame {} {
  18    global gitdir
  19    set n [file normalize $gitdir]
  20    if {[string match "*/.git" $n]} {
  21        set n [string range $n 0 end-5]
  22    }
  23    return [file tail $n]
  24}
  25
  26proc gitworktree {} {
  27    variable _gitworktree
  28    if {[info exists _gitworktree]} {
  29        return $_gitworktree
  30    }
  31    # v1.7.0 introduced --show-toplevel to return the canonical work-tree
  32    if {[catch {set _gitworktree [exec git rev-parse --show-toplevel]}]} {
  33        # try to set work tree from environment, core.worktree or use
  34        # cdup to obtain a relative path to the top of the worktree. If
  35        # run from the top, the ./ prefix ensures normalize expands pwd.
  36        if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
  37            catch {set _gitworktree [exec git config --get core.worktree]}
  38            if {$_gitworktree eq ""} {
  39                set _gitworktree [file normalize ./[exec git rev-parse --show-cdup]]
  40            }
  41        }
  42    }
  43    return $_gitworktree
  44}
  45
  46# A simple scheduler for compute-intensive stuff.
  47# The aim is to make sure that event handlers for GUI actions can
  48# run at least every 50-100 ms.  Unfortunately fileevent handlers are
  49# run before X event handlers, so reading from a fast source can
  50# make the GUI completely unresponsive.
  51proc run args {
  52    global isonrunq runq currunq
  53
  54    set script $args
  55    if {[info exists isonrunq($script)]} return
  56    if {$runq eq {} && ![info exists currunq]} {
  57        after idle dorunq
  58    }
  59    lappend runq [list {} $script]
  60    set isonrunq($script) 1
  61}
  62
  63proc filerun {fd script} {
  64    fileevent $fd readable [list filereadable $fd $script]
  65}
  66
  67proc filereadable {fd script} {
  68    global runq currunq
  69
  70    fileevent $fd readable {}
  71    if {$runq eq {} && ![info exists currunq]} {
  72        after idle dorunq
  73    }
  74    lappend runq [list $fd $script]
  75}
  76
  77proc nukefile {fd} {
  78    global runq
  79
  80    for {set i 0} {$i < [llength $runq]} {} {
  81        if {[lindex $runq $i 0] eq $fd} {
  82            set runq [lreplace $runq $i $i]
  83        } else {
  84            incr i
  85        }
  86    }
  87}
  88
  89proc dorunq {} {
  90    global isonrunq runq currunq
  91
  92    set tstart [clock clicks -milliseconds]
  93    set t0 $tstart
  94    while {[llength $runq] > 0} {
  95        set fd [lindex $runq 0 0]
  96        set script [lindex $runq 0 1]
  97        set currunq [lindex $runq 0]
  98        set runq [lrange $runq 1 end]
  99        set repeat [eval $script]
 100        unset currunq
 101        set t1 [clock clicks -milliseconds]
 102        set t [expr {$t1 - $t0}]
 103        if {$repeat ne {} && $repeat} {
 104            if {$fd eq {} || $repeat == 2} {
 105                # script returns 1 if it wants to be readded
 106                # file readers return 2 if they could do more straight away
 107                lappend runq [list $fd $script]
 108            } else {
 109                fileevent $fd readable [list filereadable $fd $script]
 110            }
 111        } elseif {$fd eq {}} {
 112            unset isonrunq($script)
 113        }
 114        set t0 $t1
 115        if {$t1 - $tstart >= 80} break
 116    }
 117    if {$runq ne {}} {
 118        after idle dorunq
 119    }
 120}
 121
 122proc reg_instance {fd} {
 123    global commfd leftover loginstance
 124
 125    set i [incr loginstance]
 126    set commfd($i) $fd
 127    set leftover($i) {}
 128    return $i
 129}
 130
 131proc unmerged_files {files} {
 132    global nr_unmerged
 133
 134    # find the list of unmerged files
 135    set mlist {}
 136    set nr_unmerged 0
 137    if {[catch {
 138        set fd [open "| git ls-files -u" r]
 139    } err]} {
 140        show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
 141        exit 1
 142    }
 143    while {[gets $fd line] >= 0} {
 144        set i [string first "\t" $line]
 145        if {$i < 0} continue
 146        set fname [string range $line [expr {$i+1}] end]
 147        if {[lsearch -exact $mlist $fname] >= 0} continue
 148        incr nr_unmerged
 149        if {$files eq {} || [path_filter $files $fname]} {
 150            lappend mlist $fname
 151        }
 152    }
 153    catch {close $fd}
 154    return $mlist
 155}
 156
 157proc parseviewargs {n arglist} {
 158    global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs env
 159    global vinlinediff
 160    global worddiff git_version
 161
 162    set vdatemode($n) 0
 163    set vmergeonly($n) 0
 164    set vinlinediff($n) 0
 165    set glflags {}
 166    set diffargs {}
 167    set nextisval 0
 168    set revargs {}
 169    set origargs $arglist
 170    set allknown 1
 171    set filtered 0
 172    set i -1
 173    foreach arg $arglist {
 174        incr i
 175        if {$nextisval} {
 176            lappend glflags $arg
 177            set nextisval 0
 178            continue
 179        }
 180        switch -glob -- $arg {
 181            "-d" -
 182            "--date-order" {
 183                set vdatemode($n) 1
 184                # remove from origargs in case we hit an unknown option
 185                set origargs [lreplace $origargs $i $i]
 186                incr i -1
 187            }
 188            "-[puabwcrRBMC]" -
 189            "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
 190            "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
 191            "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
 192            "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
 193            "--ignore-space-change" - "-U*" - "--unified=*" {
 194                # These request or affect diff output, which we don't want.
 195                # Some could be used to set our defaults for diff display.
 196                lappend diffargs $arg
 197            }
 198            "--raw" - "--patch-with-raw" - "--patch-with-stat" -
 199            "--name-only" - "--name-status" - "--color" -
 200            "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
 201            "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
 202            "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
 203            "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
 204            "--objects" - "--objects-edge" - "--reverse" {
 205                # These cause our parsing of git log's output to fail, or else
 206                # they're options we want to set ourselves, so ignore them.
 207            }
 208            "--color-words*" - "--word-diff=color" {
 209                # These trigger a word diff in the console interface,
 210                # so help the user by enabling our own support
 211                if {[package vcompare $git_version "1.7.2"] >= 0} {
 212                    set worddiff [mc "Color words"]
 213                }
 214            }
 215            "--word-diff*" {
 216                if {[package vcompare $git_version "1.7.2"] >= 0} {
 217                    set worddiff [mc "Markup words"]
 218                }
 219            }
 220            "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
 221            "--check" - "--exit-code" - "--quiet" - "--topo-order" -
 222            "--full-history" - "--dense" - "--sparse" -
 223            "--follow" - "--left-right" - "--encoding=*" {
 224                # These are harmless, and some are even useful
 225                lappend glflags $arg
 226            }
 227            "--diff-filter=*" - "--no-merges" - "--unpacked" -
 228            "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
 229            "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
 230            "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
 231            "--remove-empty" - "--first-parent" - "--cherry-pick" -
 232            "-S*" - "-G*" - "--pickaxe-all" - "--pickaxe-regex" -
 233            "--simplify-by-decoration" {
 234                # These mean that we get a subset of the commits
 235                set filtered 1
 236                lappend glflags $arg
 237            }
 238            "-L*" {
 239                # Line-log with 'stuck' argument (unstuck form is
 240                # not supported)
 241                set filtered 1
 242                set vinlinediff($n) 1
 243                set allknown 0
 244                lappend glflags $arg
 245            }
 246            "-n" {
 247                # This appears to be the only one that has a value as a
 248                # separate word following it
 249                set filtered 1
 250                set nextisval 1
 251                lappend glflags $arg
 252            }
 253            "--not" - "--all" {
 254                lappend revargs $arg
 255            }
 256            "--merge" {
 257                set vmergeonly($n) 1
 258                # git rev-parse doesn't understand --merge
 259                lappend revargs --gitk-symmetric-diff-marker MERGE_HEAD...HEAD
 260            }
 261            "--no-replace-objects" {
 262                set env(GIT_NO_REPLACE_OBJECTS) "1"
 263            }
 264            "-*" {
 265                # Other flag arguments including -<n>
 266                if {[string is digit -strict [string range $arg 1 end]]} {
 267                    set filtered 1
 268                } else {
 269                    # a flag argument that we don't recognize;
 270                    # that means we can't optimize
 271                    set allknown 0
 272                }
 273                lappend glflags $arg
 274            }
 275            default {
 276                # Non-flag arguments specify commits or ranges of commits
 277                if {[string match "*...*" $arg]} {
 278                    lappend revargs --gitk-symmetric-diff-marker
 279                }
 280                lappend revargs $arg
 281            }
 282        }
 283    }
 284    set vdflags($n) $diffargs
 285    set vflags($n) $glflags
 286    set vrevs($n) $revargs
 287    set vfiltered($n) $filtered
 288    set vorigargs($n) $origargs
 289    return $allknown
 290}
 291
 292proc parseviewrevs {view revs} {
 293    global vposids vnegids
 294
 295    if {$revs eq {}} {
 296        set revs HEAD
 297    } elseif {[lsearch -exact $revs --all] >= 0} {
 298        lappend revs HEAD
 299    }
 300    if {[catch {set ids [eval exec git rev-parse $revs]} err]} {
 301        # we get stdout followed by stderr in $err
 302        # for an unknown rev, git rev-parse echoes it and then errors out
 303        set errlines [split $err "\n"]
 304        set badrev {}
 305        for {set l 0} {$l < [llength $errlines]} {incr l} {
 306            set line [lindex $errlines $l]
 307            if {!([string length $line] == 40 && [string is xdigit $line])} {
 308                if {[string match "fatal:*" $line]} {
 309                    if {[string match "fatal: ambiguous argument*" $line]
 310                        && $badrev ne {}} {
 311                        if {[llength $badrev] == 1} {
 312                            set err "unknown revision $badrev"
 313                        } else {
 314                            set err "unknown revisions: [join $badrev ", "]"
 315                        }
 316                    } else {
 317                        set err [join [lrange $errlines $l end] "\n"]
 318                    }
 319                    break
 320                }
 321                lappend badrev $line
 322            }
 323        }
 324        error_popup "[mc "Error parsing revisions:"] $err"
 325        return {}
 326    }
 327    set ret {}
 328    set pos {}
 329    set neg {}
 330    set sdm 0
 331    foreach id [split $ids "\n"] {
 332        if {$id eq "--gitk-symmetric-diff-marker"} {
 333            set sdm 4
 334        } elseif {[string match "^*" $id]} {
 335            if {$sdm != 1} {
 336                lappend ret $id
 337                if {$sdm == 3} {
 338                    set sdm 0
 339                }
 340            }
 341            lappend neg [string range $id 1 end]
 342        } else {
 343            if {$sdm != 2} {
 344                lappend ret $id
 345            } else {
 346                lset ret end $id...[lindex $ret end]
 347            }
 348            lappend pos $id
 349        }
 350        incr sdm -1
 351    }
 352    set vposids($view) $pos
 353    set vnegids($view) $neg
 354    return $ret
 355}
 356
 357# Start off a git log process and arrange to read its output
 358proc start_rev_list {view} {
 359    global startmsecs commitidx viewcomplete curview
 360    global tclencoding
 361    global viewargs viewargscmd viewfiles vfilelimit
 362    global showlocalchanges
 363    global viewactive viewinstances vmergeonly
 364    global mainheadid viewmainheadid viewmainheadid_orig
 365    global vcanopt vflags vrevs vorigargs
 366    global show_notes
 367
 368    set startmsecs [clock clicks -milliseconds]
 369    set commitidx($view) 0
 370    # these are set this way for the error exits
 371    set viewcomplete($view) 1
 372    set viewactive($view) 0
 373    varcinit $view
 374
 375    set args $viewargs($view)
 376    if {$viewargscmd($view) ne {}} {
 377        if {[catch {
 378            set str [exec sh -c $viewargscmd($view)]
 379        } err]} {
 380            error_popup "[mc "Error executing --argscmd command:"] $err"
 381            return 0
 382        }
 383        set args [concat $args [split $str "\n"]]
 384    }
 385    set vcanopt($view) [parseviewargs $view $args]
 386
 387    set files $viewfiles($view)
 388    if {$vmergeonly($view)} {
 389        set files [unmerged_files $files]
 390        if {$files eq {}} {
 391            global nr_unmerged
 392            if {$nr_unmerged == 0} {
 393                error_popup [mc "No files selected: --merge specified but\
 394                             no files are unmerged."]
 395            } else {
 396                error_popup [mc "No files selected: --merge specified but\
 397                             no unmerged files are within file limit."]
 398            }
 399            return 0
 400        }
 401    }
 402    set vfilelimit($view) $files
 403
 404    if {$vcanopt($view)} {
 405        set revs [parseviewrevs $view $vrevs($view)]
 406        if {$revs eq {}} {
 407            return 0
 408        }
 409        set args [concat $vflags($view) $revs]
 410    } else {
 411        set args $vorigargs($view)
 412    }
 413
 414    if {[catch {
 415        set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
 416                        --parents --boundary $args "--" $files] r]
 417    } err]} {
 418        error_popup "[mc "Error executing git log:"] $err"
 419        return 0
 420    }
 421    set i [reg_instance $fd]
 422    set viewinstances($view) [list $i]
 423    set viewmainheadid($view) $mainheadid
 424    set viewmainheadid_orig($view) $mainheadid
 425    if {$files ne {} && $mainheadid ne {}} {
 426        get_viewmainhead $view
 427    }
 428    if {$showlocalchanges && $viewmainheadid($view) ne {}} {
 429        interestedin $viewmainheadid($view) dodiffindex
 430    }
 431    fconfigure $fd -blocking 0 -translation lf -eofchar {}
 432    if {$tclencoding != {}} {
 433        fconfigure $fd -encoding $tclencoding
 434    }
 435    filerun $fd [list getcommitlines $fd $i $view 0]
 436    nowbusy $view [mc "Reading"]
 437    set viewcomplete($view) 0
 438    set viewactive($view) 1
 439    return 1
 440}
 441
 442proc stop_instance {inst} {
 443    global commfd leftover
 444
 445    set fd $commfd($inst)
 446    catch {
 447        set pid [pid $fd]
 448
 449        if {$::tcl_platform(platform) eq {windows}} {
 450            exec taskkill /pid $pid
 451        } else {
 452            exec kill $pid
 453        }
 454    }
 455    catch {close $fd}
 456    nukefile $fd
 457    unset commfd($inst)
 458    unset leftover($inst)
 459}
 460
 461proc stop_backends {} {
 462    global commfd
 463
 464    foreach inst [array names commfd] {
 465        stop_instance $inst
 466    }
 467}
 468
 469proc stop_rev_list {view} {
 470    global viewinstances
 471
 472    foreach inst $viewinstances($view) {
 473        stop_instance $inst
 474    }
 475    set viewinstances($view) {}
 476}
 477
 478proc reset_pending_select {selid} {
 479    global pending_select mainheadid selectheadid
 480
 481    if {$selid ne {}} {
 482        set pending_select $selid
 483    } elseif {$selectheadid ne {}} {
 484        set pending_select $selectheadid
 485    } else {
 486        set pending_select $mainheadid
 487    }
 488}
 489
 490proc getcommits {selid} {
 491    global canv curview need_redisplay viewactive
 492
 493    initlayout
 494    if {[start_rev_list $curview]} {
 495        reset_pending_select $selid
 496        show_status [mc "Reading commits..."]
 497        set need_redisplay 1
 498    } else {
 499        show_status [mc "No commits selected"]
 500    }
 501}
 502
 503proc updatecommits {} {
 504    global curview vcanopt vorigargs vfilelimit viewinstances
 505    global viewactive viewcomplete tclencoding
 506    global startmsecs showneartags showlocalchanges
 507    global mainheadid viewmainheadid viewmainheadid_orig pending_select
 508    global hasworktree
 509    global varcid vposids vnegids vflags vrevs
 510    global show_notes
 511
 512    set hasworktree [hasworktree]
 513    rereadrefs
 514    set view $curview
 515    if {$mainheadid ne $viewmainheadid_orig($view)} {
 516        if {$showlocalchanges} {
 517            dohidelocalchanges
 518        }
 519        set viewmainheadid($view) $mainheadid
 520        set viewmainheadid_orig($view) $mainheadid
 521        if {$vfilelimit($view) ne {}} {
 522            get_viewmainhead $view
 523        }
 524    }
 525    if {$showlocalchanges} {
 526        doshowlocalchanges
 527    }
 528    if {$vcanopt($view)} {
 529        set oldpos $vposids($view)
 530        set oldneg $vnegids($view)
 531        set revs [parseviewrevs $view $vrevs($view)]
 532        if {$revs eq {}} {
 533            return
 534        }
 535        # note: getting the delta when negative refs change is hard,
 536        # and could require multiple git log invocations, so in that
 537        # case we ask git log for all the commits (not just the delta)
 538        if {$oldneg eq $vnegids($view)} {
 539            set newrevs {}
 540            set npos 0
 541            # take out positive refs that we asked for before or
 542            # that we have already seen
 543            foreach rev $revs {
 544                if {[string length $rev] == 40} {
 545                    if {[lsearch -exact $oldpos $rev] < 0
 546                        && ![info exists varcid($view,$rev)]} {
 547                        lappend newrevs $rev
 548                        incr npos
 549                    }
 550                } else {
 551                    lappend $newrevs $rev
 552                }
 553            }
 554            if {$npos == 0} return
 555            set revs $newrevs
 556            set vposids($view) [lsort -unique [concat $oldpos $vposids($view)]]
 557        }
 558        set args [concat $vflags($view) $revs --not $oldpos]
 559    } else {
 560        set args $vorigargs($view)
 561    }
 562    if {[catch {
 563        set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
 564                        --parents --boundary $args "--" $vfilelimit($view)] r]
 565    } err]} {
 566        error_popup "[mc "Error executing git log:"] $err"
 567        return
 568    }
 569    if {$viewactive($view) == 0} {
 570        set startmsecs [clock clicks -milliseconds]
 571    }
 572    set i [reg_instance $fd]
 573    lappend viewinstances($view) $i
 574    fconfigure $fd -blocking 0 -translation lf -eofchar {}
 575    if {$tclencoding != {}} {
 576        fconfigure $fd -encoding $tclencoding
 577    }
 578    filerun $fd [list getcommitlines $fd $i $view 1]
 579    incr viewactive($view)
 580    set viewcomplete($view) 0
 581    reset_pending_select {}
 582    nowbusy $view [mc "Reading"]
 583    if {$showneartags} {
 584        getallcommits
 585    }
 586}
 587
 588proc reloadcommits {} {
 589    global curview viewcomplete selectedline currentid thickerline
 590    global showneartags treediffs commitinterest cached_commitrow
 591    global targetid
 592
 593    set selid {}
 594    if {$selectedline ne {}} {
 595        set selid $currentid
 596    }
 597
 598    if {!$viewcomplete($curview)} {
 599        stop_rev_list $curview
 600    }
 601    resetvarcs $curview
 602    set selectedline {}
 603    unset -nocomplain currentid
 604    unset -nocomplain thickerline
 605    unset -nocomplain treediffs
 606    readrefs
 607    changedrefs
 608    if {$showneartags} {
 609        getallcommits
 610    }
 611    clear_display
 612    unset -nocomplain commitinterest
 613    unset -nocomplain cached_commitrow
 614    unset -nocomplain targetid
 615    setcanvscroll
 616    getcommits $selid
 617    return 0
 618}
 619
 620# This makes a string representation of a positive integer which
 621# sorts as a string in numerical order
 622proc strrep {n} {
 623    if {$n < 16} {
 624        return [format "%x" $n]
 625    } elseif {$n < 256} {
 626        return [format "x%.2x" $n]
 627    } elseif {$n < 65536} {
 628        return [format "y%.4x" $n]
 629    }
 630    return [format "z%.8x" $n]
 631}
 632
 633# Procedures used in reordering commits from git log (without
 634# --topo-order) into the order for display.
 635
 636proc varcinit {view} {
 637    global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
 638    global vtokmod varcmod vrowmod varcix vlastins
 639
 640    set varcstart($view) {{}}
 641    set vupptr($view) {0}
 642    set vdownptr($view) {0}
 643    set vleftptr($view) {0}
 644    set vbackptr($view) {0}
 645    set varctok($view) {{}}
 646    set varcrow($view) {{}}
 647    set vtokmod($view) {}
 648    set varcmod($view) 0
 649    set vrowmod($view) 0
 650    set varcix($view) {{}}
 651    set vlastins($view) {0}
 652}
 653
 654proc resetvarcs {view} {
 655    global varcid varccommits parents children vseedcount ordertok
 656    global vshortids
 657
 658    foreach vid [array names varcid $view,*] {
 659        unset varcid($vid)
 660        unset children($vid)
 661        unset parents($vid)
 662    }
 663    foreach vid [array names vshortids $view,*] {
 664        unset vshortids($vid)
 665    }
 666    # some commits might have children but haven't been seen yet
 667    foreach vid [array names children $view,*] {
 668        unset children($vid)
 669    }
 670    foreach va [array names varccommits $view,*] {
 671        unset varccommits($va)
 672    }
 673    foreach vd [array names vseedcount $view,*] {
 674        unset vseedcount($vd)
 675    }
 676    unset -nocomplain ordertok
 677}
 678
 679# returns a list of the commits with no children
 680proc seeds {v} {
 681    global vdownptr vleftptr varcstart
 682
 683    set ret {}
 684    set a [lindex $vdownptr($v) 0]
 685    while {$a != 0} {
 686        lappend ret [lindex $varcstart($v) $a]
 687        set a [lindex $vleftptr($v) $a]
 688    }
 689    return $ret
 690}
 691
 692proc newvarc {view id} {
 693    global varcid varctok parents children vdatemode
 694    global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
 695    global commitdata commitinfo vseedcount varccommits vlastins
 696
 697    set a [llength $varctok($view)]
 698    set vid $view,$id
 699    if {[llength $children($vid)] == 0 || $vdatemode($view)} {
 700        if {![info exists commitinfo($id)]} {
 701            parsecommit $id $commitdata($id) 1
 702        }
 703        set cdate [lindex [lindex $commitinfo($id) 4] 0]
 704        if {![string is integer -strict $cdate]} {
 705            set cdate 0
 706        }
 707        if {![info exists vseedcount($view,$cdate)]} {
 708            set vseedcount($view,$cdate) -1
 709        }
 710        set c [incr vseedcount($view,$cdate)]
 711        set cdate [expr {$cdate ^ 0xffffffff}]
 712        set tok "s[strrep $cdate][strrep $c]"
 713    } else {
 714        set tok {}
 715    }
 716    set ka 0
 717    if {[llength $children($vid)] > 0} {
 718        set kid [lindex $children($vid) end]
 719        set k $varcid($view,$kid)
 720        if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
 721            set ki $kid
 722            set ka $k
 723            set tok [lindex $varctok($view) $k]
 724        }
 725    }
 726    if {$ka != 0} {
 727        set i [lsearch -exact $parents($view,$ki) $id]
 728        set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
 729        append tok [strrep $j]
 730    }
 731    set c [lindex $vlastins($view) $ka]
 732    if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
 733        set c $ka
 734        set b [lindex $vdownptr($view) $ka]
 735    } else {
 736        set b [lindex $vleftptr($view) $c]
 737    }
 738    while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
 739        set c $b
 740        set b [lindex $vleftptr($view) $c]
 741    }
 742    if {$c == $ka} {
 743        lset vdownptr($view) $ka $a
 744        lappend vbackptr($view) 0
 745    } else {
 746        lset vleftptr($view) $c $a
 747        lappend vbackptr($view) $c
 748    }
 749    lset vlastins($view) $ka $a
 750    lappend vupptr($view) $ka
 751    lappend vleftptr($view) $b
 752    if {$b != 0} {
 753        lset vbackptr($view) $b $a
 754    }
 755    lappend varctok($view) $tok
 756    lappend varcstart($view) $id
 757    lappend vdownptr($view) 0
 758    lappend varcrow($view) {}
 759    lappend varcix($view) {}
 760    set varccommits($view,$a) {}
 761    lappend vlastins($view) 0
 762    return $a
 763}
 764
 765proc splitvarc {p v} {
 766    global varcid varcstart varccommits varctok vtokmod
 767    global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
 768
 769    set oa $varcid($v,$p)
 770    set otok [lindex $varctok($v) $oa]
 771    set ac $varccommits($v,$oa)
 772    set i [lsearch -exact $varccommits($v,$oa) $p]
 773    if {$i <= 0} return
 774    set na [llength $varctok($v)]
 775    # "%" sorts before "0"...
 776    set tok "$otok%[strrep $i]"
 777    lappend varctok($v) $tok
 778    lappend varcrow($v) {}
 779    lappend varcix($v) {}
 780    set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
 781    set varccommits($v,$na) [lrange $ac $i end]
 782    lappend varcstart($v) $p
 783    foreach id $varccommits($v,$na) {
 784        set varcid($v,$id) $na
 785    }
 786    lappend vdownptr($v) [lindex $vdownptr($v) $oa]
 787    lappend vlastins($v) [lindex $vlastins($v) $oa]
 788    lset vdownptr($v) $oa $na
 789    lset vlastins($v) $oa 0
 790    lappend vupptr($v) $oa
 791    lappend vleftptr($v) 0
 792    lappend vbackptr($v) 0
 793    for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
 794        lset vupptr($v) $b $na
 795    }
 796    if {[string compare $otok $vtokmod($v)] <= 0} {
 797        modify_arc $v $oa
 798    }
 799}
 800
 801proc renumbervarc {a v} {
 802    global parents children varctok varcstart varccommits
 803    global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
 804
 805    set t1 [clock clicks -milliseconds]
 806    set todo {}
 807    set isrelated($a) 1
 808    set kidchanged($a) 1
 809    set ntot 0
 810    while {$a != 0} {
 811        if {[info exists isrelated($a)]} {
 812            lappend todo $a
 813            set id [lindex $varccommits($v,$a) end]
 814            foreach p $parents($v,$id) {
 815                if {[info exists varcid($v,$p)]} {
 816                    set isrelated($varcid($v,$p)) 1
 817                }
 818            }
 819        }
 820        incr ntot
 821        set b [lindex $vdownptr($v) $a]
 822        if {$b == 0} {
 823            while {$a != 0} {
 824                set b [lindex $vleftptr($v) $a]
 825                if {$b != 0} break
 826                set a [lindex $vupptr($v) $a]
 827            }
 828        }
 829        set a $b
 830    }
 831    foreach a $todo {
 832        if {![info exists kidchanged($a)]} continue
 833        set id [lindex $varcstart($v) $a]
 834        if {[llength $children($v,$id)] > 1} {
 835            set children($v,$id) [lsort -command [list vtokcmp $v] \
 836                                      $children($v,$id)]
 837        }
 838        set oldtok [lindex $varctok($v) $a]
 839        if {!$vdatemode($v)} {
 840            set tok {}
 841        } else {
 842            set tok $oldtok
 843        }
 844        set ka 0
 845        set kid [last_real_child $v,$id]
 846        if {$kid ne {}} {
 847            set k $varcid($v,$kid)
 848            if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
 849                set ki $kid
 850                set ka $k
 851                set tok [lindex $varctok($v) $k]
 852            }
 853        }
 854        if {$ka != 0} {
 855            set i [lsearch -exact $parents($v,$ki) $id]
 856            set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
 857            append tok [strrep $j]
 858        }
 859        if {$tok eq $oldtok} {
 860            continue
 861        }
 862        set id [lindex $varccommits($v,$a) end]
 863        foreach p $parents($v,$id) {
 864            if {[info exists varcid($v,$p)]} {
 865                set kidchanged($varcid($v,$p)) 1
 866            } else {
 867                set sortkids($p) 1
 868            }
 869        }
 870        lset varctok($v) $a $tok
 871        set b [lindex $vupptr($v) $a]
 872        if {$b != $ka} {
 873            if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
 874                modify_arc $v $ka
 875            }
 876            if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
 877                modify_arc $v $b
 878            }
 879            set c [lindex $vbackptr($v) $a]
 880            set d [lindex $vleftptr($v) $a]
 881            if {$c == 0} {
 882                lset vdownptr($v) $b $d
 883            } else {
 884                lset vleftptr($v) $c $d
 885            }
 886            if {$d != 0} {
 887                lset vbackptr($v) $d $c
 888            }
 889            if {[lindex $vlastins($v) $b] == $a} {
 890                lset vlastins($v) $b $c
 891            }
 892            lset vupptr($v) $a $ka
 893            set c [lindex $vlastins($v) $ka]
 894            if {$c == 0 || \
 895                    [string compare $tok [lindex $varctok($v) $c]] < 0} {
 896                set c $ka
 897                set b [lindex $vdownptr($v) $ka]
 898            } else {
 899                set b [lindex $vleftptr($v) $c]
 900            }
 901            while {$b != 0 && \
 902                      [string compare $tok [lindex $varctok($v) $b]] >= 0} {
 903                set c $b
 904                set b [lindex $vleftptr($v) $c]
 905            }
 906            if {$c == $ka} {
 907                lset vdownptr($v) $ka $a
 908                lset vbackptr($v) $a 0
 909            } else {
 910                lset vleftptr($v) $c $a
 911                lset vbackptr($v) $a $c
 912            }
 913            lset vleftptr($v) $a $b
 914            if {$b != 0} {
 915                lset vbackptr($v) $b $a
 916            }
 917            lset vlastins($v) $ka $a
 918        }
 919    }
 920    foreach id [array names sortkids] {
 921        if {[llength $children($v,$id)] > 1} {
 922            set children($v,$id) [lsort -command [list vtokcmp $v] \
 923                                      $children($v,$id)]
 924        }
 925    }
 926    set t2 [clock clicks -milliseconds]
 927    #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
 928}
 929
 930# Fix up the graph after we have found out that in view $v,
 931# $p (a commit that we have already seen) is actually the parent
 932# of the last commit in arc $a.
 933proc fix_reversal {p a v} {
 934    global varcid varcstart varctok vupptr
 935
 936    set pa $varcid($v,$p)
 937    if {$p ne [lindex $varcstart($v) $pa]} {
 938        splitvarc $p $v
 939        set pa $varcid($v,$p)
 940    }
 941    # seeds always need to be renumbered
 942    if {[lindex $vupptr($v) $pa] == 0 ||
 943        [string compare [lindex $varctok($v) $a] \
 944             [lindex $varctok($v) $pa]] > 0} {
 945        renumbervarc $pa $v
 946    }
 947}
 948
 949proc insertrow {id p v} {
 950    global cmitlisted children parents varcid varctok vtokmod
 951    global varccommits ordertok commitidx numcommits curview
 952    global targetid targetrow vshortids
 953
 954    readcommit $id
 955    set vid $v,$id
 956    set cmitlisted($vid) 1
 957    set children($vid) {}
 958    set parents($vid) [list $p]
 959    set a [newvarc $v $id]
 960    set varcid($vid) $a
 961    lappend vshortids($v,[string range $id 0 3]) $id
 962    if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
 963        modify_arc $v $a
 964    }
 965    lappend varccommits($v,$a) $id
 966    set vp $v,$p
 967    if {[llength [lappend children($vp) $id]] > 1} {
 968        set children($vp) [lsort -command [list vtokcmp $v] $children($vp)]
 969        unset -nocomplain ordertok
 970    }
 971    fix_reversal $p $a $v
 972    incr commitidx($v)
 973    if {$v == $curview} {
 974        set numcommits $commitidx($v)
 975        setcanvscroll
 976        if {[info exists targetid]} {
 977            if {![comes_before $targetid $p]} {
 978                incr targetrow
 979            }
 980        }
 981    }
 982}
 983
 984proc insertfakerow {id p} {
 985    global varcid varccommits parents children cmitlisted
 986    global commitidx varctok vtokmod targetid targetrow curview numcommits
 987
 988    set v $curview
 989    set a $varcid($v,$p)
 990    set i [lsearch -exact $varccommits($v,$a) $p]
 991    if {$i < 0} {
 992        puts "oops: insertfakerow can't find [shortids $p] on arc $a"
 993        return
 994    }
 995    set children($v,$id) {}
 996    set parents($v,$id) [list $p]
 997    set varcid($v,$id) $a
 998    lappend children($v,$p) $id
 999    set cmitlisted($v,$id) 1
1000    set numcommits [incr commitidx($v)]
1001    # note we deliberately don't update varcstart($v) even if $i == 0
1002    set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
1003    modify_arc $v $a $i
1004    if {[info exists targetid]} {
1005        if {![comes_before $targetid $p]} {
1006            incr targetrow
1007        }
1008    }
1009    setcanvscroll
1010    drawvisible
1011}
1012
1013proc removefakerow {id} {
1014    global varcid varccommits parents children commitidx
1015    global varctok vtokmod cmitlisted currentid selectedline
1016    global targetid curview numcommits
1017
1018    set v $curview
1019    if {[llength $parents($v,$id)] != 1} {
1020        puts "oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
1021        return
1022    }
1023    set p [lindex $parents($v,$id) 0]
1024    set a $varcid($v,$id)
1025    set i [lsearch -exact $varccommits($v,$a) $id]
1026    if {$i < 0} {
1027        puts "oops: removefakerow can't find [shortids $id] on arc $a"
1028        return
1029    }
1030    unset varcid($v,$id)
1031    set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
1032    unset parents($v,$id)
1033    unset children($v,$id)
1034    unset cmitlisted($v,$id)
1035    set numcommits [incr commitidx($v) -1]
1036    set j [lsearch -exact $children($v,$p) $id]
1037    if {$j >= 0} {
1038        set children($v,$p) [lreplace $children($v,$p) $j $j]
1039    }
1040    modify_arc $v $a $i
1041    if {[info exist currentid] && $id eq $currentid} {
1042        unset currentid
1043        set selectedline {}
1044    }
1045    if {[info exists targetid] && $targetid eq $id} {
1046        set targetid $p
1047    }
1048    setcanvscroll
1049    drawvisible
1050}
1051
1052proc real_children {vp} {
1053    global children nullid nullid2
1054
1055    set kids {}
1056    foreach id $children($vp) {
1057        if {$id ne $nullid && $id ne $nullid2} {
1058            lappend kids $id
1059        }
1060    }
1061    return $kids
1062}
1063
1064proc first_real_child {vp} {
1065    global children nullid nullid2
1066
1067    foreach id $children($vp) {
1068        if {$id ne $nullid && $id ne $nullid2} {
1069            return $id
1070        }
1071    }
1072    return {}
1073}
1074
1075proc last_real_child {vp} {
1076    global children nullid nullid2
1077
1078    set kids $children($vp)
1079    for {set i [llength $kids]} {[incr i -1] >= 0} {} {
1080        set id [lindex $kids $i]
1081        if {$id ne $nullid && $id ne $nullid2} {
1082            return $id
1083        }
1084    }
1085    return {}
1086}
1087
1088proc vtokcmp {v a b} {
1089    global varctok varcid
1090
1091    return [string compare [lindex $varctok($v) $varcid($v,$a)] \
1092                [lindex $varctok($v) $varcid($v,$b)]]
1093}
1094
1095# This assumes that if lim is not given, the caller has checked that
1096# arc a's token is less than $vtokmod($v)
1097proc modify_arc {v a {lim {}}} {
1098    global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
1099
1100    if {$lim ne {}} {
1101        set c [string compare [lindex $varctok($v) $a] $vtokmod($v)]
1102        if {$c > 0} return
1103        if {$c == 0} {
1104            set r [lindex $varcrow($v) $a]
1105            if {$r ne {} && $vrowmod($v) <= $r + $lim} return
1106        }
1107    }
1108    set vtokmod($v) [lindex $varctok($v) $a]
1109    set varcmod($v) $a
1110    if {$v == $curview} {
1111        while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
1112            set a [lindex $vupptr($v) $a]
1113            set lim {}
1114        }
1115        set r 0
1116        if {$a != 0} {
1117            if {$lim eq {}} {
1118                set lim [llength $varccommits($v,$a)]
1119            }
1120            set r [expr {[lindex $varcrow($v) $a] + $lim}]
1121        }
1122        set vrowmod($v) $r
1123        undolayout $r
1124    }
1125}
1126
1127proc update_arcrows {v} {
1128    global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
1129    global varcid vrownum varcorder varcix varccommits
1130    global vupptr vdownptr vleftptr varctok
1131    global displayorder parentlist curview cached_commitrow
1132
1133    if {$vrowmod($v) == $commitidx($v)} return
1134    if {$v == $curview} {
1135        if {[llength $displayorder] > $vrowmod($v)} {
1136            set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
1137            set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
1138        }
1139        unset -nocomplain cached_commitrow
1140    }
1141    set narctot [expr {[llength $varctok($v)] - 1}]
1142    set a $varcmod($v)
1143    while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
1144        # go up the tree until we find something that has a row number,
1145        # or we get to a seed
1146        set a [lindex $vupptr($v) $a]
1147    }
1148    if {$a == 0} {
1149        set a [lindex $vdownptr($v) 0]
1150        if {$a == 0} return
1151        set vrownum($v) {0}
1152        set varcorder($v) [list $a]
1153        lset varcix($v) $a 0
1154        lset varcrow($v) $a 0
1155        set arcn 0
1156        set row 0
1157    } else {
1158        set arcn [lindex $varcix($v) $a]
1159        if {[llength $vrownum($v)] > $arcn + 1} {
1160            set vrownum($v) [lrange $vrownum($v) 0 $arcn]
1161            set varcorder($v) [lrange $varcorder($v) 0 $arcn]
1162        }
1163        set row [lindex $varcrow($v) $a]
1164    }
1165    while {1} {
1166        set p $a
1167        incr row [llength $varccommits($v,$a)]
1168        # go down if possible
1169        set b [lindex $vdownptr($v) $a]
1170        if {$b == 0} {
1171            # if not, go left, or go up until we can go left
1172            while {$a != 0} {
1173                set b [lindex $vleftptr($v) $a]
1174                if {$b != 0} break
1175                set a [lindex $vupptr($v) $a]
1176            }
1177            if {$a == 0} break
1178        }
1179        set a $b
1180        incr arcn
1181        lappend vrownum($v) $row
1182        lappend varcorder($v) $a
1183        lset varcix($v) $a $arcn
1184        lset varcrow($v) $a $row
1185    }
1186    set vtokmod($v) [lindex $varctok($v) $p]
1187    set varcmod($v) $p
1188    set vrowmod($v) $row
1189    if {[info exists currentid]} {
1190        set selectedline [rowofcommit $currentid]
1191    }
1192}
1193
1194# Test whether view $v contains commit $id
1195proc commitinview {id v} {
1196    global varcid
1197
1198    return [info exists varcid($v,$id)]
1199}
1200
1201# Return the row number for commit $id in the current view
1202proc rowofcommit {id} {
1203    global varcid varccommits varcrow curview cached_commitrow
1204    global varctok vtokmod
1205
1206    set v $curview
1207    if {![info exists varcid($v,$id)]} {
1208        puts "oops rowofcommit no arc for [shortids $id]"
1209        return {}
1210    }
1211    set a $varcid($v,$id)
1212    if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
1213        update_arcrows $v
1214    }
1215    if {[info exists cached_commitrow($id)]} {
1216        return $cached_commitrow($id)
1217    }
1218    set i [lsearch -exact $varccommits($v,$a) $id]
1219    if {$i < 0} {
1220        puts "oops didn't find commit [shortids $id] in arc $a"
1221        return {}
1222    }
1223    incr i [lindex $varcrow($v) $a]
1224    set cached_commitrow($id) $i
1225    return $i
1226}
1227
1228# Returns 1 if a is on an earlier row than b, otherwise 0
1229proc comes_before {a b} {
1230    global varcid varctok curview
1231
1232    set v $curview
1233    if {$a eq $b || ![info exists varcid($v,$a)] || \
1234            ![info exists varcid($v,$b)]} {
1235        return 0
1236    }
1237    if {$varcid($v,$a) != $varcid($v,$b)} {
1238        return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
1239                           [lindex $varctok($v) $varcid($v,$b)]] < 0}]
1240    }
1241    return [expr {[rowofcommit $a] < [rowofcommit $b]}]
1242}
1243
1244proc bsearch {l elt} {
1245    if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
1246        return 0
1247    }
1248    set lo 0
1249    set hi [llength $l]
1250    while {$hi - $lo > 1} {
1251        set mid [expr {int(($lo + $hi) / 2)}]
1252        set t [lindex $l $mid]
1253        if {$elt < $t} {
1254            set hi $mid
1255        } elseif {$elt > $t} {
1256            set lo $mid
1257        } else {
1258            return $mid
1259        }
1260    }
1261    return $lo
1262}
1263
1264# Make sure rows $start..$end-1 are valid in displayorder and parentlist
1265proc make_disporder {start end} {
1266    global vrownum curview commitidx displayorder parentlist
1267    global varccommits varcorder parents vrowmod varcrow
1268    global d_valid_start d_valid_end
1269
1270    if {$end > $vrowmod($curview)} {
1271        update_arcrows $curview
1272    }
1273    set ai [bsearch $vrownum($curview) $start]
1274    set start [lindex $vrownum($curview) $ai]
1275    set narc [llength $vrownum($curview)]
1276    for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
1277        set a [lindex $varcorder($curview) $ai]
1278        set l [llength $displayorder]
1279        set al [llength $varccommits($curview,$a)]
1280        if {$l < $r + $al} {
1281            if {$l < $r} {
1282                set pad [ntimes [expr {$r - $l}] {}]
1283                set displayorder [concat $displayorder $pad]
1284                set parentlist [concat $parentlist $pad]
1285            } elseif {$l > $r} {
1286                set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
1287                set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
1288            }
1289            foreach id $varccommits($curview,$a) {
1290                lappend displayorder $id
1291                lappend parentlist $parents($curview,$id)
1292            }
1293        } elseif {[lindex $displayorder [expr {$r + $al - 1}]] eq {}} {
1294            set i $r
1295            foreach id $varccommits($curview,$a) {
1296                lset displayorder $i $id
1297                lset parentlist $i $parents($curview,$id)
1298                incr i
1299            }
1300        }
1301        incr r $al
1302    }
1303}
1304
1305proc commitonrow {row} {
1306    global displayorder
1307
1308    set id [lindex $displayorder $row]
1309    if {$id eq {}} {
1310        make_disporder $row [expr {$row + 1}]
1311        set id [lindex $displayorder $row]
1312    }
1313    return $id
1314}
1315
1316proc closevarcs {v} {
1317    global varctok varccommits varcid parents children
1318    global cmitlisted commitidx vtokmod
1319
1320    set missing_parents 0
1321    set scripts {}
1322    set narcs [llength $varctok($v)]
1323    for {set a 1} {$a < $narcs} {incr a} {
1324        set id [lindex $varccommits($v,$a) end]
1325        foreach p $parents($v,$id) {
1326            if {[info exists varcid($v,$p)]} continue
1327            # add p as a new commit
1328            incr missing_parents
1329            set cmitlisted($v,$p) 0
1330            set parents($v,$p) {}
1331            if {[llength $children($v,$p)] == 1 &&
1332                [llength $parents($v,$id)] == 1} {
1333                set b $a
1334            } else {
1335                set b [newvarc $v $p]
1336            }
1337            set varcid($v,$p) $b
1338            if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
1339                modify_arc $v $b
1340            }
1341            lappend varccommits($v,$b) $p
1342            incr commitidx($v)
1343            set scripts [check_interest $p $scripts]
1344        }
1345    }
1346    if {$missing_parents > 0} {
1347        foreach s $scripts {
1348            eval $s
1349        }
1350    }
1351}
1352
1353# Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1354# Assumes we already have an arc for $rwid.
1355proc rewrite_commit {v id rwid} {
1356    global children parents varcid varctok vtokmod varccommits
1357
1358    foreach ch $children($v,$id) {
1359        # make $rwid be $ch's parent in place of $id
1360        set i [lsearch -exact $parents($v,$ch) $id]
1361        if {$i < 0} {
1362            puts "oops rewrite_commit didn't find $id in parent list for $ch"
1363        }
1364        set parents($v,$ch) [lreplace $parents($v,$ch) $i $i $rwid]
1365        # add $ch to $rwid's children and sort the list if necessary
1366        if {[llength [lappend children($v,$rwid) $ch]] > 1} {
1367            set children($v,$rwid) [lsort -command [list vtokcmp $v] \
1368                                        $children($v,$rwid)]
1369        }
1370        # fix the graph after joining $id to $rwid
1371        set a $varcid($v,$ch)
1372        fix_reversal $rwid $a $v
1373        # parentlist is wrong for the last element of arc $a
1374        # even if displayorder is right, hence the 3rd arg here
1375        modify_arc $v $a [expr {[llength $varccommits($v,$a)] - 1}]
1376    }
1377}
1378
1379# Mechanism for registering a command to be executed when we come
1380# across a particular commit.  To handle the case when only the
1381# prefix of the commit is known, the commitinterest array is now
1382# indexed by the first 4 characters of the ID.  Each element is a
1383# list of id, cmd pairs.
1384proc interestedin {id cmd} {
1385    global commitinterest
1386
1387    lappend commitinterest([string range $id 0 3]) $id $cmd
1388}
1389
1390proc check_interest {id scripts} {
1391    global commitinterest
1392
1393    set prefix [string range $id 0 3]
1394    if {[info exists commitinterest($prefix)]} {
1395        set newlist {}
1396        foreach {i script} $commitinterest($prefix) {
1397            if {[string match "$i*" $id]} {
1398                lappend scripts [string map [list "%I" $id "%P" $i] $script]
1399            } else {
1400                lappend newlist $i $script
1401            }
1402        }
1403        if {$newlist ne {}} {
1404            set commitinterest($prefix) $newlist
1405        } else {
1406            unset commitinterest($prefix)
1407        }
1408    }
1409    return $scripts
1410}
1411
1412proc getcommitlines {fd inst view updating}  {
1413    global cmitlisted leftover
1414    global commitidx commitdata vdatemode
1415    global parents children curview hlview
1416    global idpending ordertok
1417    global varccommits varcid varctok vtokmod vfilelimit vshortids
1418
1419    set stuff [read $fd 500000]
1420    # git log doesn't terminate the last commit with a null...
1421    if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
1422        set stuff "\0"
1423    }
1424    if {$stuff == {}} {
1425        if {![eof $fd]} {
1426            return 1
1427        }
1428        global commfd viewcomplete viewactive viewname
1429        global viewinstances
1430        unset commfd($inst)
1431        set i [lsearch -exact $viewinstances($view) $inst]
1432        if {$i >= 0} {
1433            set viewinstances($view) [lreplace $viewinstances($view) $i $i]
1434        }
1435        # set it blocking so we wait for the process to terminate
1436        fconfigure $fd -blocking 1
1437        if {[catch {close $fd} err]} {
1438            set fv {}
1439            if {$view != $curview} {
1440                set fv " for the \"$viewname($view)\" view"
1441            }
1442            if {[string range $err 0 4] == "usage"} {
1443                set err "Gitk: error reading commits$fv:\
1444                        bad arguments to git log."
1445                if {$viewname($view) eq [mc "Command line"]} {
1446                    append err \
1447                        "  (Note: arguments to gitk are passed to git log\
1448                         to allow selection of commits to be displayed.)"
1449                }
1450            } else {
1451                set err "Error reading commits$fv: $err"
1452            }
1453            error_popup $err
1454        }
1455        if {[incr viewactive($view) -1] <= 0} {
1456            set viewcomplete($view) 1
1457            # Check if we have seen any ids listed as parents that haven't
1458            # appeared in the list
1459            closevarcs $view
1460            notbusy $view
1461        }
1462        if {$view == $curview} {
1463            run chewcommits
1464        }
1465        return 0
1466    }
1467    set start 0
1468    set gotsome 0
1469    set scripts {}
1470    while 1 {
1471        set i [string first "\0" $stuff $start]
1472        if {$i < 0} {
1473            append leftover($inst) [string range $stuff $start end]
1474            break
1475        }
1476        if {$start == 0} {
1477            set cmit $leftover($inst)
1478            append cmit [string range $stuff 0 [expr {$i - 1}]]
1479            set leftover($inst) {}
1480        } else {
1481            set cmit [string range $stuff $start [expr {$i - 1}]]
1482        }
1483        set start [expr {$i + 1}]
1484        set j [string first "\n" $cmit]
1485        set ok 0
1486        set listed 1
1487        if {$j >= 0 && [string match "commit *" $cmit]} {
1488            set ids [string range $cmit 7 [expr {$j - 1}]]
1489            if {[string match {[-^<>]*} $ids]} {
1490                switch -- [string index $ids 0] {
1491                    "-" {set listed 0}
1492                    "^" {set listed 2}
1493                    "<" {set listed 3}
1494                    ">" {set listed 4}
1495                }
1496                set ids [string range $ids 1 end]
1497            }
1498            set ok 1
1499            foreach id $ids {
1500                if {[string length $id] != 40} {
1501                    set ok 0
1502                    break
1503                }
1504            }
1505        }
1506        if {!$ok} {
1507            set shortcmit $cmit
1508            if {[string length $shortcmit] > 80} {
1509                set shortcmit "[string range $shortcmit 0 80]..."
1510            }
1511            error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
1512            exit 1
1513        }
1514        set id [lindex $ids 0]
1515        set vid $view,$id
1516
1517        lappend vshortids($view,[string range $id 0 3]) $id
1518
1519        if {!$listed && $updating && ![info exists varcid($vid)] &&
1520            $vfilelimit($view) ne {}} {
1521            # git log doesn't rewrite parents for unlisted commits
1522            # when doing path limiting, so work around that here
1523            # by working out the rewritten parent with git rev-list
1524            # and if we already know about it, using the rewritten
1525            # parent as a substitute parent for $id's children.
1526            if {![catch {
1527                set rwid [exec git rev-list --first-parent --max-count=1 \
1528                              $id -- $vfilelimit($view)]
1529            }]} {
1530                if {$rwid ne {} && [info exists varcid($view,$rwid)]} {
1531                    # use $rwid in place of $id
1532                    rewrite_commit $view $id $rwid
1533                    continue
1534                }
1535            }
1536        }
1537
1538        set a 0
1539        if {[info exists varcid($vid)]} {
1540            if {$cmitlisted($vid) || !$listed} continue
1541            set a $varcid($vid)
1542        }
1543        if {$listed} {
1544            set olds [lrange $ids 1 end]
1545        } else {
1546            set olds {}
1547        }
1548        set commitdata($id) [string range $cmit [expr {$j + 1}] end]
1549        set cmitlisted($vid) $listed
1550        set parents($vid) $olds
1551        if {![info exists children($vid)]} {
1552            set children($vid) {}
1553        } elseif {$a == 0 && [llength $children($vid)] == 1} {
1554            set k [lindex $children($vid) 0]
1555            if {[llength $parents($view,$k)] == 1 &&
1556                (!$vdatemode($view) ||
1557                 $varcid($view,$k) == [llength $varctok($view)] - 1)} {
1558                set a $varcid($view,$k)
1559            }
1560        }
1561        if {$a == 0} {
1562            # new arc
1563            set a [newvarc $view $id]
1564        }
1565        if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
1566            modify_arc $view $a
1567        }
1568        if {![info exists varcid($vid)]} {
1569            set varcid($vid) $a
1570            lappend varccommits($view,$a) $id
1571            incr commitidx($view)
1572        }
1573
1574        set i 0
1575        foreach p $olds {
1576            if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
1577                set vp $view,$p
1578                if {[llength [lappend children($vp) $id]] > 1 &&
1579                    [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
1580                    set children($vp) [lsort -command [list vtokcmp $view] \
1581                                           $children($vp)]
1582                    unset -nocomplain ordertok
1583                }
1584                if {[info exists varcid($view,$p)]} {
1585                    fix_reversal $p $a $view
1586                }
1587            }
1588            incr i
1589        }
1590
1591        set scripts [check_interest $id $scripts]
1592        set gotsome 1
1593    }
1594    if {$gotsome} {
1595        global numcommits hlview
1596
1597        if {$view == $curview} {
1598            set numcommits $commitidx($view)
1599            run chewcommits
1600        }
1601        if {[info exists hlview] && $view == $hlview} {
1602            # we never actually get here...
1603            run vhighlightmore
1604        }
1605        foreach s $scripts {
1606            eval $s
1607        }
1608    }
1609    return 2
1610}
1611
1612proc chewcommits {} {
1613    global curview hlview viewcomplete
1614    global pending_select
1615
1616    layoutmore
1617    if {$viewcomplete($curview)} {
1618        global commitidx varctok
1619        global numcommits startmsecs
1620
1621        if {[info exists pending_select]} {
1622            update
1623            reset_pending_select {}
1624
1625            if {[commitinview $pending_select $curview]} {
1626                selectline [rowofcommit $pending_select] 1
1627            } else {
1628                set row [first_real_row]
1629                selectline $row 1
1630            }
1631        }
1632        if {$commitidx($curview) > 0} {
1633            #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1634            #puts "overall $ms ms for $numcommits commits"
1635            #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1636        } else {
1637            show_status [mc "No commits selected"]
1638        }
1639        notbusy layout
1640    }
1641    return 0
1642}
1643
1644proc do_readcommit {id} {
1645    global tclencoding
1646
1647    # Invoke git-log to handle automatic encoding conversion
1648    set fd [open [concat | git log --no-color --pretty=raw -1 $id] r]
1649    # Read the results using i18n.logoutputencoding
1650    fconfigure $fd -translation lf -eofchar {}
1651    if {$tclencoding != {}} {
1652        fconfigure $fd -encoding $tclencoding
1653    }
1654    set contents [read $fd]
1655    close $fd
1656    # Remove the heading line
1657    regsub {^commit [0-9a-f]+\n} $contents {} contents
1658
1659    return $contents
1660}
1661
1662proc readcommit {id} {
1663    if {[catch {set contents [do_readcommit $id]}]} return
1664    parsecommit $id $contents 1
1665}
1666
1667proc parsecommit {id contents listed} {
1668    global commitinfo
1669
1670    set inhdr 1
1671    set comment {}
1672    set headline {}
1673    set auname {}
1674    set audate {}
1675    set comname {}
1676    set comdate {}
1677    set hdrend [string first "\n\n" $contents]
1678    if {$hdrend < 0} {
1679        # should never happen...
1680        set hdrend [string length $contents]
1681    }
1682    set header [string range $contents 0 [expr {$hdrend - 1}]]
1683    set comment [string range $contents [expr {$hdrend + 2}] end]
1684    foreach line [split $header "\n"] {
1685        set line [split $line " "]
1686        set tag [lindex $line 0]
1687        if {$tag == "author"} {
1688            set audate [lrange $line end-1 end]
1689            set auname [join [lrange $line 1 end-2] " "]
1690        } elseif {$tag == "committer"} {
1691            set comdate [lrange $line end-1 end]
1692            set comname [join [lrange $line 1 end-2] " "]
1693        }
1694    }
1695    set headline {}
1696    # take the first non-blank line of the comment as the headline
1697    set headline [string trimleft $comment]
1698    set i [string first "\n" $headline]
1699    if {$i >= 0} {
1700        set headline [string range $headline 0 $i]
1701    }
1702    set headline [string trimright $headline]
1703    set i [string first "\r" $headline]
1704    if {$i >= 0} {
1705        set headline [string trimright [string range $headline 0 $i]]
1706    }
1707    if {!$listed} {
1708        # git log indents the comment by 4 spaces;
1709        # if we got this via git cat-file, add the indentation
1710        set newcomment {}
1711        foreach line [split $comment "\n"] {
1712            append newcomment "    "
1713            append newcomment $line
1714            append newcomment "\n"
1715        }
1716        set comment $newcomment
1717    }
1718    set hasnote [string first "\nNotes:\n" $contents]
1719    set diff ""
1720    # If there is diff output shown in the git-log stream, split it
1721    # out.  But get rid of the empty line that always precedes the
1722    # diff.
1723    set i [string first "\n\ndiff" $comment]
1724    if {$i >= 0} {
1725        set diff [string range $comment $i+1 end]
1726        set comment [string range $comment 0 $i-1]
1727    }
1728    set commitinfo($id) [list $headline $auname $audate \
1729                             $comname $comdate $comment $hasnote $diff]
1730}
1731
1732proc getcommit {id} {
1733    global commitdata commitinfo
1734
1735    if {[info exists commitdata($id)]} {
1736        parsecommit $id $commitdata($id) 1
1737    } else {
1738        readcommit $id
1739        if {![info exists commitinfo($id)]} {
1740            set commitinfo($id) [list [mc "No commit information available"]]
1741        }
1742    }
1743    return 1
1744}
1745
1746# Expand an abbreviated commit ID to a list of full 40-char IDs that match
1747# and are present in the current view.
1748# This is fairly slow...
1749proc longid {prefix} {
1750    global varcid curview vshortids
1751
1752    set ids {}
1753    if {[string length $prefix] >= 4} {
1754        set vshortid $curview,[string range $prefix 0 3]
1755        if {[info exists vshortids($vshortid)]} {
1756            foreach id $vshortids($vshortid) {
1757                if {[string match "$prefix*" $id]} {
1758                    if {[lsearch -exact $ids $id] < 0} {
1759                        lappend ids $id
1760                        if {[llength $ids] >= 2} break
1761                    }
1762                }
1763            }
1764        }
1765    } else {
1766        foreach match [array names varcid "$curview,$prefix*"] {
1767            lappend ids [lindex [split $match ","] 1]
1768            if {[llength $ids] >= 2} break
1769        }
1770    }
1771    return $ids
1772}
1773
1774proc readrefs {} {
1775    global tagids idtags headids idheads tagobjid
1776    global otherrefids idotherrefs mainhead mainheadid
1777    global selecthead selectheadid
1778    global hideremotes
1779
1780    foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
1781        unset -nocomplain $v
1782    }
1783    set refd [open [list | git show-ref -d] r]
1784    while {[gets $refd line] >= 0} {
1785        if {[string index $line 40] ne " "} continue
1786        set id [string range $line 0 39]
1787        set ref [string range $line 41 end]
1788        if {![string match "refs/*" $ref]} continue
1789        set name [string range $ref 5 end]
1790        if {[string match "remotes/*" $name]} {
1791            if {![string match "*/HEAD" $name] && !$hideremotes} {
1792                set headids($name) $id
1793                lappend idheads($id) $name
1794            }
1795        } elseif {[string match "heads/*" $name]} {
1796            set name [string range $name 6 end]
1797            set headids($name) $id
1798            lappend idheads($id) $name
1799        } elseif {[string match "tags/*" $name]} {
1800            # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1801            # which is what we want since the former is the commit ID
1802            set name [string range $name 5 end]
1803            if {[string match "*^{}" $name]} {
1804                set name [string range $name 0 end-3]
1805            } else {
1806                set tagobjid($name) $id
1807            }
1808            set tagids($name) $id
1809            lappend idtags($id) $name
1810        } else {
1811            set otherrefids($name) $id
1812            lappend idotherrefs($id) $name
1813        }
1814    }
1815    catch {close $refd}
1816    set mainhead {}
1817    set mainheadid {}
1818    catch {
1819        set mainheadid [exec git rev-parse HEAD]
1820        set thehead [exec git symbolic-ref HEAD]
1821        if {[string match "refs/heads/*" $thehead]} {
1822            set mainhead [string range $thehead 11 end]
1823        }
1824    }
1825    set selectheadid {}
1826    if {$selecthead ne {}} {
1827        catch {
1828            set selectheadid [exec git rev-parse --verify $selecthead]
1829        }
1830    }
1831}
1832
1833# skip over fake commits
1834proc first_real_row {} {
1835    global nullid nullid2 numcommits
1836
1837    for {set row 0} {$row < $numcommits} {incr row} {
1838        set id [commitonrow $row]
1839        if {$id ne $nullid && $id ne $nullid2} {
1840            break
1841        }
1842    }
1843    return $row
1844}
1845
1846# update things for a head moved to a child of its previous location
1847proc movehead {id name} {
1848    global headids idheads
1849
1850    removehead $headids($name) $name
1851    set headids($name) $id
1852    lappend idheads($id) $name
1853}
1854
1855# update things when a head has been removed
1856proc removehead {id name} {
1857    global headids idheads
1858
1859    if {$idheads($id) eq $name} {
1860        unset idheads($id)
1861    } else {
1862        set i [lsearch -exact $idheads($id) $name]
1863        if {$i >= 0} {
1864            set idheads($id) [lreplace $idheads($id) $i $i]
1865        }
1866    }
1867    unset headids($name)
1868}
1869
1870proc ttk_toplevel {w args} {
1871    global use_ttk
1872    eval [linsert $args 0 ::toplevel $w]
1873    if {$use_ttk} {
1874        place [ttk::frame $w._toplevel_background] -x 0 -y 0 -relwidth 1 -relheight 1
1875    }
1876    return $w
1877}
1878
1879proc make_transient {window origin} {
1880    global have_tk85
1881
1882    # In MacOS Tk 8.4 transient appears to work by setting
1883    # overrideredirect, which is utterly useless, since the
1884    # windows get no border, and are not even kept above
1885    # the parent.
1886    if {!$have_tk85 && [tk windowingsystem] eq {aqua}} return
1887
1888    wm transient $window $origin
1889
1890    # Windows fails to place transient windows normally, so
1891    # schedule a callback to center them on the parent.
1892    if {[tk windowingsystem] eq {win32}} {
1893        after idle [list tk::PlaceWindow $window widget $origin]
1894    }
1895}
1896
1897proc show_error {w top msg} {
1898    global NS
1899    if {![info exists NS]} {set NS ""}
1900    if {[wm state $top] eq "withdrawn"} { wm deiconify $top }
1901    message $w.m -text $msg -justify center -aspect 400
1902    pack $w.m -side top -fill x -padx 20 -pady 20
1903    ${NS}::button $w.ok -default active -text [mc OK] -command "destroy $top"
1904    pack $w.ok -side bottom -fill x
1905    bind $top <Visibility> "grab $top; focus $top"
1906    bind $top <Key-Return> "destroy $top"
1907    bind $top <Key-space>  "destroy $top"
1908    bind $top <Key-Escape> "destroy $top"
1909    tkwait window $top
1910}
1911
1912proc error_popup {msg {owner .}} {
1913    if {[tk windowingsystem] eq "win32"} {
1914        tk_messageBox -icon error -type ok -title [wm title .] \
1915            -parent $owner -message $msg
1916    } else {
1917        set w .error
1918        ttk_toplevel $w
1919        make_transient $w $owner
1920        show_error $w $w $msg
1921    }
1922}
1923
1924proc confirm_popup {msg {owner .}} {
1925    global confirm_ok NS
1926    set confirm_ok 0
1927    set w .confirm
1928    ttk_toplevel $w
1929    make_transient $w $owner
1930    message $w.m -text $msg -justify center -aspect 400
1931    pack $w.m -side top -fill x -padx 20 -pady 20
1932    ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
1933    pack $w.ok -side left -fill x
1934    ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
1935    pack $w.cancel -side right -fill x
1936    bind $w <Visibility> "grab $w; focus $w"
1937    bind $w <Key-Return> "set confirm_ok 1; destroy $w"
1938    bind $w <Key-space>  "set confirm_ok 1; destroy $w"
1939    bind $w <Key-Escape> "destroy $w"
1940    tk::PlaceWindow $w widget $owner
1941    tkwait window $w
1942    return $confirm_ok
1943}
1944
1945proc setoptions {} {
1946    global use_ttk
1947
1948    if {[tk windowingsystem] ne "win32"} {
1949        option add *Panedwindow.showHandle 1 startupFile
1950        option add *Panedwindow.sashRelief raised startupFile
1951        if {[tk windowingsystem] ne "aqua"} {
1952            option add *Menu.font uifont startupFile
1953        }
1954    } else {
1955        option add *Menu.TearOff 0 startupFile
1956    }
1957    option add *Button.font uifont startupFile
1958    option add *Checkbutton.font uifont startupFile
1959    option add *Radiobutton.font uifont startupFile
1960    option add *Menubutton.font uifont startupFile
1961    option add *Label.font uifont startupFile
1962    option add *Message.font uifont startupFile
1963    option add *Entry.font textfont startupFile
1964    option add *Text.font textfont startupFile
1965    option add *Labelframe.font uifont startupFile
1966    option add *Spinbox.font textfont startupFile
1967    option add *Listbox.font mainfont startupFile
1968}
1969
1970proc setttkstyle {} {
1971    eval font configure TkDefaultFont [fontflags mainfont]
1972    eval font configure TkTextFont [fontflags textfont]
1973    eval font configure TkHeadingFont [fontflags mainfont]
1974    eval font configure TkCaptionFont [fontflags mainfont] -weight bold
1975    eval font configure TkTooltipFont [fontflags uifont]
1976    eval font configure TkFixedFont   [fontflags textfont]
1977    eval font configure TkIconFont    [fontflags uifont]
1978    eval font configure TkMenuFont    [fontflags uifont]
1979    eval font configure TkSmallCaptionFont [fontflags uifont]
1980}
1981
1982# Make a menu and submenus.
1983# m is the window name for the menu, items is the list of menu items to add.
1984# Each item is a list {mc label type description options...}
1985# mc is ignored; it's so we can put mc there to alert xgettext
1986# label is the string that appears in the menu
1987# type is cascade, command or radiobutton (should add checkbutton)
1988# description depends on type; it's the sublist for cascade, the
1989# command to invoke for command, or {variable value} for radiobutton
1990proc makemenu {m items} {
1991    menu $m
1992    if {[tk windowingsystem] eq {aqua}} {
1993        set Meta1 Cmd
1994    } else {
1995        set Meta1 Ctrl
1996    }
1997    foreach i $items {
1998        set name [mc [lindex $i 1]]
1999        set type [lindex $i 2]
2000        set thing [lindex $i 3]
2001        set params [list $type]
2002        if {$name ne {}} {
2003            set u [string first "&" [string map {&& x} $name]]
2004            lappend params -label [string map {&& & & {}} $name]
2005            if {$u >= 0} {
2006                lappend params -underline $u
2007            }
2008        }
2009        switch -- $type {
2010            "cascade" {
2011                set submenu [string tolower [string map {& ""} [lindex $i 1]]]
2012                lappend params -menu $m.$submenu
2013            }
2014            "command" {
2015                lappend params -command $thing
2016            }
2017            "radiobutton" {
2018                lappend params -variable [lindex $thing 0] \
2019                    -value [lindex $thing 1]
2020            }
2021        }
2022        set tail [lrange $i 4 end]
2023        regsub -all {\yMeta1\y} $tail $Meta1 tail
2024        eval $m add $params $tail
2025        if {$type eq "cascade"} {
2026            makemenu $m.$submenu $thing
2027        }
2028    }
2029}
2030
2031# translate string and remove ampersands
2032proc mca {str} {
2033    return [string map {&& & & {}} [mc $str]]
2034}
2035
2036proc cleardropsel {w} {
2037    $w selection clear
2038}
2039proc makedroplist {w varname args} {
2040    global use_ttk
2041    if {$use_ttk} {
2042        set width 0
2043        foreach label $args {
2044            set cx [string length $label]
2045            if {$cx > $width} {set width $cx}
2046        }
2047        set gm [ttk::combobox $w -width $width -state readonly\
2048                    -textvariable $varname -values $args \
2049                    -exportselection false]
2050        bind $gm <<ComboboxSelected>> [list $gm selection clear]
2051    } else {
2052        set gm [eval [linsert $args 0 tk_optionMenu $w $varname]]
2053    }
2054    return $gm
2055}
2056
2057proc makewindow {} {
2058    global canv canv2 canv3 linespc charspc ctext cflist cscroll
2059    global tabstop
2060    global findtype findtypemenu findloc findstring fstring geometry
2061    global entries sha1entry sha1string sha1but
2062    global diffcontextstring diffcontext
2063    global ignorespace
2064    global maincursor textcursor curtextcursor
2065    global rowctxmenu fakerowmenu mergemax wrapcomment
2066    global highlight_files gdttype
2067    global searchstring sstring
2068    global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
2069    global uifgcolor uifgdisabledcolor
2070    global filesepbgcolor filesepfgcolor
2071    global mergecolors foundbgcolor currentsearchhitbgcolor
2072    global headctxmenu progresscanv progressitem progresscoords statusw
2073    global fprogitem fprogcoord lastprogupdate progupdatepending
2074    global rprogitem rprogcoord rownumsel numcommits
2075    global have_tk85 use_ttk NS
2076    global git_version
2077    global worddiff
2078
2079    # The "mc" arguments here are purely so that xgettext
2080    # sees the following string as needing to be translated
2081    set file {
2082        mc "&File" cascade {
2083            {mc "&Update" command updatecommits -accelerator F5}
2084            {mc "&Reload" command reloadcommits -accelerator Shift-F5}
2085            {mc "Reread re&ferences" command rereadrefs}
2086            {mc "&List references" command showrefs -accelerator F2}
2087            {xx "" separator}
2088            {mc "Start git &gui" command {exec git gui &}}
2089            {xx "" separator}
2090            {mc "&Quit" command doquit -accelerator Meta1-Q}
2091        }}
2092    set edit {
2093        mc "&Edit" cascade {
2094            {mc "&Preferences" command doprefs}
2095        }}
2096    set view {
2097        mc "&View" cascade {
2098            {mc "&New view..." command {newview 0} -accelerator Shift-F4}
2099            {mc "&Edit view..." command editview -state disabled -accelerator F4}
2100            {mc "&Delete view" command delview -state disabled}
2101            {xx "" separator}
2102            {mc "&All files" radiobutton {selectedview 0} -command {showview 0}}
2103        }}
2104    if {[tk windowingsystem] ne "aqua"} {
2105        set help {
2106        mc "&Help" cascade {
2107            {mc "&About gitk" command about}
2108            {mc "&Key bindings" command keys}
2109        }}
2110        set bar [list $file $edit $view $help]
2111    } else {
2112        proc ::tk::mac::ShowPreferences {} {doprefs}
2113        proc ::tk::mac::Quit {} {doquit}
2114        lset file end [lreplace [lindex $file end] end-1 end]
2115        set apple {
2116        xx "&Apple" cascade {
2117            {mc "&About gitk" command about}
2118            {xx "" separator}
2119        }}
2120        set help {
2121        mc "&Help" cascade {
2122            {mc "&Key bindings" command keys}
2123        }}
2124        set bar [list $apple $file $view $help]
2125    }
2126    makemenu .bar $bar
2127    . configure -menu .bar
2128
2129    if {$use_ttk} {
2130        # cover the non-themed toplevel with a themed frame.
2131        place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1
2132    }
2133
2134    # the gui has upper and lower half, parts of a paned window.
2135    ${NS}::panedwindow .ctop -orient vertical
2136
2137    # possibly use assumed geometry
2138    if {![info exists geometry(pwsash0)]} {
2139        set geometry(topheight) [expr {15 * $linespc}]
2140        set geometry(topwidth) [expr {80 * $charspc}]
2141        set geometry(botheight) [expr {15 * $linespc}]
2142        set geometry(botwidth) [expr {50 * $charspc}]
2143        set geometry(pwsash0) [list [expr {40 * $charspc}] 2]
2144        set geometry(pwsash1) [list [expr {60 * $charspc}] 2]
2145    }
2146
2147    # the upper half will have a paned window, a scroll bar to the right, and some stuff below
2148    ${NS}::frame .tf -height $geometry(topheight) -width $geometry(topwidth)
2149    ${NS}::frame .tf.histframe
2150    ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal
2151    if {!$use_ttk} {
2152        .tf.histframe.pwclist configure -sashpad 0 -handlesize 4
2153    }
2154
2155    # create three canvases
2156    set cscroll .tf.histframe.csb
2157    set canv .tf.histframe.pwclist.canv
2158    canvas $canv \
2159        -selectbackground $selectbgcolor \
2160        -background $bgcolor -bd 0 \
2161        -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
2162    .tf.histframe.pwclist add $canv
2163    set canv2 .tf.histframe.pwclist.canv2
2164    canvas $canv2 \
2165        -selectbackground $selectbgcolor \
2166        -background $bgcolor -bd 0 -yscrollincr $linespc
2167    .tf.histframe.pwclist add $canv2
2168    set canv3 .tf.histframe.pwclist.canv3
2169    canvas $canv3 \
2170        -selectbackground $selectbgcolor \
2171        -background $bgcolor -bd 0 -yscrollincr $linespc
2172    .tf.histframe.pwclist add $canv3
2173    if {$use_ttk} {
2174        bind .tf.histframe.pwclist <Map> {
2175            bind %W <Map> {}
2176            .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0]
2177            .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0]
2178        }
2179    } else {
2180        eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
2181        eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
2182    }
2183
2184    # a scroll bar to rule them
2185    ${NS}::scrollbar $cscroll -command {allcanvs yview}
2186    if {!$use_ttk} {$cscroll configure -highlightthickness 0}
2187    pack $cscroll -side right -fill y
2188    bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
2189    lappend bglist $canv $canv2 $canv3
2190    pack .tf.histframe.pwclist -fill both -expand 1 -side left
2191
2192    # we have two button bars at bottom of top frame. Bar 1
2193    ${NS}::frame .tf.bar
2194    ${NS}::frame .tf.lbar -height 15
2195
2196    set sha1entry .tf.bar.sha1
2197    set entries $sha1entry
2198    set sha1but .tf.bar.sha1label
2199    button $sha1but -text "[mc "SHA1 ID:"] " -state disabled -relief flat \
2200        -command gotocommit -width 8
2201    $sha1but conf -disabledforeground [$sha1but cget -foreground]
2202    pack .tf.bar.sha1label -side left
2203    ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string
2204    trace add variable sha1string write sha1change
2205    pack $sha1entry -side left -pady 2
2206
2207    set bm_left_data {
2208        #define left_width 16
2209        #define left_height 16
2210        static unsigned char left_bits[] = {
2211        0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
2212        0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
2213        0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
2214    }
2215    set bm_right_data {
2216        #define right_width 16
2217        #define right_height 16
2218        static unsigned char right_bits[] = {
2219        0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
2220        0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
2221        0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
2222    }
2223    image create bitmap bm-left -data $bm_left_data -foreground $uifgcolor
2224    image create bitmap bm-left-gray -data $bm_left_data -foreground $uifgdisabledcolor
2225    image create bitmap bm-right -data $bm_right_data -foreground $uifgcolor
2226    image create bitmap bm-right-gray -data $bm_right_data -foreground $uifgdisabledcolor
2227
2228    ${NS}::button .tf.bar.leftbut -command goback -state disabled -width 26
2229    if {$use_ttk} {
2230        .tf.bar.leftbut configure -image [list bm-left disabled bm-left-gray]
2231    } else {
2232        .tf.bar.leftbut configure -image bm-left
2233    }
2234    pack .tf.bar.leftbut -side left -fill y
2235    ${NS}::button .tf.bar.rightbut -command goforw -state disabled -width 26
2236    if {$use_ttk} {
2237        .tf.bar.rightbut configure -image [list bm-right disabled bm-right-gray]
2238    } else {
2239        .tf.bar.rightbut configure -image bm-right
2240    }
2241    pack .tf.bar.rightbut -side left -fill y
2242
2243    ${NS}::label .tf.bar.rowlabel -text [mc "Row"]
2244    set rownumsel {}
2245    ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \
2246        -relief sunken -anchor e
2247    ${NS}::label .tf.bar.rowlabel2 -text "/"
2248    ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \
2249        -relief sunken -anchor e
2250    pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
2251        -side left
2252    if {!$use_ttk} {
2253        foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont}
2254    }
2255    global selectedline
2256    trace add variable selectedline write selectedline_change
2257
2258    # Status label and progress bar
2259    set statusw .tf.bar.status
2260    ${NS}::label $statusw -width 15 -relief sunken
2261    pack $statusw -side left -padx 5
2262    if {$use_ttk} {
2263        set progresscanv [ttk::progressbar .tf.bar.progress]
2264    } else {
2265        set h [expr {[font metrics uifont -linespace] + 2}]
2266        set progresscanv .tf.bar.progress
2267        canvas $progresscanv -relief sunken -height $h -borderwidth 2
2268        set progressitem [$progresscanv create rect -1 0 0 $h -fill lime]
2269        set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
2270        set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
2271    }
2272    pack $progresscanv -side right -expand 1 -fill x -padx {0 2}
2273    set progresscoords {0 0}
2274    set fprogcoord 0
2275    set rprogcoord 0
2276    bind $progresscanv <Configure> adjustprogress
2277    set lastprogupdate [clock clicks -milliseconds]
2278    set progupdatepending 0
2279
2280    # build up the bottom bar of upper window
2281    ${NS}::label .tf.lbar.flabel -text "[mc "Find"] "
2282
2283    set bm_down_data {
2284        #define down_width 16
2285        #define down_height 16
2286        static unsigned char down_bits[] = {
2287        0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2288        0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2289        0x87, 0xe1, 0x8e, 0x71, 0x9c, 0x39, 0xb8, 0x1d,
2290        0xf0, 0x0f, 0xe0, 0x07, 0xc0, 0x03, 0x80, 0x01};
2291    }
2292    image create bitmap bm-down -data $bm_down_data -foreground $uifgcolor
2293    ${NS}::button .tf.lbar.fnext -width 26 -command {dofind 1 1}
2294    .tf.lbar.fnext configure -image bm-down
2295
2296    set bm_up_data {
2297        #define up_width 16
2298        #define up_height 16
2299        static unsigned char up_bits[] = {
2300        0x80, 0x01, 0xc0, 0x03, 0xe0, 0x07, 0xf0, 0x0f,
2301        0xb8, 0x1d, 0x9c, 0x39, 0x8e, 0x71, 0x87, 0xe1,
2302        0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2303        0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01};
2304    }
2305    image create bitmap bm-up -data $bm_up_data -foreground $uifgcolor
2306    ${NS}::button .tf.lbar.fprev -width 26 -command {dofind -1 1}
2307    .tf.lbar.fprev configure -image bm-up
2308
2309    ${NS}::label .tf.lbar.flab2 -text " [mc "commit"] "
2310
2311    pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
2312        -side left -fill y
2313    set gdttype [mc "containing:"]
2314    set gm [makedroplist .tf.lbar.gdttype gdttype \
2315                [mc "containing:"] \
2316                [mc "touching paths:"] \
2317                [mc "adding/removing string:"] \
2318                [mc "changing lines matching:"]]
2319    trace add variable gdttype write gdttype_change
2320    pack .tf.lbar.gdttype -side left -fill y
2321
2322    set findstring {}
2323    set fstring .tf.lbar.findstring
2324    lappend entries $fstring
2325    ${NS}::entry $fstring -width 30 -textvariable findstring
2326    trace add variable findstring write find_change
2327    set findtype [mc "Exact"]
2328    set findtypemenu [makedroplist .tf.lbar.findtype \
2329                          findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
2330    trace add variable findtype write findcom_change
2331    set findloc [mc "All fields"]
2332    makedroplist .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
2333        [mc "Comments"] [mc "Author"] [mc "Committer"]
2334    trace add variable findloc write find_change
2335    pack .tf.lbar.findloc -side right
2336    pack .tf.lbar.findtype -side right
2337    pack $fstring -side left -expand 1 -fill x
2338
2339    # Finish putting the upper half of the viewer together
2340    pack .tf.lbar -in .tf -side bottom -fill x
2341    pack .tf.bar -in .tf -side bottom -fill x
2342    pack .tf.histframe -fill both -side top -expand 1
2343    .ctop add .tf
2344    if {!$use_ttk} {
2345        .ctop paneconfigure .tf -height $geometry(topheight)
2346        .ctop paneconfigure .tf -width $geometry(topwidth)
2347    }
2348
2349    # now build up the bottom
2350    ${NS}::panedwindow .pwbottom -orient horizontal
2351
2352    # lower left, a text box over search bar, scroll bar to the right
2353    # if we know window height, then that will set the lower text height, otherwise
2354    # we set lower text height which will drive window height
2355    if {[info exists geometry(main)]} {
2356        ${NS}::frame .bleft -width $geometry(botwidth)
2357    } else {
2358        ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
2359    }
2360    ${NS}::frame .bleft.top
2361    ${NS}::frame .bleft.mid
2362    ${NS}::frame .bleft.bottom
2363
2364    # gap between sub-widgets
2365    set wgap [font measure uifont "i"]
2366
2367    ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch
2368    pack .bleft.top.search -side left -padx 5
2369    set sstring .bleft.top.sstring
2370    set searchstring ""
2371    ${NS}::entry $sstring -width 20 -textvariable searchstring
2372    lappend entries $sstring
2373    trace add variable searchstring write incrsearch
2374    pack $sstring -side left -expand 1 -fill x
2375    ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \
2376        -command changediffdisp -variable diffelide -value {0 0}
2377    ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \
2378        -command changediffdisp -variable diffelide -value {0 1}
2379    ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \
2380        -command changediffdisp -variable diffelide -value {1 0}
2381
2382    ${NS}::label .bleft.mid.labeldiffcontext -text "      [mc "Lines of context"]: "
2383    pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left -ipadx $wgap
2384    spinbox .bleft.mid.diffcontext -width 5 \
2385        -from 0 -increment 1 -to 10000000 \
2386        -validate all -validatecommand "diffcontextvalidate %P" \
2387        -textvariable diffcontextstring
2388    .bleft.mid.diffcontext set $diffcontext
2389    trace add variable diffcontextstring write diffcontextchange
2390    lappend entries .bleft.mid.diffcontext
2391    pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left -ipadx $wgap
2392    ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
2393        -command changeignorespace -variable ignorespace
2394    pack .bleft.mid.ignspace -side left -padx 5
2395
2396    set worddiff [mc "Line diff"]
2397    if {[package vcompare $git_version "1.7.2"] >= 0} {
2398        makedroplist .bleft.mid.worddiff worddiff [mc "Line diff"] \
2399            [mc "Markup words"] [mc "Color words"]
2400        trace add variable worddiff write changeworddiff
2401        pack .bleft.mid.worddiff -side left -padx 5
2402    }
2403
2404    set ctext .bleft.bottom.ctext
2405    text $ctext -background $bgcolor -foreground $fgcolor \
2406        -state disabled -font textfont \
2407        -yscrollcommand scrolltext -wrap none \
2408        -xscrollcommand ".bleft.bottom.sbhorizontal set"
2409    if {$have_tk85} {
2410        $ctext conf -tabstyle wordprocessor
2411    }
2412    ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview"
2413    ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h
2414    pack .bleft.top -side top -fill x
2415    pack .bleft.mid -side top -fill x
2416    grid $ctext .bleft.bottom.sb -sticky nsew
2417    grid .bleft.bottom.sbhorizontal -sticky ew
2418    grid columnconfigure .bleft.bottom 0 -weight 1
2419    grid rowconfigure .bleft.bottom 0 -weight 1
2420    grid rowconfigure .bleft.bottom 1 -weight 0
2421    pack .bleft.bottom -side top -fill both -expand 1
2422    lappend bglist $ctext
2423    lappend fglist $ctext
2424
2425    $ctext tag conf comment -wrap $wrapcomment
2426    $ctext tag conf filesep -font textfontbold -fore $filesepfgcolor -back $filesepbgcolor
2427    $ctext tag conf hunksep -fore [lindex $diffcolors 2]
2428    $ctext tag conf d0 -fore [lindex $diffcolors 0]
2429    $ctext tag conf dresult -fore [lindex $diffcolors 1]
2430    $ctext tag conf m0 -fore [lindex $mergecolors 0]
2431    $ctext tag conf m1 -fore [lindex $mergecolors 1]
2432    $ctext tag conf m2 -fore [lindex $mergecolors 2]
2433    $ctext tag conf m3 -fore [lindex $mergecolors 3]
2434    $ctext tag conf m4 -fore [lindex $mergecolors 4]
2435    $ctext tag conf m5 -fore [lindex $mergecolors 5]
2436    $ctext tag conf m6 -fore [lindex $mergecolors 6]
2437    $ctext tag conf m7 -fore [lindex $mergecolors 7]
2438    $ctext tag conf m8 -fore [lindex $mergecolors 8]
2439    $ctext tag conf m9 -fore [lindex $mergecolors 9]
2440    $ctext tag conf m10 -fore [lindex $mergecolors 10]
2441    $ctext tag conf m11 -fore [lindex $mergecolors 11]
2442    $ctext tag conf m12 -fore [lindex $mergecolors 12]
2443    $ctext tag conf m13 -fore [lindex $mergecolors 13]
2444    $ctext tag conf m14 -fore [lindex $mergecolors 14]
2445    $ctext tag conf m15 -fore [lindex $mergecolors 15]
2446    $ctext tag conf mmax -fore darkgrey
2447    set mergemax 16
2448    $ctext tag conf mresult -font textfontbold
2449    $ctext tag conf msep -font textfontbold
2450    $ctext tag conf found -back $foundbgcolor
2451    $ctext tag conf currentsearchhit -back $currentsearchhitbgcolor
2452    $ctext tag conf wwrap -wrap word -lmargin2 1c
2453    $ctext tag conf bold -font textfontbold
2454
2455    .pwbottom add .bleft
2456    if {!$use_ttk} {
2457        .pwbottom paneconfigure .bleft -width $geometry(botwidth)
2458    }
2459
2460    # lower right
2461    ${NS}::frame .bright
2462    ${NS}::frame .bright.mode
2463    ${NS}::radiobutton .bright.mode.patch -text [mc "Patch"] \
2464        -command reselectline -variable cmitmode -value "patch"
2465    ${NS}::radiobutton .bright.mode.tree -text [mc "Tree"] \
2466        -command reselectline -variable cmitmode -value "tree"
2467    grid .bright.mode.patch .bright.mode.tree -sticky ew
2468    pack .bright.mode -side top -fill x
2469    set cflist .bright.cfiles
2470    set indent [font measure mainfont "nn"]
2471    text $cflist \
2472        -selectbackground $selectbgcolor \
2473        -background $bgcolor -foreground $fgcolor \
2474        -font mainfont \
2475        -tabs [list $indent [expr {2 * $indent}]] \
2476        -yscrollcommand ".bright.sb set" \
2477        -cursor [. cget -cursor] \
2478        -spacing1 1 -spacing3 1
2479    lappend bglist $cflist
2480    lappend fglist $cflist
2481    ${NS}::scrollbar .bright.sb -command "$cflist yview"
2482    pack .bright.sb -side right -fill y
2483    pack $cflist -side left -fill both -expand 1
2484    $cflist tag configure highlight \
2485        -background [$cflist cget -selectbackground]
2486    $cflist tag configure bold -font mainfontbold
2487
2488    .pwbottom add .bright
2489    .ctop add .pwbottom
2490
2491    # restore window width & height if known
2492    if {[info exists geometry(main)]} {
2493        if {[scan $geometry(main) "%dx%d" w h] >= 2} {
2494            if {$w > [winfo screenwidth .]} {
2495                set w [winfo screenwidth .]
2496            }
2497            if {$h > [winfo screenheight .]} {
2498                set h [winfo screenheight .]
2499            }
2500            wm geometry . "${w}x$h"
2501        }
2502    }
2503
2504    if {[info exists geometry(state)] && $geometry(state) eq "zoomed"} {
2505        wm state . $geometry(state)
2506    }
2507
2508    if {[tk windowingsystem] eq {aqua}} {
2509        set M1B M1
2510        set ::BM "3"
2511    } else {
2512        set M1B Control
2513        set ::BM "2"
2514    }
2515
2516    if {$use_ttk} {
2517        bind .ctop <Map> {
2518            bind %W <Map> {}
2519            %W sashpos 0 $::geometry(topheight)
2520        }
2521        bind .pwbottom <Map> {
2522            bind %W <Map> {}
2523            %W sashpos 0 $::geometry(botwidth)
2524        }
2525    }
2526
2527    bind .pwbottom <Configure> {resizecdetpanes %W %w}
2528    pack .ctop -fill both -expand 1
2529    bindall <1> {selcanvline %W %x %y}
2530    #bindall <B1-Motion> {selcanvline %W %x %y}
2531    if {[tk windowingsystem] == "win32"} {
2532        bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
2533        bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
2534    } else {
2535        bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
2536        bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
2537        bind $ctext <Button> {
2538            if {"%b" eq 6} {
2539                $ctext xview scroll -5 units
2540            } elseif {"%b" eq 7} {
2541                $ctext xview scroll 5 units
2542            }
2543        }
2544        if {[tk windowingsystem] eq "aqua"} {
2545            bindall <MouseWheel> {
2546                set delta [expr {- (%D)}]
2547                allcanvs yview scroll $delta units
2548            }
2549            bindall <Shift-MouseWheel> {
2550                set delta [expr {- (%D)}]
2551                $canv xview scroll $delta units
2552            }
2553        }
2554    }
2555    bindall <$::BM> "canvscan mark %W %x %y"
2556    bindall <B$::BM-Motion> "canvscan dragto %W %x %y"
2557    bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2558    bind . <$M1B-Key-w> doquit
2559    bindkey <Home> selfirstline
2560    bindkey <End> sellastline
2561    bind . <Key-Up> "selnextline -1"
2562    bind . <Key-Down> "selnextline 1"
2563    bind . <Shift-Key-Up> "dofind -1 0"
2564    bind . <Shift-Key-Down> "dofind 1 0"
2565    bindkey <Key-Right> "goforw"
2566    bindkey <Key-Left> "goback"
2567    bind . <Key-Prior> "selnextpage -1"
2568    bind . <Key-Next> "selnextpage 1"
2569    bind . <$M1B-Home> "allcanvs yview moveto 0.0"
2570    bind . <$M1B-End> "allcanvs yview moveto 1.0"
2571    bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
2572    bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
2573    bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2574    bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
2575    bindkey <Key-Delete> "$ctext yview scroll -1 pages"
2576    bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
2577    bindkey <Key-space> "$ctext yview scroll 1 pages"
2578    bindkey p "selnextline -1"
2579    bindkey n "selnextline 1"
2580    bindkey z "goback"
2581    bindkey x "goforw"
2582    bindkey k "selnextline -1"
2583    bindkey j "selnextline 1"
2584    bindkey h "goback"
2585    bindkey l "goforw"
2586    bindkey b prevfile
2587    bindkey d "$ctext yview scroll 18 units"
2588    bindkey u "$ctext yview scroll -18 units"
2589    bindkey g {$sha1entry delete 0 end; focus $sha1entry}
2590    bindkey / {focus $fstring}
2591    bindkey <Key-KP_Divide> {focus $fstring}
2592    bindkey <Key-Return> {dofind 1 1}
2593    bindkey ? {dofind -1 1}
2594    bindkey f nextfile
2595    bind . <F5> updatecommits
2596    bindmodfunctionkey Shift 5 reloadcommits
2597    bind . <F2> showrefs
2598    bindmodfunctionkey Shift 4 {newview 0}
2599    bind . <F4> edit_or_newview
2600    bind . <$M1B-q> doquit
2601    bind . <$M1B-f> {dofind 1 1}
2602    bind . <$M1B-g> {dofind 1 0}
2603    bind . <$M1B-r> dosearchback
2604    bind . <$M1B-s> dosearch
2605    bind . <$M1B-equal> {incrfont 1}
2606    bind . <$M1B-plus> {incrfont 1}
2607    bind . <$M1B-KP_Add> {incrfont 1}
2608    bind . <$M1B-minus> {incrfont -1}
2609    bind . <$M1B-KP_Subtract> {incrfont -1}
2610    wm protocol . WM_DELETE_WINDOW doquit
2611    bind . <Destroy> {stop_backends}
2612    bind . <Button-1> "click %W"
2613    bind $fstring <Key-Return> {dofind 1 1}
2614    bind $sha1entry <Key-Return> {gotocommit; break}
2615    bind $sha1entry <<PasteSelection>> clearsha1
2616    bind $sha1entry <<Paste>> clearsha1
2617    bind $cflist <1> {sel_flist %W %x %y; break}
2618    bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
2619    bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
2620    global ctxbut
2621    bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
2622    bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
2623    bind $ctext <Button-1> {focus %W}
2624    bind $ctext <<Selection>> rehighlight_search_results
2625    for {set i 1} {$i < 10} {incr i} {
2626        bind . <$M1B-Key-$i> [list go_to_parent $i]
2627    }
2628
2629    set maincursor [. cget -cursor]
2630    set textcursor [$ctext cget -cursor]
2631    set curtextcursor $textcursor
2632
2633    set rowctxmenu .rowctxmenu
2634    makemenu $rowctxmenu {
2635        {mc "Diff this -> selected" command {diffvssel 0}}
2636        {mc "Diff selected -> this" command {diffvssel 1}}
2637        {mc "Make patch" command mkpatch}
2638        {mc "Create tag" command mktag}
2639        {mc "Copy commit summary" command copysummary}
2640        {mc "Write commit to file" command writecommit}
2641        {mc "Create new branch" command mkbranch}
2642        {mc "Cherry-pick this commit" command cherrypick}
2643        {mc "Reset HEAD branch to here" command resethead}
2644        {mc "Mark this commit" command markhere}
2645        {mc "Return to mark" command gotomark}
2646        {mc "Find descendant of this and mark" command find_common_desc}
2647        {mc "Compare with marked commit" command compare_commits}
2648        {mc "Diff this -> marked commit" command {diffvsmark 0}}
2649        {mc "Diff marked commit -> this" command {diffvsmark 1}}
2650        {mc "Revert this commit" command revert}
2651    }
2652    $rowctxmenu configure -tearoff 0
2653
2654    set fakerowmenu .fakerowmenu
2655    makemenu $fakerowmenu {
2656        {mc "Diff this -> selected" command {diffvssel 0}}
2657        {mc "Diff selected -> this" command {diffvssel 1}}
2658        {mc "Make patch" command mkpatch}
2659        {mc "Diff this -> marked commit" command {diffvsmark 0}}
2660        {mc "Diff marked commit -> this" command {diffvsmark 1}}
2661    }
2662    $fakerowmenu configure -tearoff 0
2663
2664    set headctxmenu .headctxmenu
2665    makemenu $headctxmenu {
2666        {mc "Check out this branch" command cobranch}
2667        {mc "Rename this branch" command mvbranch}
2668        {mc "Remove this branch" command rmbranch}
2669        {mc "Copy branch name" command {clipboard clear; clipboard append $headmenuhead}}
2670    }
2671    $headctxmenu configure -tearoff 0
2672
2673    global flist_menu
2674    set flist_menu .flistctxmenu
2675    makemenu $flist_menu {
2676        {mc "Highlight this too" command {flist_hl 0}}
2677        {mc "Highlight this only" command {flist_hl 1}}
2678        {mc "External diff" command {external_diff}}
2679        {mc "Blame parent commit" command {external_blame 1}}
2680        {mc "Copy path" command {clipboard clear; clipboard append $flist_menu_file}}
2681    }
2682    $flist_menu configure -tearoff 0
2683
2684    global diff_menu
2685    set diff_menu .diffctxmenu
2686    makemenu $diff_menu {
2687        {mc "Show origin of this line" command show_line_source}
2688        {mc "Run git gui blame on this line" command {external_blame_diff}}
2689    }
2690    $diff_menu configure -tearoff 0
2691}
2692
2693# Windows sends all mouse wheel events to the current focused window, not
2694# the one where the mouse hovers, so bind those events here and redirect
2695# to the correct window
2696proc windows_mousewheel_redirector {W X Y D} {
2697    global canv canv2 canv3
2698    set w [winfo containing -displayof $W $X $Y]
2699    if {$w ne ""} {
2700        set u [expr {$D < 0 ? 5 : -5}]
2701        if {$w == $canv || $w == $canv2 || $w == $canv3} {
2702            allcanvs yview scroll $u units
2703        } else {
2704            catch {
2705                $w yview scroll $u units
2706            }
2707        }
2708    }
2709}
2710
2711# Update row number label when selectedline changes
2712proc selectedline_change {n1 n2 op} {
2713    global selectedline rownumsel
2714
2715    if {$selectedline eq {}} {
2716        set rownumsel {}
2717    } else {
2718        set rownumsel [expr {$selectedline + 1}]
2719    }
2720}
2721
2722# mouse-2 makes all windows scan vertically, but only the one
2723# the cursor is in scans horizontally
2724proc canvscan {op w x y} {
2725    global canv canv2 canv3
2726    foreach c [list $canv $canv2 $canv3] {
2727        if {$c == $w} {
2728            $c scan $op $x $y
2729        } else {
2730            $c scan $op 0 $y
2731        }
2732    }
2733}
2734
2735proc scrollcanv {cscroll f0 f1} {
2736    $cscroll set $f0 $f1
2737    drawvisible
2738    flushhighlights
2739}
2740
2741# when we make a key binding for the toplevel, make sure
2742# it doesn't get triggered when that key is pressed in the
2743# find string entry widget.
2744proc bindkey {ev script} {
2745    global entries
2746    bind . $ev $script
2747    set escript [bind Entry $ev]
2748    if {$escript == {}} {
2749        set escript [bind Entry <Key>]
2750    }
2751    foreach e $entries {
2752        bind $e $ev "$escript; break"
2753    }
2754}
2755
2756proc bindmodfunctionkey {mod n script} {
2757    bind . <$mod-F$n> $script
2758    catch { bind . <$mod-XF86_Switch_VT_$n> $script }
2759}
2760
2761# set the focus back to the toplevel for any click outside
2762# the entry widgets
2763proc click {w} {
2764    global ctext entries
2765    foreach e [concat $entries $ctext] {
2766        if {$w == $e} return
2767    }
2768    focus .
2769}
2770
2771# Adjust the progress bar for a change in requested extent or canvas size
2772proc adjustprogress {} {
2773    global progresscanv progressitem progresscoords
2774    global fprogitem fprogcoord lastprogupdate progupdatepending
2775    global rprogitem rprogcoord use_ttk
2776
2777    if {$use_ttk} {
2778        $progresscanv configure -value [expr {int($fprogcoord * 100)}]
2779        return
2780    }
2781
2782    set w [expr {[winfo width $progresscanv] - 4}]
2783    set x0 [expr {$w * [lindex $progresscoords 0]}]
2784    set x1 [expr {$w * [lindex $progresscoords 1]}]
2785    set h [winfo height $progresscanv]
2786    $progresscanv coords $progressitem $x0 0 $x1 $h
2787    $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2788    $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2789    set now [clock clicks -milliseconds]
2790    if {$now >= $lastprogupdate + 100} {
2791        set progupdatepending 0
2792        update
2793    } elseif {!$progupdatepending} {
2794        set progupdatepending 1
2795        after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2796    }
2797}
2798
2799proc doprogupdate {} {
2800    global lastprogupdate progupdatepending
2801
2802    if {$progupdatepending} {
2803        set progupdatepending 0
2804        set lastprogupdate [clock clicks -milliseconds]
2805        update
2806    }
2807}
2808
2809proc config_check_tmp_exists {tries_left} {
2810    global config_file_tmp
2811
2812    if {[file exists $config_file_tmp]} {
2813        incr tries_left -1
2814        if {$tries_left > 0} {
2815            after 100 [list config_check_tmp_exists $tries_left]
2816        } else {
2817            error_popup "There appears to be a stale $config_file_tmp\
2818 file, which will prevent gitk from saving its configuration on exit.\
2819 Please remove it if it is not being used by any existing gitk process."
2820        }
2821    }
2822}
2823
2824proc config_init_trace {name} {
2825    global config_variable_changed config_variable_original
2826
2827    upvar #0 $name var
2828    set config_variable_changed($name) 0
2829    set config_variable_original($name) $var
2830}
2831
2832proc config_variable_change_cb {name name2 op} {
2833    global config_variable_changed config_variable_original
2834
2835    upvar #0 $name var
2836    if {$op eq "write" &&
2837        (![info exists config_variable_original($name)] ||
2838         $config_variable_original($name) ne $var)} {
2839        set config_variable_changed($name) 1
2840    }
2841}
2842
2843proc savestuff {w} {
2844    global stuffsaved
2845    global config_file config_file_tmp
2846    global config_variables config_variable_changed
2847    global viewchanged
2848
2849    upvar #0 viewname current_viewname
2850    upvar #0 viewfiles current_viewfiles
2851    upvar #0 viewargs current_viewargs
2852    upvar #0 viewargscmd current_viewargscmd
2853    upvar #0 viewperm current_viewperm
2854    upvar #0 nextviewnum current_nextviewnum
2855    upvar #0 use_ttk current_use_ttk
2856
2857    if {$stuffsaved} return
2858    if {![winfo viewable .]} return
2859    set remove_tmp 0
2860    if {[catch {
2861        set try_count 0
2862        while {[catch {set f [open $config_file_tmp {WRONLY CREAT EXCL}]}]} {
2863            if {[incr try_count] > 50} {
2864                error "Unable to write config file: $config_file_tmp exists"
2865            }
2866            after 100
2867        }
2868        set remove_tmp 1
2869        if {$::tcl_platform(platform) eq {windows}} {
2870            file attributes $config_file_tmp -hidden true
2871        }
2872        if {[file exists $config_file]} {
2873            source $config_file
2874        }
2875        foreach var_name $config_variables {
2876            upvar #0 $var_name var
2877            upvar 0 $var_name old_var
2878            if {!$config_variable_changed($var_name) && [info exists old_var]} {
2879                puts $f [list set $var_name $old_var]
2880            } else {
2881                puts $f [list set $var_name $var]
2882            }
2883        }
2884
2885        puts $f "set geometry(main) [wm geometry .]"
2886        puts $f "set geometry(state) [wm state .]"
2887        puts $f "set geometry(topwidth) [winfo width .tf]"
2888        puts $f "set geometry(topheight) [winfo height .tf]"
2889        if {$current_use_ttk} {
2890            puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
2891            puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
2892        } else {
2893            puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2894            puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2895        }
2896        puts $f "set geometry(botwidth) [winfo width .bleft]"
2897        puts $f "set geometry(botheight) [winfo height .bleft]"
2898
2899        array set view_save {}
2900        array set views {}
2901        if {![info exists permviews]} { set permviews {} }
2902        foreach view $permviews {
2903            set view_save([lindex $view 0]) 1
2904            set views([lindex $view 0]) $view
2905        }
2906        puts -nonewline $f "set permviews {"
2907        for {set v 1} {$v < $current_nextviewnum} {incr v} {
2908            if {$viewchanged($v)} {
2909                if {$current_viewperm($v)} {
2910                    set views($current_viewname($v)) [list $current_viewname($v) $current_viewfiles($v) $current_viewargs($v) $current_viewargscmd($v)]
2911                } else {
2912                    set view_save($current_viewname($v)) 0
2913                }
2914            }
2915        }
2916        # write old and updated view to their places and append remaining to the end
2917        foreach view $permviews {
2918            set view_name [lindex $view 0]
2919            if {$view_save($view_name)} {
2920                puts $f "{$views($view_name)}"
2921            }
2922            unset views($view_name)
2923        }
2924        foreach view_name [array names views] {
2925            puts $f "{$views($view_name)}"
2926        }
2927        puts $f "}"
2928        close $f
2929        file rename -force $config_file_tmp $config_file
2930        set remove_tmp 0
2931    } err]} {
2932        puts "Error saving config: $err"
2933    }
2934    if {$remove_tmp} {
2935        file delete -force $config_file_tmp
2936    }
2937    set stuffsaved 1
2938}
2939
2940proc resizeclistpanes {win w} {
2941    global oldwidth use_ttk
2942    if {[info exists oldwidth($win)]} {
2943        if {$use_ttk} {
2944            set s0 [$win sashpos 0]
2945            set s1 [$win sashpos 1]
2946        } else {
2947            set s0 [$win sash coord 0]
2948            set s1 [$win sash coord 1]
2949        }
2950        if {$w < 60} {
2951            set sash0 [expr {int($w/2 - 2)}]
2952            set sash1 [expr {int($w*5/6 - 2)}]
2953        } else {
2954            set factor [expr {1.0 * $w / $oldwidth($win)}]
2955            set sash0 [expr {int($factor * [lindex $s0 0])}]
2956            set sash1 [expr {int($factor * [lindex $s1 0])}]
2957            if {$sash0 < 30} {
2958                set sash0 30
2959            }
2960            if {$sash1 < $sash0 + 20} {
2961                set sash1 [expr {$sash0 + 20}]
2962            }
2963            if {$sash1 > $w - 10} {
2964                set sash1 [expr {$w - 10}]
2965                if {$sash0 > $sash1 - 20} {
2966                    set sash0 [expr {$sash1 - 20}]
2967                }
2968            }
2969        }
2970        if {$use_ttk} {
2971            $win sashpos 0 $sash0
2972            $win sashpos 1 $sash1
2973        } else {
2974            $win sash place 0 $sash0 [lindex $s0 1]
2975            $win sash place 1 $sash1 [lindex $s1 1]
2976        }
2977    }
2978    set oldwidth($win) $w
2979}
2980
2981proc resizecdetpanes {win w} {
2982    global oldwidth use_ttk
2983    if {[info exists oldwidth($win)]} {
2984        if {$use_ttk} {
2985            set s0 [$win sashpos 0]
2986        } else {
2987            set s0 [$win sash coord 0]
2988        }
2989        if {$w < 60} {
2990            set sash0 [expr {int($w*3/4 - 2)}]
2991        } else {
2992            set factor [expr {1.0 * $w / $oldwidth($win)}]
2993            set sash0 [expr {int($factor * [lindex $s0 0])}]
2994            if {$sash0 < 45} {
2995                set sash0 45
2996            }
2997            if {$sash0 > $w - 15} {
2998                set sash0 [expr {$w - 15}]
2999            }
3000        }
3001        if {$use_ttk} {
3002            $win sashpos 0 $sash0
3003        } else {
3004            $win sash place 0 $sash0 [lindex $s0 1]
3005        }
3006    }
3007    set oldwidth($win) $w
3008}
3009
3010proc allcanvs args {
3011    global canv canv2 canv3
3012    eval $canv $args
3013    eval $canv2 $args
3014    eval $canv3 $args
3015}
3016
3017proc bindall {event action} {
3018    global canv canv2 canv3
3019    bind $canv $event $action
3020    bind $canv2 $event $action
3021    bind $canv3 $event $action
3022}
3023
3024proc about {} {
3025    global bgcolor NS
3026    set w .about
3027    if {[winfo exists $w]} {
3028        raise $w
3029        return
3030    }
3031    ttk_toplevel $w
3032    wm title $w [mc "About gitk"]
3033    make_transient $w .
3034    message $w.m -text [mc "
3035Gitk - a commit viewer for git
3036
3037Copyright \u00a9 2005-2014 Paul Mackerras
3038
3039Use and redistribute under the terms of the GNU General Public License"] \
3040            -justify center -aspect 400 -border 2 -bg $bgcolor -relief groove
3041    pack $w.m -side top -fill x -padx 2 -pady 2
3042    ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
3043    pack $w.ok -side bottom
3044    bind $w <Visibility> "focus $w.ok"
3045    bind $w <Key-Escape> "destroy $w"
3046    bind $w <Key-Return> "destroy $w"
3047    tk::PlaceWindow $w widget .
3048}
3049
3050proc keys {} {
3051    global bgcolor NS
3052    set w .keys
3053    if {[winfo exists $w]} {
3054        raise $w
3055        return
3056    }
3057    if {[tk windowingsystem] eq {aqua}} {
3058        set M1T Cmd
3059    } else {
3060        set M1T Ctrl
3061    }
3062    ttk_toplevel $w
3063    wm title $w [mc "Gitk key bindings"]
3064    make_transient $w .
3065    message $w.m -text "
3066[mc "Gitk key bindings:"]
3067
3068[mc "<%s-Q>             Quit" $M1T]
3069[mc "<%s-W>             Close window" $M1T]
3070[mc "<Home>             Move to first commit"]
3071[mc "<End>              Move to last commit"]
3072[mc "<Up>, p, k Move up one commit"]
3073[mc "<Down>, n, j       Move down one commit"]
3074[mc "<Left>, z, h       Go back in history list"]
3075[mc "<Right>, x, l      Go forward in history list"]
3076[mc "<%s-n>     Go to n-th parent of current commit in history list" $M1T]
3077[mc "<PageUp>   Move up one page in commit list"]
3078[mc "<PageDown> Move down one page in commit list"]
3079[mc "<%s-Home>  Scroll to top of commit list" $M1T]
3080[mc "<%s-End>   Scroll to bottom of commit list" $M1T]
3081[mc "<%s-Up>    Scroll commit list up one line" $M1T]
3082[mc "<%s-Down>  Scroll commit list down one line" $M1T]
3083[mc "<%s-PageUp>        Scroll commit list up one page" $M1T]
3084[mc "<%s-PageDown>      Scroll commit list down one page" $M1T]
3085[mc "<Shift-Up> Find backwards (upwards, later commits)"]
3086[mc "<Shift-Down>       Find forwards (downwards, earlier commits)"]
3087[mc "<Delete>, b        Scroll diff view up one page"]
3088[mc "<Backspace>        Scroll diff view up one page"]
3089[mc "<Space>            Scroll diff view down one page"]
3090[mc "u          Scroll diff view up 18 lines"]
3091[mc "d          Scroll diff view down 18 lines"]
3092[mc "<%s-F>             Find" $M1T]
3093[mc "<%s-G>             Move to next find hit" $M1T]
3094[mc "<Return>   Move to next find hit"]
3095[mc "g          Go to commit"]
3096[mc "/          Focus the search box"]
3097[mc "?          Move to previous find hit"]
3098[mc "f          Scroll diff view to next file"]
3099[mc "<%s-S>             Search for next hit in diff view" $M1T]
3100[mc "<%s-R>             Search for previous hit in diff view" $M1T]
3101[mc "<%s-KP+>   Increase font size" $M1T]
3102[mc "<%s-plus>  Increase font size" $M1T]
3103[mc "<%s-KP->   Decrease font size" $M1T]
3104[mc "<%s-minus> Decrease font size" $M1T]
3105[mc "<F5>               Update"]
3106" \
3107            -justify left -bg $bgcolor -border 2 -relief groove
3108    pack $w.m -side top -fill both -padx 2 -pady 2
3109    ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
3110    bind $w <Key-Escape> [list destroy $w]
3111    pack $w.ok -side bottom
3112    bind $w <Visibility> "focus $w.ok"
3113    bind $w <Key-Escape> "destroy $w"
3114    bind $w <Key-Return> "destroy $w"
3115}
3116
3117# Procedures for manipulating the file list window at the
3118# bottom right of the overall window.
3119
3120proc treeview {w l openlevs} {
3121    global treecontents treediropen treeheight treeparent treeindex
3122
3123    set ix 0
3124    set treeindex() 0
3125    set lev 0
3126    set prefix {}
3127    set prefixend -1
3128    set prefendstack {}
3129    set htstack {}
3130    set ht 0
3131    set treecontents() {}
3132    $w conf -state normal
3133    foreach f $l {
3134        while {[string range $f 0 $prefixend] ne $prefix} {
3135            if {$lev <= $openlevs} {
3136                $w mark set e:$treeindex($prefix) "end -1c"
3137                $w mark gravity e:$treeindex($prefix) left
3138            }
3139            set treeheight($prefix) $ht
3140            incr ht [lindex $htstack end]
3141            set htstack [lreplace $htstack end end]
3142            set prefixend [lindex $prefendstack end]
3143            set prefendstack [lreplace $prefendstack end end]
3144            set prefix [string range $prefix 0 $prefixend]
3145            incr lev -1
3146        }
3147        set tail [string range $f [expr {$prefixend+1}] end]
3148        while {[set slash [string first "/" $tail]] >= 0} {
3149            lappend htstack $ht
3150            set ht 0
3151            lappend prefendstack $prefixend
3152            incr prefixend [expr {$slash + 1}]
3153            set d [string range $tail 0 $slash]
3154            lappend treecontents($prefix) $d
3155            set oldprefix $prefix
3156            append prefix $d
3157            set treecontents($prefix) {}
3158            set treeindex($prefix) [incr ix]
3159            set treeparent($prefix) $oldprefix
3160            set tail [string range $tail [expr {$slash+1}] end]
3161            if {$lev <= $openlevs} {
3162                set ht 1
3163                set treediropen($prefix) [expr {$lev < $openlevs}]
3164                set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
3165                $w mark set d:$ix "end -1c"
3166                $w mark gravity d:$ix left
3167                set str "\n"
3168                for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3169                $w insert end $str
3170                $w image create end -align center -image $bm -padx 1 \
3171                    -name a:$ix
3172                $w insert end $d [highlight_tag $prefix]
3173                $w mark set s:$ix "end -1c"
3174                $w mark gravity s:$ix left
3175            }
3176            incr lev
3177        }
3178        if {$tail ne {}} {
3179            if {$lev <= $openlevs} {
3180                incr ht
3181                set str "\n"
3182                for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3183                $w insert end $str
3184                $w insert end $tail [highlight_tag $f]
3185            }
3186            lappend treecontents($prefix) $tail
3187        }
3188    }
3189    while {$htstack ne {}} {
3190        set treeheight($prefix) $ht
3191        incr ht [lindex $htstack end]
3192        set htstack [lreplace $htstack end end]
3193        set prefixend [lindex $prefendstack end]
3194        set prefendstack [lreplace $prefendstack end end]
3195        set prefix [string range $prefix 0 $prefixend]
3196    }
3197    $w conf -state disabled
3198}
3199
3200proc linetoelt {l} {
3201    global treeheight treecontents
3202
3203    set y 2
3204    set prefix {}
3205    while {1} {
3206        foreach e $treecontents($prefix) {
3207            if {$y == $l} {
3208                return "$prefix$e"
3209            }
3210            set n 1
3211            if {[string index $e end] eq "/"} {
3212                set n $treeheight($prefix$e)
3213                if {$y + $n > $l} {
3214                    append prefix $e
3215                    incr y
3216                    break
3217                }
3218            }
3219            incr y $n
3220        }
3221    }
3222}
3223
3224proc highlight_tree {y prefix} {
3225    global treeheight treecontents cflist
3226
3227    foreach e $treecontents($prefix) {
3228        set path $prefix$e
3229        if {[highlight_tag $path] ne {}} {
3230            $cflist tag add bold $y.0 "$y.0 lineend"
3231        }
3232        incr y
3233        if {[string index $e end] eq "/" && $treeheight($path) > 1} {
3234            set y [highlight_tree $y $path]
3235        }
3236    }
3237    return $y
3238}
3239
3240proc treeclosedir {w dir} {
3241    global treediropen treeheight treeparent treeindex
3242
3243    set ix $treeindex($dir)
3244    $w conf -state normal
3245    $w delete s:$ix e:$ix
3246    set treediropen($dir) 0
3247    $w image configure a:$ix -image tri-rt
3248    $w conf -state disabled
3249    set n [expr {1 - $treeheight($dir)}]
3250    while {$dir ne {}} {
3251        incr treeheight($dir) $n
3252        set dir $treeparent($dir)
3253    }
3254}
3255
3256proc treeopendir {w dir} {
3257    global treediropen treeheight treeparent treecontents treeindex
3258
3259    set ix $treeindex($dir)
3260    $w conf -state normal
3261    $w image configure a:$ix -image tri-dn
3262    $w mark set e:$ix s:$ix
3263    $w mark gravity e:$ix right
3264    set lev 0
3265    set str "\n"
3266    set n [llength $treecontents($dir)]
3267    for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
3268        incr lev
3269        append str "\t"
3270        incr treeheight($x) $n
3271    }
3272    foreach e $treecontents($dir) {
3273        set de $dir$e
3274        if {[string index $e end] eq "/"} {
3275            set iy $treeindex($de)
3276            $w mark set d:$iy e:$ix
3277            $w mark gravity d:$iy left
3278            $w insert e:$ix $str
3279            set treediropen($de) 0
3280            $w image create e:$ix -align center -image tri-rt -padx 1 \
3281                -name a:$iy
3282            $w insert e:$ix $e [highlight_tag $de]
3283            $w mark set s:$iy e:$ix
3284            $w mark gravity s:$iy left
3285            set treeheight($de) 1
3286        } else {
3287            $w insert e:$ix $str
3288            $w insert e:$ix $e [highlight_tag $de]
3289        }
3290    }
3291    $w mark gravity e:$ix right
3292    $w conf -state disabled
3293    set treediropen($dir) 1
3294    set top [lindex [split [$w index @0,0] .] 0]
3295    set ht [$w cget -height]
3296    set l [lindex [split [$w index s:$ix] .] 0]
3297    if {$l < $top} {
3298        $w yview $l.0
3299    } elseif {$l + $n + 1 > $top + $ht} {
3300        set top [expr {$l + $n + 2 - $ht}]
3301        if {$l < $top} {
3302            set top $l
3303        }
3304        $w yview $top.0
3305    }
3306}
3307
3308proc treeclick {w x y} {
3309    global treediropen cmitmode ctext cflist cflist_top
3310
3311    if {$cmitmode ne "tree"} return
3312    if {![info exists cflist_top]} return
3313    set l [lindex [split [$w index "@$x,$y"] "."] 0]
3314    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3315    $cflist tag add highlight $l.0 "$l.0 lineend"
3316    set cflist_top $l
3317    if {$l == 1} {
3318        $ctext yview 1.0
3319        return
3320    }
3321    set e [linetoelt $l]
3322    if {[string index $e end] ne "/"} {
3323        showfile $e
3324    } elseif {$treediropen($e)} {
3325        treeclosedir $w $e
3326    } else {
3327        treeopendir $w $e
3328    }
3329}
3330
3331proc setfilelist {id} {
3332    global treefilelist cflist jump_to_here
3333
3334    treeview $cflist $treefilelist($id) 0
3335    if {$jump_to_here ne {}} {
3336        set f [lindex $jump_to_here 0]
3337        if {[lsearch -exact $treefilelist($id) $f] >= 0} {
3338            showfile $f
3339        }
3340    }
3341}
3342
3343image create bitmap tri-rt -background black -foreground blue -data {
3344    #define tri-rt_width 13
3345    #define tri-rt_height 13
3346    static unsigned char tri-rt_bits[] = {
3347       0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
3348       0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
3349       0x00, 0x00};
3350} -maskdata {
3351    #define tri-rt-mask_width 13
3352    #define tri-rt-mask_height 13
3353    static unsigned char tri-rt-mask_bits[] = {
3354       0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
3355       0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
3356       0x08, 0x00};
3357}
3358image create bitmap tri-dn -background black -foreground blue -data {
3359    #define tri-dn_width 13
3360    #define tri-dn_height 13
3361    static unsigned char tri-dn_bits[] = {
3362       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
3363       0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3364       0x00, 0x00};
3365} -maskdata {
3366    #define tri-dn-mask_width 13
3367    #define tri-dn-mask_height 13
3368    static unsigned char tri-dn-mask_bits[] = {
3369       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
3370       0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
3371       0x00, 0x00};
3372}
3373
3374image create bitmap reficon-T -background black -foreground yellow -data {
3375    #define tagicon_width 13
3376    #define tagicon_height 9
3377    static unsigned char tagicon_bits[] = {
3378       0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
3379       0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
3380} -maskdata {
3381    #define tagicon-mask_width 13
3382    #define tagicon-mask_height 9
3383    static unsigned char tagicon-mask_bits[] = {
3384       0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
3385       0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
3386}
3387set rectdata {
3388    #define headicon_width 13
3389    #define headicon_height 9
3390    static unsigned char headicon_bits[] = {
3391       0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3392       0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3393}
3394set rectmask {
3395    #define headicon-mask_width 13
3396    #define headicon-mask_height 9
3397    static unsigned char headicon-mask_bits[] = {
3398       0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3399       0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3400}
3401image create bitmap reficon-H -background black -foreground lime \
3402    -data $rectdata -maskdata $rectmask
3403image create bitmap reficon-o -background black -foreground "#ddddff" \
3404    -data $rectdata -maskdata $rectmask
3405
3406proc init_flist {first} {
3407    global cflist cflist_top difffilestart
3408
3409    $cflist conf -state normal
3410    $cflist delete 0.0 end
3411    if {$first ne {}} {
3412        $cflist insert end $first
3413        set cflist_top 1
3414        $cflist tag add highlight 1.0 "1.0 lineend"
3415    } else {
3416        unset -nocomplain cflist_top
3417    }
3418    $cflist conf -state disabled
3419    set difffilestart {}
3420}
3421
3422proc highlight_tag {f} {
3423    global highlight_paths
3424
3425    foreach p $highlight_paths {
3426        if {[string match $p $f]} {
3427            return "bold"
3428        }
3429    }
3430    return {}
3431}
3432
3433proc highlight_filelist {} {
3434    global cmitmode cflist
3435
3436    $cflist conf -state normal
3437    if {$cmitmode ne "tree"} {
3438        set end [lindex [split [$cflist index end] .] 0]
3439        for {set l 2} {$l < $end} {incr l} {
3440            set line [$cflist get $l.0 "$l.0 lineend"]
3441            if {[highlight_tag $line] ne {}} {
3442                $cflist tag add bold $l.0 "$l.0 lineend"
3443            }
3444        }
3445    } else {
3446        highlight_tree 2 {}
3447    }
3448    $cflist conf -state disabled
3449}
3450
3451proc unhighlight_filelist {} {
3452    global cflist
3453
3454    $cflist conf -state normal
3455    $cflist tag remove bold 1.0 end
3456    $cflist conf -state disabled
3457}
3458
3459proc add_flist {fl} {
3460    global cflist
3461
3462    $cflist conf -state normal
3463    foreach f $fl {
3464        $cflist insert end "\n"
3465        $cflist insert end $f [highlight_tag $f]
3466    }
3467    $cflist conf -state disabled
3468}
3469
3470proc sel_flist {w x y} {
3471    global ctext difffilestart cflist cflist_top cmitmode
3472
3473    if {$cmitmode eq "tree"} return
3474    if {![info exists cflist_top]} return
3475    set l [lindex [split [$w index "@$x,$y"] "."] 0]
3476    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3477    $cflist tag add highlight $l.0 "$l.0 lineend"
3478    set cflist_top $l
3479    if {$l == 1} {
3480        $ctext yview 1.0
3481    } else {
3482        catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
3483    }
3484    suppress_highlighting_file_for_current_scrollpos
3485}
3486
3487proc pop_flist_menu {w X Y x y} {
3488    global ctext cflist cmitmode flist_menu flist_menu_file
3489    global treediffs diffids
3490
3491    stopfinding
3492    set l [lindex [split [$w index "@$x,$y"] "."] 0]
3493    if {$l <= 1} return
3494    if {$cmitmode eq "tree"} {
3495        set e [linetoelt $l]
3496        if {[string index $e end] eq "/"} return
3497    } else {
3498        set e [lindex $treediffs($diffids) [expr {$l-2}]]
3499    }
3500    set flist_menu_file $e
3501    set xdiffstate "normal"
3502    if {$cmitmode eq "tree"} {
3503        set xdiffstate "disabled"
3504    }
3505    # Disable "External diff" item in tree mode
3506    $flist_menu entryconf 2 -state $xdiffstate
3507    tk_popup $flist_menu $X $Y
3508}
3509
3510proc find_ctext_fileinfo {line} {
3511    global ctext_file_names ctext_file_lines
3512
3513    set ok [bsearch $ctext_file_lines $line]
3514    set tline [lindex $ctext_file_lines $ok]
3515
3516    if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3517        return {}
3518    } else {
3519        return [list [lindex $ctext_file_names $ok] $tline]
3520    }
3521}
3522
3523proc pop_diff_menu {w X Y x y} {
3524    global ctext diff_menu flist_menu_file
3525    global diff_menu_txtpos diff_menu_line
3526    global diff_menu_filebase
3527
3528    set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3529    set diff_menu_line [lindex $diff_menu_txtpos 0]
3530    # don't pop up the menu on hunk-separator or file-separator lines
3531    if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3532        return
3533    }
3534    stopfinding
3535    set f [find_ctext_fileinfo $diff_menu_line]
3536    if {$f eq {}} return
3537    set flist_menu_file [lindex $f 0]
3538    set diff_menu_filebase [lindex $f 1]
3539    tk_popup $diff_menu $X $Y
3540}
3541
3542proc flist_hl {only} {
3543    global flist_menu_file findstring gdttype
3544
3545    set x [shellquote $flist_menu_file]
3546    if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
3547        set findstring $x
3548    } else {
3549        append findstring " " $x
3550    }
3551    set gdttype [mc "touching paths:"]
3552}
3553
3554proc gitknewtmpdir {} {
3555    global diffnum gitktmpdir gitdir env
3556
3557    if {![info exists gitktmpdir]} {
3558        if {[info exists env(GITK_TMPDIR)]} {
3559            set tmpdir $env(GITK_TMPDIR)
3560        } elseif {[info exists env(TMPDIR)]} {
3561            set tmpdir $env(TMPDIR)
3562        } else {
3563            set tmpdir $gitdir
3564        }
3565        set gitktmpformat [file join $tmpdir ".gitk-tmp.XXXXXX"]
3566        if {[catch {set gitktmpdir [exec mktemp -d $gitktmpformat]}]} {
3567            set gitktmpdir [file join $gitdir [format ".gitk-tmp.%s" [pid]]]
3568        }
3569        if {[catch {file mkdir $gitktmpdir} err]} {
3570            error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3571            unset gitktmpdir
3572            return {}
3573        }
3574        set diffnum 0
3575    }
3576    incr diffnum
3577    set diffdir [file join $gitktmpdir $diffnum]
3578    if {[catch {file mkdir $diffdir} err]} {
3579        error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3580        return {}
3581    }
3582    return $diffdir
3583}
3584
3585proc save_file_from_commit {filename output what} {
3586    global nullfile
3587
3588    if {[catch {exec git show $filename -- > $output} err]} {
3589        if {[string match "fatal: bad revision *" $err]} {
3590            return $nullfile
3591        }
3592        error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
3593        return {}
3594    }
3595    return $output
3596}
3597
3598proc external_diff_get_one_file {diffid filename diffdir} {
3599    global nullid nullid2 nullfile
3600    global worktree
3601
3602    if {$diffid == $nullid} {
3603        set difffile [file join $worktree $filename]
3604        if {[file exists $difffile]} {
3605            return $difffile
3606        }
3607        return $nullfile
3608    }
3609    if {$diffid == $nullid2} {
3610        set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3611        return [save_file_from_commit :$filename $difffile index]
3612    }
3613    set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3614    return [save_file_from_commit $diffid:$filename $difffile \
3615               "revision $diffid"]
3616}
3617
3618proc external_diff {} {
3619    global nullid nullid2
3620    global flist_menu_file
3621    global diffids
3622    global extdifftool
3623
3624    if {[llength $diffids] == 1} {
3625        # no reference commit given
3626        set diffidto [lindex $diffids 0]
3627        if {$diffidto eq $nullid} {
3628            # diffing working copy with index
3629            set diffidfrom $nullid2
3630        } elseif {$diffidto eq $nullid2} {
3631            # diffing index with HEAD
3632            set diffidfrom "HEAD"
3633        } else {
3634            # use first parent commit
3635            global parentlist selectedline
3636            set diffidfrom [lindex $parentlist $selectedline 0]
3637        }
3638    } else {
3639        set diffidfrom [lindex $diffids 0]
3640        set diffidto [lindex $diffids 1]
3641    }
3642
3643    # make sure that several diffs wont collide
3644    set diffdir [gitknewtmpdir]
3645    if {$diffdir eq {}} return
3646
3647    # gather files to diff
3648    set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3649    set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3650
3651    if {$difffromfile ne {} && $difftofile ne {}} {
3652        set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
3653        if {[catch {set fl [open |$cmd r]} err]} {
3654            file delete -force $diffdir
3655            error_popup "$extdifftool: [mc "command failed:"] $err"
3656        } else {
3657            fconfigure $fl -blocking 0
3658            filerun $fl [list delete_at_eof $fl $diffdir]
3659        }
3660    }
3661}
3662
3663proc find_hunk_blamespec {base line} {
3664    global ctext
3665
3666    # Find and parse the hunk header
3667    set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3668    if {$s_lix eq {}} return
3669
3670    set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3671    if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3672            s_line old_specs osz osz1 new_line nsz]} {
3673        return
3674    }
3675
3676    # base lines for the parents
3677    set base_lines [list $new_line]
3678    foreach old_spec [lrange [split $old_specs " "] 1 end] {
3679        if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3680                old_spec old_line osz]} {
3681            return
3682        }
3683        lappend base_lines $old_line
3684    }
3685
3686    # Now scan the lines to determine offset within the hunk
3687    set max_parent [expr {[llength $base_lines]-2}]
3688    set dline 0
3689    set s_lno [lindex [split $s_lix "."] 0]
3690
3691    # Determine if the line is removed
3692    set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3693    if {[string match {[-+ ]*} $chunk]} {
3694        set removed_idx [string first "-" $chunk]
3695        # Choose a parent index
3696        if {$removed_idx >= 0} {
3697            set parent $removed_idx
3698        } else {
3699            set unchanged_idx [string first " " $chunk]
3700            if {$unchanged_idx >= 0} {
3701                set parent $unchanged_idx
3702            } else {
3703                # blame the current commit
3704                set parent -1
3705            }
3706        }
3707        # then count other lines that belong to it
3708        for {set i $line} {[incr i -1] > $s_lno} {} {
3709            set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3710            # Determine if the line is removed
3711            set removed_idx [string first "-" $chunk]
3712            if {$parent >= 0} {
3713                set code [string index $chunk $parent]
3714                if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3715                    incr dline
3716                }
3717            } else {
3718                if {$removed_idx < 0} {
3719                    incr dline
3720                }
3721            }
3722        }
3723        incr parent
3724    } else {
3725        set parent 0
3726    }
3727
3728    incr dline [lindex $base_lines $parent]
3729    return [list $parent $dline]
3730}
3731
3732proc external_blame_diff {} {
3733    global currentid cmitmode
3734    global diff_menu_txtpos diff_menu_line
3735    global diff_menu_filebase flist_menu_file
3736
3737    if {$cmitmode eq "tree"} {
3738        set parent_idx 0
3739        set line [expr {$diff_menu_line - $diff_menu_filebase}]
3740    } else {
3741        set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3742        if {$hinfo ne {}} {
3743            set parent_idx [lindex $hinfo 0]
3744            set line [lindex $hinfo 1]
3745        } else {
3746            set parent_idx 0
3747            set line 0
3748        }
3749    }
3750
3751    external_blame $parent_idx $line
3752}
3753
3754# Find the SHA1 ID of the blob for file $fname in the index
3755# at stage 0 or 2
3756proc index_sha1 {fname} {
3757    set f [open [list | git ls-files -s $fname] r]
3758    while {[gets $f line] >= 0} {
3759        set info [lindex [split $line "\t"] 0]
3760        set stage [lindex $info 2]
3761        if {$stage eq "0" || $stage eq "2"} {
3762            close $f
3763            return [lindex $info 1]
3764        }
3765    }
3766    close $f
3767    return {}
3768}
3769
3770# Turn an absolute path into one relative to the current directory
3771proc make_relative {f} {
3772    if {[file pathtype $f] eq "relative"} {
3773        return $f
3774    }
3775    set elts [file split $f]
3776    set here [file split [pwd]]
3777    set ei 0
3778    set hi 0
3779    set res {}
3780    foreach d $here {
3781        if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3782            lappend res ".."
3783        } else {
3784            incr ei
3785        }
3786        incr hi
3787    }
3788    set elts [concat $res [lrange $elts $ei end]]
3789    return [eval file join $elts]
3790}
3791
3792proc external_blame {parent_idx {line {}}} {
3793    global flist_menu_file cdup
3794    global nullid nullid2
3795    global parentlist selectedline currentid
3796
3797    if {$parent_idx > 0} {
3798        set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3799    } else {
3800        set base_commit $currentid
3801    }
3802
3803    if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3804        error_popup [mc "No such commit"]
3805        return
3806    }
3807
3808    set cmdline [list git gui blame]
3809    if {$line ne {} && $line > 1} {
3810        lappend cmdline "--line=$line"
3811    }
3812    set f [file join $cdup $flist_menu_file]
3813    # Unfortunately it seems git gui blame doesn't like
3814    # being given an absolute path...
3815    set f [make_relative $f]
3816    lappend cmdline $base_commit $f
3817    if {[catch {eval exec $cmdline &} err]} {
3818        error_popup "[mc "git gui blame: command failed:"] $err"
3819    }
3820}
3821
3822proc show_line_source {} {
3823    global cmitmode currentid parents curview blamestuff blameinst
3824    global diff_menu_line diff_menu_filebase flist_menu_file
3825    global nullid nullid2 gitdir cdup
3826
3827    set from_index {}
3828    if {$cmitmode eq "tree"} {
3829        set id $currentid
3830        set line [expr {$diff_menu_line - $diff_menu_filebase}]
3831    } else {
3832        set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3833        if {$h eq {}} return
3834        set pi [lindex $h 0]
3835        if {$pi == 0} {
3836            mark_ctext_line $diff_menu_line
3837            return
3838        }
3839        incr pi -1
3840        if {$currentid eq $nullid} {
3841            if {$pi > 0} {
3842                # must be a merge in progress...
3843                if {[catch {
3844                    # get the last line from .git/MERGE_HEAD
3845                    set f [open [file join $gitdir MERGE_HEAD] r]
3846                    set id [lindex [split [read $f] "\n"] end-1]
3847                    close $f
3848                } err]} {
3849                    error_popup [mc "Couldn't read merge head: %s" $err]
3850                    return
3851                }
3852            } elseif {$parents($curview,$currentid) eq $nullid2} {
3853                # need to do the blame from the index
3854                if {[catch {
3855                    set from_index [index_sha1 $flist_menu_file]
3856                } err]} {
3857                    error_popup [mc "Error reading index: %s" $err]
3858                    return
3859                }
3860            } else {
3861                set id $parents($curview,$currentid)
3862            }
3863        } else {
3864            set id [lindex $parents($curview,$currentid) $pi]
3865        }
3866        set line [lindex $h 1]
3867    }
3868    set blameargs {}
3869    if {$from_index ne {}} {
3870        lappend blameargs | git cat-file blob $from_index
3871    }
3872    lappend blameargs | git blame -p -L$line,+1
3873    if {$from_index ne {}} {
3874        lappend blameargs --contents -
3875    } else {
3876        lappend blameargs $id
3877    }
3878    lappend blameargs -- [file join $cdup $flist_menu_file]
3879    if {[catch {
3880        set f [open $blameargs r]
3881    } err]} {
3882        error_popup [mc "Couldn't start git blame: %s" $err]
3883        return
3884    }
3885    nowbusy blaming [mc "Searching"]
3886    fconfigure $f -blocking 0
3887    set i [reg_instance $f]
3888    set blamestuff($i) {}
3889    set blameinst $i
3890    filerun $f [list read_line_source $f $i]
3891}
3892
3893proc stopblaming {} {
3894    global blameinst
3895
3896    if {[info exists blameinst]} {
3897        stop_instance $blameinst
3898        unset blameinst
3899        notbusy blaming
3900    }
3901}
3902
3903proc read_line_source {fd inst} {
3904    global blamestuff curview commfd blameinst nullid nullid2
3905
3906    while {[gets $fd line] >= 0} {
3907        lappend blamestuff($inst) $line
3908    }
3909    if {![eof $fd]} {
3910        return 1
3911    }
3912    unset commfd($inst)
3913    unset blameinst
3914    notbusy blaming
3915    fconfigure $fd -blocking 1
3916    if {[catch {close $fd} err]} {
3917        error_popup [mc "Error running git blame: %s" $err]
3918        return 0
3919    }
3920
3921    set fname {}
3922    set line [split [lindex $blamestuff($inst) 0] " "]
3923    set id [lindex $line 0]
3924    set lnum [lindex $line 1]
3925    if {[string length $id] == 40 && [string is xdigit $id] &&
3926        [string is digit -strict $lnum]} {
3927        # look for "filename" line
3928        foreach l $blamestuff($inst) {
3929            if {[string match "filename *" $l]} {
3930                set fname [string range $l 9 end]
3931                break
3932            }
3933        }
3934    }
3935    if {$fname ne {}} {
3936        # all looks good, select it
3937        if {$id eq $nullid} {
3938            # blame uses all-zeroes to mean not committed,
3939            # which would mean a change in the index
3940            set id $nullid2
3941        }
3942        if {[commitinview $id $curview]} {
3943            selectline [rowofcommit $id] 1 [list $fname $lnum] 1
3944        } else {
3945            error_popup [mc "That line comes from commit %s, \
3946                             which is not in this view" [shortids $id]]
3947        }
3948    } else {
3949        puts "oops couldn't parse git blame output"
3950    }
3951    return 0
3952}
3953
3954# delete $dir when we see eof on $f (presumably because the child has exited)
3955proc delete_at_eof {f dir} {
3956    while {[gets $f line] >= 0} {}
3957    if {[eof $f]} {
3958        if {[catch {close $f} err]} {
3959            error_popup "[mc "External diff viewer failed:"] $err"
3960        }
3961        file delete -force $dir
3962        return 0
3963    }
3964    return 1
3965}
3966
3967# Functions for adding and removing shell-type quoting
3968
3969proc shellquote {str} {
3970    if {![string match "*\['\"\\ \t]*" $str]} {
3971        return $str
3972    }
3973    if {![string match "*\['\"\\]*" $str]} {
3974        return "\"$str\""
3975    }
3976    if {![string match "*'*" $str]} {
3977        return "'$str'"
3978    }
3979    return "\"[string map {\" \\\" \\ \\\\} $str]\""
3980}
3981
3982proc shellarglist {l} {
3983    set str {}
3984    foreach a $l {
3985        if {$str ne {}} {
3986            append str " "
3987        }
3988        append str [shellquote $a]
3989    }
3990    return $str
3991}
3992
3993proc shelldequote {str} {
3994    set ret {}
3995    set used -1
3996    while {1} {
3997        incr used
3998        if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
3999            append ret [string range $str $used end]
4000            set used [string length $str]
4001            break
4002        }
4003        set first [lindex $first 0]
4004        set ch [string index $str $first]
4005        if {$first > $used} {
4006            append ret [string range $str $used [expr {$first - 1}]]
4007            set used $first
4008        }
4009        if {$ch eq " " || $ch eq "\t"} break
4010        incr used
4011        if {$ch eq "'"} {
4012            set first [string first "'" $str $used]
4013            if {$first < 0} {
4014                error "unmatched single-quote"
4015            }
4016            append ret [string range $str $used [expr {$first - 1}]]
4017            set used $first
4018            continue
4019        }
4020        if {$ch eq "\\"} {
4021            if {$used >= [string length $str]} {
4022                error "trailing backslash"
4023            }
4024            append ret [string index $str $used]
4025            continue
4026        }
4027        # here ch == "\""
4028        while {1} {
4029            if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
4030                error "unmatched double-quote"
4031            }
4032            set first [lindex $first 0]
4033            set ch [string index $str $first]
4034            if {$first > $used} {
4035                append ret [string range $str $used [expr {$first - 1}]]
4036                set used $first
4037            }
4038            if {$ch eq "\""} break
4039            incr used
4040            append ret [string index $str $used]
4041            incr used
4042        }
4043    }
4044    return [list $used $ret]
4045}
4046
4047proc shellsplit {str} {
4048    set l {}
4049    while {1} {
4050        set str [string trimleft $str]
4051        if {$str eq {}} break
4052        set dq [shelldequote $str]
4053        set n [lindex $dq 0]
4054        set word [lindex $dq 1]
4055        set str [string range $str $n end]
4056        lappend l $word
4057    }
4058    return $l
4059}
4060
4061proc set_window_title {} {
4062    global appname curview viewname vrevs
4063    set rev [mc "All files"]
4064    if {$curview ne 0} {
4065        if {$viewname($curview) eq [mc "Command line"]} {
4066            set rev [string map {"--gitk-symmetric-diff-marker" "--merge"} $vrevs($curview)]
4067        } else {
4068            set rev $viewname($curview)
4069        }
4070    }
4071    wm title . "[reponame]: $rev - $appname"
4072}
4073
4074# Code to implement multiple views
4075
4076proc newview {ishighlight} {
4077    global nextviewnum newviewname newishighlight
4078    global revtreeargs viewargscmd newviewopts curview
4079
4080    set newishighlight $ishighlight
4081    set top .gitkview
4082    if {[winfo exists $top]} {
4083        raise $top
4084        return
4085    }
4086    decode_view_opts $nextviewnum $revtreeargs
4087    set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
4088    set newviewopts($nextviewnum,perm) 0
4089    set newviewopts($nextviewnum,cmd)  $viewargscmd($curview)
4090    vieweditor $top $nextviewnum [mc "Gitk view definition"]
4091}
4092
4093set known_view_options {
4094    {perm      b    .  {}               {mc "Remember this view"}}
4095    {reflabel  l    +  {}               {mc "References (space separated list):"}}
4096    {refs      t15  .. {}               {mc "Branches & tags:"}}
4097    {allrefs   b    *. "--all"          {mc "All refs"}}
4098    {branches  b    .  "--branches"     {mc "All (local) branches"}}
4099    {tags      b    .  "--tags"         {mc "All tags"}}
4100    {remotes   b    .  "--remotes"      {mc "All remote-tracking branches"}}
4101    {commitlbl l    +  {}               {mc "Commit Info (regular expressions):"}}
4102    {author    t15  .. "--author=*"     {mc "Author:"}}
4103    {committer t15  .  "--committer=*"  {mc "Committer:"}}
4104    {loginfo   t15  .. "--grep=*"       {mc "Commit Message:"}}
4105    {allmatch  b    .. "--all-match"    {mc "Matches all Commit Info criteria"}}
4106    {igrep     b    .. "--invert-grep"  {mc "Matches no Commit Info criteria"}}
4107    {changes_l l    +  {}               {mc "Changes to Files:"}}
4108    {pickaxe_s r0   .  {}               {mc "Fixed String"}}
4109    {pickaxe_t r1   .  "--pickaxe-regex"  {mc "Regular Expression"}}
4110    {pickaxe   t15  .. "-S*"            {mc "Search string:"}}
4111    {datelabel l    +  {}               {mc "Commit Dates (\"2 weeks ago\", \"2009-03-17 15:27:38\", \"March 17, 2009 15:27:38\"):"}}
4112    {since     t15  ..  {"--since=*" "--after=*"}  {mc "Since:"}}
4113    {until     t15  .   {"--until=*" "--before=*"} {mc "Until:"}}
4114    {limit_lbl l    +  {}               {mc "Limit and/or skip a number of revisions (positive integer):"}}
4115    {limit     t10  *. "--max-count=*"  {mc "Number to show:"}}
4116    {skip      t10  .  "--skip=*"       {mc "Number to skip:"}}
4117    {misc_lbl  l    +  {}               {mc "Miscellaneous options:"}}
4118    {dorder    b    *. {"--date-order" "-d"}      {mc "Strictly sort by date"}}
4119    {lright    b    .  "--left-right"   {mc "Mark branch sides"}}
4120    {first     b    .  "--first-parent" {mc "Limit to first parent"}}
4121    {smplhst   b    .  "--simplify-by-decoration"   {mc "Simple history"}}
4122    {args      t50  *. {}               {mc "Additional arguments to git log:"}}
4123    {allpaths  path +  {}               {mc "Enter files and directories to include, one per line:"}}
4124    {cmd       t50= +  {}               {mc "Command to generate more commits to include:"}}
4125    }
4126
4127# Convert $newviewopts($n, ...) into args for git log.
4128proc encode_view_opts {n} {
4129    global known_view_options newviewopts
4130
4131    set rargs [list]
4132    foreach opt $known_view_options {
4133        set patterns [lindex $opt 3]
4134        if {$patterns eq {}} continue
4135        set pattern [lindex $patterns 0]
4136
4137        if {[lindex $opt 1] eq "b"} {
4138            set val $newviewopts($n,[lindex $opt 0])
4139            if {$val} {
4140                lappend rargs $pattern
4141            }
4142        } elseif {[regexp {^r(\d+)$} [lindex $opt 1] type value]} {
4143            regexp {^(.*_)} [lindex $opt 0] uselessvar button_id
4144            set val $newviewopts($n,$button_id)
4145            if {$val eq $value} {
4146                lappend rargs $pattern
4147            }
4148        } else {
4149            set val $newviewopts($n,[lindex $opt 0])
4150            set val [string trim $val]
4151            if {$val ne {}} {
4152                set pfix [string range $pattern 0 end-1]
4153                lappend rargs $pfix$val
4154            }
4155        }
4156    }
4157    set rargs [concat $rargs [shellsplit $newviewopts($n,refs)]]
4158    return [concat $rargs [shellsplit $newviewopts($n,args)]]
4159}
4160
4161# Fill $newviewopts($n, ...) based on args for git log.
4162proc decode_view_opts {n view_args} {
4163    global known_view_options newviewopts
4164
4165    foreach opt $known_view_options {
4166        set id [lindex $opt 0]
4167        if {[lindex $opt 1] eq "b"} {
4168            # Checkboxes
4169            set val 0
4170        } elseif {[regexp {^r(\d+)$} [lindex $opt 1]]} {
4171            # Radiobuttons
4172            regexp {^(.*_)} $id uselessvar id
4173            set val 0
4174        } else {
4175            # Text fields
4176            set val {}
4177        }
4178        set newviewopts($n,$id) $val
4179    }
4180    set oargs [list]
4181    set refargs [list]
4182    foreach arg $view_args {
4183        if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
4184            && ![info exists found(limit)]} {
4185            set newviewopts($n,limit) $cnt
4186            set found(limit) 1
4187            continue
4188        }
4189        catch { unset val }
4190        foreach opt $known_view_options {
4191            set id [lindex $opt 0]
4192            if {[info exists found($id)]} continue
4193            foreach pattern [lindex $opt 3] {
4194                if {![string match $pattern $arg]} continue
4195                if {[lindex $opt 1] eq "b"} {
4196                    # Check buttons
4197                    set val 1
4198                } elseif {[regexp {^r(\d+)$} [lindex $opt 1] match num]} {
4199                    # Radio buttons
4200                    regexp {^(.*_)} $id uselessvar id
4201                    set val $num
4202                } else {
4203                    # Text input fields
4204                    set size [string length $pattern]
4205                    set val [string range $arg [expr {$size-1}] end]
4206                }
4207                set newviewopts($n,$id) $val
4208                set found($id) 1
4209                break
4210            }
4211            if {[info exists val]} break
4212        }
4213        if {[info exists val]} continue
4214        if {[regexp {^-} $arg]} {
4215            lappend oargs $arg
4216        } else {
4217            lappend refargs $arg
4218        }
4219    }
4220    set newviewopts($n,refs) [shellarglist $refargs]
4221    set newviewopts($n,args) [shellarglist $oargs]
4222}
4223
4224proc edit_or_newview {} {
4225    global curview
4226
4227    if {$curview > 0} {
4228        editview
4229    } else {
4230        newview 0
4231    }
4232}
4233
4234proc editview {} {
4235    global curview
4236    global viewname viewperm newviewname newviewopts
4237    global viewargs viewargscmd
4238
4239    set top .gitkvedit-$curview
4240    if {[winfo exists $top]} {
4241        raise $top
4242        return
4243    }
4244    decode_view_opts $curview $viewargs($curview)
4245    set newviewname($curview)      $viewname($curview)
4246    set newviewopts($curview,perm) $viewperm($curview)
4247    set newviewopts($curview,cmd)  $viewargscmd($curview)
4248    vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
4249}
4250
4251proc vieweditor {top n title} {
4252    global newviewname newviewopts viewfiles bgcolor
4253    global known_view_options NS
4254
4255    ttk_toplevel $top
4256    wm title $top [concat $title [mc "-- criteria for selecting revisions"]]
4257    make_transient $top .
4258
4259    # View name
4260    ${NS}::frame $top.nfr
4261    ${NS}::label $top.nl -text [mc "View Name"]
4262    ${NS}::entry $top.name -width 20 -textvariable newviewname($n)
4263    pack $top.nfr -in $top -fill x -pady 5 -padx 3
4264    pack $top.nl -in $top.nfr -side left -padx {0 5}
4265    pack $top.name -in $top.nfr -side left -padx {0 25}
4266
4267    # View options
4268    set cframe $top.nfr
4269    set cexpand 0
4270    set cnt 0
4271    foreach opt $known_view_options {
4272        set id [lindex $opt 0]
4273        set type [lindex $opt 1]
4274        set flags [lindex $opt 2]
4275        set title [eval [lindex $opt 4]]
4276        set lxpad 0
4277
4278        if {$flags eq "+" || $flags eq "*"} {
4279            set cframe $top.fr$cnt
4280            incr cnt
4281            ${NS}::frame $cframe
4282            pack $cframe -in $top -fill x -pady 3 -padx 3
4283            set cexpand [expr {$flags eq "*"}]
4284        } elseif {$flags eq ".." || $flags eq "*."} {
4285            set cframe $top.fr$cnt
4286            incr cnt
4287            ${NS}::frame $cframe
4288            pack $cframe -in $top -fill x -pady 3 -padx [list 15 3]
4289            set cexpand [expr {$flags eq "*."}]
4290        } else {
4291            set lxpad 5
4292        }
4293
4294        if {$type eq "l"} {
4295            ${NS}::label $cframe.l_$id -text $title
4296            pack $cframe.l_$id -in $cframe -side left -pady [list 3 0] -anchor w
4297        } elseif {$type eq "b"} {
4298            ${NS}::checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
4299            pack $cframe.c_$id -in $cframe -side left \
4300                -padx [list $lxpad 0] -expand $cexpand -anchor w
4301        } elseif {[regexp {^r(\d+)$} $type type sz]} {
4302            regexp {^(.*_)} $id uselessvar button_id
4303            ${NS}::radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz
4304            pack $cframe.c_$id -in $cframe -side left \
4305                -padx [list $lxpad 0] -expand $cexpand -anchor w
4306        } elseif {[regexp {^t(\d+)$} $type type sz]} {
4307            ${NS}::label $cframe.l_$id -text $title
4308            ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4309                -textvariable newviewopts($n,$id)
4310            pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
4311            pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
4312        } elseif {[regexp {^t(\d+)=$} $type type sz]} {
4313            ${NS}::label $cframe.l_$id -text $title
4314            ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4315                -textvariable newviewopts($n,$id)
4316            pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
4317            pack $cframe.e_$id -in $cframe -side top -fill x
4318        } elseif {$type eq "path"} {
4319            ${NS}::label $top.l -text $title
4320            pack $top.l -in $top -side top -pady [list 3 0] -anchor w -padx 3
4321            text $top.t -width 40 -height 5 -background $bgcolor
4322            if {[info exists viewfiles($n)]} {
4323                foreach f $viewfiles($n) {
4324                    $top.t insert end $f
4325                    $top.t insert end "\n"
4326                }
4327                $top.t delete {end - 1c} end
4328                $top.t mark set insert 0.0
4329            }
4330            pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
4331        }
4332    }
4333
4334    ${NS}::frame $top.buts
4335    ${NS}::button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
4336    ${NS}::button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
4337    ${NS}::button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
4338    bind $top <Control-Return> [list newviewok $top $n]
4339    bind $top <F5> [list newviewok $top $n 1]
4340    bind $top <Escape> [list destroy $top]
4341    grid $top.buts.ok $top.buts.apply $top.buts.can
4342    grid columnconfigure $top.buts 0 -weight 1 -uniform a
4343    grid columnconfigure $top.buts 1 -weight 1 -uniform a
4344    grid columnconfigure $top.buts 2 -weight 1 -uniform a
4345    pack $top.buts -in $top -side top -fill x
4346    focus $top.t
4347}
4348
4349proc doviewmenu {m first cmd op argv} {
4350    set nmenu [$m index end]
4351    for {set i $first} {$i <= $nmenu} {incr i} {
4352        if {[$m entrycget $i -command] eq $cmd} {
4353            eval $m $op $i $argv
4354            break
4355        }
4356    }
4357}
4358
4359proc allviewmenus {n op args} {
4360    # global viewhlmenu
4361
4362    doviewmenu .bar.view 5 [list showview $n] $op $args
4363    # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
4364}
4365
4366proc newviewok {top n {apply 0}} {
4367    global nextviewnum newviewperm newviewname newishighlight
4368    global viewname viewfiles viewperm viewchanged selectedview curview
4369    global viewargs viewargscmd newviewopts viewhlmenu
4370
4371    if {[catch {
4372        set newargs [encode_view_opts $n]
4373    } err]} {
4374        error_popup "[mc "Error in commit selection arguments:"] $err" $top
4375        return
4376    }
4377    set files {}
4378    foreach f [split [$top.t get 0.0 end] "\n"] {
4379        set ft [string trim $f]
4380        if {$ft ne {}} {
4381            lappend files $ft
4382        }
4383    }
4384    if {![info exists viewfiles($n)]} {
4385        # creating a new view
4386        incr nextviewnum
4387        set viewname($n) $newviewname($n)
4388        set viewperm($n) $newviewopts($n,perm)
4389        set viewchanged($n) 1
4390        set viewfiles($n) $files
4391        set viewargs($n) $newargs
4392        set viewargscmd($n) $newviewopts($n,cmd)
4393        addviewmenu $n
4394        if {!$newishighlight} {
4395            run showview $n
4396        } else {
4397            run addvhighlight $n
4398        }
4399    } else {
4400        # editing an existing view
4401        set viewperm($n) $newviewopts($n,perm)
4402        set viewchanged($n) 1
4403        if {$newviewname($n) ne $viewname($n)} {
4404            set viewname($n) $newviewname($n)
4405            doviewmenu .bar.view 5 [list showview $n] \
4406                entryconf [list -label $viewname($n)]
4407            # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
4408                # entryconf [list -label $viewname($n) -value $viewname($n)]
4409        }
4410        if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
4411                $newviewopts($n,cmd) ne $viewargscmd($n)} {
4412            set viewfiles($n) $files
4413            set viewargs($n) $newargs
4414            set viewargscmd($n) $newviewopts($n,cmd)
4415            if {$curview == $n} {
4416                run reloadcommits
4417            }
4418        }
4419    }
4420    if {$apply} return
4421    catch {destroy $top}
4422}
4423
4424proc delview {} {
4425    global curview viewperm hlview selectedhlview viewchanged
4426
4427    if {$curview == 0} return
4428    if {[info exists hlview] && $hlview == $curview} {
4429        set selectedhlview [mc "None"]
4430        unset hlview
4431    }
4432    allviewmenus $curview delete
4433    set viewperm($curview) 0
4434    set viewchanged($curview) 1
4435    showview 0
4436}
4437
4438proc addviewmenu {n} {
4439    global viewname viewhlmenu
4440
4441    .bar.view add radiobutton -label $viewname($n) \
4442        -command [list showview $n] -variable selectedview -value $n
4443    #$viewhlmenu add radiobutton -label $viewname($n) \
4444    #   -command [list addvhighlight $n] -variable selectedhlview
4445}
4446
4447proc showview {n} {
4448    global curview cached_commitrow ordertok
4449    global displayorder parentlist rowidlist rowisopt rowfinal
4450    global colormap rowtextx nextcolor canvxmax
4451    global numcommits viewcomplete
4452    global selectedline currentid canv canvy0
4453    global treediffs
4454    global pending_select mainheadid
4455    global commitidx
4456    global selectedview
4457    global hlview selectedhlview commitinterest
4458
4459    if {$n == $curview} return
4460    set selid {}
4461    set ymax [lindex [$canv cget -scrollregion] 3]
4462    set span [$canv yview]
4463    set ytop [expr {[lindex $span 0] * $ymax}]
4464    set ybot [expr {[lindex $span 1] * $ymax}]
4465    set yscreen [expr {($ybot - $ytop) / 2}]
4466    if {$selectedline ne {}} {
4467        set selid $currentid
4468        set y [yc $selectedline]
4469        if {$ytop < $y && $y < $ybot} {
4470            set yscreen [expr {$y - $ytop}]
4471        }
4472    } elseif {[info exists pending_select]} {
4473        set selid $pending_select
4474        unset pending_select
4475    }
4476    unselectline
4477    normalline
4478    unset -nocomplain treediffs
4479    clear_display
4480    if {[info exists hlview] && $hlview == $n} {
4481        unset hlview
4482        set selectedhlview [mc "None"]
4483    }
4484    unset -nocomplain commitinterest
4485    unset -nocomplain cached_commitrow
4486    unset -nocomplain ordertok
4487
4488    set curview $n
4489    set selectedview $n
4490    .bar.view entryconf [mca "&Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
4491    .bar.view entryconf [mca "&Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
4492
4493    run refill_reflist
4494    if {![info exists viewcomplete($n)]} {
4495        getcommits $selid
4496        return
4497    }
4498
4499    set displayorder {}
4500    set parentlist {}
4501    set rowidlist {}
4502    set rowisopt {}
4503    set rowfinal {}
4504    set numcommits $commitidx($n)
4505
4506    unset -nocomplain colormap
4507    unset -nocomplain rowtextx
4508    set nextcolor 0
4509    set canvxmax [$canv cget -width]
4510    set curview $n
4511    set row 0
4512    setcanvscroll
4513    set yf 0
4514    set row {}
4515    if {$selid ne {} && [commitinview $selid $n]} {
4516        set row [rowofcommit $selid]
4517        # try to get the selected row in the same position on the screen
4518        set ymax [lindex [$canv cget -scrollregion] 3]
4519        set ytop [expr {[yc $row] - $yscreen}]
4520        if {$ytop < 0} {
4521            set ytop 0
4522        }
4523        set yf [expr {$ytop * 1.0 / $ymax}]
4524    }
4525    allcanvs yview moveto $yf
4526    drawvisible
4527    if {$row ne {}} {
4528        selectline $row 0
4529    } elseif {!$viewcomplete($n)} {
4530        reset_pending_select $selid
4531    } else {
4532        reset_pending_select {}
4533
4534        if {[commitinview $pending_select $curview]} {
4535            selectline [rowofcommit $pending_select] 1
4536        } else {
4537            set row [first_real_row]
4538            if {$row < $numcommits} {
4539                selectline $row 0
4540            }
4541        }
4542    }
4543    if {!$viewcomplete($n)} {
4544        if {$numcommits == 0} {
4545            show_status [mc "Reading commits..."]
4546        }
4547    } elseif {$numcommits == 0} {
4548        show_status [mc "No commits selected"]
4549    }
4550    set_window_title
4551}
4552
4553# Stuff relating to the highlighting facility
4554
4555proc ishighlighted {id} {
4556    global vhighlights fhighlights nhighlights rhighlights
4557
4558    if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
4559        return $nhighlights($id)
4560    }
4561    if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
4562        return $vhighlights($id)
4563    }
4564    if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
4565        return $fhighlights($id)
4566    }
4567    if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4568        return $rhighlights($id)
4569    }
4570    return 0
4571}
4572
4573proc bolden {id font} {
4574    global canv linehtag currentid boldids need_redisplay markedid
4575
4576    # need_redisplay = 1 means the display is stale and about to be redrawn
4577    if {$need_redisplay} return
4578    lappend boldids $id
4579    $canv itemconf $linehtag($id) -font $font
4580    if {[info exists currentid] && $id eq $currentid} {
4581        $canv delete secsel
4582        set t [eval $canv create rect [$canv bbox $linehtag($id)] \
4583                   -outline {{}} -tags secsel \
4584                   -fill [$canv cget -selectbackground]]
4585        $canv lower $t
4586    }
4587    if {[info exists markedid] && $id eq $markedid} {
4588        make_idmark $id
4589    }
4590}
4591
4592proc bolden_name {id font} {
4593    global canv2 linentag currentid boldnameids need_redisplay
4594
4595    if {$need_redisplay} return
4596    lappend boldnameids $id
4597    $canv2 itemconf $linentag($id) -font $font
4598    if {[info exists currentid] && $id eq $currentid} {
4599        $canv2 delete secsel
4600        set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
4601                   -outline {{}} -tags secsel \
4602                   -fill [$canv2 cget -selectbackground]]
4603        $canv2 lower $t
4604    }
4605}
4606
4607proc unbolden {} {
4608    global boldids
4609
4610    set stillbold {}
4611    foreach id $boldids {
4612        if {![ishighlighted $id]} {
4613            bolden $id mainfont
4614        } else {
4615            lappend stillbold $id
4616        }
4617    }
4618    set boldids $stillbold
4619}
4620
4621proc addvhighlight {n} {
4622    global hlview viewcomplete curview vhl_done commitidx
4623
4624    if {[info exists hlview]} {
4625        delvhighlight
4626    }
4627    set hlview $n
4628    if {$n != $curview && ![info exists viewcomplete($n)]} {
4629        start_rev_list $n
4630    }
4631    set vhl_done $commitidx($hlview)
4632    if {$vhl_done > 0} {
4633        drawvisible
4634    }
4635}
4636
4637proc delvhighlight {} {
4638    global hlview vhighlights
4639
4640    if {![info exists hlview]} return
4641    unset hlview
4642    unset -nocomplain vhighlights
4643    unbolden
4644}
4645
4646proc vhighlightmore {} {
4647    global hlview vhl_done commitidx vhighlights curview
4648
4649    set max $commitidx($hlview)
4650    set vr [visiblerows]
4651    set r0 [lindex $vr 0]
4652    set r1 [lindex $vr 1]
4653    for {set i $vhl_done} {$i < $max} {incr i} {
4654        set id [commitonrow $i $hlview]
4655        if {[commitinview $id $curview]} {
4656            set row [rowofcommit $id]
4657            if {$r0 <= $row && $row <= $r1} {
4658                if {![highlighted $row]} {
4659                    bolden $id mainfontbold
4660                }
4661                set vhighlights($id) 1
4662            }
4663        }
4664    }
4665    set vhl_done $max
4666    return 0
4667}
4668
4669proc askvhighlight {row id} {
4670    global hlview vhighlights iddrawn
4671
4672    if {[commitinview $id $hlview]} {
4673        if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
4674            bolden $id mainfontbold
4675        }
4676        set vhighlights($id) 1
4677    } else {
4678        set vhighlights($id) 0
4679    }
4680}
4681
4682proc hfiles_change {} {
4683    global highlight_files filehighlight fhighlights fh_serial
4684    global highlight_paths
4685
4686    if {[info exists filehighlight]} {
4687        # delete previous highlights
4688        catch {close $filehighlight}
4689        unset filehighlight
4690        unset -nocomplain fhighlights
4691        unbolden
4692        unhighlight_filelist
4693    }
4694    set highlight_paths {}
4695    after cancel do_file_hl $fh_serial
4696    incr fh_serial
4697    if {$highlight_files ne {}} {
4698        after 300 do_file_hl $fh_serial
4699    }
4700}
4701
4702proc gdttype_change {name ix op} {
4703    global gdttype highlight_files findstring findpattern
4704
4705    stopfinding
4706    if {$findstring ne {}} {
4707        if {$gdttype eq [mc "containing:"]} {
4708            if {$highlight_files ne {}} {
4709                set highlight_files {}
4710                hfiles_change
4711            }
4712            findcom_change
4713        } else {
4714            if {$findpattern ne {}} {
4715                set findpattern {}
4716                findcom_change
4717            }
4718            set highlight_files $findstring
4719            hfiles_change
4720        }
4721        drawvisible
4722    }
4723    # enable/disable findtype/findloc menus too
4724}
4725
4726proc find_change {name ix op} {
4727    global gdttype findstring highlight_files
4728
4729    stopfinding
4730    if {$gdttype eq [mc "containing:"]} {
4731        findcom_change
4732    } else {
4733        if {$highlight_files ne $findstring} {
4734            set highlight_files $findstring
4735            hfiles_change
4736        }
4737    }
4738    drawvisible
4739}
4740
4741proc findcom_change args {
4742    global nhighlights boldnameids
4743    global findpattern findtype findstring gdttype
4744
4745    stopfinding
4746    # delete previous highlights, if any
4747    foreach id $boldnameids {
4748        bolden_name $id mainfont
4749    }
4750    set boldnameids {}
4751    unset -nocomplain nhighlights
4752    unbolden
4753    unmarkmatches
4754    if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
4755        set findpattern {}
4756    } elseif {$findtype eq [mc "Regexp"]} {
4757        set findpattern $findstring
4758    } else {
4759        set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4760                   $findstring]
4761        set findpattern "*$e*"
4762    }
4763}
4764
4765proc makepatterns {l} {
4766    set ret {}
4767    foreach e $l {
4768        set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4769        if {[string index $ee end] eq "/"} {
4770            lappend ret "$ee*"
4771        } else {
4772            lappend ret $ee
4773            lappend ret "$ee/*"
4774        }
4775    }
4776    return $ret
4777}
4778
4779proc do_file_hl {serial} {
4780    global highlight_files filehighlight highlight_paths gdttype fhl_list
4781    global cdup findtype
4782
4783    if {$gdttype eq [mc "touching paths:"]} {
4784        # If "exact" match then convert backslashes to forward slashes.
4785        # Most useful to support Windows-flavoured file paths.
4786        if {$findtype eq [mc "Exact"]} {
4787            set highlight_files [string map {"\\" "/"} $highlight_files]
4788        }
4789        if {[catch {set paths [shellsplit $highlight_files]}]} return
4790        set highlight_paths [makepatterns $paths]
4791        highlight_filelist
4792        set relative_paths {}
4793        foreach path $paths {
4794            lappend relative_paths [file join $cdup $path]
4795        }
4796        set gdtargs [concat -- $relative_paths]
4797    } elseif {$gdttype eq [mc "adding/removing string:"]} {
4798        set gdtargs [list "-S$highlight_files"]
4799    } elseif {$gdttype eq [mc "changing lines matching:"]} {
4800        set gdtargs [list "-G$highlight_files"]
4801    } else {
4802        # must be "containing:", i.e. we're searching commit info
4803        return
4804    }
4805    set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
4806    set filehighlight [open $cmd r+]
4807    fconfigure $filehighlight -blocking 0
4808    filerun $filehighlight readfhighlight
4809    set fhl_list {}
4810    drawvisible
4811    flushhighlights
4812}
4813
4814proc flushhighlights {} {
4815    global filehighlight fhl_list
4816
4817    if {[info exists filehighlight]} {
4818        lappend fhl_list {}
4819        puts $filehighlight ""
4820        flush $filehighlight
4821    }
4822}
4823
4824proc askfilehighlight {row id} {
4825    global filehighlight fhighlights fhl_list
4826
4827    lappend fhl_list $id
4828    set fhighlights($id) -1
4829    puts $filehighlight $id
4830}
4831
4832proc readfhighlight {} {
4833    global filehighlight fhighlights curview iddrawn
4834    global fhl_list find_dirn
4835
4836    if {![info exists filehighlight]} {
4837        return 0
4838    }
4839    set nr 0
4840    while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4841        set line [string trim $line]
4842        set i [lsearch -exact $fhl_list $line]
4843        if {$i < 0} continue
4844        for {set j 0} {$j < $i} {incr j} {
4845            set id [lindex $fhl_list $j]
4846            set fhighlights($id) 0
4847        }
4848        set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4849        if {$line eq {}} continue
4850        if {![commitinview $line $curview]} continue
4851        if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4852            bolden $line mainfontbold
4853        }
4854        set fhighlights($line) 1
4855    }
4856    if {[eof $filehighlight]} {
4857        # strange...
4858        puts "oops, git diff-tree died"
4859        catch {close $filehighlight}
4860        unset filehighlight
4861        return 0
4862    }
4863    if {[info exists find_dirn]} {
4864        run findmore
4865    }
4866    return 1
4867}
4868
4869proc doesmatch {f} {
4870    global findtype findpattern
4871
4872    if {$findtype eq [mc "Regexp"]} {
4873        return [regexp $findpattern $f]
4874    } elseif {$findtype eq [mc "IgnCase"]} {
4875        return [string match -nocase $findpattern $f]
4876    } else {
4877        return [string match $findpattern $f]
4878    }
4879}
4880
4881proc askfindhighlight {row id} {
4882    global nhighlights commitinfo iddrawn
4883    global findloc
4884    global markingmatches
4885
4886    if {![info exists commitinfo($id)]} {
4887        getcommit $id
4888    }
4889    set info $commitinfo($id)
4890    set isbold 0
4891    set fldtypes [list [mc Headline] [mc Author] "" [mc Committer] "" [mc Comments]]
4892    foreach f $info ty $fldtypes {
4893        if {$ty eq ""} continue
4894        if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4895            [doesmatch $f]} {
4896            if {$ty eq [mc "Author"]} {
4897                set isbold 2
4898                break
4899            }
4900            set isbold 1
4901        }
4902    }
4903    if {$isbold && [info exists iddrawn($id)]} {
4904        if {![ishighlighted $id]} {
4905            bolden $id mainfontbold
4906            if {$isbold > 1} {
4907                bolden_name $id mainfontbold
4908            }
4909        }
4910        if {$markingmatches} {
4911            markrowmatches $row $id
4912        }
4913    }
4914    set nhighlights($id) $isbold
4915}
4916
4917proc markrowmatches {row id} {
4918    global canv canv2 linehtag linentag commitinfo findloc
4919
4920    set headline [lindex $commitinfo($id) 0]
4921    set author [lindex $commitinfo($id) 1]
4922    $canv delete match$row
4923    $canv2 delete match$row
4924    if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4925        set m [findmatches $headline]
4926        if {$m ne {}} {
4927            markmatches $canv $row $headline $linehtag($id) $m \
4928                [$canv itemcget $linehtag($id) -font] $row
4929        }
4930    }
4931    if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4932        set m [findmatches $author]
4933        if {$m ne {}} {
4934            markmatches $canv2 $row $author $linentag($id) $m \
4935                [$canv2 itemcget $linentag($id) -font] $row
4936        }
4937    }
4938}
4939
4940proc vrel_change {name ix op} {
4941    global highlight_related
4942
4943    rhighlight_none
4944    if {$highlight_related ne [mc "None"]} {
4945        run drawvisible
4946    }
4947}
4948
4949# prepare for testing whether commits are descendents or ancestors of a
4950proc rhighlight_sel {a} {
4951    global descendent desc_todo ancestor anc_todo
4952    global highlight_related
4953
4954    unset -nocomplain descendent
4955    set desc_todo [list $a]
4956    unset -nocomplain ancestor
4957    set anc_todo [list $a]
4958    if {$highlight_related ne [mc "None"]} {
4959        rhighlight_none
4960        run drawvisible
4961    }
4962}
4963
4964proc rhighlight_none {} {
4965    global rhighlights
4966
4967    unset -nocomplain rhighlights
4968    unbolden
4969}
4970
4971proc is_descendent {a} {
4972    global curview children descendent desc_todo
4973
4974    set v $curview
4975    set la [rowofcommit $a]
4976    set todo $desc_todo
4977    set leftover {}
4978    set done 0
4979    for {set i 0} {$i < [llength $todo]} {incr i} {
4980        set do [lindex $todo $i]
4981        if {[rowofcommit $do] < $la} {
4982            lappend leftover $do
4983            continue
4984        }
4985        foreach nk $children($v,$do) {
4986            if {![info exists descendent($nk)]} {
4987                set descendent($nk) 1
4988                lappend todo $nk
4989                if {$nk eq $a} {
4990                    set done 1
4991                }
4992            }
4993        }
4994        if {$done} {
4995            set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4996            return
4997        }
4998    }
4999    set descendent($a) 0
5000    set desc_todo $leftover
5001}
5002
5003proc is_ancestor {a} {
5004    global curview parents ancestor anc_todo
5005
5006    set v $curview
5007    set la [rowofcommit $a]
5008    set todo $anc_todo
5009    set leftover {}
5010    set done 0
5011    for {set i 0} {$i < [llength $todo]} {incr i} {
5012        set do [lindex $todo $i]
5013        if {![commitinview $do $v] || [rowofcommit $do] > $la} {
5014            lappend leftover $do
5015            continue
5016        }
5017        foreach np $parents($v,$do) {
5018            if {![info exists ancestor($np)]} {
5019                set ancestor($np) 1
5020                lappend todo $np
5021                if {$np eq $a} {
5022                    set done 1
5023                }
5024            }
5025        }
5026        if {$done} {
5027            set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
5028            return
5029        }
5030    }
5031    set ancestor($a) 0
5032    set anc_todo $leftover
5033}
5034
5035proc askrelhighlight {row id} {
5036    global descendent highlight_related iddrawn rhighlights
5037    global selectedline ancestor
5038
5039    if {$selectedline eq {}} return
5040    set isbold 0
5041    if {$highlight_related eq [mc "Descendant"] ||
5042        $highlight_related eq [mc "Not descendant"]} {
5043        if {![info exists descendent($id)]} {
5044            is_descendent $id
5045        }
5046        if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
5047            set isbold 1
5048        }
5049    } elseif {$highlight_related eq [mc "Ancestor"] ||
5050              $highlight_related eq [mc "Not ancestor"]} {
5051        if {![info exists ancestor($id)]} {
5052            is_ancestor $id
5053        }
5054        if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
5055            set isbold 1
5056        }
5057    }
5058    if {[info exists iddrawn($id)]} {
5059        if {$isbold && ![ishighlighted $id]} {
5060            bolden $id mainfontbold
5061        }
5062    }
5063    set rhighlights($id) $isbold
5064}
5065
5066# Graph layout functions
5067
5068proc shortids {ids} {
5069    set res {}
5070    foreach id $ids {
5071        if {[llength $id] > 1} {
5072            lappend res [shortids $id]
5073        } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
5074            lappend res [string range $id 0 7]
5075        } else {
5076            lappend res $id
5077        }
5078    }
5079    return $res
5080}
5081
5082proc ntimes {n o} {
5083    set ret {}
5084    set o [list $o]
5085    for {set mask 1} {$mask <= $n} {incr mask $mask} {
5086        if {($n & $mask) != 0} {
5087            set ret [concat $ret $o]
5088        }
5089        set o [concat $o $o]
5090    }
5091    return $ret
5092}
5093
5094proc ordertoken {id} {
5095    global ordertok curview varcid varcstart varctok curview parents children
5096    global nullid nullid2
5097
5098    if {[info exists ordertok($id)]} {
5099        return $ordertok($id)
5100    }
5101    set origid $id
5102    set todo {}
5103    while {1} {
5104        if {[info exists varcid($curview,$id)]} {
5105            set a $varcid($curview,$id)
5106            set p [lindex $varcstart($curview) $a]
5107        } else {
5108            set p [lindex $children($curview,$id) 0]
5109        }
5110        if {[info exists ordertok($p)]} {
5111            set tok $ordertok($p)
5112            break
5113        }
5114        set id [first_real_child $curview,$p]
5115        if {$id eq {}} {
5116            # it's a root
5117            set tok [lindex $varctok($curview) $varcid($curview,$p)]
5118            break
5119        }
5120        if {[llength $parents($curview,$id)] == 1} {
5121            lappend todo [list $p {}]
5122        } else {
5123            set j [lsearch -exact $parents($curview,$id) $p]
5124            if {$j < 0} {
5125                puts "oops didn't find [shortids $p] in parents of [shortids $id]"
5126            }
5127            lappend todo [list $p [strrep $j]]
5128        }
5129    }
5130    for {set i [llength $todo]} {[incr i -1] >= 0} {} {
5131        set p [lindex $todo $i 0]
5132        append tok [lindex $todo $i 1]
5133        set ordertok($p) $tok
5134    }
5135    set ordertok($origid) $tok
5136    return $tok
5137}
5138
5139# Work out where id should go in idlist so that order-token
5140# values increase from left to right
5141proc idcol {idlist id {i 0}} {
5142    set t [ordertoken $id]
5143    if {$i < 0} {
5144        set i 0
5145    }
5146    if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
5147        if {$i > [llength $idlist]} {
5148            set i [llength $idlist]
5149        }
5150        while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
5151        incr i
5152    } else {
5153        if {$t > [ordertoken [lindex $idlist $i]]} {
5154            while {[incr i] < [llength $idlist] &&
5155                   $t >= [ordertoken [lindex $idlist $i]]} {}
5156        }
5157    }
5158    return $i
5159}
5160
5161proc initlayout {} {
5162    global rowidlist rowisopt rowfinal displayorder parentlist
5163    global numcommits canvxmax canv
5164    global nextcolor
5165    global colormap rowtextx
5166
5167    set numcommits 0
5168    set displayorder {}
5169    set parentlist {}
5170    set nextcolor 0
5171    set rowidlist {}
5172    set rowisopt {}
5173    set rowfinal {}
5174    set canvxmax [$canv cget -width]
5175    unset -nocomplain colormap
5176    unset -nocomplain rowtextx
5177    setcanvscroll
5178}
5179
5180proc setcanvscroll {} {
5181    global canv canv2 canv3 numcommits linespc canvxmax canvy0
5182    global lastscrollset lastscrollrows
5183
5184    set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
5185    $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
5186    $canv2 conf -scrollregion [list 0 0 0 $ymax]
5187    $canv3 conf -scrollregion [list 0 0 0 $ymax]
5188    set lastscrollset [clock clicks -milliseconds]
5189    set lastscrollrows $numcommits
5190}
5191
5192proc visiblerows {} {
5193    global canv numcommits linespc
5194
5195    set ymax [lindex [$canv cget -scrollregion] 3]
5196    if {$ymax eq {} || $ymax == 0} return
5197    set f [$canv yview]
5198    set y0 [expr {int([lindex $f 0] * $ymax)}]
5199    set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
5200    if {$r0 < 0} {
5201        set r0 0
5202    }
5203    set y1 [expr {int([lindex $f 1] * $ymax)}]
5204    set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
5205    if {$r1 >= $numcommits} {
5206        set r1 [expr {$numcommits - 1}]
5207    }
5208    return [list $r0 $r1]
5209}
5210
5211proc layoutmore {} {
5212    global commitidx viewcomplete curview
5213    global numcommits pending_select curview
5214    global lastscrollset lastscrollrows
5215
5216    if {$lastscrollrows < 100 || $viewcomplete($curview) ||
5217        [clock clicks -milliseconds] - $lastscrollset > 500} {
5218        setcanvscroll
5219    }
5220    if {[info exists pending_select] &&
5221        [commitinview $pending_select $curview]} {
5222        update
5223        selectline [rowofcommit $pending_select] 1
5224    }
5225    drawvisible
5226}
5227
5228# With path limiting, we mightn't get the actual HEAD commit,
5229# so ask git rev-list what is the first ancestor of HEAD that
5230# touches a file in the path limit.
5231proc get_viewmainhead {view} {
5232    global viewmainheadid vfilelimit viewinstances mainheadid
5233
5234    catch {
5235        set rfd [open [concat | git rev-list -1 $mainheadid \
5236                           -- $vfilelimit($view)] r]
5237        set j [reg_instance $rfd]
5238        lappend viewinstances($view) $j
5239        fconfigure $rfd -blocking 0
5240        filerun $rfd [list getviewhead $rfd $j $view]
5241        set viewmainheadid($curview) {}
5242    }
5243}
5244
5245# git rev-list should give us just 1 line to use as viewmainheadid($view)
5246proc getviewhead {fd inst view} {
5247    global viewmainheadid commfd curview viewinstances showlocalchanges
5248
5249    set id {}
5250    if {[gets $fd line] < 0} {
5251        if {![eof $fd]} {
5252            return 1
5253        }
5254    } elseif {[string length $line] == 40 && [string is xdigit $line]} {
5255        set id $line
5256    }
5257    set viewmainheadid($view) $id
5258    close $fd
5259    unset commfd($inst)
5260    set i [lsearch -exact $viewinstances($view) $inst]
5261    if {$i >= 0} {
5262        set viewinstances($view) [lreplace $viewinstances($view) $i $i]
5263    }
5264    if {$showlocalchanges && $id ne {} && $view == $curview} {
5265        doshowlocalchanges
5266    }
5267    return 0
5268}
5269
5270proc doshowlocalchanges {} {
5271    global curview viewmainheadid
5272
5273    if {$viewmainheadid($curview) eq {}} return
5274    if {[commitinview $viewmainheadid($curview) $curview]} {
5275        dodiffindex
5276    } else {
5277        interestedin $viewmainheadid($curview) dodiffindex
5278    }
5279}
5280
5281proc dohidelocalchanges {} {
5282    global nullid nullid2 lserial curview
5283
5284    if {[commitinview $nullid $curview]} {
5285        removefakerow $nullid
5286    }
5287    if {[commitinview $nullid2 $curview]} {
5288        removefakerow $nullid2
5289    }
5290    incr lserial
5291}
5292
5293# spawn off a process to do git diff-index --cached HEAD
5294proc dodiffindex {} {
5295    global lserial showlocalchanges vfilelimit curview
5296    global hasworktree git_version
5297
5298    if {!$showlocalchanges || !$hasworktree} return
5299    incr lserial
5300    if {[package vcompare $git_version "1.7.2"] >= 0} {
5301        set cmd "|git diff-index --cached --ignore-submodules=dirty HEAD"
5302    } else {
5303        set cmd "|git diff-index --cached HEAD"
5304    }
5305    if {$vfilelimit($curview) ne {}} {
5306        set cmd [concat $cmd -- $vfilelimit($curview)]
5307    }
5308    set fd [open $cmd r]
5309    fconfigure $fd -blocking 0
5310    set i [reg_instance $fd]
5311    filerun $fd [list readdiffindex $fd $lserial $i]
5312}
5313
5314proc readdiffindex {fd serial inst} {
5315    global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
5316    global vfilelimit
5317
5318    set isdiff 1
5319    if {[gets $fd line] < 0} {
5320        if {![eof $fd]} {
5321            return 1
5322        }
5323        set isdiff 0
5324    }
5325    # we only need to see one line and we don't really care what it says...
5326    stop_instance $inst
5327
5328    if {$serial != $lserial} {
5329        return 0
5330    }
5331
5332    # now see if there are any local changes not checked in to the index
5333    set cmd "|git diff-files"
5334    if {$vfilelimit($curview) ne {}} {
5335        set cmd [concat $cmd -- $vfilelimit($curview)]
5336    }
5337    set fd [open $cmd r]
5338    fconfigure $fd -blocking 0
5339    set i [reg_instance $fd]
5340    filerun $fd [list readdifffiles $fd $serial $i]
5341
5342    if {$isdiff && ![commitinview $nullid2 $curview]} {
5343        # add the line for the changes in the index to the graph
5344        set hl [mc "Local changes checked in to index but not committed"]
5345        set commitinfo($nullid2) [list  $hl {} {} {} {} "    $hl\n"]
5346        set commitdata($nullid2) "\n    $hl\n"
5347        if {[commitinview $nullid $curview]} {
5348            removefakerow $nullid
5349        }
5350        insertfakerow $nullid2 $viewmainheadid($curview)
5351    } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
5352        if {[commitinview $nullid $curview]} {
5353            removefakerow $nullid
5354        }
5355        removefakerow $nullid2
5356    }
5357    return 0
5358}
5359
5360proc readdifffiles {fd serial inst} {
5361    global viewmainheadid nullid nullid2 curview
5362    global commitinfo commitdata lserial
5363
5364    set isdiff 1
5365    if {[gets $fd line] < 0} {
5366        if {![eof $fd]} {
5367            return 1
5368        }
5369        set isdiff 0
5370    }
5371    # we only need to see one line and we don't really care what it says...
5372    stop_instance $inst
5373
5374    if {$serial != $lserial} {
5375        return 0
5376    }
5377
5378    if {$isdiff && ![commitinview $nullid $curview]} {
5379        # add the line for the local diff to the graph
5380        set hl [mc "Local uncommitted changes, not checked in to index"]
5381        set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
5382        set commitdata($nullid) "\n    $hl\n"
5383        if {[commitinview $nullid2 $curview]} {
5384            set p $nullid2
5385        } else {
5386            set p $viewmainheadid($curview)
5387        }
5388        insertfakerow $nullid $p
5389    } elseif {!$isdiff && [commitinview $nullid $curview]} {
5390        removefakerow $nullid
5391    }
5392    return 0
5393}
5394
5395proc nextuse {id row} {
5396    global curview children
5397
5398    if {[info exists children($curview,$id)]} {
5399        foreach kid $children($curview,$id) {
5400            if {![commitinview $kid $curview]} {
5401                return -1
5402            }
5403            if {[rowofcommit $kid] > $row} {
5404                return [rowofcommit $kid]
5405            }
5406        }
5407    }
5408    if {[commitinview $id $curview]} {
5409        return [rowofcommit $id]
5410    }
5411    return -1
5412}
5413
5414proc prevuse {id row} {
5415    global curview children
5416
5417    set ret -1
5418    if {[info exists children($curview,$id)]} {
5419        foreach kid $children($curview,$id) {
5420            if {![commitinview $kid $curview]} break
5421            if {[rowofcommit $kid] < $row} {
5422                set ret [rowofcommit $kid]
5423            }
5424        }
5425    }
5426    return $ret
5427}
5428
5429proc make_idlist {row} {
5430    global displayorder parentlist uparrowlen downarrowlen mingaplen
5431    global commitidx curview children
5432
5433    set r [expr {$row - $mingaplen - $downarrowlen - 1}]
5434    if {$r < 0} {
5435        set r 0
5436    }
5437    set ra [expr {$row - $downarrowlen}]
5438    if {$ra < 0} {
5439        set ra 0
5440    }
5441    set rb [expr {$row + $uparrowlen}]
5442    if {$rb > $commitidx($curview)} {
5443        set rb $commitidx($curview)
5444    }
5445    make_disporder $r [expr {$rb + 1}]
5446    set ids {}
5447    for {} {$r < $ra} {incr r} {
5448        set nextid [lindex $displayorder [expr {$r + 1}]]
5449        foreach p [lindex $parentlist $r] {
5450            if {$p eq $nextid} continue
5451            set rn [nextuse $p $r]
5452            if {$rn >= $row &&
5453                $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
5454                lappend ids [list [ordertoken $p] $p]
5455            }
5456        }
5457    }
5458    for {} {$r < $row} {incr r} {
5459        set nextid [lindex $displayorder [expr {$r + 1}]]
5460        foreach p [lindex $parentlist $r] {
5461            if {$p eq $nextid} continue
5462            set rn [nextuse $p $r]
5463            if {$rn < 0 || $rn >= $row} {
5464                lappend ids [list [ordertoken $p] $p]
5465            }
5466        }
5467    }
5468    set id [lindex $displayorder $row]
5469    lappend ids [list [ordertoken $id] $id]
5470    while {$r < $rb} {
5471        foreach p [lindex $parentlist $r] {
5472            set firstkid [lindex $children($curview,$p) 0]
5473            if {[rowofcommit $firstkid] < $row} {
5474                lappend ids [list [ordertoken $p] $p]
5475            }
5476        }
5477        incr r
5478        set id [lindex $displayorder $r]
5479        if {$id ne {}} {
5480            set firstkid [lindex $children($curview,$id) 0]
5481            if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
5482                lappend ids [list [ordertoken $id] $id]
5483            }
5484        }
5485    }
5486    set idlist {}
5487    foreach idx [lsort -unique $ids] {
5488        lappend idlist [lindex $idx 1]
5489    }
5490    return $idlist
5491}
5492
5493proc rowsequal {a b} {
5494    while {[set i [lsearch -exact $a {}]] >= 0} {
5495        set a [lreplace $a $i $i]
5496    }
5497    while {[set i [lsearch -exact $b {}]] >= 0} {
5498        set b [lreplace $b $i $i]
5499    }
5500    return [expr {$a eq $b}]
5501}
5502
5503proc makeupline {id row rend col} {
5504    global rowidlist uparrowlen downarrowlen mingaplen
5505
5506    for {set r $rend} {1} {set r $rstart} {
5507        set rstart [prevuse $id $r]
5508        if {$rstart < 0} return
5509        if {$rstart < $row} break
5510    }
5511    if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5512        set rstart [expr {$rend - $uparrowlen - 1}]
5513    }
5514    for {set r $rstart} {[incr r] <= $row} {} {
5515        set idlist [lindex $rowidlist $r]
5516        if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5517            set col [idcol $idlist $id $col]
5518            lset rowidlist $r [linsert $idlist $col $id]
5519            changedrow $r
5520        }
5521    }
5522}
5523
5524proc layoutrows {row endrow} {
5525    global rowidlist rowisopt rowfinal displayorder
5526    global uparrowlen downarrowlen maxwidth mingaplen
5527    global children parentlist
5528    global commitidx viewcomplete curview
5529
5530    make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
5531    set idlist {}
5532    if {$row > 0} {
5533        set rm1 [expr {$row - 1}]
5534        foreach id [lindex $rowidlist $rm1] {
5535            if {$id ne {}} {
5536                lappend idlist $id
5537            }
5538        }
5539        set final [lindex $rowfinal $rm1]
5540    }
5541    for {} {$row < $endrow} {incr row} {
5542        set rm1 [expr {$row - 1}]
5543        if {$rm1 < 0 || $idlist eq {}} {
5544            set idlist [make_idlist $row]
5545            set final 1
5546        } else {
5547            set id [lindex $displayorder $rm1]
5548            set col [lsearch -exact $idlist $id]
5549            set idlist [lreplace $idlist $col $col]
5550            foreach p [lindex $parentlist $rm1] {
5551                if {[lsearch -exact $idlist $p] < 0} {
5552                    set col [idcol $idlist $p $col]
5553                    set idlist [linsert $idlist $col $p]
5554                    # if not the first child, we have to insert a line going up
5555                    if {$id ne [lindex $children($curview,$p) 0]} {
5556                        makeupline $p $rm1 $row $col
5557                    }
5558                }
5559            }
5560            set id [lindex $displayorder $row]
5561            if {$row > $downarrowlen} {
5562                set termrow [expr {$row - $downarrowlen - 1}]
5563                foreach p [lindex $parentlist $termrow] {
5564                    set i [lsearch -exact $idlist $p]
5565                    if {$i < 0} continue
5566                    set nr [nextuse $p $termrow]
5567                    if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5568                        set idlist [lreplace $idlist $i $i]
5569                    }
5570                }
5571            }
5572            set col [lsearch -exact $idlist $id]
5573            if {$col < 0} {
5574                set col [idcol $idlist $id]
5575                set idlist [linsert $idlist $col $id]
5576                if {$children($curview,$id) ne {}} {
5577                    makeupline $id $rm1 $row $col
5578                }
5579            }
5580            set r [expr {$row + $uparrowlen - 1}]
5581            if {$r < $commitidx($curview)} {
5582                set x $col
5583                foreach p [lindex $parentlist $r] {
5584                    if {[lsearch -exact $idlist $p] >= 0} continue
5585                    set fk [lindex $children($curview,$p) 0]
5586                    if {[rowofcommit $fk] < $row} {
5587                        set x [idcol $idlist $p $x]
5588                        set idlist [linsert $idlist $x $p]
5589                    }
5590                }
5591                if {[incr r] < $commitidx($curview)} {
5592                    set p [lindex $displayorder $r]
5593                    if {[lsearch -exact $idlist $p] < 0} {
5594                        set fk [lindex $children($curview,$p) 0]
5595                        if {$fk ne {} && [rowofcommit $fk] < $row} {
5596                            set x [idcol $idlist $p $x]
5597                            set idlist [linsert $idlist $x $p]
5598                        }
5599                    }
5600                }
5601            }
5602        }
5603        if {$final && !$viewcomplete($curview) &&
5604            $row + $uparrowlen + $mingaplen + $downarrowlen
5605                >= $commitidx($curview)} {
5606            set final 0
5607        }
5608        set l [llength $rowidlist]
5609        if {$row == $l} {
5610            lappend rowidlist $idlist
5611            lappend rowisopt 0
5612            lappend rowfinal $final
5613        } elseif {$row < $l} {
5614            if {![rowsequal $idlist [lindex $rowidlist $row]]} {
5615                lset rowidlist $row $idlist
5616                changedrow $row
5617            }
5618            lset rowfinal $row $final
5619        } else {
5620            set pad [ntimes [expr {$row - $l}] {}]
5621            set rowidlist [concat $rowidlist $pad]
5622            lappend rowidlist $idlist
5623            set rowfinal [concat $rowfinal $pad]
5624            lappend rowfinal $final
5625            set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5626        }
5627    }
5628    return $row
5629}
5630
5631proc changedrow {row} {
5632    global displayorder iddrawn rowisopt need_redisplay
5633
5634    set l [llength $rowisopt]
5635    if {$row < $l} {
5636        lset rowisopt $row 0
5637        if {$row + 1 < $l} {
5638            lset rowisopt [expr {$row + 1}] 0
5639            if {$row + 2 < $l} {
5640                lset rowisopt [expr {$row + 2}] 0
5641            }
5642        }
5643    }
5644    set id [lindex $displayorder $row]
5645    if {[info exists iddrawn($id)]} {
5646        set need_redisplay 1
5647    }
5648}
5649
5650proc insert_pad {row col npad} {
5651    global rowidlist
5652
5653    set pad [ntimes $npad {}]
5654    set idlist [lindex $rowidlist $row]
5655    set bef [lrange $idlist 0 [expr {$col - 1}]]
5656    set aft [lrange $idlist $col end]
5657    set i [lsearch -exact $aft {}]
5658    if {$i > 0} {
5659        set aft [lreplace $aft $i $i]
5660    }
5661    lset rowidlist $row [concat $bef $pad $aft]
5662    changedrow $row
5663}
5664
5665proc optimize_rows {row col endrow} {
5666    global rowidlist rowisopt displayorder curview children
5667
5668    if {$row < 1} {
5669        set row 1
5670    }
5671    for {} {$row < $endrow} {incr row; set col 0} {
5672        if {[lindex $rowisopt $row]} continue
5673        set haspad 0
5674        set y0 [expr {$row - 1}]
5675        set ym [expr {$row - 2}]
5676        set idlist [lindex $rowidlist $row]
5677        set previdlist [lindex $rowidlist $y0]
5678        if {$idlist eq {} || $previdlist eq {}} continue
5679        if {$ym >= 0} {
5680            set pprevidlist [lindex $rowidlist $ym]
5681            if {$pprevidlist eq {}} continue
5682        } else {
5683            set pprevidlist {}
5684        }
5685        set x0 -1
5686        set xm -1
5687        for {} {$col < [llength $idlist]} {incr col} {
5688            set id [lindex $idlist $col]
5689            if {[lindex $previdlist $col] eq $id} continue
5690            if {$id eq {}} {
5691                set haspad 1
5692                continue
5693            }
5694            set x0 [lsearch -exact $previdlist $id]
5695            if {$x0 < 0} continue
5696            set z [expr {$x0 - $col}]
5697            set isarrow 0
5698            set z0 {}
5699            if {$ym >= 0} {
5700                set xm [lsearch -exact $pprevidlist $id]
5701                if {$xm >= 0} {
5702                    set z0 [expr {$xm - $x0}]
5703                }
5704            }
5705            if {$z0 eq {}} {
5706                # if row y0 is the first child of $id then it's not an arrow
5707                if {[lindex $children($curview,$id) 0] ne
5708                    [lindex $displayorder $y0]} {
5709                    set isarrow 1
5710                }
5711            }
5712            if {!$isarrow && $id ne [lindex $displayorder $row] &&
5713                [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5714                set isarrow 1
5715            }
5716            # Looking at lines from this row to the previous row,
5717            # make them go straight up if they end in an arrow on
5718            # the previous row; otherwise make them go straight up
5719            # or at 45 degrees.
5720            if {$z < -1 || ($z < 0 && $isarrow)} {
5721                # Line currently goes left too much;
5722                # insert pads in the previous row, then optimize it
5723                set npad [expr {-1 - $z + $isarrow}]
5724                insert_pad $y0 $x0 $npad
5725                if {$y0 > 0} {
5726                    optimize_rows $y0 $x0 $row
5727                }
5728                set previdlist [lindex $rowidlist $y0]
5729                set x0 [lsearch -exact $previdlist $id]
5730                set z [expr {$x0 - $col}]
5731                if {$z0 ne {}} {
5732                    set pprevidlist [lindex $rowidlist $ym]
5733                    set xm [lsearch -exact $pprevidlist $id]
5734                    set z0 [expr {$xm - $x0}]
5735                }
5736            } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5737                # Line currently goes right too much;
5738                # insert pads in this line
5739                set npad [expr {$z - 1 + $isarrow}]
5740                insert_pad $row $col $npad
5741                set idlist [lindex $rowidlist $row]
5742                incr col $npad
5743                set z [expr {$x0 - $col}]
5744                set haspad 1
5745            }
5746            if {$z0 eq {} && !$isarrow && $ym >= 0} {
5747                # this line links to its first child on row $row-2
5748                set id [lindex $displayorder $ym]
5749                set xc [lsearch -exact $pprevidlist $id]
5750                if {$xc >= 0} {
5751                    set z0 [expr {$xc - $x0}]
5752                }
5753            }
5754            # avoid lines jigging left then immediately right
5755            if {$z0 ne {} && $z < 0 && $z0 > 0} {
5756                insert_pad $y0 $x0 1
5757                incr x0
5758                optimize_rows $y0 $x0 $row
5759                set previdlist [lindex $rowidlist $y0]
5760            }
5761        }
5762        if {!$haspad} {
5763            # Find the first column that doesn't have a line going right
5764            for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5765                set id [lindex $idlist $col]
5766                if {$id eq {}} break
5767                set x0 [lsearch -exact $previdlist $id]
5768                if {$x0 < 0} {
5769                    # check if this is the link to the first child
5770                    set kid [lindex $displayorder $y0]
5771                    if {[lindex $children($curview,$id) 0] eq $kid} {
5772                        # it is, work out offset to child
5773                        set x0 [lsearch -exact $previdlist $kid]
5774                    }
5775                }
5776                if {$x0 <= $col} break
5777            }
5778            # Insert a pad at that column as long as it has a line and
5779            # isn't the last column
5780            if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5781                set idlist [linsert $idlist $col {}]
5782                lset rowidlist $row $idlist
5783                changedrow $row
5784            }
5785        }
5786    }
5787}
5788
5789proc xc {row col} {
5790    global canvx0 linespc
5791    return [expr {$canvx0 + $col * $linespc}]
5792}
5793
5794proc yc {row} {
5795    global canvy0 linespc
5796    return [expr {$canvy0 + $row * $linespc}]
5797}
5798
5799proc linewidth {id} {
5800    global thickerline lthickness
5801
5802    set wid $lthickness
5803    if {[info exists thickerline] && $id eq $thickerline} {
5804        set wid [expr {2 * $lthickness}]
5805    }
5806    return $wid
5807}
5808
5809proc rowranges {id} {
5810    global curview children uparrowlen downarrowlen
5811    global rowidlist
5812
5813    set kids $children($curview,$id)
5814    if {$kids eq {}} {
5815        return {}
5816    }
5817    set ret {}
5818    lappend kids $id
5819    foreach child $kids {
5820        if {![commitinview $child $curview]} break
5821        set row [rowofcommit $child]
5822        if {![info exists prev]} {
5823            lappend ret [expr {$row + 1}]
5824        } else {
5825            if {$row <= $prevrow} {
5826                puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5827            }
5828            # see if the line extends the whole way from prevrow to row
5829            if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5830                [lsearch -exact [lindex $rowidlist \
5831                            [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5832                # it doesn't, see where it ends
5833                set r [expr {$prevrow + $downarrowlen}]
5834                if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5835                    while {[incr r -1] > $prevrow &&
5836                           [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5837                } else {
5838                    while {[incr r] <= $row &&
5839                           [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5840                    incr r -1
5841                }
5842                lappend ret $r
5843                # see where it starts up again
5844                set r [expr {$row - $uparrowlen}]
5845                if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5846                    while {[incr r] < $row &&
5847                           [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5848                } else {
5849                    while {[incr r -1] >= $prevrow &&
5850                           [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5851                    incr r
5852                }
5853                lappend ret $r
5854            }
5855        }
5856        if {$child eq $id} {
5857            lappend ret $row
5858        }
5859        set prev $child
5860        set prevrow $row
5861    }
5862    return $ret
5863}
5864
5865proc drawlineseg {id row endrow arrowlow} {
5866    global rowidlist displayorder iddrawn linesegs
5867    global canv colormap linespc curview maxlinelen parentlist
5868
5869    set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5870    set le [expr {$row + 1}]
5871    set arrowhigh 1
5872    while {1} {
5873        set c [lsearch -exact [lindex $rowidlist $le] $id]
5874        if {$c < 0} {
5875            incr le -1
5876            break
5877        }
5878        lappend cols $c
5879        set x [lindex $displayorder $le]
5880        if {$x eq $id} {
5881            set arrowhigh 0
5882            break
5883        }
5884        if {[info exists iddrawn($x)] || $le == $endrow} {
5885            set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5886            if {$c >= 0} {
5887                lappend cols $c
5888                set arrowhigh 0
5889            }
5890            break
5891        }
5892        incr le
5893    }
5894    if {$le <= $row} {
5895        return $row
5896    }
5897
5898    set lines {}
5899    set i 0
5900    set joinhigh 0
5901    if {[info exists linesegs($id)]} {
5902        set lines $linesegs($id)
5903        foreach li $lines {
5904            set r0 [lindex $li 0]
5905            if {$r0 > $row} {
5906                if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5907                    set joinhigh 1
5908                }
5909                break
5910            }
5911            incr i
5912        }
5913    }
5914    set joinlow 0
5915    if {$i > 0} {
5916        set li [lindex $lines [expr {$i-1}]]
5917        set r1 [lindex $li 1]
5918        if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5919            set joinlow 1
5920        }
5921    }
5922
5923    set x [lindex $cols [expr {$le - $row}]]
5924    set xp [lindex $cols [expr {$le - 1 - $row}]]
5925    set dir [expr {$xp - $x}]
5926    if {$joinhigh} {
5927        set ith [lindex $lines $i 2]
5928        set coords [$canv coords $ith]
5929        set ah [$canv itemcget $ith -arrow]
5930        set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5931        set x2 [lindex $cols [expr {$le + 1 - $row}]]
5932        if {$x2 ne {} && $x - $x2 == $dir} {
5933            set coords [lrange $coords 0 end-2]
5934        }
5935    } else {
5936        set coords [list [xc $le $x] [yc $le]]
5937    }
5938    if {$joinlow} {
5939        set itl [lindex $lines [expr {$i-1}] 2]
5940        set al [$canv itemcget $itl -arrow]
5941        set arrowlow [expr {$al eq "last" || $al eq "both"}]
5942    } elseif {$arrowlow} {
5943        if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5944            [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5945            set arrowlow 0
5946        }
5947    }
5948    set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5949    for {set y $le} {[incr y -1] > $row} {} {
5950        set x $xp
5951        set xp [lindex $cols [expr {$y - 1 - $row}]]
5952        set ndir [expr {$xp - $x}]
5953        if {$dir != $ndir || $xp < 0} {
5954            lappend coords [xc $y $x] [yc $y]
5955        }
5956        set dir $ndir
5957    }
5958    if {!$joinlow} {
5959        if {$xp < 0} {
5960            # join parent line to first child
5961            set ch [lindex $displayorder $row]
5962            set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5963            if {$xc < 0} {
5964                puts "oops: drawlineseg: child $ch not on row $row"
5965            } elseif {$xc != $x} {
5966                if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5967                    set d [expr {int(0.5 * $linespc)}]
5968                    set x1 [xc $row $x]
5969                    if {$xc < $x} {
5970                        set x2 [expr {$x1 - $d}]
5971                    } else {
5972                        set x2 [expr {$x1 + $d}]
5973                    }
5974                    set y2 [yc $row]
5975                    set y1 [expr {$y2 + $d}]
5976                    lappend coords $x1 $y1 $x2 $y2
5977                } elseif {$xc < $x - 1} {
5978                    lappend coords [xc $row [expr {$x-1}]] [yc $row]
5979                } elseif {$xc > $x + 1} {
5980                    lappend coords [xc $row [expr {$x+1}]] [yc $row]
5981                }
5982                set x $xc
5983            }
5984            lappend coords [xc $row $x] [yc $row]
5985        } else {
5986            set xn [xc $row $xp]
5987            set yn [yc $row]
5988            lappend coords $xn $yn
5989        }
5990        if {!$joinhigh} {
5991            assigncolor $id
5992            set t [$canv create line $coords -width [linewidth $id] \
5993                       -fill $colormap($id) -tags lines.$id -arrow $arrow]
5994            $canv lower $t
5995            bindline $t $id
5996            set lines [linsert $lines $i [list $row $le $t]]
5997        } else {
5998            $canv coords $ith $coords
5999            if {$arrow ne $ah} {
6000                $canv itemconf $ith -arrow $arrow
6001            }
6002            lset lines $i 0 $row
6003        }
6004    } else {
6005        set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
6006        set ndir [expr {$xo - $xp}]
6007        set clow [$canv coords $itl]
6008        if {$dir == $ndir} {
6009            set clow [lrange $clow 2 end]
6010        }
6011        set coords [concat $coords $clow]
6012        if {!$joinhigh} {
6013            lset lines [expr {$i-1}] 1 $le
6014        } else {
6015            # coalesce two pieces
6016            $canv delete $ith
6017            set b [lindex $lines [expr {$i-1}] 0]
6018            set e [lindex $lines $i 1]
6019            set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
6020        }
6021        $canv coords $itl $coords
6022        if {$arrow ne $al} {
6023            $canv itemconf $itl -arrow $arrow
6024        }
6025    }
6026
6027    set linesegs($id) $lines
6028    return $le
6029}
6030
6031proc drawparentlinks {id row} {
6032    global rowidlist canv colormap curview parentlist
6033    global idpos linespc
6034
6035    set rowids [lindex $rowidlist $row]
6036    set col [lsearch -exact $rowids $id]
6037    if {$col < 0} return
6038    set olds [lindex $parentlist $row]
6039    set row2 [expr {$row + 1}]
6040    set x [xc $row $col]
6041    set y [yc $row]
6042    set y2 [yc $row2]
6043    set d [expr {int(0.5 * $linespc)}]
6044    set ymid [expr {$y + $d}]
6045    set ids [lindex $rowidlist $row2]
6046    # rmx = right-most X coord used
6047    set rmx 0
6048    foreach p $olds {
6049        set i [lsearch -exact $ids $p]
6050        if {$i < 0} {
6051            puts "oops, parent $p of $id not in list"
6052            continue
6053        }
6054        set x2 [xc $row2 $i]
6055        if {$x2 > $rmx} {
6056            set rmx $x2
6057        }
6058        set j [lsearch -exact $rowids $p]
6059        if {$j < 0} {
6060            # drawlineseg will do this one for us
6061            continue
6062        }
6063        assigncolor $p
6064        # should handle duplicated parents here...
6065        set coords [list $x $y]
6066        if {$i != $col} {
6067            # if attaching to a vertical segment, draw a smaller
6068            # slant for visual distinctness
6069            if {$i == $j} {
6070                if {$i < $col} {
6071                    lappend coords [expr {$x2 + $d}] $y $x2 $ymid
6072                } else {
6073                    lappend coords [expr {$x2 - $d}] $y $x2 $ymid
6074                }
6075            } elseif {$i < $col && $i < $j} {
6076                # segment slants towards us already
6077                lappend coords [xc $row $j] $y
6078            } else {
6079                if {$i < $col - 1} {
6080                    lappend coords [expr {$x2 + $linespc}] $y
6081                } elseif {$i > $col + 1} {
6082                    lappend coords [expr {$x2 - $linespc}] $y
6083                }
6084                lappend coords $x2 $y2
6085            }
6086        } else {
6087            lappend coords $x2 $y2
6088        }
6089        set t [$canv create line $coords -width [linewidth $p] \
6090                   -fill $colormap($p) -tags lines.$p]
6091        $canv lower $t
6092        bindline $t $p
6093    }
6094    if {$rmx > [lindex $idpos($id) 1]} {
6095        lset idpos($id) 1 $rmx
6096        redrawtags $id
6097    }
6098}
6099
6100proc drawlines {id} {
6101    global canv
6102
6103    $canv itemconf lines.$id -width [linewidth $id]
6104}
6105
6106proc drawcmittext {id row col} {
6107    global linespc canv canv2 canv3 fgcolor curview
6108    global cmitlisted commitinfo rowidlist parentlist
6109    global rowtextx idpos idtags idheads idotherrefs
6110    global linehtag linentag linedtag selectedline
6111    global canvxmax boldids boldnameids fgcolor markedid
6112    global mainheadid nullid nullid2 circleitem circlecolors ctxbut
6113    global mainheadcirclecolor workingfilescirclecolor indexcirclecolor
6114    global circleoutlinecolor
6115
6116    # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
6117    set listed $cmitlisted($curview,$id)
6118    if {$id eq $nullid} {
6119        set ofill $workingfilescirclecolor
6120    } elseif {$id eq $nullid2} {
6121        set ofill $indexcirclecolor
6122    } elseif {$id eq $mainheadid} {
6123        set ofill $mainheadcirclecolor
6124    } else {
6125        set ofill [lindex $circlecolors $listed]
6126    }
6127    set x [xc $row $col]
6128    set y [yc $row]
6129    set orad [expr {$linespc / 3}]
6130    if {$listed <= 2} {
6131        set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
6132                   [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6133                   -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6134    } elseif {$listed == 3} {
6135        # triangle pointing left for left-side commits
6136        set t [$canv create polygon \
6137                   [expr {$x - $orad}] $y \
6138                   [expr {$x + $orad - 1}] [expr {$y - $orad}] \
6139                   [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6140                   -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6141    } else {
6142        # triangle pointing right for right-side commits
6143        set t [$canv create polygon \
6144                   [expr {$x + $orad - 1}] $y \
6145                   [expr {$x - $orad}] [expr {$y - $orad}] \
6146                   [expr {$x - $orad}] [expr {$y + $orad - 1}] \
6147                   -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6148    }
6149    set circleitem($row) $t
6150    $canv raise $t
6151    $canv bind $t <1> {selcanvline {} %x %y}
6152    set rmx [llength [lindex $rowidlist $row]]
6153    set olds [lindex $parentlist $row]
6154    if {$olds ne {}} {
6155        set nextids [lindex $rowidlist [expr {$row + 1}]]
6156        foreach p $olds {
6157            set i [lsearch -exact $nextids $p]
6158            if {$i > $rmx} {
6159                set rmx $i
6160            }
6161        }
6162    }
6163    set xt [xc $row $rmx]
6164    set rowtextx($row) $xt
6165    set idpos($id) [list $x $xt $y]
6166    if {[info exists idtags($id)] || [info exists idheads($id)]
6167        || [info exists idotherrefs($id)]} {
6168        set xt [drawtags $id $x $xt $y]
6169    }
6170    if {[lindex $commitinfo($id) 6] > 0} {
6171        set xt [drawnotesign $xt $y]
6172    }
6173    set headline [lindex $commitinfo($id) 0]
6174    set name [lindex $commitinfo($id) 1]
6175    set date [lindex $commitinfo($id) 2]
6176    set date [formatdate $date]
6177    set font mainfont
6178    set nfont mainfont
6179    set isbold [ishighlighted $id]
6180    if {$isbold > 0} {
6181        lappend boldids $id
6182        set font mainfontbold
6183        if {$isbold > 1} {
6184            lappend boldnameids $id
6185            set nfont mainfontbold
6186        }
6187    }
6188    set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
6189                           -text $headline -font $font -tags text]
6190    $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
6191    set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
6192                           -text $name -font $nfont -tags text]
6193    set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
6194                           -text $date -font mainfont -tags text]
6195    if {$selectedline == $row} {
6196        make_secsel $id
6197    }
6198    if {[info exists markedid] && $markedid eq $id} {
6199        make_idmark $id
6200    }
6201    set xr [expr {$xt + [font measure $font $headline]}]
6202    if {$xr > $canvxmax} {
6203        set canvxmax $xr
6204        setcanvscroll
6205    }
6206}
6207
6208proc drawcmitrow {row} {
6209    global displayorder rowidlist nrows_drawn
6210    global iddrawn markingmatches
6211    global commitinfo numcommits
6212    global filehighlight fhighlights findpattern nhighlights
6213    global hlview vhighlights
6214    global highlight_related rhighlights
6215
6216    if {$row >= $numcommits} return
6217
6218    set id [lindex $displayorder $row]
6219    if {[info exists hlview] && ![info exists vhighlights($id)]} {
6220        askvhighlight $row $id
6221    }
6222    if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
6223        askfilehighlight $row $id
6224    }
6225    if {$findpattern ne {} && ![info exists nhighlights($id)]} {
6226        askfindhighlight $row $id
6227    }
6228    if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
6229        askrelhighlight $row $id
6230    }
6231    if {![info exists iddrawn($id)]} {
6232        set col [lsearch -exact [lindex $rowidlist $row] $id]
6233        if {$col < 0} {
6234            puts "oops, row $row id $id not in list"
6235            return
6236        }
6237        if {![info exists commitinfo($id)]} {
6238            getcommit $id
6239        }
6240        assigncolor $id
6241        drawcmittext $id $row $col
6242        set iddrawn($id) 1
6243        incr nrows_drawn
6244    }
6245    if {$markingmatches} {
6246        markrowmatches $row $id
6247    }
6248}
6249
6250proc drawcommits {row {endrow {}}} {
6251    global numcommits iddrawn displayorder curview need_redisplay
6252    global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
6253
6254    if {$row < 0} {
6255        set row 0
6256    }
6257    if {$endrow eq {}} {
6258        set endrow $row
6259    }
6260    if {$endrow >= $numcommits} {
6261        set endrow [expr {$numcommits - 1}]
6262    }
6263
6264    set rl1 [expr {$row - $downarrowlen - 3}]
6265    if {$rl1 < 0} {
6266        set rl1 0
6267    }
6268    set ro1 [expr {$row - 3}]
6269    if {$ro1 < 0} {
6270        set ro1 0
6271    }
6272    set r2 [expr {$endrow + $uparrowlen + 3}]
6273    if {$r2 > $numcommits} {
6274        set r2 $numcommits
6275    }
6276    for {set r $rl1} {$r < $r2} {incr r} {
6277        if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
6278            if {$rl1 < $r} {
6279                layoutrows $rl1 $r
6280            }
6281            set rl1 [expr {$r + 1}]
6282        }
6283    }
6284    if {$rl1 < $r} {
6285        layoutrows $rl1 $r
6286    }
6287    optimize_rows $ro1 0 $r2
6288    if {$need_redisplay || $nrows_drawn > 2000} {
6289        clear_display
6290    }
6291
6292    # make the lines join to already-drawn rows either side
6293    set r [expr {$row - 1}]
6294    if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
6295        set r $row
6296    }
6297    set er [expr {$endrow + 1}]
6298    if {$er >= $numcommits ||
6299        ![info exists iddrawn([lindex $displayorder $er])]} {
6300        set er $endrow
6301    }
6302    for {} {$r <= $er} {incr r} {
6303        set id [lindex $displayorder $r]
6304        set wasdrawn [info exists iddrawn($id)]
6305        drawcmitrow $r
6306        if {$r == $er} break
6307        set nextid [lindex $displayorder [expr {$r + 1}]]
6308        if {$wasdrawn && [info exists iddrawn($nextid)]} continue
6309        drawparentlinks $id $r
6310
6311        set rowids [lindex $rowidlist $r]
6312        foreach lid $rowids {
6313            if {$lid eq {}} continue
6314            if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
6315            if {$lid eq $id} {
6316                # see if this is the first child of any of its parents
6317                foreach p [lindex $parentlist $r] {
6318                    if {[lsearch -exact $rowids $p] < 0} {
6319                        # make this line extend up to the child
6320                        set lineend($p) [drawlineseg $p $r $er 0]
6321                    }
6322                }
6323            } else {
6324                set lineend($lid) [drawlineseg $lid $r $er 1]
6325            }
6326        }
6327    }
6328}
6329
6330proc undolayout {row} {
6331    global uparrowlen mingaplen downarrowlen
6332    global rowidlist rowisopt rowfinal need_redisplay
6333
6334    set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
6335    if {$r < 0} {
6336        set r 0
6337    }
6338    if {[llength $rowidlist] > $r} {
6339        incr r -1
6340        set rowidlist [lrange $rowidlist 0 $r]
6341        set rowfinal [lrange $rowfinal 0 $r]
6342        set rowisopt [lrange $rowisopt 0 $r]
6343        set need_redisplay 1
6344        run drawvisible
6345    }
6346}
6347
6348proc drawvisible {} {
6349    global canv linespc curview vrowmod selectedline targetrow targetid
6350    global need_redisplay cscroll numcommits
6351
6352    set fs [$canv yview]
6353    set ymax [lindex [$canv cget -scrollregion] 3]
6354    if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
6355    set f0 [lindex $fs 0]
6356    set f1 [lindex $fs 1]
6357    set y0 [expr {int($f0 * $ymax)}]
6358    set y1 [expr {int($f1 * $ymax)}]
6359
6360    if {[info exists targetid]} {
6361        if {[commitinview $targetid $curview]} {
6362            set r [rowofcommit $targetid]
6363            if {$r != $targetrow} {
6364                # Fix up the scrollregion and change the scrolling position
6365                # now that our target row has moved.
6366                set diff [expr {($r - $targetrow) * $linespc}]
6367                set targetrow $r
6368                setcanvscroll
6369                set ymax [lindex [$canv cget -scrollregion] 3]
6370                incr y0 $diff
6371                incr y1 $diff
6372                set f0 [expr {$y0 / $ymax}]
6373                set f1 [expr {$y1 / $ymax}]
6374                allcanvs yview moveto $f0
6375                $cscroll set $f0 $f1
6376                set need_redisplay 1
6377            }
6378        } else {
6379            unset targetid
6380        }
6381    }
6382
6383    set row [expr {int(($y0 - 3) / $linespc) - 1}]
6384    set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
6385    if {$endrow >= $vrowmod($curview)} {
6386        update_arcrows $curview
6387    }
6388    if {$selectedline ne {} &&
6389        $row <= $selectedline && $selectedline <= $endrow} {
6390        set targetrow $selectedline
6391    } elseif {[info exists targetid]} {
6392        set targetrow [expr {int(($row + $endrow) / 2)}]
6393    }
6394    if {[info exists targetrow]} {
6395        if {$targetrow >= $numcommits} {
6396            set targetrow [expr {$numcommits - 1}]
6397        }
6398        set targetid [commitonrow $targetrow]
6399    }
6400    drawcommits $row $endrow
6401}
6402
6403proc clear_display {} {
6404    global iddrawn linesegs need_redisplay nrows_drawn
6405    global vhighlights fhighlights nhighlights rhighlights
6406    global linehtag linentag linedtag boldids boldnameids
6407
6408    allcanvs delete all
6409    unset -nocomplain iddrawn
6410    unset -nocomplain linesegs
6411    unset -nocomplain linehtag
6412    unset -nocomplain linentag
6413    unset -nocomplain linedtag
6414    set boldids {}
6415    set boldnameids {}
6416    unset -nocomplain vhighlights
6417    unset -nocomplain fhighlights
6418    unset -nocomplain nhighlights
6419    unset -nocomplain rhighlights
6420    set need_redisplay 0
6421    set nrows_drawn 0
6422}
6423
6424proc findcrossings {id} {
6425    global rowidlist parentlist numcommits displayorder
6426
6427    set cross {}
6428    set ccross {}
6429    foreach {s e} [rowranges $id] {
6430        if {$e >= $numcommits} {
6431            set e [expr {$numcommits - 1}]
6432        }
6433        if {$e <= $s} continue
6434        for {set row $e} {[incr row -1] >= $s} {} {
6435            set x [lsearch -exact [lindex $rowidlist $row] $id]
6436            if {$x < 0} break
6437            set olds [lindex $parentlist $row]
6438            set kid [lindex $displayorder $row]
6439            set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
6440            if {$kidx < 0} continue
6441            set nextrow [lindex $rowidlist [expr {$row + 1}]]
6442            foreach p $olds {
6443                set px [lsearch -exact $nextrow $p]
6444                if {$px < 0} continue
6445                if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
6446                    if {[lsearch -exact $ccross $p] >= 0} continue
6447                    if {$x == $px + ($kidx < $px? -1: 1)} {
6448                        lappend ccross $p
6449                    } elseif {[lsearch -exact $cross $p] < 0} {
6450                        lappend cross $p
6451                    }
6452                }
6453            }
6454        }
6455    }
6456    return [concat $ccross {{}} $cross]
6457}
6458
6459proc assigncolor {id} {
6460    global colormap colors nextcolor
6461    global parents children children curview
6462
6463    if {[info exists colormap($id)]} return
6464    set ncolors [llength $colors]
6465    if {[info exists children($curview,$id)]} {
6466        set kids $children($curview,$id)
6467    } else {
6468        set kids {}
6469    }
6470    if {[llength $kids] == 1} {
6471        set child [lindex $kids 0]
6472        if {[info exists colormap($child)]
6473            && [llength $parents($curview,$child)] == 1} {
6474            set colormap($id) $colormap($child)
6475            return
6476        }
6477    }
6478    set badcolors {}
6479    set origbad {}
6480    foreach x [findcrossings $id] {
6481        if {$x eq {}} {
6482            # delimiter between corner crossings and other crossings
6483            if {[llength $badcolors] >= $ncolors - 1} break
6484            set origbad $badcolors
6485        }
6486        if {[info exists colormap($x)]
6487            && [lsearch -exact $badcolors $colormap($x)] < 0} {
6488            lappend badcolors $colormap($x)
6489        }
6490    }
6491    if {[llength $badcolors] >= $ncolors} {
6492        set badcolors $origbad
6493    }
6494    set origbad $badcolors
6495    if {[llength $badcolors] < $ncolors - 1} {
6496        foreach child $kids {
6497            if {[info exists colormap($child)]
6498                && [lsearch -exact $badcolors $colormap($child)] < 0} {
6499                lappend badcolors $colormap($child)
6500            }
6501            foreach p $parents($curview,$child) {
6502                if {[info exists colormap($p)]
6503                    && [lsearch -exact $badcolors $colormap($p)] < 0} {
6504                    lappend badcolors $colormap($p)
6505                }
6506            }
6507        }
6508        if {[llength $badcolors] >= $ncolors} {
6509            set badcolors $origbad
6510        }
6511    }
6512    for {set i 0} {$i <= $ncolors} {incr i} {
6513        set c [lindex $colors $nextcolor]
6514        if {[incr nextcolor] >= $ncolors} {
6515            set nextcolor 0
6516        }
6517        if {[lsearch -exact $badcolors $c]} break
6518    }
6519    set colormap($id) $c
6520}
6521
6522proc bindline {t id} {
6523    global canv
6524
6525    $canv bind $t <Enter> "lineenter %x %y $id"
6526    $canv bind $t <Motion> "linemotion %x %y $id"
6527    $canv bind $t <Leave> "lineleave $id"
6528    $canv bind $t <Button-1> "lineclick %x %y $id 1"
6529}
6530
6531proc graph_pane_width {} {
6532    global use_ttk
6533
6534    if {$use_ttk} {
6535        set g [.tf.histframe.pwclist sashpos 0]
6536    } else {
6537        set g [.tf.histframe.pwclist sash coord 0]
6538    }
6539    return [lindex $g 0]
6540}
6541
6542proc totalwidth {l font extra} {
6543    set tot 0
6544    foreach str $l {
6545        set tot [expr {$tot + [font measure $font $str] + $extra}]
6546    }
6547    return $tot
6548}
6549
6550proc drawtags {id x xt y1} {
6551    global idtags idheads idotherrefs mainhead
6552    global linespc lthickness
6553    global canv rowtextx curview fgcolor bgcolor ctxbut
6554    global headbgcolor headfgcolor headoutlinecolor remotebgcolor
6555    global tagbgcolor tagfgcolor tagoutlinecolor
6556    global reflinecolor
6557
6558    set marks {}
6559    set ntags 0
6560    set nheads 0
6561    set singletag 0
6562    set maxtags 3
6563    set maxtagpct 25
6564    set maxwidth [expr {[graph_pane_width] * $maxtagpct / 100}]
6565    set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6566    set extra [expr {$delta + $lthickness + $linespc}]
6567
6568    if {[info exists idtags($id)]} {
6569        set marks $idtags($id)
6570        set ntags [llength $marks]
6571        if {$ntags > $maxtags ||
6572            [totalwidth $marks mainfont $extra] > $maxwidth} {
6573            # show just a single "n tags..." tag
6574            set singletag 1
6575            if {$ntags == 1} {
6576                set marks [list "tag..."]
6577            } else {
6578                set marks [list [format "%d tags..." $ntags]]
6579            }
6580            set ntags 1
6581        }
6582    }
6583    if {[info exists idheads($id)]} {
6584        set marks [concat $marks $idheads($id)]
6585        set nheads [llength $idheads($id)]
6586    }
6587    if {[info exists idotherrefs($id)]} {
6588        set marks [concat $marks $idotherrefs($id)]
6589    }
6590    if {$marks eq {}} {
6591        return $xt
6592    }
6593
6594    set yt [expr {$y1 - 0.5 * $linespc}]
6595    set yb [expr {$yt + $linespc - 1}]
6596    set xvals {}
6597    set wvals {}
6598    set i -1
6599    foreach tag $marks {
6600        incr i
6601        if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
6602            set wid [font measure mainfontbold $tag]
6603        } else {
6604            set wid [font measure mainfont $tag]
6605        }
6606        lappend xvals $xt
6607        lappend wvals $wid
6608        set xt [expr {$xt + $wid + $extra}]
6609    }
6610    set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
6611               -width $lthickness -fill $reflinecolor -tags tag.$id]
6612    $canv lower $t
6613    foreach tag $marks x $xvals wid $wvals {
6614        set tag_quoted [string map {% %%} $tag]
6615        set xl [expr {$x + $delta}]
6616        set xr [expr {$x + $delta + $wid + $lthickness}]
6617        set font mainfont
6618        if {[incr ntags -1] >= 0} {
6619            # draw a tag
6620            set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6621                       $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
6622                       -width 1 -outline $tagoutlinecolor -fill $tagbgcolor \
6623                       -tags tag.$id]
6624            if {$singletag} {
6625                set tagclick [list showtags $id 1]
6626            } else {
6627                set tagclick [list showtag $tag_quoted 1]
6628            }
6629            $canv bind $t <1> $tagclick
6630            set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
6631        } else {
6632            # draw a head or other ref
6633            if {[incr nheads -1] >= 0} {
6634                set col $headbgcolor
6635                if {$tag eq $mainhead} {
6636                    set font mainfontbold
6637                }
6638            } else {
6639                set col "#ddddff"
6640            }
6641            set xl [expr {$xl - $delta/2}]
6642            $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
6643                -width 1 -outline black -fill $col -tags tag.$id
6644            if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
6645                set rwid [font measure mainfont $remoteprefix]
6646                set xi [expr {$x + 1}]
6647                set yti [expr {$yt + 1}]
6648                set xri [expr {$x + $rwid}]
6649                $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6650                        -width 0 -fill $remotebgcolor -tags tag.$id
6651            }
6652        }
6653        set t [$canv create text $xl $y1 -anchor w -text $tag -fill $headfgcolor \
6654                   -font $font -tags [list tag.$id text]]
6655        if {$ntags >= 0} {
6656            $canv bind $t <1> $tagclick
6657        } elseif {$nheads >= 0} {
6658            $canv bind $t $ctxbut [list headmenu %X %Y $id $tag_quoted]
6659        }
6660    }
6661    return $xt
6662}
6663
6664proc drawnotesign {xt y} {
6665    global linespc canv fgcolor
6666
6667    set orad [expr {$linespc / 3}]
6668    set t [$canv create rectangle [expr {$xt - $orad}] [expr {$y - $orad}] \
6669               [expr {$xt + $orad - 1}] [expr {$y + $orad - 1}] \
6670               -fill yellow -outline $fgcolor -width 1 -tags circle]
6671    set xt [expr {$xt + $orad * 3}]
6672    return $xt
6673}
6674
6675proc xcoord {i level ln} {
6676    global canvx0 xspc1 xspc2
6677
6678    set x [expr {$canvx0 + $i * $xspc1($ln)}]
6679    if {$i > 0 && $i == $level} {
6680        set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6681    } elseif {$i > $level} {
6682        set x [expr {$x + $xspc2 - $xspc1($ln)}]
6683    }
6684    return $x
6685}
6686
6687proc show_status {msg} {
6688    global canv fgcolor
6689
6690    clear_display
6691    set_window_title
6692    $canv create text 3 3 -anchor nw -text $msg -font mainfont \
6693        -tags text -fill $fgcolor
6694}
6695
6696# Don't change the text pane cursor if it is currently the hand cursor,
6697# showing that we are over a sha1 ID link.
6698proc settextcursor {c} {
6699    global ctext curtextcursor
6700
6701    if {[$ctext cget -cursor] == $curtextcursor} {
6702        $ctext config -cursor $c
6703    }
6704    set curtextcursor $c
6705}
6706
6707proc nowbusy {what {name {}}} {
6708    global isbusy busyname statusw
6709
6710    if {[array names isbusy] eq {}} {
6711        . config -cursor watch
6712        settextcursor watch
6713    }
6714    set isbusy($what) 1
6715    set busyname($what) $name
6716    if {$name ne {}} {
6717        $statusw conf -text $name
6718    }
6719}
6720
6721proc notbusy {what} {
6722    global isbusy maincursor textcursor busyname statusw
6723
6724    catch {
6725        unset isbusy($what)
6726        if {$busyname($what) ne {} &&
6727            [$statusw cget -text] eq $busyname($what)} {
6728            $statusw conf -text {}
6729        }
6730    }
6731    if {[array names isbusy] eq {}} {
6732        . config -cursor $maincursor
6733        settextcursor $textcursor
6734    }
6735}
6736
6737proc findmatches {f} {
6738    global findtype findstring
6739    if {$findtype == [mc "Regexp"]} {
6740        set matches [regexp -indices -all -inline $findstring $f]
6741    } else {
6742        set fs $findstring
6743        if {$findtype == [mc "IgnCase"]} {
6744            set f [string tolower $f]
6745            set fs [string tolower $fs]
6746        }
6747        set matches {}
6748        set i 0
6749        set l [string length $fs]
6750        while {[set j [string first $fs $f $i]] >= 0} {
6751            lappend matches [list $j [expr {$j+$l-1}]]
6752            set i [expr {$j + $l}]
6753        }
6754    }
6755    return $matches
6756}
6757
6758proc dofind {{dirn 1} {wrap 1}} {
6759    global findstring findstartline findcurline selectedline numcommits
6760    global gdttype filehighlight fh_serial find_dirn findallowwrap
6761
6762    if {[info exists find_dirn]} {
6763        if {$find_dirn == $dirn} return
6764        stopfinding
6765    }
6766    focus .
6767    if {$findstring eq {} || $numcommits == 0} return
6768    if {$selectedline eq {}} {
6769        set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6770    } else {
6771        set findstartline $selectedline
6772    }
6773    set findcurline $findstartline
6774    nowbusy finding [mc "Searching"]
6775    if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6776        after cancel do_file_hl $fh_serial
6777        do_file_hl $fh_serial
6778    }
6779    set find_dirn $dirn
6780    set findallowwrap $wrap
6781    run findmore
6782}
6783
6784proc stopfinding {} {
6785    global find_dirn findcurline fprogcoord
6786
6787    if {[info exists find_dirn]} {
6788        unset find_dirn
6789        unset findcurline
6790        notbusy finding
6791        set fprogcoord 0
6792        adjustprogress
6793    }
6794    stopblaming
6795}
6796
6797proc findmore {} {
6798    global commitdata commitinfo numcommits findpattern findloc
6799    global findstartline findcurline findallowwrap
6800    global find_dirn gdttype fhighlights fprogcoord
6801    global curview varcorder vrownum varccommits vrowmod
6802
6803    if {![info exists find_dirn]} {
6804        return 0
6805    }
6806    set fldtypes [list [mc "Headline"] [mc "Author"] "" [mc "Committer"] "" [mc "Comments"]]
6807    set l $findcurline
6808    set moretodo 0
6809    if {$find_dirn > 0} {
6810        incr l
6811        if {$l >= $numcommits} {
6812            set l 0
6813        }
6814        if {$l <= $findstartline} {
6815            set lim [expr {$findstartline + 1}]
6816        } else {
6817            set lim $numcommits
6818            set moretodo $findallowwrap
6819        }
6820    } else {
6821        if {$l == 0} {
6822            set l $numcommits
6823        }
6824        incr l -1
6825        if {$l >= $findstartline} {
6826            set lim [expr {$findstartline - 1}]
6827        } else {
6828            set lim -1
6829            set moretodo $findallowwrap
6830        }
6831    }
6832    set n [expr {($lim - $l) * $find_dirn}]
6833    if {$n > 500} {
6834        set n 500
6835        set moretodo 1
6836    }
6837    if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6838        update_arcrows $curview
6839    }
6840    set found 0
6841    set domore 1
6842    set ai [bsearch $vrownum($curview) $l]
6843    set a [lindex $varcorder($curview) $ai]
6844    set arow [lindex $vrownum($curview) $ai]
6845    set ids [lindex $varccommits($curview,$a)]
6846    set arowend [expr {$arow + [llength $ids]}]
6847    if {$gdttype eq [mc "containing:"]} {
6848        for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6849            if {$l < $arow || $l >= $arowend} {
6850                incr ai $find_dirn
6851                set a [lindex $varcorder($curview) $ai]
6852                set arow [lindex $vrownum($curview) $ai]
6853                set ids [lindex $varccommits($curview,$a)]
6854                set arowend [expr {$arow + [llength $ids]}]
6855            }
6856            set id [lindex $ids [expr {$l - $arow}]]
6857            # shouldn't happen unless git log doesn't give all the commits...
6858            if {![info exists commitdata($id)] ||
6859                ![doesmatch $commitdata($id)]} {
6860                continue
6861            }
6862            if {![info exists commitinfo($id)]} {
6863                getcommit $id
6864            }
6865            set info $commitinfo($id)
6866            foreach f $info ty $fldtypes {
6867                if {$ty eq ""} continue
6868                if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6869                    [doesmatch $f]} {
6870                    set found 1
6871                    break
6872                }
6873            }
6874            if {$found} break
6875        }
6876    } else {
6877        for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6878            if {$l < $arow || $l >= $arowend} {
6879                incr ai $find_dirn
6880                set a [lindex $varcorder($curview) $ai]
6881                set arow [lindex $vrownum($curview) $ai]
6882                set ids [lindex $varccommits($curview,$a)]
6883                set arowend [expr {$arow + [llength $ids]}]
6884            }
6885            set id [lindex $ids [expr {$l - $arow}]]
6886            if {![info exists fhighlights($id)]} {
6887                # this sets fhighlights($id) to -1
6888                askfilehighlight $l $id
6889            }
6890            if {$fhighlights($id) > 0} {
6891                set found $domore
6892                break
6893            }
6894            if {$fhighlights($id) < 0} {
6895                if {$domore} {
6896                    set domore 0
6897                    set findcurline [expr {$l - $find_dirn}]
6898                }
6899            }
6900        }
6901    }
6902    if {$found || ($domore && !$moretodo)} {
6903        unset findcurline
6904        unset find_dirn
6905        notbusy finding
6906        set fprogcoord 0
6907        adjustprogress
6908        if {$found} {
6909            findselectline $l
6910        } else {
6911            bell
6912        }
6913        return 0
6914    }
6915    if {!$domore} {
6916        flushhighlights
6917    } else {
6918        set findcurline [expr {$l - $find_dirn}]
6919    }
6920    set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6921    if {$n < 0} {
6922        incr n $numcommits
6923    }
6924    set fprogcoord [expr {$n * 1.0 / $numcommits}]
6925    adjustprogress
6926    return $domore
6927}
6928
6929proc findselectline {l} {
6930    global findloc commentend ctext findcurline markingmatches gdttype
6931
6932    set markingmatches [expr {$gdttype eq [mc "containing:"]}]
6933    set findcurline $l
6934    selectline $l 1
6935    if {$markingmatches &&
6936        ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
6937        # highlight the matches in the comments
6938        set f [$ctext get 1.0 $commentend]
6939        set matches [findmatches $f]
6940        foreach match $matches {
6941            set start [lindex $match 0]
6942            set end [expr {[lindex $match 1] + 1}]
6943            $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6944        }
6945    }
6946    drawvisible
6947}
6948
6949# mark the bits of a headline or author that match a find string
6950proc markmatches {canv l str tag matches font row} {
6951    global selectedline
6952
6953    set bbox [$canv bbox $tag]
6954    set x0 [lindex $bbox 0]
6955    set y0 [lindex $bbox 1]
6956    set y1 [lindex $bbox 3]
6957    foreach match $matches {
6958        set start [lindex $match 0]
6959        set end [lindex $match 1]
6960        if {$start > $end} continue
6961        set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6962        set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6963        set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6964                   [expr {$x0+$xlen+2}] $y1 \
6965                   -outline {} -tags [list match$l matches] -fill yellow]
6966        $canv lower $t
6967        if {$row == $selectedline} {
6968            $canv raise $t secsel
6969        }
6970    }
6971}
6972
6973proc unmarkmatches {} {
6974    global markingmatches
6975
6976    allcanvs delete matches
6977    set markingmatches 0
6978    stopfinding
6979}
6980
6981proc selcanvline {w x y} {
6982    global canv canvy0 ctext linespc
6983    global rowtextx
6984    set ymax [lindex [$canv cget -scrollregion] 3]
6985    if {$ymax == {}} return
6986    set yfrac [lindex [$canv yview] 0]
6987    set y [expr {$y + $yfrac * $ymax}]
6988    set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6989    if {$l < 0} {
6990        set l 0
6991    }
6992    if {$w eq $canv} {
6993        set xmax [lindex [$canv cget -scrollregion] 2]
6994        set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6995        if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
6996    }
6997    unmarkmatches
6998    selectline $l 1
6999}
7000
7001proc commit_descriptor {p} {
7002    global commitinfo
7003    if {![info exists commitinfo($p)]} {
7004        getcommit $p
7005    }
7006    set l "..."
7007    if {[llength $commitinfo($p)] > 1} {
7008        set l [lindex $commitinfo($p) 0]
7009    }
7010    return "$p ($l)\n"
7011}
7012
7013# append some text to the ctext widget, and make any SHA1 ID
7014# that we know about be a clickable link.
7015proc appendwithlinks {text tags} {
7016    global ctext linknum curview
7017
7018    set start [$ctext index "end - 1c"]
7019    $ctext insert end $text $tags
7020    set links [regexp -indices -all -inline {(?:\m|-g)[0-9a-f]{6,40}\M} $text]
7021    foreach l $links {
7022        set s [lindex $l 0]
7023        set e [lindex $l 1]
7024        set linkid [string range $text $s $e]
7025        incr e
7026        $ctext tag delete link$linknum
7027        $ctext tag add link$linknum "$start + $s c" "$start + $e c"
7028        setlink $linkid link$linknum
7029        incr linknum
7030    }
7031}
7032
7033proc setlink {id lk} {
7034    global curview ctext pendinglinks
7035    global linkfgcolor
7036
7037    if {[string range $id 0 1] eq "-g"} {
7038      set id [string range $id 2 end]
7039    }
7040
7041    set known 0
7042    if {[string length $id] < 40} {
7043        set matches [longid $id]
7044        if {[llength $matches] > 0} {
7045            if {[llength $matches] > 1} return
7046            set known 1
7047            set id [lindex $matches 0]
7048        }
7049    } else {
7050        set known [commitinview $id $curview]
7051    }
7052    if {$known} {
7053        $ctext tag conf $lk -foreground $linkfgcolor -underline 1
7054        $ctext tag bind $lk <1> [list selbyid $id]
7055        $ctext tag bind $lk <Enter> {linkcursor %W 1}
7056        $ctext tag bind $lk <Leave> {linkcursor %W -1}
7057    } else {
7058        lappend pendinglinks($id) $lk
7059        interestedin $id {makelink %P}
7060    }
7061}
7062
7063proc appendshortlink {id {pre {}} {post {}}} {
7064    global ctext linknum
7065
7066    $ctext insert end $pre
7067    $ctext tag delete link$linknum
7068    $ctext insert end [string range $id 0 7] link$linknum
7069    $ctext insert end $post
7070    setlink $id link$linknum
7071    incr linknum
7072}
7073
7074proc makelink {id} {
7075    global pendinglinks
7076
7077    if {![info exists pendinglinks($id)]} return
7078    foreach lk $pendinglinks($id) {
7079        setlink $id $lk
7080    }
7081    unset pendinglinks($id)
7082}
7083
7084proc linkcursor {w inc} {
7085    global linkentercount curtextcursor
7086
7087    if {[incr linkentercount $inc] > 0} {
7088        $w configure -cursor hand2
7089    } else {
7090        $w configure -cursor $curtextcursor
7091        if {$linkentercount < 0} {
7092            set linkentercount 0
7093        }
7094    }
7095}
7096
7097proc viewnextline {dir} {
7098    global canv linespc
7099
7100    $canv delete hover
7101    set ymax [lindex [$canv cget -scrollregion] 3]
7102    set wnow [$canv yview]
7103    set wtop [expr {[lindex $wnow 0] * $ymax}]
7104    set newtop [expr {$wtop + $dir * $linespc}]
7105    if {$newtop < 0} {
7106        set newtop 0
7107    } elseif {$newtop > $ymax} {
7108        set newtop $ymax
7109    }
7110    allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7111}
7112
7113# add a list of tag or branch names at position pos
7114# returns the number of names inserted
7115proc appendrefs {pos ids var} {
7116    global ctext linknum curview $var maxrefs visiblerefs mainheadid
7117
7118    if {[catch {$ctext index $pos}]} {
7119        return 0
7120    }
7121    $ctext conf -state normal
7122    $ctext delete $pos "$pos lineend"
7123    set tags {}
7124    foreach id $ids {
7125        foreach tag [set $var\($id\)] {
7126            lappend tags [list $tag $id]
7127        }
7128    }
7129
7130    set sep {}
7131    set tags [lsort -index 0 -decreasing $tags]
7132    set nutags 0
7133
7134    if {[llength $tags] > $maxrefs} {
7135        # If we are displaying heads, and there are too many,
7136        # see if there are some important heads to display.
7137        # Currently that are the current head and heads listed in $visiblerefs option
7138        set itags {}
7139        if {$var eq "idheads"} {
7140            set utags {}
7141            foreach ti $tags {
7142                set hname [lindex $ti 0]
7143                set id [lindex $ti 1]
7144                if {([lsearch -exact $visiblerefs $hname] != -1 || $id eq $mainheadid) &&
7145                    [llength $itags] < $maxrefs} {
7146                    lappend itags $ti
7147                } else {
7148                    lappend utags $ti
7149                }
7150            }
7151            set tags $utags
7152        }
7153        if {$itags ne {}} {
7154            set str [mc "and many more"]
7155            set sep " "
7156        } else {
7157            set str [mc "many"]
7158        }
7159        $ctext insert $pos "$str ([llength $tags])"
7160        set nutags [llength $tags]
7161        set tags $itags
7162    }
7163
7164    foreach ti $tags {
7165        set id [lindex $ti 1]
7166        set lk link$linknum
7167        incr linknum
7168        $ctext tag delete $lk
7169        $ctext insert $pos $sep
7170        $ctext insert $pos [lindex $ti 0] $lk
7171        setlink $id $lk
7172        set sep ", "
7173    }
7174    $ctext tag add wwrap "$pos linestart" "$pos lineend"
7175    $ctext conf -state disabled
7176    return [expr {[llength $tags] + $nutags}]
7177}
7178
7179# called when we have finished computing the nearby tags
7180proc dispneartags {delay} {
7181    global selectedline currentid showneartags tagphase
7182
7183    if {$selectedline eq {} || !$showneartags} return
7184    after cancel dispnexttag
7185    if {$delay} {
7186        after 200 dispnexttag
7187        set tagphase -1
7188    } else {
7189        after idle dispnexttag
7190        set tagphase 0
7191    }
7192}
7193
7194proc dispnexttag {} {
7195    global selectedline currentid showneartags tagphase ctext
7196
7197    if {$selectedline eq {} || !$showneartags} return
7198    switch -- $tagphase {
7199        0 {
7200            set dtags [desctags $currentid]
7201            if {$dtags ne {}} {
7202                appendrefs precedes $dtags idtags
7203            }
7204        }
7205        1 {
7206            set atags [anctags $currentid]
7207            if {$atags ne {}} {
7208                appendrefs follows $atags idtags
7209            }
7210        }
7211        2 {
7212            set dheads [descheads $currentid]
7213            if {$dheads ne {}} {
7214                if {[appendrefs branch $dheads idheads] > 1
7215                    && [$ctext get "branch -3c"] eq "h"} {
7216                    # turn "Branch" into "Branches"
7217                    $ctext conf -state normal
7218                    $ctext insert "branch -2c" "es"
7219                    $ctext conf -state disabled
7220                }
7221            }
7222        }
7223    }
7224    if {[incr tagphase] <= 2} {
7225        after idle dispnexttag
7226    }
7227}
7228
7229proc make_secsel {id} {
7230    global linehtag linentag linedtag canv canv2 canv3
7231
7232    if {![info exists linehtag($id)]} return
7233    $canv delete secsel
7234    set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
7235               -tags secsel -fill [$canv cget -selectbackground]]
7236    $canv lower $t
7237    $canv2 delete secsel
7238    set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
7239               -tags secsel -fill [$canv2 cget -selectbackground]]
7240    $canv2 lower $t
7241    $canv3 delete secsel
7242    set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
7243               -tags secsel -fill [$canv3 cget -selectbackground]]
7244    $canv3 lower $t
7245}
7246
7247proc make_idmark {id} {
7248    global linehtag canv fgcolor
7249
7250    if {![info exists linehtag($id)]} return
7251    $canv delete markid
7252    set t [eval $canv create rect [$canv bbox $linehtag($id)] \
7253               -tags markid -outline $fgcolor]
7254    $canv raise $t
7255}
7256
7257proc selectline {l isnew {desired_loc {}} {switch_to_patch 0}} {
7258    global canv ctext commitinfo selectedline
7259    global canvy0 linespc parents children curview
7260    global currentid sha1entry
7261    global commentend idtags linknum
7262    global mergemax numcommits pending_select
7263    global cmitmode showneartags allcommits
7264    global targetrow targetid lastscrollrows
7265    global autoselect autosellen jump_to_here
7266    global vinlinediff
7267
7268    unset -nocomplain pending_select
7269    $canv delete hover
7270    normalline
7271    unsel_reflist
7272    stopfinding
7273    if {$l < 0 || $l >= $numcommits} return
7274    set id [commitonrow $l]
7275    set targetid $id
7276    set targetrow $l
7277    set selectedline $l
7278    set currentid $id
7279    if {$lastscrollrows < $numcommits} {
7280        setcanvscroll
7281    }
7282
7283    if {$cmitmode ne "patch" && $switch_to_patch} {
7284        set cmitmode "patch"
7285    }
7286
7287    set y [expr {$canvy0 + $l * $linespc}]
7288    set ymax [lindex [$canv cget -scrollregion] 3]
7289    set ytop [expr {$y - $linespc - 1}]
7290    set ybot [expr {$y + $linespc + 1}]
7291    set wnow [$canv yview]
7292    set wtop [expr {[lindex $wnow 0] * $ymax}]
7293    set wbot [expr {[lindex $wnow 1] * $ymax}]
7294    set wh [expr {$wbot - $wtop}]
7295    set newtop $wtop
7296    if {$ytop < $wtop} {
7297        if {$ybot < $wtop} {
7298            set newtop [expr {$y - $wh / 2.0}]
7299        } else {
7300            set newtop $ytop
7301            if {$newtop > $wtop - $linespc} {
7302                set newtop [expr {$wtop - $linespc}]
7303            }
7304        }
7305    } elseif {$ybot > $wbot} {
7306        if {$ytop > $wbot} {
7307            set newtop [expr {$y - $wh / 2.0}]
7308        } else {
7309            set newtop [expr {$ybot - $wh}]
7310            if {$newtop < $wtop + $linespc} {
7311                set newtop [expr {$wtop + $linespc}]
7312            }
7313        }
7314    }
7315    if {$newtop != $wtop} {
7316        if {$newtop < 0} {
7317            set newtop 0
7318        }
7319        allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7320        drawvisible
7321    }
7322
7323    make_secsel $id
7324
7325    if {$isnew} {
7326        addtohistory [list selbyid $id 0] savecmitpos
7327    }
7328
7329    $sha1entry delete 0 end
7330    $sha1entry insert 0 $id
7331    if {$autoselect} {
7332        $sha1entry selection range 0 $autosellen
7333    }
7334    rhighlight_sel $id
7335
7336    $ctext conf -state normal
7337    clear_ctext
7338    set linknum 0
7339    if {![info exists commitinfo($id)]} {
7340        getcommit $id
7341    }
7342    set info $commitinfo($id)
7343    set date [formatdate [lindex $info 2]]
7344    $ctext insert end "[mc "Author"]: [lindex $info 1]  $date\n"
7345    set date [formatdate [lindex $info 4]]
7346    $ctext insert end "[mc "Committer"]: [lindex $info 3]  $date\n"
7347    if {[info exists idtags($id)]} {
7348        $ctext insert end [mc "Tags:"]
7349        foreach tag $idtags($id) {
7350            $ctext insert end " $tag"
7351        }
7352        $ctext insert end "\n"
7353    }
7354
7355    set headers {}
7356    set olds $parents($curview,$id)
7357    if {[llength $olds] > 1} {
7358        set np 0
7359        foreach p $olds {
7360            if {$np >= $mergemax} {
7361                set tag mmax
7362            } else {
7363                set tag m$np
7364            }
7365            $ctext insert end "[mc "Parent"]: " $tag
7366            appendwithlinks [commit_descriptor $p] {}
7367            incr np
7368        }
7369    } else {
7370        foreach p $olds {
7371            append headers "[mc "Parent"]: [commit_descriptor $p]"
7372        }
7373    }
7374
7375    foreach c $children($curview,$id) {
7376        append headers "[mc "Child"]:  [commit_descriptor $c]"
7377    }
7378
7379    # make anything that looks like a SHA1 ID be a clickable link
7380    appendwithlinks $headers {}
7381    if {$showneartags} {
7382        if {![info exists allcommits]} {
7383            getallcommits
7384        }
7385        $ctext insert end "[mc "Branch"]: "
7386        $ctext mark set branch "end -1c"
7387        $ctext mark gravity branch left
7388        $ctext insert end "\n[mc "Follows"]: "
7389        $ctext mark set follows "end -1c"
7390        $ctext mark gravity follows left
7391        $ctext insert end "\n[mc "Precedes"]: "
7392        $ctext mark set precedes "end -1c"
7393        $ctext mark gravity precedes left
7394        $ctext insert end "\n"
7395        dispneartags 1
7396    }
7397    $ctext insert end "\n"
7398    set comment [lindex $info 5]
7399    if {[string first "\r" $comment] >= 0} {
7400        set comment [string map {"\r" "\n    "} $comment]
7401    }
7402    appendwithlinks $comment {comment}
7403
7404    $ctext tag remove found 1.0 end
7405    $ctext conf -state disabled
7406    set commentend [$ctext index "end - 1c"]
7407
7408    set jump_to_here $desired_loc
7409    init_flist [mc "Comments"]
7410    if {$cmitmode eq "tree"} {
7411        gettree $id
7412    } elseif {$vinlinediff($curview) == 1} {
7413        showinlinediff $id
7414    } elseif {[llength $olds] <= 1} {
7415        startdiff $id
7416    } else {
7417        mergediff $id
7418    }
7419}
7420
7421proc selfirstline {} {
7422    unmarkmatches
7423    selectline 0 1
7424}
7425
7426proc sellastline {} {
7427    global numcommits
7428    unmarkmatches
7429    set l [expr {$numcommits - 1}]
7430    selectline $l 1
7431}
7432
7433proc selnextline {dir} {
7434    global selectedline
7435    focus .
7436    if {$selectedline eq {}} return
7437    set l [expr {$selectedline + $dir}]
7438    unmarkmatches
7439    selectline $l 1
7440}
7441
7442proc selnextpage {dir} {
7443    global canv linespc selectedline numcommits
7444
7445    set lpp [expr {([winfo height $canv] - 2) / $linespc}]
7446    if {$lpp < 1} {
7447        set lpp 1
7448    }
7449    allcanvs yview scroll [expr {$dir * $lpp}] units
7450    drawvisible
7451    if {$selectedline eq {}} return
7452    set l [expr {$selectedline + $dir * $lpp}]
7453    if {$l < 0} {
7454        set l 0
7455    } elseif {$l >= $numcommits} {
7456        set l [expr $numcommits - 1]
7457    }
7458    unmarkmatches
7459    selectline $l 1
7460}
7461
7462proc unselectline {} {
7463    global selectedline currentid
7464
7465    set selectedline {}
7466    unset -nocomplain currentid
7467    allcanvs delete secsel
7468    rhighlight_none
7469}
7470
7471proc reselectline {} {
7472    global selectedline
7473
7474    if {$selectedline ne {}} {
7475        selectline $selectedline 0
7476    }
7477}
7478
7479proc addtohistory {cmd {saveproc {}}} {
7480    global history historyindex curview
7481
7482    unset_posvars
7483    save_position
7484    set elt [list $curview $cmd $saveproc {}]
7485    if {$historyindex > 0
7486        && [lindex $history [expr {$historyindex - 1}]] == $elt} {
7487        return
7488    }
7489
7490    if {$historyindex < [llength $history]} {
7491        set history [lreplace $history $historyindex end $elt]
7492    } else {
7493        lappend history $elt
7494    }
7495    incr historyindex
7496    if {$historyindex > 1} {
7497        .tf.bar.leftbut conf -state normal
7498    } else {
7499        .tf.bar.leftbut conf -state disabled
7500    }
7501    .tf.bar.rightbut conf -state disabled
7502}
7503
7504# save the scrolling position of the diff display pane
7505proc save_position {} {
7506    global historyindex history
7507
7508    if {$historyindex < 1} return
7509    set hi [expr {$historyindex - 1}]
7510    set fn [lindex $history $hi 2]
7511    if {$fn ne {}} {
7512        lset history $hi 3 [eval $fn]
7513    }
7514}
7515
7516proc unset_posvars {} {
7517    global last_posvars
7518
7519    if {[info exists last_posvars]} {
7520        foreach {var val} $last_posvars {
7521            global $var
7522            unset -nocomplain $var
7523        }
7524        unset last_posvars
7525    }
7526}
7527
7528proc godo {elt} {
7529    global curview last_posvars
7530
7531    set view [lindex $elt 0]
7532    set cmd [lindex $elt 1]
7533    set pv [lindex $elt 3]
7534    if {$curview != $view} {
7535        showview $view
7536    }
7537    unset_posvars
7538    foreach {var val} $pv {
7539        global $var
7540        set $var $val
7541    }
7542    set last_posvars $pv
7543    eval $cmd
7544}
7545
7546proc goback {} {
7547    global history historyindex
7548    focus .
7549
7550    if {$historyindex > 1} {
7551        save_position
7552        incr historyindex -1
7553        godo [lindex $history [expr {$historyindex - 1}]]
7554        .tf.bar.rightbut conf -state normal
7555    }
7556    if {$historyindex <= 1} {
7557        .tf.bar.leftbut conf -state disabled
7558    }
7559}
7560
7561proc goforw {} {
7562    global history historyindex
7563    focus .
7564
7565    if {$historyindex < [llength $history]} {
7566        save_position
7567        set cmd [lindex $history $historyindex]
7568        incr historyindex
7569        godo $cmd
7570        .tf.bar.leftbut conf -state normal
7571    }
7572    if {$historyindex >= [llength $history]} {
7573        .tf.bar.rightbut conf -state disabled
7574    }
7575}
7576
7577proc go_to_parent {i} {
7578    global parents curview targetid
7579    set ps $parents($curview,$targetid)
7580    if {[llength $ps] >= $i} {
7581        selbyid [lindex $ps [expr $i - 1]]
7582    }
7583}
7584
7585proc gettree {id} {
7586    global treefilelist treeidlist diffids diffmergeid treepending
7587    global nullid nullid2
7588
7589    set diffids $id
7590    unset -nocomplain diffmergeid
7591    if {![info exists treefilelist($id)]} {
7592        if {![info exists treepending]} {
7593            if {$id eq $nullid} {
7594                set cmd [list | git ls-files]
7595            } elseif {$id eq $nullid2} {
7596                set cmd [list | git ls-files --stage -t]
7597            } else {
7598                set cmd [list | git ls-tree -r $id]
7599            }
7600            if {[catch {set gtf [open $cmd r]}]} {
7601                return
7602            }
7603            set treepending $id
7604            set treefilelist($id) {}
7605            set treeidlist($id) {}
7606            fconfigure $gtf -blocking 0 -encoding binary
7607            filerun $gtf [list gettreeline $gtf $id]
7608        }
7609    } else {
7610        setfilelist $id
7611    }
7612}
7613
7614proc gettreeline {gtf id} {
7615    global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
7616
7617    set nl 0
7618    while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
7619        if {$diffids eq $nullid} {
7620            set fname $line
7621        } else {
7622            set i [string first "\t" $line]
7623            if {$i < 0} continue
7624            set fname [string range $line [expr {$i+1}] end]
7625            set line [string range $line 0 [expr {$i-1}]]
7626            if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7627            set sha1 [lindex $line 2]
7628            lappend treeidlist($id) $sha1
7629        }
7630        if {[string index $fname 0] eq "\""} {
7631            set fname [lindex $fname 0]
7632        }
7633        set fname [encoding convertfrom $fname]
7634        lappend treefilelist($id) $fname
7635    }
7636    if {![eof $gtf]} {
7637        return [expr {$nl >= 1000? 2: 1}]
7638    }
7639    close $gtf
7640    unset treepending
7641    if {$cmitmode ne "tree"} {
7642        if {![info exists diffmergeid]} {
7643            gettreediffs $diffids
7644        }
7645    } elseif {$id ne $diffids} {
7646        gettree $diffids
7647    } else {
7648        setfilelist $id
7649    }
7650    return 0
7651}
7652
7653proc showfile {f} {
7654    global treefilelist treeidlist diffids nullid nullid2
7655    global ctext_file_names ctext_file_lines
7656    global ctext commentend
7657
7658    set i [lsearch -exact $treefilelist($diffids) $f]
7659    if {$i < 0} {
7660        puts "oops, $f not in list for id $diffids"
7661        return
7662    }
7663    if {$diffids eq $nullid} {
7664        if {[catch {set bf [open $f r]} err]} {
7665            puts "oops, can't read $f: $err"
7666            return
7667        }
7668    } else {
7669        set blob [lindex $treeidlist($diffids) $i]
7670        if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7671            puts "oops, error reading blob $blob: $err"
7672            return
7673        }
7674    }
7675    fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7676    filerun $bf [list getblobline $bf $diffids]
7677    $ctext config -state normal
7678    clear_ctext $commentend
7679    lappend ctext_file_names $f
7680    lappend ctext_file_lines [lindex [split $commentend "."] 0]
7681    $ctext insert end "\n"
7682    $ctext insert end "$f\n" filesep
7683    $ctext config -state disabled
7684    $ctext yview $commentend
7685    settabs 0
7686}
7687
7688proc getblobline {bf id} {
7689    global diffids cmitmode ctext
7690
7691    if {$id ne $diffids || $cmitmode ne "tree"} {
7692        catch {close $bf}
7693        return 0
7694    }
7695    $ctext config -state normal
7696    set nl 0
7697    while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7698        $ctext insert end "$line\n"
7699    }
7700    if {[eof $bf]} {
7701        global jump_to_here ctext_file_names commentend
7702
7703        # delete last newline
7704        $ctext delete "end - 2c" "end - 1c"
7705        close $bf
7706        if {$jump_to_here ne {} &&
7707            [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7708            set lnum [expr {[lindex $jump_to_here 1] +
7709                            [lindex [split $commentend .] 0]}]
7710            mark_ctext_line $lnum
7711        }
7712        $ctext config -state disabled
7713        return 0
7714    }
7715    $ctext config -state disabled
7716    return [expr {$nl >= 1000? 2: 1}]
7717}
7718
7719proc mark_ctext_line {lnum} {
7720    global ctext markbgcolor
7721
7722    $ctext tag delete omark
7723    $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7724    $ctext tag conf omark -background $markbgcolor
7725    $ctext see $lnum.0
7726}
7727
7728proc mergediff {id} {
7729    global diffmergeid
7730    global diffids treediffs
7731    global parents curview
7732
7733    set diffmergeid $id
7734    set diffids $id
7735    set treediffs($id) {}
7736    set np [llength $parents($curview,$id)]
7737    settabs $np
7738    getblobdiffs $id
7739}
7740
7741proc startdiff {ids} {
7742    global treediffs diffids treepending diffmergeid nullid nullid2
7743
7744    settabs 1
7745    set diffids $ids
7746    unset -nocomplain diffmergeid
7747    if {![info exists treediffs($ids)] ||
7748        [lsearch -exact $ids $nullid] >= 0 ||
7749        [lsearch -exact $ids $nullid2] >= 0} {
7750        if {![info exists treepending]} {
7751            gettreediffs $ids
7752        }
7753    } else {
7754        addtocflist $ids
7755    }
7756}
7757
7758proc showinlinediff {ids} {
7759    global commitinfo commitdata ctext
7760    global treediffs
7761
7762    set info $commitinfo($ids)
7763    set diff [lindex $info 7]
7764    set difflines [split $diff "\n"]
7765
7766    initblobdiffvars
7767    set treediff {}
7768
7769    set inhdr 0
7770    foreach line $difflines {
7771        if {![string compare -length 5 "diff " $line]} {
7772            set inhdr 1
7773        } elseif {$inhdr && ![string compare -length 4 "+++ " $line]} {
7774            # offset also accounts for the b/ prefix
7775            lappend treediff [string range $line 6 end]
7776            set inhdr 0
7777        }
7778    }
7779
7780    set treediffs($ids) $treediff
7781    add_flist $treediff
7782
7783    $ctext conf -state normal
7784    foreach line $difflines {
7785        parseblobdiffline $ids $line
7786    }
7787    maybe_scroll_ctext 1
7788    $ctext conf -state disabled
7789}
7790
7791# If the filename (name) is under any of the passed filter paths
7792# then return true to include the file in the listing.
7793proc path_filter {filter name} {
7794    set worktree [gitworktree]
7795    foreach p $filter {
7796        set fq_p [file normalize $p]
7797        set fq_n [file normalize [file join $worktree $name]]
7798        if {[string match [file normalize $fq_p]* $fq_n]} {
7799            return 1
7800        }
7801    }
7802    return 0
7803}
7804
7805proc addtocflist {ids} {
7806    global treediffs
7807
7808    add_flist $treediffs($ids)
7809    getblobdiffs $ids
7810}
7811
7812proc diffcmd {ids flags} {
7813    global log_showroot nullid nullid2 git_version
7814
7815    set i [lsearch -exact $ids $nullid]
7816    set j [lsearch -exact $ids $nullid2]
7817    if {$i >= 0} {
7818        if {[llength $ids] > 1 && $j < 0} {
7819            # comparing working directory with some specific revision
7820            set cmd [concat | git diff-index $flags]
7821            if {$i == 0} {
7822                lappend cmd -R [lindex $ids 1]
7823            } else {
7824                lappend cmd [lindex $ids 0]
7825            }
7826        } else {
7827            # comparing working directory with index
7828            set cmd [concat | git diff-files $flags]
7829            if {$j == 1} {
7830                lappend cmd -R
7831            }
7832        }
7833    } elseif {$j >= 0} {
7834        if {[package vcompare $git_version "1.7.2"] >= 0} {
7835            set flags "$flags --ignore-submodules=dirty"
7836        }
7837        set cmd [concat | git diff-index --cached $flags]
7838        if {[llength $ids] > 1} {
7839            # comparing index with specific revision
7840            if {$j == 0} {
7841                lappend cmd -R [lindex $ids 1]
7842            } else {
7843                lappend cmd [lindex $ids 0]
7844            }
7845        } else {
7846            # comparing index with HEAD
7847            lappend cmd HEAD
7848        }
7849    } else {
7850        if {$log_showroot} {
7851            lappend flags --root
7852        }
7853        set cmd [concat | git diff-tree -r $flags $ids]
7854    }
7855    return $cmd
7856}
7857
7858proc gettreediffs {ids} {
7859    global treediff treepending limitdiffs vfilelimit curview
7860
7861    set cmd [diffcmd $ids {--no-commit-id}]
7862    if {$limitdiffs && $vfilelimit($curview) ne {}} {
7863            set cmd [concat $cmd -- $vfilelimit($curview)]
7864    }
7865    if {[catch {set gdtf [open $cmd r]}]} return
7866
7867    set treepending $ids
7868    set treediff {}
7869    fconfigure $gdtf -blocking 0 -encoding binary
7870    filerun $gdtf [list gettreediffline $gdtf $ids]
7871}
7872
7873proc gettreediffline {gdtf ids} {
7874    global treediff treediffs treepending diffids diffmergeid
7875    global cmitmode vfilelimit curview limitdiffs perfile_attrs
7876
7877    set nr 0
7878    set sublist {}
7879    set max 1000
7880    if {$perfile_attrs} {
7881        # cache_gitattr is slow, and even slower on win32 where we
7882        # have to invoke it for only about 30 paths at a time
7883        set max 500
7884        if {[tk windowingsystem] == "win32"} {
7885            set max 120
7886        }
7887    }
7888    while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7889        set i [string first "\t" $line]
7890        if {$i >= 0} {
7891            set file [string range $line [expr {$i+1}] end]
7892            if {[string index $file 0] eq "\""} {
7893                set file [lindex $file 0]
7894            }
7895            set file [encoding convertfrom $file]
7896            if {$file ne [lindex $treediff end]} {
7897                lappend treediff $file
7898                lappend sublist $file
7899            }
7900        }
7901    }
7902    if {$perfile_attrs} {
7903        cache_gitattr encoding $sublist
7904    }
7905    if {![eof $gdtf]} {
7906        return [expr {$nr >= $max? 2: 1}]
7907    }
7908    close $gdtf
7909    set treediffs($ids) $treediff
7910    unset treepending
7911    if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7912        gettree $diffids
7913    } elseif {$ids != $diffids} {
7914        if {![info exists diffmergeid]} {
7915            gettreediffs $diffids
7916        }
7917    } else {
7918        addtocflist $ids
7919    }
7920    return 0
7921}
7922
7923# empty string or positive integer
7924proc diffcontextvalidate {v} {
7925    return [regexp {^(|[1-9][0-9]*)$} $v]
7926}
7927
7928proc diffcontextchange {n1 n2 op} {
7929    global diffcontextstring diffcontext
7930
7931    if {[string is integer -strict $diffcontextstring]} {
7932        if {$diffcontextstring >= 0} {
7933            set diffcontext $diffcontextstring
7934            reselectline
7935        }
7936    }
7937}
7938
7939proc changeignorespace {} {
7940    reselectline
7941}
7942
7943proc changeworddiff {name ix op} {
7944    reselectline
7945}
7946
7947proc initblobdiffvars {} {
7948    global diffencoding targetline diffnparents
7949    global diffinhdr currdiffsubmod diffseehere
7950    set targetline {}
7951    set diffnparents 0
7952    set diffinhdr 0
7953    set diffencoding [get_path_encoding {}]
7954    set currdiffsubmod ""
7955    set diffseehere -1
7956}
7957
7958proc getblobdiffs {ids} {
7959    global blobdifffd diffids env
7960    global treediffs
7961    global diffcontext
7962    global ignorespace
7963    global worddiff
7964    global limitdiffs vfilelimit curview
7965    global git_version
7966
7967    set textconv {}
7968    if {[package vcompare $git_version "1.6.1"] >= 0} {
7969        set textconv "--textconv"
7970    }
7971    set submodule {}
7972    if {[package vcompare $git_version "1.6.6"] >= 0} {
7973        set submodule "--submodule"
7974    }
7975    set cmd [diffcmd $ids "-p $textconv $submodule  -C --cc --no-commit-id -U$diffcontext"]
7976    if {$ignorespace} {
7977        append cmd " -w"
7978    }
7979    if {$worddiff ne [mc "Line diff"]} {
7980        append cmd " --word-diff=porcelain"
7981    }
7982    if {$limitdiffs && $vfilelimit($curview) ne {}} {
7983        set cmd [concat $cmd -- $vfilelimit($curview)]
7984    }
7985    if {[catch {set bdf [open $cmd r]} err]} {
7986        error_popup [mc "Error getting diffs: %s" $err]
7987        return
7988    }
7989    fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
7990    set blobdifffd($ids) $bdf
7991    initblobdiffvars
7992    filerun $bdf [list getblobdiffline $bdf $diffids]
7993}
7994
7995proc savecmitpos {} {
7996    global ctext cmitmode
7997
7998    if {$cmitmode eq "tree"} {
7999        return {}
8000    }
8001    return [list target_scrollpos [$ctext index @0,0]]
8002}
8003
8004proc savectextpos {} {
8005    global ctext
8006
8007    return [list target_scrollpos [$ctext index @0,0]]
8008}
8009
8010proc maybe_scroll_ctext {ateof} {
8011    global ctext target_scrollpos
8012
8013    if {![info exists target_scrollpos]} return
8014    if {!$ateof} {
8015        set nlines [expr {[winfo height $ctext]
8016                          / [font metrics textfont -linespace]}]
8017        if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
8018    }
8019    $ctext yview $target_scrollpos
8020    unset target_scrollpos
8021}
8022
8023proc setinlist {var i val} {
8024    global $var
8025
8026    while {[llength [set $var]] < $i} {
8027        lappend $var {}
8028    }
8029    if {[llength [set $var]] == $i} {
8030        lappend $var $val
8031    } else {
8032        lset $var $i $val
8033    }
8034}
8035
8036proc makediffhdr {fname ids} {
8037    global ctext curdiffstart treediffs diffencoding
8038    global ctext_file_names jump_to_here targetline diffline
8039
8040    set fname [encoding convertfrom $fname]
8041    set diffencoding [get_path_encoding $fname]
8042    set i [lsearch -exact $treediffs($ids) $fname]
8043    if {$i >= 0} {
8044        setinlist difffilestart $i $curdiffstart
8045    }
8046    lset ctext_file_names end $fname
8047    set l [expr {(78 - [string length $fname]) / 2}]
8048    set pad [string range "----------------------------------------" 1 $l]
8049    $ctext insert $curdiffstart "$pad $fname $pad" filesep
8050    set targetline {}
8051    if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
8052        set targetline [lindex $jump_to_here 1]
8053    }
8054    set diffline 0
8055}
8056
8057proc blobdiffmaybeseehere {ateof} {
8058    global diffseehere
8059    if {$diffseehere >= 0} {
8060        mark_ctext_line [lindex [split $diffseehere .] 0]
8061    }
8062    maybe_scroll_ctext $ateof
8063}
8064
8065proc getblobdiffline {bdf ids} {
8066    global diffids blobdifffd
8067    global ctext
8068
8069    set nr 0
8070    $ctext conf -state normal
8071    while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
8072        if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
8073            catch {close $bdf}
8074            return 0
8075        }
8076        parseblobdiffline $ids $line
8077    }
8078    $ctext conf -state disabled
8079    blobdiffmaybeseehere [eof $bdf]
8080    if {[eof $bdf]} {
8081        catch {close $bdf}
8082        return 0
8083    }
8084    return [expr {$nr >= 1000? 2: 1}]
8085}
8086
8087proc parseblobdiffline {ids line} {
8088    global ctext curdiffstart
8089    global diffnexthead diffnextnote difffilestart
8090    global ctext_file_names ctext_file_lines
8091    global diffinhdr treediffs mergemax diffnparents
8092    global diffencoding jump_to_here targetline diffline currdiffsubmod
8093    global worddiff diffseehere
8094
8095    if {![string compare -length 5 "diff " $line]} {
8096        if {![regexp {^diff (--cc|--git) } $line m type]} {
8097            set line [encoding convertfrom $line]
8098            $ctext insert end "$line\n" hunksep
8099            continue
8100        }
8101        # start of a new file
8102        set diffinhdr 1
8103        $ctext insert end "\n"
8104        set curdiffstart [$ctext index "end - 1c"]
8105        lappend ctext_file_names ""
8106        lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8107        $ctext insert end "\n" filesep
8108
8109        if {$type eq "--cc"} {
8110            # start of a new file in a merge diff
8111            set fname [string range $line 10 end]
8112            if {[lsearch -exact $treediffs($ids) $fname] < 0} {
8113                lappend treediffs($ids) $fname
8114                add_flist [list $fname]
8115            }
8116
8117        } else {
8118            set line [string range $line 11 end]
8119            # If the name hasn't changed the length will be odd,
8120            # the middle char will be a space, and the two bits either
8121            # side will be a/name and b/name, or "a/name" and "b/name".
8122            # If the name has changed we'll get "rename from" and
8123            # "rename to" or "copy from" and "copy to" lines following
8124            # this, and we'll use them to get the filenames.
8125            # This complexity is necessary because spaces in the
8126            # filename(s) don't get escaped.
8127            set l [string length $line]
8128            set i [expr {$l / 2}]
8129            if {!(($l & 1) && [string index $line $i] eq " " &&
8130                  [string range $line 2 [expr {$i - 1}]] eq \
8131                      [string range $line [expr {$i + 3}] end])} {
8132                return
8133            }
8134            # unescape if quoted and chop off the a/ from the front
8135            if {[string index $line 0] eq "\""} {
8136                set fname [string range [lindex $line 0] 2 end]
8137            } else {
8138                set fname [string range $line 2 [expr {$i - 1}]]
8139            }
8140        }
8141        makediffhdr $fname $ids
8142
8143    } elseif {![string compare -length 16 "* Unmerged path " $line]} {
8144        set fname [encoding convertfrom [string range $line 16 end]]
8145        $ctext insert end "\n"
8146        set curdiffstart [$ctext index "end - 1c"]
8147        lappend ctext_file_names $fname
8148        lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8149        $ctext insert end "$line\n" filesep
8150        set i [lsearch -exact $treediffs($ids) $fname]
8151        if {$i >= 0} {
8152            setinlist difffilestart $i $curdiffstart
8153        }
8154
8155    } elseif {![string compare -length 2 "@@" $line]} {
8156        regexp {^@@+} $line ats
8157        set line [encoding convertfrom $diffencoding $line]
8158        $ctext insert end "$line\n" hunksep
8159        if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
8160            set diffline $nl
8161        }
8162        set diffnparents [expr {[string length $ats] - 1}]
8163        set diffinhdr 0
8164
8165    } elseif {![string compare -length 10 "Submodule " $line]} {
8166        # start of a new submodule
8167        if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
8168            set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
8169        } else {
8170            set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
8171        }
8172        if {$currdiffsubmod != $fname} {
8173            $ctext insert end "\n";     # Add newline after commit message
8174        }
8175        set curdiffstart [$ctext index "end - 1c"]
8176        lappend ctext_file_names ""
8177        if {$currdiffsubmod != $fname} {
8178            lappend ctext_file_lines $fname
8179            makediffhdr $fname $ids
8180            set currdiffsubmod $fname
8181            $ctext insert end "\n$line\n" filesep
8182        } else {
8183            $ctext insert end "$line\n" filesep
8184        }
8185    } elseif {![string compare -length 3 "  >" $line]} {
8186        set $currdiffsubmod ""
8187        set line [encoding convertfrom $diffencoding $line]
8188        $ctext insert end "$line\n" dresult
8189    } elseif {![string compare -length 3 "  <" $line]} {
8190        set $currdiffsubmod ""
8191        set line [encoding convertfrom $diffencoding $line]
8192        $ctext insert end "$line\n" d0
8193    } elseif {$diffinhdr} {
8194        if {![string compare -length 12 "rename from " $line]} {
8195            set fname [string range $line [expr 6 + [string first " from " $line] ] end]
8196            if {[string index $fname 0] eq "\""} {
8197                set fname [lindex $fname 0]
8198            }
8199            set fname [encoding convertfrom $fname]
8200            set i [lsearch -exact $treediffs($ids) $fname]
8201            if {$i >= 0} {
8202                setinlist difffilestart $i $curdiffstart
8203            }
8204        } elseif {![string compare -length 10 $line "rename to "] ||
8205                  ![string compare -length 8 $line "copy to "]} {
8206            set fname [string range $line [expr 4 + [string first " to " $line] ] end]
8207            if {[string index $fname 0] eq "\""} {
8208                set fname [lindex $fname 0]
8209            }
8210            makediffhdr $fname $ids
8211        } elseif {[string compare -length 3 $line "---"] == 0} {
8212            # do nothing
8213            return
8214        } elseif {[string compare -length 3 $line "+++"] == 0} {
8215            set diffinhdr 0
8216            return
8217        }
8218        $ctext insert end "$line\n" filesep
8219
8220    } else {
8221        set line [string map {\x1A ^Z} \
8222                      [encoding convertfrom $diffencoding $line]]
8223        # parse the prefix - one ' ', '-' or '+' for each parent
8224        set prefix [string range $line 0 [expr {$diffnparents - 1}]]
8225        set tag [expr {$diffnparents > 1? "m": "d"}]
8226        set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
8227        set words_pre_markup ""
8228        set words_post_markup ""
8229        if {[string trim $prefix " -+"] eq {}} {
8230            # prefix only has " ", "-" and "+" in it: normal diff line
8231            set num [string first "-" $prefix]
8232            if {$dowords} {
8233                set line [string range $line 1 end]
8234            }
8235            if {$num >= 0} {
8236                # removed line, first parent with line is $num
8237                if {$num >= $mergemax} {
8238                    set num "max"
8239                }
8240                if {$dowords && $worddiff eq [mc "Markup words"]} {
8241                    $ctext insert end "\[-$line-\]" $tag$num
8242                } else {
8243                    $ctext insert end "$line" $tag$num
8244                }
8245                if {!$dowords} {
8246                    $ctext insert end "\n" $tag$num
8247                }
8248            } else {
8249                set tags {}
8250                if {[string first "+" $prefix] >= 0} {
8251                    # added line
8252                    lappend tags ${tag}result
8253                    if {$diffnparents > 1} {
8254                        set num [string first " " $prefix]
8255                        if {$num >= 0} {
8256                            if {$num >= $mergemax} {
8257                                set num "max"
8258                            }
8259                            lappend tags m$num
8260                        }
8261                    }
8262                    set words_pre_markup "{+"
8263                    set words_post_markup "+}"
8264                }
8265                if {$targetline ne {}} {
8266                    if {$diffline == $targetline} {
8267                        set diffseehere [$ctext index "end - 1 chars"]
8268                        set targetline {}
8269                    } else {
8270                        incr diffline
8271                    }
8272                }
8273                if {$dowords && $worddiff eq [mc "Markup words"]} {
8274                    $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
8275                } else {
8276                    $ctext insert end "$line" $tags
8277                }
8278                if {!$dowords} {
8279                    $ctext insert end "\n" $tags
8280                }
8281            }
8282        } elseif {$dowords && $prefix eq "~"} {
8283            $ctext insert end "\n" {}
8284        } else {
8285            # "\ No newline at end of file",
8286            # or something else we don't recognize
8287            $ctext insert end "$line\n" hunksep
8288        }
8289    }
8290}
8291
8292proc changediffdisp {} {
8293    global ctext diffelide
8294
8295    $ctext tag conf d0 -elide [lindex $diffelide 0]
8296    $ctext tag conf dresult -elide [lindex $diffelide 1]
8297}
8298
8299proc highlightfile {cline} {
8300    global cflist cflist_top
8301
8302    if {![info exists cflist_top]} return
8303
8304    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
8305    $cflist tag add highlight $cline.0 "$cline.0 lineend"
8306    $cflist see $cline.0
8307    set cflist_top $cline
8308}
8309
8310proc highlightfile_for_scrollpos {topidx} {
8311    global cmitmode difffilestart
8312
8313    if {$cmitmode eq "tree"} return
8314    if {![info exists difffilestart]} return
8315
8316    set top [lindex [split $topidx .] 0]
8317    if {$difffilestart eq {} || $top < [lindex $difffilestart 0]} {
8318        highlightfile 0
8319    } else {
8320        highlightfile [expr {[bsearch $difffilestart $top] + 2}]
8321    }
8322}
8323
8324proc prevfile {} {
8325    global difffilestart ctext cmitmode
8326
8327    if {$cmitmode eq "tree"} return
8328    set prev 0.0
8329    set here [$ctext index @0,0]
8330    foreach loc $difffilestart {
8331        if {[$ctext compare $loc >= $here]} {
8332            $ctext yview $prev
8333            return
8334        }
8335        set prev $loc
8336    }
8337    $ctext yview $prev
8338}
8339
8340proc nextfile {} {
8341    global difffilestart ctext cmitmode
8342
8343    if {$cmitmode eq "tree"} return
8344    set here [$ctext index @0,0]
8345    foreach loc $difffilestart {
8346        if {[$ctext compare $loc > $here]} {
8347            $ctext yview $loc
8348            return
8349        }
8350    }
8351}
8352
8353proc clear_ctext {{first 1.0}} {
8354    global ctext smarktop smarkbot
8355    global ctext_file_names ctext_file_lines
8356    global pendinglinks
8357
8358    set l [lindex [split $first .] 0]
8359    if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
8360        set smarktop $l
8361    }
8362    if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
8363        set smarkbot $l
8364    }
8365    $ctext delete $first end
8366    if {$first eq "1.0"} {
8367        unset -nocomplain pendinglinks
8368    }
8369    set ctext_file_names {}
8370    set ctext_file_lines {}
8371}
8372
8373proc settabs {{firstab {}}} {
8374    global firsttabstop tabstop ctext have_tk85
8375
8376    if {$firstab ne {} && $have_tk85} {
8377        set firsttabstop $firstab
8378    }
8379    set w [font measure textfont "0"]
8380    if {$firsttabstop != 0} {
8381        $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
8382                               [expr {($firsttabstop + 2 * $tabstop) * $w}]]
8383    } elseif {$have_tk85 || $tabstop != 8} {
8384        $ctext conf -tabs [expr {$tabstop * $w}]
8385    } else {
8386        $ctext conf -tabs {}
8387    }
8388}
8389
8390proc incrsearch {name ix op} {
8391    global ctext searchstring searchdirn
8392
8393    if {[catch {$ctext index anchor}]} {
8394        # no anchor set, use start of selection, or of visible area
8395        set sel [$ctext tag ranges sel]
8396        if {$sel ne {}} {
8397            $ctext mark set anchor [lindex $sel 0]
8398        } elseif {$searchdirn eq "-forwards"} {
8399            $ctext mark set anchor @0,0
8400        } else {
8401            $ctext mark set anchor @0,[winfo height $ctext]
8402        }
8403    }
8404    if {$searchstring ne {}} {
8405        set here [$ctext search -count mlen $searchdirn -- $searchstring anchor]
8406        if {$here ne {}} {
8407            $ctext see $here
8408            set mend "$here + $mlen c"
8409            $ctext tag remove sel 1.0 end
8410            $ctext tag add sel $here $mend
8411            suppress_highlighting_file_for_current_scrollpos
8412            highlightfile_for_scrollpos $here
8413        }
8414    }
8415    rehighlight_search_results
8416}
8417
8418proc dosearch {} {
8419    global sstring ctext searchstring searchdirn
8420
8421    focus $sstring
8422    $sstring icursor end
8423    set searchdirn -forwards
8424    if {$searchstring ne {}} {
8425        set sel [$ctext tag ranges sel]
8426        if {$sel ne {}} {
8427            set start "[lindex $sel 0] + 1c"
8428        } elseif {[catch {set start [$ctext index anchor]}]} {
8429            set start "@0,0"
8430        }
8431        set match [$ctext search -count mlen -- $searchstring $start]
8432        $ctext tag remove sel 1.0 end
8433        if {$match eq {}} {
8434            bell
8435            return
8436        }
8437        $ctext see $match
8438        suppress_highlighting_file_for_current_scrollpos
8439        highlightfile_for_scrollpos $match
8440        set mend "$match + $mlen c"
8441        $ctext tag add sel $match $mend
8442        $ctext mark unset anchor
8443        rehighlight_search_results
8444    }
8445}
8446
8447proc dosearchback {} {
8448    global sstring ctext searchstring searchdirn
8449
8450    focus $sstring
8451    $sstring icursor end
8452    set searchdirn -backwards
8453    if {$searchstring ne {}} {
8454        set sel [$ctext tag ranges sel]
8455        if {$sel ne {}} {
8456            set start [lindex $sel 0]
8457        } elseif {[catch {set start [$ctext index anchor]}]} {
8458            set start @0,[winfo height $ctext]
8459        }
8460        set match [$ctext search -backwards -count ml -- $searchstring $start]
8461        $ctext tag remove sel 1.0 end
8462        if {$match eq {}} {
8463            bell
8464            return
8465        }
8466        $ctext see $match
8467        suppress_highlighting_file_for_current_scrollpos
8468        highlightfile_for_scrollpos $match
8469        set mend "$match + $ml c"
8470        $ctext tag add sel $match $mend
8471        $ctext mark unset anchor
8472        rehighlight_search_results
8473    }
8474}
8475
8476proc rehighlight_search_results {} {
8477    global ctext searchstring
8478
8479    $ctext tag remove found 1.0 end
8480    $ctext tag remove currentsearchhit 1.0 end
8481
8482    if {$searchstring ne {}} {
8483        searchmarkvisible 1
8484    }
8485}
8486
8487proc searchmark {first last} {
8488    global ctext searchstring
8489
8490    set sel [$ctext tag ranges sel]
8491
8492    set mend $first.0
8493    while {1} {
8494        set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8495        if {$match eq {}} break
8496        set mend "$match + $mlen c"
8497        if {$sel ne {} && [$ctext compare $match == [lindex $sel 0]]} {
8498            $ctext tag add currentsearchhit $match $mend
8499        } else {
8500            $ctext tag add found $match $mend
8501        }
8502    }
8503}
8504
8505proc searchmarkvisible {doall} {
8506    global ctext smarktop smarkbot
8507
8508    set topline [lindex [split [$ctext index @0,0] .] 0]
8509    set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8510    if {$doall || $botline < $smarktop || $topline > $smarkbot} {
8511        # no overlap with previous
8512        searchmark $topline $botline
8513        set smarktop $topline
8514        set smarkbot $botline
8515    } else {
8516        if {$topline < $smarktop} {
8517            searchmark $topline [expr {$smarktop-1}]
8518            set smarktop $topline
8519        }
8520        if {$botline > $smarkbot} {
8521            searchmark [expr {$smarkbot+1}] $botline
8522            set smarkbot $botline
8523        }
8524    }
8525}
8526
8527proc suppress_highlighting_file_for_current_scrollpos {} {
8528    global ctext suppress_highlighting_file_for_this_scrollpos
8529
8530    set suppress_highlighting_file_for_this_scrollpos [$ctext index @0,0]
8531}
8532
8533proc scrolltext {f0 f1} {
8534    global searchstring cmitmode ctext
8535    global suppress_highlighting_file_for_this_scrollpos
8536
8537    set topidx [$ctext index @0,0]
8538    if {![info exists suppress_highlighting_file_for_this_scrollpos]
8539        || $topidx ne $suppress_highlighting_file_for_this_scrollpos} {
8540        highlightfile_for_scrollpos $topidx
8541    }
8542
8543    unset -nocomplain suppress_highlighting_file_for_this_scrollpos
8544
8545    .bleft.bottom.sb set $f0 $f1
8546    if {$searchstring ne {}} {
8547        searchmarkvisible 0
8548    }
8549}
8550
8551proc setcoords {} {
8552    global linespc charspc canvx0 canvy0
8553    global xspc1 xspc2 lthickness
8554
8555    set linespc [font metrics mainfont -linespace]
8556    set charspc [font measure mainfont "m"]
8557    set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8558    set canvx0 [expr {int(3 + 0.5 * $linespc)}]
8559    set lthickness [expr {int($linespc / 9) + 1}]
8560    set xspc1(0) $linespc
8561    set xspc2 $linespc
8562}
8563
8564proc redisplay {} {
8565    global canv
8566    global selectedline
8567
8568    set ymax [lindex [$canv cget -scrollregion] 3]
8569    if {$ymax eq {} || $ymax == 0} return
8570    set span [$canv yview]
8571    clear_display
8572    setcanvscroll
8573    allcanvs yview moveto [lindex $span 0]
8574    drawvisible
8575    if {$selectedline ne {}} {
8576        selectline $selectedline 0
8577        allcanvs yview moveto [lindex $span 0]
8578    }
8579}
8580
8581proc parsefont {f n} {
8582    global fontattr
8583
8584    set fontattr($f,family) [lindex $n 0]
8585    set s [lindex $n 1]
8586    if {$s eq {} || $s == 0} {
8587        set s 10
8588    } elseif {$s < 0} {
8589        set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
8590    }
8591    set fontattr($f,size) $s
8592    set fontattr($f,weight) normal
8593    set fontattr($f,slant) roman
8594    foreach style [lrange $n 2 end] {
8595        switch -- $style {
8596            "normal" -
8597            "bold"   {set fontattr($f,weight) $style}
8598            "roman" -
8599            "italic" {set fontattr($f,slant) $style}
8600        }
8601    }
8602}
8603
8604proc fontflags {f {isbold 0}} {
8605    global fontattr
8606
8607    return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8608                -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8609                -slant $fontattr($f,slant)]
8610}
8611
8612proc fontname {f} {
8613    global fontattr
8614
8615    set n [list $fontattr($f,family) $fontattr($f,size)]
8616    if {$fontattr($f,weight) eq "bold"} {
8617        lappend n "bold"
8618    }
8619    if {$fontattr($f,slant) eq "italic"} {
8620        lappend n "italic"
8621    }
8622    return $n
8623}
8624
8625proc incrfont {inc} {
8626    global mainfont textfont ctext canv cflist showrefstop
8627    global stopped entries fontattr
8628
8629    unmarkmatches
8630    set s $fontattr(mainfont,size)
8631    incr s $inc
8632    if {$s < 1} {
8633        set s 1
8634    }
8635    set fontattr(mainfont,size) $s
8636    font config mainfont -size $s
8637    font config mainfontbold -size $s
8638    set mainfont [fontname mainfont]
8639    set s $fontattr(textfont,size)
8640    incr s $inc
8641    if {$s < 1} {
8642        set s 1
8643    }
8644    set fontattr(textfont,size) $s
8645    font config textfont -size $s
8646    font config textfontbold -size $s
8647    set textfont [fontname textfont]
8648    setcoords
8649    settabs
8650    redisplay
8651}
8652
8653proc clearsha1 {} {
8654    global sha1entry sha1string
8655    if {[string length $sha1string] == 40} {
8656        $sha1entry delete 0 end
8657    }
8658}
8659
8660proc sha1change {n1 n2 op} {
8661    global sha1string currentid sha1but
8662    if {$sha1string == {}
8663        || ([info exists currentid] && $sha1string == $currentid)} {
8664        set state disabled
8665    } else {
8666        set state normal
8667    }
8668    if {[$sha1but cget -state] == $state} return
8669    if {$state == "normal"} {
8670        $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
8671    } else {
8672        $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
8673    }
8674}
8675
8676proc gotocommit {} {
8677    global sha1string tagids headids curview varcid
8678
8679    if {$sha1string == {}
8680        || ([info exists currentid] && $sha1string == $currentid)} return
8681    if {[info exists tagids($sha1string)]} {
8682        set id $tagids($sha1string)
8683    } elseif {[info exists headids($sha1string)]} {
8684        set id $headids($sha1string)
8685    } else {
8686        set id [string tolower $sha1string]
8687        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
8688            set matches [longid $id]
8689            if {$matches ne {}} {
8690                if {[llength $matches] > 1} {
8691                    error_popup [mc "Short SHA1 id %s is ambiguous" $id]
8692                    return
8693                }
8694                set id [lindex $matches 0]
8695            }
8696        } else {
8697            if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8698                error_popup [mc "Revision %s is not known" $sha1string]
8699                return
8700            }
8701        }
8702    }
8703    if {[commitinview $id $curview]} {
8704        selectline [rowofcommit $id] 1
8705        return
8706    }
8707    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
8708        set msg [mc "SHA1 id %s is not known" $sha1string]
8709    } else {
8710        set msg [mc "Revision %s is not in the current view" $sha1string]
8711    }
8712    error_popup $msg
8713}
8714
8715proc lineenter {x y id} {
8716    global hoverx hovery hoverid hovertimer
8717    global commitinfo canv
8718
8719    if {![info exists commitinfo($id)] && ![getcommit $id]} return
8720    set hoverx $x
8721    set hovery $y
8722    set hoverid $id
8723    if {[info exists hovertimer]} {
8724        after cancel $hovertimer
8725    }
8726    set hovertimer [after 500 linehover]
8727    $canv delete hover
8728}
8729
8730proc linemotion {x y id} {
8731    global hoverx hovery hoverid hovertimer
8732
8733    if {[info exists hoverid] && $id == $hoverid} {
8734        set hoverx $x
8735        set hovery $y
8736        if {[info exists hovertimer]} {
8737            after cancel $hovertimer
8738        }
8739        set hovertimer [after 500 linehover]
8740    }
8741}
8742
8743proc lineleave {id} {
8744    global hoverid hovertimer canv
8745
8746    if {[info exists hoverid] && $id == $hoverid} {
8747        $canv delete hover
8748        if {[info exists hovertimer]} {
8749            after cancel $hovertimer
8750            unset hovertimer
8751        }
8752        unset hoverid
8753    }
8754}
8755
8756proc linehover {} {
8757    global hoverx hovery hoverid hovertimer
8758    global canv linespc lthickness
8759    global linehoverbgcolor linehoverfgcolor linehoveroutlinecolor
8760
8761    global commitinfo
8762
8763    set text [lindex $commitinfo($hoverid) 0]
8764    set ymax [lindex [$canv cget -scrollregion] 3]
8765    if {$ymax == {}} return
8766    set yfrac [lindex [$canv yview] 0]
8767    set x [expr {$hoverx + 2 * $linespc}]
8768    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8769    set x0 [expr {$x - 2 * $lthickness}]
8770    set y0 [expr {$y - 2 * $lthickness}]
8771    set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
8772    set y1 [expr {$y + $linespc + 2 * $lthickness}]
8773    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8774               -fill $linehoverbgcolor -outline $linehoveroutlinecolor \
8775               -width 1 -tags hover]
8776    $canv raise $t
8777    set t [$canv create text $x $y -anchor nw -text $text -tags hover \
8778               -font mainfont -fill $linehoverfgcolor]
8779    $canv raise $t
8780}
8781
8782proc clickisonarrow {id y} {
8783    global lthickness
8784
8785    set ranges [rowranges $id]
8786    set thresh [expr {2 * $lthickness + 6}]
8787    set n [expr {[llength $ranges] - 1}]
8788    for {set i 1} {$i < $n} {incr i} {
8789        set row [lindex $ranges $i]
8790        if {abs([yc $row] - $y) < $thresh} {
8791            return $i
8792        }
8793    }
8794    return {}
8795}
8796
8797proc arrowjump {id n y} {
8798    global canv
8799
8800    # 1 <-> 2, 3 <-> 4, etc...
8801    set n [expr {(($n - 1) ^ 1) + 1}]
8802    set row [lindex [rowranges $id] $n]
8803    set yt [yc $row]
8804    set ymax [lindex [$canv cget -scrollregion] 3]
8805    if {$ymax eq {} || $ymax <= 0} return
8806    set view [$canv yview]
8807    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8808    set yfrac [expr {$yt / $ymax - $yspan / 2}]
8809    if {$yfrac < 0} {
8810        set yfrac 0
8811    }
8812    allcanvs yview moveto $yfrac
8813}
8814
8815proc lineclick {x y id isnew} {
8816    global ctext commitinfo children canv thickerline curview
8817
8818    if {![info exists commitinfo($id)] && ![getcommit $id]} return
8819    unmarkmatches
8820    unselectline
8821    normalline
8822    $canv delete hover
8823    # draw this line thicker than normal
8824    set thickerline $id
8825    drawlines $id
8826    if {$isnew} {
8827        set ymax [lindex [$canv cget -scrollregion] 3]
8828        if {$ymax eq {}} return
8829        set yfrac [lindex [$canv yview] 0]
8830        set y [expr {$y + $yfrac * $ymax}]
8831    }
8832    set dirn [clickisonarrow $id $y]
8833    if {$dirn ne {}} {
8834        arrowjump $id $dirn $y
8835        return
8836    }
8837
8838    if {$isnew} {
8839        addtohistory [list lineclick $x $y $id 0] savectextpos
8840    }
8841    # fill the details pane with info about this line
8842    $ctext conf -state normal
8843    clear_ctext
8844    settabs 0
8845    $ctext insert end "[mc "Parent"]:\t"
8846    $ctext insert end $id link0
8847    setlink $id link0
8848    set info $commitinfo($id)
8849    $ctext insert end "\n\t[lindex $info 0]\n"
8850    $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8851    set date [formatdate [lindex $info 2]]
8852    $ctext insert end "\t[mc "Date"]:\t$date\n"
8853    set kids $children($curview,$id)
8854    if {$kids ne {}} {
8855        $ctext insert end "\n[mc "Children"]:"
8856        set i 0
8857        foreach child $kids {
8858            incr i
8859            if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8860            set info $commitinfo($child)
8861            $ctext insert end "\n\t"
8862            $ctext insert end $child link$i
8863            setlink $child link$i
8864            $ctext insert end "\n\t[lindex $info 0]"
8865            $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8866            set date [formatdate [lindex $info 2]]
8867            $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8868        }
8869    }
8870    maybe_scroll_ctext 1
8871    $ctext conf -state disabled
8872    init_flist {}
8873}
8874
8875proc normalline {} {
8876    global thickerline
8877    if {[info exists thickerline]} {
8878        set id $thickerline
8879        unset thickerline
8880        drawlines $id
8881    }
8882}
8883
8884proc selbyid {id {isnew 1}} {
8885    global curview
8886    if {[commitinview $id $curview]} {
8887        selectline [rowofcommit $id] $isnew
8888    }
8889}
8890
8891proc mstime {} {
8892    global startmstime
8893    if {![info exists startmstime]} {
8894        set startmstime [clock clicks -milliseconds]
8895    }
8896    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8897}
8898
8899proc rowmenu {x y id} {
8900    global rowctxmenu selectedline rowmenuid curview
8901    global nullid nullid2 fakerowmenu mainhead markedid
8902
8903    stopfinding
8904    set rowmenuid $id
8905    if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8906        set state disabled
8907    } else {
8908        set state normal
8909    }
8910    if {[info exists markedid] && $markedid ne $id} {
8911        set mstate normal
8912    } else {
8913        set mstate disabled
8914    }
8915    if {$id ne $nullid && $id ne $nullid2} {
8916        set menu $rowctxmenu
8917        if {$mainhead ne {}} {
8918            $menu entryconfigure 8 -label [mc "Reset %s branch to here" $mainhead] -state normal
8919        } else {
8920            $menu entryconfigure 8 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8921        }
8922        $menu entryconfigure 10 -state $mstate
8923        $menu entryconfigure 11 -state $mstate
8924        $menu entryconfigure 12 -state $mstate
8925    } else {
8926        set menu $fakerowmenu
8927    }
8928    $menu entryconfigure [mca "Diff this -> selected"] -state $state
8929    $menu entryconfigure [mca "Diff selected -> this"] -state $state
8930    $menu entryconfigure [mca "Make patch"] -state $state
8931    $menu entryconfigure [mca "Diff this -> marked commit"] -state $mstate
8932    $menu entryconfigure [mca "Diff marked commit -> this"] -state $mstate
8933    tk_popup $menu $x $y
8934}
8935
8936proc markhere {} {
8937    global rowmenuid markedid canv
8938
8939    set markedid $rowmenuid
8940    make_idmark $markedid
8941}
8942
8943proc gotomark {} {
8944    global markedid
8945
8946    if {[info exists markedid]} {
8947        selbyid $markedid
8948    }
8949}
8950
8951proc replace_by_kids {l r} {
8952    global curview children
8953
8954    set id [commitonrow $r]
8955    set l [lreplace $l 0 0]
8956    foreach kid $children($curview,$id) {
8957        lappend l [rowofcommit $kid]
8958    }
8959    return [lsort -integer -decreasing -unique $l]
8960}
8961
8962proc find_common_desc {} {
8963    global markedid rowmenuid curview children
8964
8965    if {![info exists markedid]} return
8966    if {![commitinview $markedid $curview] ||
8967        ![commitinview $rowmenuid $curview]} return
8968    #set t1 [clock clicks -milliseconds]
8969    set l1 [list [rowofcommit $markedid]]
8970    set l2 [list [rowofcommit $rowmenuid]]
8971    while 1 {
8972        set r1 [lindex $l1 0]
8973        set r2 [lindex $l2 0]
8974        if {$r1 eq {} || $r2 eq {}} break
8975        if {$r1 == $r2} {
8976            selectline $r1 1
8977            break
8978        }
8979        if {$r1 > $r2} {
8980            set l1 [replace_by_kids $l1 $r1]
8981        } else {
8982            set l2 [replace_by_kids $l2 $r2]
8983        }
8984    }
8985    #set t2 [clock clicks -milliseconds]
8986    #puts "took [expr {$t2-$t1}]ms"
8987}
8988
8989proc compare_commits {} {
8990    global markedid rowmenuid curview children
8991
8992    if {![info exists markedid]} return
8993    if {![commitinview $markedid $curview]} return
8994    addtohistory [list do_cmp_commits $markedid $rowmenuid]
8995    do_cmp_commits $markedid $rowmenuid
8996}
8997
8998proc getpatchid {id} {
8999    global patchids
9000
9001    if {![info exists patchids($id)]} {
9002        set cmd [diffcmd [list $id] {-p --root}]
9003        # trim off the initial "|"
9004        set cmd [lrange $cmd 1 end]
9005        if {[catch {
9006            set x [eval exec $cmd | git patch-id]
9007            set patchids($id) [lindex $x 0]
9008        }]} {
9009            set patchids($id) "error"
9010        }
9011    }
9012    return $patchids($id)
9013}
9014
9015proc do_cmp_commits {a b} {
9016    global ctext curview parents children patchids commitinfo
9017
9018    $ctext conf -state normal
9019    clear_ctext
9020    init_flist {}
9021    for {set i 0} {$i < 100} {incr i} {
9022        set skipa 0
9023        set skipb 0
9024        if {[llength $parents($curview,$a)] > 1} {
9025            appendshortlink $a [mc "Skipping merge commit "] "\n"
9026            set skipa 1
9027        } else {
9028            set patcha [getpatchid $a]
9029        }
9030        if {[llength $parents($curview,$b)] > 1} {
9031            appendshortlink $b [mc "Skipping merge commit "] "\n"
9032            set skipb 1
9033        } else {
9034            set patchb [getpatchid $b]
9035        }
9036        if {!$skipa && !$skipb} {
9037            set heada [lindex $commitinfo($a) 0]
9038            set headb [lindex $commitinfo($b) 0]
9039            if {$patcha eq "error"} {
9040                appendshortlink $a [mc "Error getting patch ID for "] \
9041                    [mc " - stopping\n"]
9042                break
9043            }
9044            if {$patchb eq "error"} {
9045                appendshortlink $b [mc "Error getting patch ID for "] \
9046                    [mc " - stopping\n"]
9047                break
9048            }
9049            if {$patcha eq $patchb} {
9050                if {$heada eq $headb} {
9051                    appendshortlink $a [mc "Commit "]
9052                    appendshortlink $b " == " "  $heada\n"
9053                } else {
9054                    appendshortlink $a [mc "Commit "] "  $heada\n"
9055                    appendshortlink $b [mc " is the same patch as\n       "] \
9056                        "  $headb\n"
9057                }
9058                set skipa 1
9059                set skipb 1
9060            } else {
9061                $ctext insert end "\n"
9062                appendshortlink $a [mc "Commit "] "  $heada\n"
9063                appendshortlink $b [mc " differs from\n       "] \
9064                    "  $headb\n"
9065                $ctext insert end [mc "Diff of commits:\n\n"]
9066                $ctext conf -state disabled
9067                update
9068                diffcommits $a $b
9069                return
9070            }
9071        }
9072        if {$skipa} {
9073            set kids [real_children $curview,$a]
9074            if {[llength $kids] != 1} {
9075                $ctext insert end "\n"
9076                appendshortlink $a [mc "Commit "] \
9077                    [mc " has %s children - stopping\n" [llength $kids]]
9078                break
9079            }
9080            set a [lindex $kids 0]
9081        }
9082        if {$skipb} {
9083            set kids [real_children $curview,$b]
9084            if {[llength $kids] != 1} {
9085                appendshortlink $b [mc "Commit "] \
9086                    [mc " has %s children - stopping\n" [llength $kids]]
9087                break
9088            }
9089            set b [lindex $kids 0]
9090        }
9091    }
9092    $ctext conf -state disabled
9093}
9094
9095proc diffcommits {a b} {
9096    global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
9097
9098    set tmpdir [gitknewtmpdir]
9099    set fna [file join $tmpdir "commit-[string range $a 0 7]"]
9100    set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
9101    if {[catch {
9102        exec git diff-tree -p --pretty $a >$fna
9103        exec git diff-tree -p --pretty $b >$fnb
9104    } err]} {
9105        error_popup [mc "Error writing commit to file: %s" $err]
9106        return
9107    }
9108    if {[catch {
9109        set fd [open "| diff -U$diffcontext $fna $fnb" r]
9110    } err]} {
9111        error_popup [mc "Error diffing commits: %s" $err]
9112        return
9113    }
9114    set diffids [list commits $a $b]
9115    set blobdifffd($diffids) $fd
9116    set diffinhdr 0
9117    set currdiffsubmod ""
9118    filerun $fd [list getblobdiffline $fd $diffids]
9119}
9120
9121proc diffvssel {dirn} {
9122    global rowmenuid selectedline
9123
9124    if {$selectedline eq {}} return
9125    if {$dirn} {
9126        set oldid [commitonrow $selectedline]
9127        set newid $rowmenuid
9128    } else {
9129        set oldid $rowmenuid
9130        set newid [commitonrow $selectedline]
9131    }
9132    addtohistory [list doseldiff $oldid $newid] savectextpos
9133    doseldiff $oldid $newid
9134}
9135
9136proc diffvsmark {dirn} {
9137    global rowmenuid markedid
9138
9139    if {![info exists markedid]} return
9140    if {$dirn} {
9141        set oldid $markedid
9142        set newid $rowmenuid
9143    } else {
9144        set oldid $rowmenuid
9145        set newid $markedid
9146    }
9147    addtohistory [list doseldiff $oldid $newid] savectextpos
9148    doseldiff $oldid $newid
9149}
9150
9151proc doseldiff {oldid newid} {
9152    global ctext
9153    global commitinfo
9154
9155    $ctext conf -state normal
9156    clear_ctext
9157    init_flist [mc "Top"]
9158    $ctext insert end "[mc "From"] "
9159    $ctext insert end $oldid link0
9160    setlink $oldid link0
9161    $ctext insert end "\n     "
9162    $ctext insert end [lindex $commitinfo($oldid) 0]
9163    $ctext insert end "\n\n[mc "To"]   "
9164    $ctext insert end $newid link1
9165    setlink $newid link1
9166    $ctext insert end "\n     "
9167    $ctext insert end [lindex $commitinfo($newid) 0]
9168    $ctext insert end "\n"
9169    $ctext conf -state disabled
9170    $ctext tag remove found 1.0 end
9171    startdiff [list $oldid $newid]
9172}
9173
9174proc mkpatch {} {
9175    global rowmenuid currentid commitinfo patchtop patchnum NS
9176
9177    if {![info exists currentid]} return
9178    set oldid $currentid
9179    set oldhead [lindex $commitinfo($oldid) 0]
9180    set newid $rowmenuid
9181    set newhead [lindex $commitinfo($newid) 0]
9182    set top .patch
9183    set patchtop $top
9184    catch {destroy $top}
9185    ttk_toplevel $top
9186    make_transient $top .
9187    ${NS}::label $top.title -text [mc "Generate patch"]
9188    grid $top.title - -pady 10
9189    ${NS}::label $top.from -text [mc "From:"]
9190    ${NS}::entry $top.fromsha1 -width 40
9191    $top.fromsha1 insert 0 $oldid
9192    $top.fromsha1 conf -state readonly
9193    grid $top.from $top.fromsha1 -sticky w
9194    ${NS}::entry $top.fromhead -width 60
9195    $top.fromhead insert 0 $oldhead
9196    $top.fromhead conf -state readonly
9197    grid x $top.fromhead -sticky w
9198    ${NS}::label $top.to -text [mc "To:"]
9199    ${NS}::entry $top.tosha1 -width 40
9200    $top.tosha1 insert 0 $newid
9201    $top.tosha1 conf -state readonly
9202    grid $top.to $top.tosha1 -sticky w
9203    ${NS}::entry $top.tohead -width 60
9204    $top.tohead insert 0 $newhead
9205    $top.tohead conf -state readonly
9206    grid x $top.tohead -sticky w
9207    ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
9208    grid $top.rev x -pady 10 -padx 5
9209    ${NS}::label $top.flab -text [mc "Output file:"]
9210    ${NS}::entry $top.fname -width 60
9211    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
9212    incr patchnum
9213    grid $top.flab $top.fname -sticky w
9214    ${NS}::frame $top.buts
9215    ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
9216    ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
9217    bind $top <Key-Return> mkpatchgo
9218    bind $top <Key-Escape> mkpatchcan
9219    grid $top.buts.gen $top.buts.can
9220    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9221    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9222    grid $top.buts - -pady 10 -sticky ew
9223    focus $top.fname
9224}
9225
9226proc mkpatchrev {} {
9227    global patchtop
9228
9229    set oldid [$patchtop.fromsha1 get]
9230    set oldhead [$patchtop.fromhead get]
9231    set newid [$patchtop.tosha1 get]
9232    set newhead [$patchtop.tohead get]
9233    foreach e [list fromsha1 fromhead tosha1 tohead] \
9234            v [list $newid $newhead $oldid $oldhead] {
9235        $patchtop.$e conf -state normal
9236        $patchtop.$e delete 0 end
9237        $patchtop.$e insert 0 $v
9238        $patchtop.$e conf -state readonly
9239    }
9240}
9241
9242proc mkpatchgo {} {
9243    global patchtop nullid nullid2
9244
9245    set oldid [$patchtop.fromsha1 get]
9246    set newid [$patchtop.tosha1 get]
9247    set fname [$patchtop.fname get]
9248    set cmd [diffcmd [list $oldid $newid] -p]
9249    # trim off the initial "|"
9250    set cmd [lrange $cmd 1 end]
9251    lappend cmd >$fname &
9252    if {[catch {eval exec $cmd} err]} {
9253        error_popup "[mc "Error creating patch:"] $err" $patchtop
9254    }
9255    catch {destroy $patchtop}
9256    unset patchtop
9257}
9258
9259proc mkpatchcan {} {
9260    global patchtop
9261
9262    catch {destroy $patchtop}
9263    unset patchtop
9264}
9265
9266proc mktag {} {
9267    global rowmenuid mktagtop commitinfo NS
9268
9269    set top .maketag
9270    set mktagtop $top
9271    catch {destroy $top}
9272    ttk_toplevel $top
9273    make_transient $top .
9274    ${NS}::label $top.title -text [mc "Create tag"]
9275    grid $top.title - -pady 10
9276    ${NS}::label $top.id -text [mc "ID:"]
9277    ${NS}::entry $top.sha1 -width 40
9278    $top.sha1 insert 0 $rowmenuid
9279    $top.sha1 conf -state readonly
9280    grid $top.id $top.sha1 -sticky w
9281    ${NS}::entry $top.head -width 60
9282    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9283    $top.head conf -state readonly
9284    grid x $top.head -sticky w
9285    ${NS}::label $top.tlab -text [mc "Tag name:"]
9286    ${NS}::entry $top.tag -width 60
9287    grid $top.tlab $top.tag -sticky w
9288    ${NS}::label $top.op -text [mc "Tag message is optional"]
9289    grid $top.op -columnspan 2 -sticky we
9290    ${NS}::label $top.mlab -text [mc "Tag message:"]
9291    ${NS}::entry $top.msg -width 60
9292    grid $top.mlab $top.msg -sticky w
9293    ${NS}::frame $top.buts
9294    ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
9295    ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
9296    bind $top <Key-Return> mktaggo
9297    bind $top <Key-Escape> mktagcan
9298    grid $top.buts.gen $top.buts.can
9299    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9300    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9301    grid $top.buts - -pady 10 -sticky ew
9302    focus $top.tag
9303}
9304
9305proc domktag {} {
9306    global mktagtop env tagids idtags
9307
9308    set id [$mktagtop.sha1 get]
9309    set tag [$mktagtop.tag get]
9310    set msg [$mktagtop.msg get]
9311    if {$tag == {}} {
9312        error_popup [mc "No tag name specified"] $mktagtop
9313        return 0
9314    }
9315    if {[info exists tagids($tag)]} {
9316        error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
9317        return 0
9318    }
9319    if {[catch {
9320        if {$msg != {}} {
9321            exec git tag -a -m $msg $tag $id
9322        } else {
9323            exec git tag $tag $id
9324        }
9325    } err]} {
9326        error_popup "[mc "Error creating tag:"] $err" $mktagtop
9327        return 0
9328    }
9329
9330    set tagids($tag) $id
9331    lappend idtags($id) $tag
9332    redrawtags $id
9333    addedtag $id
9334    dispneartags 0
9335    run refill_reflist
9336    return 1
9337}
9338
9339proc redrawtags {id} {
9340    global canv linehtag idpos currentid curview cmitlisted markedid
9341    global canvxmax iddrawn circleitem mainheadid circlecolors
9342    global mainheadcirclecolor
9343
9344    if {![commitinview $id $curview]} return
9345    if {![info exists iddrawn($id)]} return
9346    set row [rowofcommit $id]
9347    if {$id eq $mainheadid} {
9348        set ofill $mainheadcirclecolor
9349    } else {
9350        set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
9351    }
9352    $canv itemconf $circleitem($row) -fill $ofill
9353    $canv delete tag.$id
9354    set xt [eval drawtags $id $idpos($id)]
9355    $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
9356    set text [$canv itemcget $linehtag($id) -text]
9357    set font [$canv itemcget $linehtag($id) -font]
9358    set xr [expr {$xt + [font measure $font $text]}]
9359    if {$xr > $canvxmax} {
9360        set canvxmax $xr
9361        setcanvscroll
9362    }
9363    if {[info exists currentid] && $currentid == $id} {
9364        make_secsel $id
9365    }
9366    if {[info exists markedid] && $markedid eq $id} {
9367        make_idmark $id
9368    }
9369}
9370
9371proc mktagcan {} {
9372    global mktagtop
9373
9374    catch {destroy $mktagtop}
9375    unset mktagtop
9376}
9377
9378proc mktaggo {} {
9379    if {![domktag]} return
9380    mktagcan
9381}
9382
9383proc copysummary {} {
9384    global rowmenuid autosellen
9385
9386    set format "%h (\"%s\", %ad)"
9387    set cmd [list git show -s --pretty=format:$format --date=short]
9388    if {$autosellen < 40} {
9389        lappend cmd --abbrev=$autosellen
9390    }
9391    set summary [eval exec $cmd $rowmenuid]
9392
9393    clipboard clear
9394    clipboard append $summary
9395}
9396
9397proc writecommit {} {
9398    global rowmenuid wrcomtop commitinfo wrcomcmd NS
9399
9400    set top .writecommit
9401    set wrcomtop $top
9402    catch {destroy $top}
9403    ttk_toplevel $top
9404    make_transient $top .
9405    ${NS}::label $top.title -text [mc "Write commit to file"]
9406    grid $top.title - -pady 10
9407    ${NS}::label $top.id -text [mc "ID:"]
9408    ${NS}::entry $top.sha1 -width 40
9409    $top.sha1 insert 0 $rowmenuid
9410    $top.sha1 conf -state readonly
9411    grid $top.id $top.sha1 -sticky w
9412    ${NS}::entry $top.head -width 60
9413    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9414    $top.head conf -state readonly
9415    grid x $top.head -sticky w
9416    ${NS}::label $top.clab -text [mc "Command:"]
9417    ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
9418    grid $top.clab $top.cmd -sticky w -pady 10
9419    ${NS}::label $top.flab -text [mc "Output file:"]
9420    ${NS}::entry $top.fname -width 60
9421    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
9422    grid $top.flab $top.fname -sticky w
9423    ${NS}::frame $top.buts
9424    ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
9425    ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
9426    bind $top <Key-Return> wrcomgo
9427    bind $top <Key-Escape> wrcomcan
9428    grid $top.buts.gen $top.buts.can
9429    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9430    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9431    grid $top.buts - -pady 10 -sticky ew
9432    focus $top.fname
9433}
9434
9435proc wrcomgo {} {
9436    global wrcomtop
9437
9438    set id [$wrcomtop.sha1 get]
9439    set cmd "echo $id | [$wrcomtop.cmd get]"
9440    set fname [$wrcomtop.fname get]
9441    if {[catch {exec sh -c $cmd >$fname &} err]} {
9442        error_popup "[mc "Error writing commit:"] $err" $wrcomtop
9443    }
9444    catch {destroy $wrcomtop}
9445    unset wrcomtop
9446}
9447
9448proc wrcomcan {} {
9449    global wrcomtop
9450
9451    catch {destroy $wrcomtop}
9452    unset wrcomtop
9453}
9454
9455proc mkbranch {} {
9456    global NS rowmenuid
9457
9458    set top .branchdialog
9459
9460    set val(name) ""
9461    set val(id) $rowmenuid
9462    set val(command) [list mkbrgo $top]
9463
9464    set ui(title) [mc "Create branch"]
9465    set ui(accept) [mc "Create"]
9466
9467    branchdia $top val ui
9468}
9469
9470proc mvbranch {} {
9471    global NS
9472    global headmenuid headmenuhead
9473
9474    set top .branchdialog
9475
9476    set val(name) $headmenuhead
9477    set val(id) $headmenuid
9478    set val(command) [list mvbrgo $top $headmenuhead]
9479
9480    set ui(title) [mc "Rename branch %s" $headmenuhead]
9481    set ui(accept) [mc "Rename"]
9482
9483    branchdia $top val ui
9484}
9485
9486proc branchdia {top valvar uivar} {
9487    global NS commitinfo
9488    upvar $valvar val $uivar ui
9489
9490    catch {destroy $top}
9491    ttk_toplevel $top
9492    make_transient $top .
9493    ${NS}::label $top.title -text $ui(title)
9494    grid $top.title - -pady 10
9495    ${NS}::label $top.id -text [mc "ID:"]
9496    ${NS}::entry $top.sha1 -width 40
9497    $top.sha1 insert 0 $val(id)
9498    $top.sha1 conf -state readonly
9499    grid $top.id $top.sha1 -sticky w
9500    ${NS}::entry $top.head -width 60
9501    $top.head insert 0 [lindex $commitinfo($val(id)) 0]
9502    $top.head conf -state readonly
9503    grid x $top.head -sticky ew
9504    grid columnconfigure $top 1 -weight 1
9505    ${NS}::label $top.nlab -text [mc "Name:"]
9506    ${NS}::entry $top.name -width 40
9507    $top.name insert 0 $val(name)
9508    grid $top.nlab $top.name -sticky w
9509    ${NS}::frame $top.buts
9510    ${NS}::button $top.buts.go -text $ui(accept) -command $val(command)
9511    ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
9512    bind $top <Key-Return> $val(command)
9513    bind $top <Key-Escape> "catch {destroy $top}"
9514    grid $top.buts.go $top.buts.can
9515    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9516    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9517    grid $top.buts - -pady 10 -sticky ew
9518    focus $top.name
9519}
9520
9521proc mkbrgo {top} {
9522    global headids idheads
9523
9524    set name [$top.name get]
9525    set id [$top.sha1 get]
9526    set cmdargs {}
9527    set old_id {}
9528    if {$name eq {}} {
9529        error_popup [mc "Please specify a name for the new branch"] $top
9530        return
9531    }
9532    if {[info exists headids($name)]} {
9533        if {![confirm_popup [mc \
9534                "Branch '%s' already exists. Overwrite?" $name] $top]} {
9535            return
9536        }
9537        set old_id $headids($name)
9538        lappend cmdargs -f
9539    }
9540    catch {destroy $top}
9541    lappend cmdargs $name $id
9542    nowbusy newbranch
9543    update
9544    if {[catch {
9545        eval exec git branch $cmdargs
9546    } err]} {
9547        notbusy newbranch
9548        error_popup $err
9549    } else {
9550        notbusy newbranch
9551        if {$old_id ne {}} {
9552            movehead $id $name
9553            movedhead $id $name
9554            redrawtags $old_id
9555            redrawtags $id
9556        } else {
9557            set headids($name) $id
9558            lappend idheads($id) $name
9559            addedhead $id $name
9560            redrawtags $id
9561        }
9562        dispneartags 0
9563        run refill_reflist
9564    }
9565}
9566
9567proc mvbrgo {top prevname} {
9568    global headids idheads mainhead mainheadid
9569
9570    set name [$top.name get]
9571    set id [$top.sha1 get]
9572    set cmdargs {}
9573    if {$name eq $prevname} {
9574        catch {destroy $top}
9575        return
9576    }
9577    if {$name eq {}} {
9578        error_popup [mc "Please specify a new name for the branch"] $top
9579        return
9580    }
9581    catch {destroy $top}
9582    lappend cmdargs -m $prevname $name
9583    nowbusy renamebranch
9584    update
9585    if {[catch {
9586        eval exec git branch $cmdargs
9587    } err]} {
9588        notbusy renamebranch
9589        error_popup $err
9590    } else {
9591        notbusy renamebranch
9592        removehead $id $prevname
9593        removedhead $id $prevname
9594        set headids($name) $id
9595        lappend idheads($id) $name
9596        addedhead $id $name
9597        if {$prevname eq $mainhead} {
9598            set mainhead $name
9599            set mainheadid $id
9600        }
9601        redrawtags $id
9602        dispneartags 0
9603        run refill_reflist
9604    }
9605}
9606
9607proc exec_citool {tool_args {baseid {}}} {
9608    global commitinfo env
9609
9610    set save_env [array get env GIT_AUTHOR_*]
9611
9612    if {$baseid ne {}} {
9613        if {![info exists commitinfo($baseid)]} {
9614            getcommit $baseid
9615        }
9616        set author [lindex $commitinfo($baseid) 1]
9617        set date [lindex $commitinfo($baseid) 2]
9618        if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9619                    $author author name email]
9620            && $date ne {}} {
9621            set env(GIT_AUTHOR_NAME) $name
9622            set env(GIT_AUTHOR_EMAIL) $email
9623            set env(GIT_AUTHOR_DATE) $date
9624        }
9625    }
9626
9627    eval exec git citool $tool_args &
9628
9629    array unset env GIT_AUTHOR_*
9630    array set env $save_env
9631}
9632
9633proc cherrypick {} {
9634    global rowmenuid curview
9635    global mainhead mainheadid
9636    global gitdir
9637
9638    set oldhead [exec git rev-parse HEAD]
9639    set dheads [descheads $rowmenuid]
9640    if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
9641        set ok [confirm_popup [mc "Commit %s is already\
9642                included in branch %s -- really re-apply it?" \
9643                                   [string range $rowmenuid 0 7] $mainhead]]
9644        if {!$ok} return
9645    }
9646    nowbusy cherrypick [mc "Cherry-picking"]
9647    update
9648    # Unfortunately git-cherry-pick writes stuff to stderr even when
9649    # no error occurs, and exec takes that as an indication of error...
9650    if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9651        notbusy cherrypick
9652        if {[regexp -line \
9653                 {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9654                 $err msg fname]} {
9655            error_popup [mc "Cherry-pick failed because of local changes\
9656                        to file '%s'.\nPlease commit, reset or stash\
9657                        your changes and try again." $fname]
9658        } elseif {[regexp -line \
9659                       {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
9660                       $err]} {
9661            if {[confirm_popup [mc "Cherry-pick failed because of merge\
9662                        conflict.\nDo you wish to run git citool to\
9663                        resolve it?"]]} {
9664                # Force citool to read MERGE_MSG
9665                file delete [file join $gitdir "GITGUI_MSG"]
9666                exec_citool {} $rowmenuid
9667            }
9668        } else {
9669            error_popup $err
9670        }
9671        run updatecommits
9672        return
9673    }
9674    set newhead [exec git rev-parse HEAD]
9675    if {$newhead eq $oldhead} {
9676        notbusy cherrypick
9677        error_popup [mc "No changes committed"]
9678        return
9679    }
9680    addnewchild $newhead $oldhead
9681    if {[commitinview $oldhead $curview]} {
9682        # XXX this isn't right if we have a path limit...
9683        insertrow $newhead $oldhead $curview
9684        if {$mainhead ne {}} {
9685            movehead $newhead $mainhead
9686            movedhead $newhead $mainhead
9687        }
9688        set mainheadid $newhead
9689        redrawtags $oldhead
9690        redrawtags $newhead
9691        selbyid $newhead
9692    }
9693    notbusy cherrypick
9694}
9695
9696proc revert {} {
9697    global rowmenuid curview
9698    global mainhead mainheadid
9699    global gitdir
9700
9701    set oldhead [exec git rev-parse HEAD]
9702    set dheads [descheads $rowmenuid]
9703    if { $dheads eq {} || [lsearch -exact $dheads $oldhead] == -1 } {
9704       set ok [confirm_popup [mc "Commit %s is not\
9705           included in branch %s -- really revert it?" \
9706                      [string range $rowmenuid 0 7] $mainhead]]
9707       if {!$ok} return
9708    }
9709    nowbusy revert [mc "Reverting"]
9710    update
9711
9712    if [catch {exec git revert --no-edit $rowmenuid} err] {
9713        notbusy revert
9714        if [regexp {files would be overwritten by merge:(\n(( |\t)+[^\n]+\n)+)}\
9715                $err match files] {
9716            regsub {\n( |\t)+} $files "\n" files
9717            error_popup [mc "Revert failed because of local changes to\
9718                the following files:%s Please commit, reset or stash \
9719                your changes and try again." $files]
9720        } elseif [regexp {error: could not revert} $err] {
9721            if [confirm_popup [mc "Revert failed because of merge conflict.\n\
9722                Do you wish to run git citool to resolve it?"]] {
9723                # Force citool to read MERGE_MSG
9724                file delete [file join $gitdir "GITGUI_MSG"]
9725                exec_citool {} $rowmenuid
9726            }
9727        } else { error_popup $err }
9728        run updatecommits
9729        return
9730    }
9731
9732    set newhead [exec git rev-parse HEAD]
9733    if { $newhead eq $oldhead } {
9734        notbusy revert
9735        error_popup [mc "No changes committed"]
9736        return
9737    }
9738
9739    addnewchild $newhead $oldhead
9740
9741    if [commitinview $oldhead $curview] {
9742        # XXX this isn't right if we have a path limit...
9743        insertrow $newhead $oldhead $curview
9744        if {$mainhead ne {}} {
9745            movehead $newhead $mainhead
9746            movedhead $newhead $mainhead
9747        }
9748        set mainheadid $newhead
9749        redrawtags $oldhead
9750        redrawtags $newhead
9751        selbyid $newhead
9752    }
9753
9754    notbusy revert
9755}
9756
9757proc resethead {} {
9758    global mainhead rowmenuid confirm_ok resettype NS
9759
9760    set confirm_ok 0
9761    set w ".confirmreset"
9762    ttk_toplevel $w
9763    make_transient $w .
9764    wm title $w [mc "Confirm reset"]
9765    ${NS}::label $w.m -text \
9766        [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
9767    pack $w.m -side top -fill x -padx 20 -pady 20
9768    ${NS}::labelframe $w.f -text [mc "Reset type:"]
9769    set resettype mixed
9770    ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
9771        -text [mc "Soft: Leave working tree and index untouched"]
9772    grid $w.f.soft -sticky w
9773    ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
9774        -text [mc "Mixed: Leave working tree untouched, reset index"]
9775    grid $w.f.mixed -sticky w
9776    ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
9777        -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
9778    grid $w.f.hard -sticky w
9779    pack $w.f -side top -fill x -padx 4
9780    ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
9781    pack $w.ok -side left -fill x -padx 20 -pady 20
9782    ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
9783    bind $w <Key-Escape> [list destroy $w]
9784    pack $w.cancel -side right -fill x -padx 20 -pady 20
9785    bind $w <Visibility> "grab $w; focus $w"
9786    tkwait window $w
9787    if {!$confirm_ok} return
9788    if {[catch {set fd [open \
9789            [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
9790        error_popup $err
9791    } else {
9792        dohidelocalchanges
9793        filerun $fd [list readresetstat $fd]
9794        nowbusy reset [mc "Resetting"]
9795        selbyid $rowmenuid
9796    }
9797}
9798
9799proc readresetstat {fd} {
9800    global mainhead mainheadid showlocalchanges rprogcoord
9801
9802    if {[gets $fd line] >= 0} {
9803        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9804            set rprogcoord [expr {1.0 * $m / $n}]
9805            adjustprogress
9806        }
9807        return 1
9808    }
9809    set rprogcoord 0
9810    adjustprogress
9811    notbusy reset
9812    if {[catch {close $fd} err]} {
9813        error_popup $err
9814    }
9815    set oldhead $mainheadid
9816    set newhead [exec git rev-parse HEAD]
9817    if {$newhead ne $oldhead} {
9818        movehead $newhead $mainhead
9819        movedhead $newhead $mainhead
9820        set mainheadid $newhead
9821        redrawtags $oldhead
9822        redrawtags $newhead
9823    }
9824    if {$showlocalchanges} {
9825        doshowlocalchanges
9826    }
9827    return 0
9828}
9829
9830# context menu for a head
9831proc headmenu {x y id head} {
9832    global headmenuid headmenuhead headctxmenu mainhead headids
9833
9834    stopfinding
9835    set headmenuid $id
9836    set headmenuhead $head
9837    array set state {0 normal 1 normal 2 normal}
9838    if {[string match "remotes/*" $head]} {
9839        set localhead [string range $head [expr [string last / $head] + 1] end]
9840        if {[info exists headids($localhead)]} {
9841            set state(0) disabled
9842        }
9843        array set state {1 disabled 2 disabled}
9844    }
9845    if {$head eq $mainhead} {
9846        array set state {0 disabled 2 disabled}
9847    }
9848    foreach i {0 1 2} {
9849        $headctxmenu entryconfigure $i -state $state($i)
9850    }
9851    tk_popup $headctxmenu $x $y
9852}
9853
9854proc cobranch {} {
9855    global headmenuid headmenuhead headids
9856    global showlocalchanges
9857
9858    # check the tree is clean first??
9859    set newhead $headmenuhead
9860    set command [list | git checkout]
9861    if {[string match "remotes/*" $newhead]} {
9862        set remote $newhead
9863        set newhead [string range $newhead [expr [string last / $newhead] + 1] end]
9864        # The following check is redundant - the menu option should
9865        # be disabled to begin with...
9866        if {[info exists headids($newhead)]} {
9867            error_popup [mc "A local branch named %s exists already" $newhead]
9868            return
9869        }
9870        lappend command -b $newhead --track $remote
9871    } else {
9872        lappend command $newhead
9873    }
9874    lappend command 2>@1
9875    nowbusy checkout [mc "Checking out"]
9876    update
9877    dohidelocalchanges
9878    if {[catch {
9879        set fd [open $command r]
9880    } err]} {
9881        notbusy checkout
9882        error_popup $err
9883        if {$showlocalchanges} {
9884            dodiffindex
9885        }
9886    } else {
9887        filerun $fd [list readcheckoutstat $fd $newhead $headmenuid]
9888    }
9889}
9890
9891proc readcheckoutstat {fd newhead newheadid} {
9892    global mainhead mainheadid headids idheads showlocalchanges progresscoords
9893    global viewmainheadid curview
9894
9895    if {[gets $fd line] >= 0} {
9896        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9897            set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9898            adjustprogress
9899        }
9900        return 1
9901    }
9902    set progresscoords {0 0}
9903    adjustprogress
9904    notbusy checkout
9905    if {[catch {close $fd} err]} {
9906        error_popup $err
9907        return
9908    }
9909    set oldmainid $mainheadid
9910    if {! [info exists headids($newhead)]} {
9911        set headids($newhead) $newheadid
9912        lappend idheads($newheadid) $newhead
9913        addedhead $newheadid $newhead
9914    }
9915    set mainhead $newhead
9916    set mainheadid $newheadid
9917    set viewmainheadid($curview) $newheadid
9918    redrawtags $oldmainid
9919    redrawtags $newheadid
9920    selbyid $newheadid
9921    if {$showlocalchanges} {
9922        dodiffindex
9923    }
9924}
9925
9926proc rmbranch {} {
9927    global headmenuid headmenuhead mainhead
9928    global idheads
9929
9930    set head $headmenuhead
9931    set id $headmenuid
9932    # this check shouldn't be needed any more...
9933    if {$head eq $mainhead} {
9934        error_popup [mc "Cannot delete the currently checked-out branch"]
9935        return
9936    }
9937    set dheads [descheads $id]
9938    if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
9939        # the stuff on this branch isn't on any other branch
9940        if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9941                        branch.\nReally delete branch %s?" $head $head]]} return
9942    }
9943    nowbusy rmbranch
9944    update
9945    if {[catch {exec git branch -D $head} err]} {
9946        notbusy rmbranch
9947        error_popup $err
9948        return
9949    }
9950    removehead $id $head
9951    removedhead $id $head
9952    redrawtags $id
9953    notbusy rmbranch
9954    dispneartags 0
9955    run refill_reflist
9956}
9957
9958# Display a list of tags and heads
9959proc showrefs {} {
9960    global showrefstop bgcolor fgcolor selectbgcolor NS
9961    global bglist fglist reflistfilter reflist maincursor
9962
9963    set top .showrefs
9964    set showrefstop $top
9965    if {[winfo exists $top]} {
9966        raise $top
9967        refill_reflist
9968        return
9969    }
9970    ttk_toplevel $top
9971    wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
9972    make_transient $top .
9973    text $top.list -background $bgcolor -foreground $fgcolor \
9974        -selectbackground $selectbgcolor -font mainfont \
9975        -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
9976        -width 30 -height 20 -cursor $maincursor \
9977        -spacing1 1 -spacing3 1 -state disabled
9978    $top.list tag configure highlight -background $selectbgcolor
9979    if {![lsearch -exact $bglist $top.list]} {
9980        lappend bglist $top.list
9981        lappend fglist $top.list
9982    }
9983    ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
9984    ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
9985    grid $top.list $top.ysb -sticky nsew
9986    grid $top.xsb x -sticky ew
9987    ${NS}::frame $top.f
9988    ${NS}::label $top.f.l -text "[mc "Filter"]: "
9989    ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
9990    set reflistfilter "*"
9991    trace add variable reflistfilter write reflistfilter_change
9992    pack $top.f.e -side right -fill x -expand 1
9993    pack $top.f.l -side left
9994    grid $top.f - -sticky ew -pady 2
9995    ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
9996    bind $top <Key-Escape> [list destroy $top]
9997    grid $top.close -
9998    grid columnconfigure $top 0 -weight 1
9999    grid rowconfigure $top 0 -weight 1
10000    bind $top.list <1> {break}
10001    bind $top.list <B1-Motion> {break}
10002    bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
10003    set reflist {}
10004    refill_reflist
10005}
10006
10007proc sel_reflist {w x y} {
10008    global showrefstop reflist headids tagids otherrefids
10009
10010    if {![winfo exists $showrefstop]} return
10011    set l [lindex [split [$w index "@$x,$y"] "."] 0]
10012    set ref [lindex $reflist [expr {$l-1}]]
10013    set n [lindex $ref 0]
10014    switch -- [lindex $ref 1] {
10015        "H" {selbyid $headids($n)}
10016        "T" {selbyid $tagids($n)}
10017        "o" {selbyid $otherrefids($n)}
10018    }
10019    $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
10020}
10021
10022proc unsel_reflist {} {
10023    global showrefstop
10024
10025    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
10026    $showrefstop.list tag remove highlight 0.0 end
10027}
10028
10029proc reflistfilter_change {n1 n2 op} {
10030    global reflistfilter
10031
10032    after cancel refill_reflist
10033    after 200 refill_reflist
10034}
10035
10036proc refill_reflist {} {
10037    global reflist reflistfilter showrefstop headids tagids otherrefids
10038    global curview
10039
10040    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
10041    set refs {}
10042    foreach n [array names headids] {
10043        if {[string match $reflistfilter $n]} {
10044            if {[commitinview $headids($n) $curview]} {
10045                lappend refs [list $n H]
10046            } else {
10047                interestedin $headids($n) {run refill_reflist}
10048            }
10049        }
10050    }
10051    foreach n [array names tagids] {
10052        if {[string match $reflistfilter $n]} {
10053            if {[commitinview $tagids($n) $curview]} {
10054                lappend refs [list $n T]
10055            } else {
10056                interestedin $tagids($n) {run refill_reflist}
10057            }
10058        }
10059    }
10060    foreach n [array names otherrefids] {
10061        if {[string match $reflistfilter $n]} {
10062            if {[commitinview $otherrefids($n) $curview]} {
10063                lappend refs [list $n o]
10064            } else {
10065                interestedin $otherrefids($n) {run refill_reflist}
10066            }
10067        }
10068    }
10069    set refs [lsort -index 0 $refs]
10070    if {$refs eq $reflist} return
10071
10072    # Update the contents of $showrefstop.list according to the
10073    # differences between $reflist (old) and $refs (new)
10074    $showrefstop.list conf -state normal
10075    $showrefstop.list insert end "\n"
10076    set i 0
10077    set j 0
10078    while {$i < [llength $reflist] || $j < [llength $refs]} {
10079        if {$i < [llength $reflist]} {
10080            if {$j < [llength $refs]} {
10081                set cmp [string compare [lindex $reflist $i 0] \
10082                             [lindex $refs $j 0]]
10083                if {$cmp == 0} {
10084                    set cmp [string compare [lindex $reflist $i 1] \
10085                                 [lindex $refs $j 1]]
10086                }
10087            } else {
10088                set cmp -1
10089            }
10090        } else {
10091            set cmp 1
10092        }
10093        switch -- $cmp {
10094            -1 {
10095                $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
10096                incr i
10097            }
10098            0 {
10099                incr i
10100                incr j
10101            }
10102            1 {
10103                set l [expr {$j + 1}]
10104                $showrefstop.list image create $l.0 -align baseline \
10105                    -image reficon-[lindex $refs $j 1] -padx 2
10106                $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
10107                incr j
10108            }
10109        }
10110    }
10111    set reflist $refs
10112    # delete last newline
10113    $showrefstop.list delete end-2c end-1c
10114    $showrefstop.list conf -state disabled
10115}
10116
10117# Stuff for finding nearby tags
10118proc getallcommits {} {
10119    global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
10120    global idheads idtags idotherrefs allparents tagobjid
10121    global gitdir
10122
10123    if {![info exists allcommits]} {
10124        set nextarc 0
10125        set allcommits 0
10126        set seeds {}
10127        set allcwait 0
10128        set cachedarcs 0
10129        set allccache [file join $gitdir "gitk.cache"]
10130        if {![catch {
10131            set f [open $allccache r]
10132            set allcwait 1
10133            getcache $f
10134        }]} return
10135    }
10136
10137    if {$allcwait} {
10138        return
10139    }
10140    set cmd [list | git rev-list --parents]
10141    set allcupdate [expr {$seeds ne {}}]
10142    if {!$allcupdate} {
10143        set ids "--all"
10144    } else {
10145        set refs [concat [array names idheads] [array names idtags] \
10146                      [array names idotherrefs]]
10147        set ids {}
10148        set tagobjs {}
10149        foreach name [array names tagobjid] {
10150            lappend tagobjs $tagobjid($name)
10151        }
10152        foreach id [lsort -unique $refs] {
10153            if {![info exists allparents($id)] &&
10154                [lsearch -exact $tagobjs $id] < 0} {
10155                lappend ids $id
10156            }
10157        }
10158        if {$ids ne {}} {
10159            foreach id $seeds {
10160                lappend ids "^$id"
10161            }
10162        }
10163    }
10164    if {$ids ne {}} {
10165        set fd [open [concat $cmd $ids] r]
10166        fconfigure $fd -blocking 0
10167        incr allcommits
10168        nowbusy allcommits
10169        filerun $fd [list getallclines $fd]
10170    } else {
10171        dispneartags 0
10172    }
10173}
10174
10175# Since most commits have 1 parent and 1 child, we group strings of
10176# such commits into "arcs" joining branch/merge points (BMPs), which
10177# are commits that either don't have 1 parent or don't have 1 child.
10178#
10179# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
10180# arcout(id) - outgoing arcs for BMP
10181# arcids(a) - list of IDs on arc including end but not start
10182# arcstart(a) - BMP ID at start of arc
10183# arcend(a) - BMP ID at end of arc
10184# growing(a) - arc a is still growing
10185# arctags(a) - IDs out of arcids (excluding end) that have tags
10186# archeads(a) - IDs out of arcids (excluding end) that have heads
10187# The start of an arc is at the descendent end, so "incoming" means
10188# coming from descendents, and "outgoing" means going towards ancestors.
10189
10190proc getallclines {fd} {
10191    global allparents allchildren idtags idheads nextarc
10192    global arcnos arcids arctags arcout arcend arcstart archeads growing
10193    global seeds allcommits cachedarcs allcupdate
10194
10195    set nid 0
10196    while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
10197        set id [lindex $line 0]
10198        if {[info exists allparents($id)]} {
10199            # seen it already
10200            continue
10201        }
10202        set cachedarcs 0
10203        set olds [lrange $line 1 end]
10204        set allparents($id) $olds
10205        if {![info exists allchildren($id)]} {
10206            set allchildren($id) {}
10207            set arcnos($id) {}
10208            lappend seeds $id
10209        } else {
10210            set a $arcnos($id)
10211            if {[llength $olds] == 1 && [llength $a] == 1} {
10212                lappend arcids($a) $id
10213                if {[info exists idtags($id)]} {
10214                    lappend arctags($a) $id
10215                }
10216                if {[info exists idheads($id)]} {
10217                    lappend archeads($a) $id
10218                }
10219                if {[info exists allparents($olds)]} {
10220                    # seen parent already
10221                    if {![info exists arcout($olds)]} {
10222                        splitarc $olds
10223                    }
10224                    lappend arcids($a) $olds
10225                    set arcend($a) $olds
10226                    unset growing($a)
10227                }
10228                lappend allchildren($olds) $id
10229                lappend arcnos($olds) $a
10230                continue
10231            }
10232        }
10233        foreach a $arcnos($id) {
10234            lappend arcids($a) $id
10235            set arcend($a) $id
10236            unset growing($a)
10237        }
10238
10239        set ao {}
10240        foreach p $olds {
10241            lappend allchildren($p) $id
10242            set a [incr nextarc]
10243            set arcstart($a) $id
10244            set archeads($a) {}
10245            set arctags($a) {}
10246            set archeads($a) {}
10247            set arcids($a) {}
10248            lappend ao $a
10249            set growing($a) 1
10250            if {[info exists allparents($p)]} {
10251                # seen it already, may need to make a new branch
10252                if {![info exists arcout($p)]} {
10253                    splitarc $p
10254                }
10255                lappend arcids($a) $p
10256                set arcend($a) $p
10257                unset growing($a)
10258            }
10259            lappend arcnos($p) $a
10260        }
10261        set arcout($id) $ao
10262    }
10263    if {$nid > 0} {
10264        global cached_dheads cached_dtags cached_atags
10265        unset -nocomplain cached_dheads
10266        unset -nocomplain cached_dtags
10267        unset -nocomplain cached_atags
10268    }
10269    if {![eof $fd]} {
10270        return [expr {$nid >= 1000? 2: 1}]
10271    }
10272    set cacheok 1
10273    if {[catch {
10274        fconfigure $fd -blocking 1
10275        close $fd
10276    } err]} {
10277        # got an error reading the list of commits
10278        # if we were updating, try rereading the whole thing again
10279        if {$allcupdate} {
10280            incr allcommits -1
10281            dropcache $err
10282            return
10283        }
10284        error_popup "[mc "Error reading commit topology information;\
10285                branch and preceding/following tag information\
10286                will be incomplete."]\n($err)"
10287        set cacheok 0
10288    }
10289    if {[incr allcommits -1] == 0} {
10290        notbusy allcommits
10291        if {$cacheok} {
10292            run savecache
10293        }
10294    }
10295    dispneartags 0
10296    return 0
10297}
10298
10299proc recalcarc {a} {
10300    global arctags archeads arcids idtags idheads
10301
10302    set at {}
10303    set ah {}
10304    foreach id [lrange $arcids($a) 0 end-1] {
10305        if {[info exists idtags($id)]} {
10306            lappend at $id
10307        }
10308        if {[info exists idheads($id)]} {
10309            lappend ah $id
10310        }
10311    }
10312    set arctags($a) $at
10313    set archeads($a) $ah
10314}
10315
10316proc splitarc {p} {
10317    global arcnos arcids nextarc arctags archeads idtags idheads
10318    global arcstart arcend arcout allparents growing
10319
10320    set a $arcnos($p)
10321    if {[llength $a] != 1} {
10322        puts "oops splitarc called but [llength $a] arcs already"
10323        return
10324    }
10325    set a [lindex $a 0]
10326    set i [lsearch -exact $arcids($a) $p]
10327    if {$i < 0} {
10328        puts "oops splitarc $p not in arc $a"
10329        return
10330    }
10331    set na [incr nextarc]
10332    if {[info exists arcend($a)]} {
10333        set arcend($na) $arcend($a)
10334    } else {
10335        set l [lindex $allparents([lindex $arcids($a) end]) 0]
10336        set j [lsearch -exact $arcnos($l) $a]
10337        set arcnos($l) [lreplace $arcnos($l) $j $j $na]
10338    }
10339    set tail [lrange $arcids($a) [expr {$i+1}] end]
10340    set arcids($a) [lrange $arcids($a) 0 $i]
10341    set arcend($a) $p
10342    set arcstart($na) $p
10343    set arcout($p) $na
10344    set arcids($na) $tail
10345    if {[info exists growing($a)]} {
10346        set growing($na) 1
10347        unset growing($a)
10348    }
10349
10350    foreach id $tail {
10351        if {[llength $arcnos($id)] == 1} {
10352            set arcnos($id) $na
10353        } else {
10354            set j [lsearch -exact $arcnos($id) $a]
10355            set arcnos($id) [lreplace $arcnos($id) $j $j $na]
10356        }
10357    }
10358
10359    # reconstruct tags and heads lists
10360    if {$arctags($a) ne {} || $archeads($a) ne {}} {
10361        recalcarc $a
10362        recalcarc $na
10363    } else {
10364        set arctags($na) {}
10365        set archeads($na) {}
10366    }
10367}
10368
10369# Update things for a new commit added that is a child of one
10370# existing commit.  Used when cherry-picking.
10371proc addnewchild {id p} {
10372    global allparents allchildren idtags nextarc
10373    global arcnos arcids arctags arcout arcend arcstart archeads growing
10374    global seeds allcommits
10375
10376    if {![info exists allcommits] || ![info exists arcnos($p)]} return
10377    set allparents($id) [list $p]
10378    set allchildren($id) {}
10379    set arcnos($id) {}
10380    lappend seeds $id
10381    lappend allchildren($p) $id
10382    set a [incr nextarc]
10383    set arcstart($a) $id
10384    set archeads($a) {}
10385    set arctags($a) {}
10386    set arcids($a) [list $p]
10387    set arcend($a) $p
10388    if {![info exists arcout($p)]} {
10389        splitarc $p
10390    }
10391    lappend arcnos($p) $a
10392    set arcout($id) [list $a]
10393}
10394
10395# This implements a cache for the topology information.
10396# The cache saves, for each arc, the start and end of the arc,
10397# the ids on the arc, and the outgoing arcs from the end.
10398proc readcache {f} {
10399    global arcnos arcids arcout arcstart arcend arctags archeads nextarc
10400    global idtags idheads allparents cachedarcs possible_seeds seeds growing
10401    global allcwait
10402
10403    set a $nextarc
10404    set lim $cachedarcs
10405    if {$lim - $a > 500} {
10406        set lim [expr {$a + 500}]
10407    }
10408    if {[catch {
10409        if {$a == $lim} {
10410            # finish reading the cache and setting up arctags, etc.
10411            set line [gets $f]
10412            if {$line ne "1"} {error "bad final version"}
10413            close $f
10414            foreach id [array names idtags] {
10415                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10416                    [llength $allparents($id)] == 1} {
10417                    set a [lindex $arcnos($id) 0]
10418                    if {$arctags($a) eq {}} {
10419                        recalcarc $a
10420                    }
10421                }
10422            }
10423            foreach id [array names idheads] {
10424                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10425                    [llength $allparents($id)] == 1} {
10426                    set a [lindex $arcnos($id) 0]
10427                    if {$archeads($a) eq {}} {
10428                        recalcarc $a
10429                    }
10430                }
10431            }
10432            foreach id [lsort -unique $possible_seeds] {
10433                if {$arcnos($id) eq {}} {
10434                    lappend seeds $id
10435                }
10436            }
10437            set allcwait 0
10438        } else {
10439            while {[incr a] <= $lim} {
10440                set line [gets $f]
10441                if {[llength $line] != 3} {error "bad line"}
10442                set s [lindex $line 0]
10443                set arcstart($a) $s
10444                lappend arcout($s) $a
10445                if {![info exists arcnos($s)]} {
10446                    lappend possible_seeds $s
10447                    set arcnos($s) {}
10448                }
10449                set e [lindex $line 1]
10450                if {$e eq {}} {
10451                    set growing($a) 1
10452                } else {
10453                    set arcend($a) $e
10454                    if {![info exists arcout($e)]} {
10455                        set arcout($e) {}
10456                    }
10457                }
10458                set arcids($a) [lindex $line 2]
10459                foreach id $arcids($a) {
10460                    lappend allparents($s) $id
10461                    set s $id
10462                    lappend arcnos($id) $a
10463                }
10464                if {![info exists allparents($s)]} {
10465                    set allparents($s) {}
10466                }
10467                set arctags($a) {}
10468                set archeads($a) {}
10469            }
10470            set nextarc [expr {$a - 1}]
10471        }
10472    } err]} {
10473        dropcache $err
10474        return 0
10475    }
10476    if {!$allcwait} {
10477        getallcommits
10478    }
10479    return $allcwait
10480}
10481
10482proc getcache {f} {
10483    global nextarc cachedarcs possible_seeds
10484
10485    if {[catch {
10486        set line [gets $f]
10487        if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
10488        # make sure it's an integer
10489        set cachedarcs [expr {int([lindex $line 1])}]
10490        if {$cachedarcs < 0} {error "bad number of arcs"}
10491        set nextarc 0
10492        set possible_seeds {}
10493        run readcache $f
10494    } err]} {
10495        dropcache $err
10496    }
10497    return 0
10498}
10499
10500proc dropcache {err} {
10501    global allcwait nextarc cachedarcs seeds
10502
10503    #puts "dropping cache ($err)"
10504    foreach v {arcnos arcout arcids arcstart arcend growing \
10505                   arctags archeads allparents allchildren} {
10506        global $v
10507        unset -nocomplain $v
10508    }
10509    set allcwait 0
10510    set nextarc 0
10511    set cachedarcs 0
10512    set seeds {}
10513    getallcommits
10514}
10515
10516proc writecache {f} {
10517    global cachearc cachedarcs allccache
10518    global arcstart arcend arcnos arcids arcout
10519
10520    set a $cachearc
10521    set lim $cachedarcs
10522    if {$lim - $a > 1000} {
10523        set lim [expr {$a + 1000}]
10524    }
10525    if {[catch {
10526        while {[incr a] <= $lim} {
10527            if {[info exists arcend($a)]} {
10528                puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
10529            } else {
10530                puts $f [list $arcstart($a) {} $arcids($a)]
10531            }
10532        }
10533    } err]} {
10534        catch {close $f}
10535        catch {file delete $allccache}
10536        #puts "writing cache failed ($err)"
10537        return 0
10538    }
10539    set cachearc [expr {$a - 1}]
10540    if {$a > $cachedarcs} {
10541        puts $f "1"
10542        close $f
10543        return 0
10544    }
10545    return 1
10546}
10547
10548proc savecache {} {
10549    global nextarc cachedarcs cachearc allccache
10550
10551    if {$nextarc == $cachedarcs} return
10552    set cachearc 0
10553    set cachedarcs $nextarc
10554    catch {
10555        set f [open $allccache w]
10556        puts $f [list 1 $cachedarcs]
10557        run writecache $f
10558    }
10559}
10560
10561# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
10562# or 0 if neither is true.
10563proc anc_or_desc {a b} {
10564    global arcout arcstart arcend arcnos cached_isanc
10565
10566    if {$arcnos($a) eq $arcnos($b)} {
10567        # Both are on the same arc(s); either both are the same BMP,
10568        # or if one is not a BMP, the other is also not a BMP or is
10569        # the BMP at end of the arc (and it only has 1 incoming arc).
10570        # Or both can be BMPs with no incoming arcs.
10571        if {$a eq $b || $arcnos($a) eq {}} {
10572            return 0
10573        }
10574        # assert {[llength $arcnos($a)] == 1}
10575        set arc [lindex $arcnos($a) 0]
10576        set i [lsearch -exact $arcids($arc) $a]
10577        set j [lsearch -exact $arcids($arc) $b]
10578        if {$i < 0 || $i > $j} {
10579            return 1
10580        } else {
10581            return -1
10582        }
10583    }
10584
10585    if {![info exists arcout($a)]} {
10586        set arc [lindex $arcnos($a) 0]
10587        if {[info exists arcend($arc)]} {
10588            set aend $arcend($arc)
10589        } else {
10590            set aend {}
10591        }
10592        set a $arcstart($arc)
10593    } else {
10594        set aend $a
10595    }
10596    if {![info exists arcout($b)]} {
10597        set arc [lindex $arcnos($b) 0]
10598        if {[info exists arcend($arc)]} {
10599            set bend $arcend($arc)
10600        } else {
10601            set bend {}
10602        }
10603        set b $arcstart($arc)
10604    } else {
10605        set bend $b
10606    }
10607    if {$a eq $bend} {
10608        return 1
10609    }
10610    if {$b eq $aend} {
10611        return -1
10612    }
10613    if {[info exists cached_isanc($a,$bend)]} {
10614        if {$cached_isanc($a,$bend)} {
10615            return 1
10616        }
10617    }
10618    if {[info exists cached_isanc($b,$aend)]} {
10619        if {$cached_isanc($b,$aend)} {
10620            return -1
10621        }
10622        if {[info exists cached_isanc($a,$bend)]} {
10623            return 0
10624        }
10625    }
10626
10627    set todo [list $a $b]
10628    set anc($a) a
10629    set anc($b) b
10630    for {set i 0} {$i < [llength $todo]} {incr i} {
10631        set x [lindex $todo $i]
10632        if {$anc($x) eq {}} {
10633            continue
10634        }
10635        foreach arc $arcnos($x) {
10636            set xd $arcstart($arc)
10637            if {$xd eq $bend} {
10638                set cached_isanc($a,$bend) 1
10639                set cached_isanc($b,$aend) 0
10640                return 1
10641            } elseif {$xd eq $aend} {
10642                set cached_isanc($b,$aend) 1
10643                set cached_isanc($a,$bend) 0
10644                return -1
10645            }
10646            if {![info exists anc($xd)]} {
10647                set anc($xd) $anc($x)
10648                lappend todo $xd
10649            } elseif {$anc($xd) ne $anc($x)} {
10650                set anc($xd) {}
10651            }
10652        }
10653    }
10654    set cached_isanc($a,$bend) 0
10655    set cached_isanc($b,$aend) 0
10656    return 0
10657}
10658
10659# This identifies whether $desc has an ancestor that is
10660# a growing tip of the graph and which is not an ancestor of $anc
10661# and returns 0 if so and 1 if not.
10662# If we subsequently discover a tag on such a growing tip, and that
10663# turns out to be a descendent of $anc (which it could, since we
10664# don't necessarily see children before parents), then $desc
10665# isn't a good choice to display as a descendent tag of
10666# $anc (since it is the descendent of another tag which is
10667# a descendent of $anc).  Similarly, $anc isn't a good choice to
10668# display as a ancestor tag of $desc.
10669#
10670proc is_certain {desc anc} {
10671    global arcnos arcout arcstart arcend growing problems
10672
10673    set certain {}
10674    if {[llength $arcnos($anc)] == 1} {
10675        # tags on the same arc are certain
10676        if {$arcnos($desc) eq $arcnos($anc)} {
10677            return 1
10678        }
10679        if {![info exists arcout($anc)]} {
10680            # if $anc is partway along an arc, use the start of the arc instead
10681            set a [lindex $arcnos($anc) 0]
10682            set anc $arcstart($a)
10683        }
10684    }
10685    if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
10686        set x $desc
10687    } else {
10688        set a [lindex $arcnos($desc) 0]
10689        set x $arcend($a)
10690    }
10691    if {$x == $anc} {
10692        return 1
10693    }
10694    set anclist [list $x]
10695    set dl($x) 1
10696    set nnh 1
10697    set ngrowanc 0
10698    for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
10699        set x [lindex $anclist $i]
10700        if {$dl($x)} {
10701            incr nnh -1
10702        }
10703        set done($x) 1
10704        foreach a $arcout($x) {
10705            if {[info exists growing($a)]} {
10706                if {![info exists growanc($x)] && $dl($x)} {
10707                    set growanc($x) 1
10708                    incr ngrowanc
10709                }
10710            } else {
10711                set y $arcend($a)
10712                if {[info exists dl($y)]} {
10713                    if {$dl($y)} {
10714                        if {!$dl($x)} {
10715                            set dl($y) 0
10716                            if {![info exists done($y)]} {
10717                                incr nnh -1
10718                            }
10719                            if {[info exists growanc($x)]} {
10720                                incr ngrowanc -1
10721                            }
10722                            set xl [list $y]
10723                            for {set k 0} {$k < [llength $xl]} {incr k} {
10724                                set z [lindex $xl $k]
10725                                foreach c $arcout($z) {
10726                                    if {[info exists arcend($c)]} {
10727                                        set v $arcend($c)
10728                                        if {[info exists dl($v)] && $dl($v)} {
10729                                            set dl($v) 0
10730                                            if {![info exists done($v)]} {
10731                                                incr nnh -1
10732                                            }
10733                                            if {[info exists growanc($v)]} {
10734                                                incr ngrowanc -1
10735                                            }
10736                                            lappend xl $v
10737                                        }
10738                                    }
10739                                }
10740                            }
10741                        }
10742                    }
10743                } elseif {$y eq $anc || !$dl($x)} {
10744                    set dl($y) 0
10745                    lappend anclist $y
10746                } else {
10747                    set dl($y) 1
10748                    lappend anclist $y
10749                    incr nnh
10750                }
10751            }
10752        }
10753    }
10754    foreach x [array names growanc] {
10755        if {$dl($x)} {
10756            return 0
10757        }
10758        return 0
10759    }
10760    return 1
10761}
10762
10763proc validate_arctags {a} {
10764    global arctags idtags
10765
10766    set i -1
10767    set na $arctags($a)
10768    foreach id $arctags($a) {
10769        incr i
10770        if {![info exists idtags($id)]} {
10771            set na [lreplace $na $i $i]
10772            incr i -1
10773        }
10774    }
10775    set arctags($a) $na
10776}
10777
10778proc validate_archeads {a} {
10779    global archeads idheads
10780
10781    set i -1
10782    set na $archeads($a)
10783    foreach id $archeads($a) {
10784        incr i
10785        if {![info exists idheads($id)]} {
10786            set na [lreplace $na $i $i]
10787            incr i -1
10788        }
10789    }
10790    set archeads($a) $na
10791}
10792
10793# Return the list of IDs that have tags that are descendents of id,
10794# ignoring IDs that are descendents of IDs already reported.
10795proc desctags {id} {
10796    global arcnos arcstart arcids arctags idtags allparents
10797    global growing cached_dtags
10798
10799    if {![info exists allparents($id)]} {
10800        return {}
10801    }
10802    set t1 [clock clicks -milliseconds]
10803    set argid $id
10804    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10805        # part-way along an arc; check that arc first
10806        set a [lindex $arcnos($id) 0]
10807        if {$arctags($a) ne {}} {
10808            validate_arctags $a
10809            set i [lsearch -exact $arcids($a) $id]
10810            set tid {}
10811            foreach t $arctags($a) {
10812                set j [lsearch -exact $arcids($a) $t]
10813                if {$j >= $i} break
10814                set tid $t
10815            }
10816            if {$tid ne {}} {
10817                return $tid
10818            }
10819        }
10820        set id $arcstart($a)
10821        if {[info exists idtags($id)]} {
10822            return $id
10823        }
10824    }
10825    if {[info exists cached_dtags($id)]} {
10826        return $cached_dtags($id)
10827    }
10828
10829    set origid $id
10830    set todo [list $id]
10831    set queued($id) 1
10832    set nc 1
10833    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10834        set id [lindex $todo $i]
10835        set done($id) 1
10836        set ta [info exists hastaggedancestor($id)]
10837        if {!$ta} {
10838            incr nc -1
10839        }
10840        # ignore tags on starting node
10841        if {!$ta && $i > 0} {
10842            if {[info exists idtags($id)]} {
10843                set tagloc($id) $id
10844                set ta 1
10845            } elseif {[info exists cached_dtags($id)]} {
10846                set tagloc($id) $cached_dtags($id)
10847                set ta 1
10848            }
10849        }
10850        foreach a $arcnos($id) {
10851            set d $arcstart($a)
10852            if {!$ta && $arctags($a) ne {}} {
10853                validate_arctags $a
10854                if {$arctags($a) ne {}} {
10855                    lappend tagloc($id) [lindex $arctags($a) end]
10856                }
10857            }
10858            if {$ta || $arctags($a) ne {}} {
10859                set tomark [list $d]
10860                for {set j 0} {$j < [llength $tomark]} {incr j} {
10861                    set dd [lindex $tomark $j]
10862                    if {![info exists hastaggedancestor($dd)]} {
10863                        if {[info exists done($dd)]} {
10864                            foreach b $arcnos($dd) {
10865                                lappend tomark $arcstart($b)
10866                            }
10867                            if {[info exists tagloc($dd)]} {
10868                                unset tagloc($dd)
10869                            }
10870                        } elseif {[info exists queued($dd)]} {
10871                            incr nc -1
10872                        }
10873                        set hastaggedancestor($dd) 1
10874                    }
10875                }
10876            }
10877            if {![info exists queued($d)]} {
10878                lappend todo $d
10879                set queued($d) 1
10880                if {![info exists hastaggedancestor($d)]} {
10881                    incr nc
10882                }
10883            }
10884        }
10885    }
10886    set tags {}
10887    foreach id [array names tagloc] {
10888        if {![info exists hastaggedancestor($id)]} {
10889            foreach t $tagloc($id) {
10890                if {[lsearch -exact $tags $t] < 0} {
10891                    lappend tags $t
10892                }
10893            }
10894        }
10895    }
10896    set t2 [clock clicks -milliseconds]
10897    set loopix $i
10898
10899    # remove tags that are descendents of other tags
10900    for {set i 0} {$i < [llength $tags]} {incr i} {
10901        set a [lindex $tags $i]
10902        for {set j 0} {$j < $i} {incr j} {
10903            set b [lindex $tags $j]
10904            set r [anc_or_desc $a $b]
10905            if {$r == 1} {
10906                set tags [lreplace $tags $j $j]
10907                incr j -1
10908                incr i -1
10909            } elseif {$r == -1} {
10910                set tags [lreplace $tags $i $i]
10911                incr i -1
10912                break
10913            }
10914        }
10915    }
10916
10917    if {[array names growing] ne {}} {
10918        # graph isn't finished, need to check if any tag could get
10919        # eclipsed by another tag coming later.  Simply ignore any
10920        # tags that could later get eclipsed.
10921        set ctags {}
10922        foreach t $tags {
10923            if {[is_certain $t $origid]} {
10924                lappend ctags $t
10925            }
10926        }
10927        if {$tags eq $ctags} {
10928            set cached_dtags($origid) $tags
10929        } else {
10930            set tags $ctags
10931        }
10932    } else {
10933        set cached_dtags($origid) $tags
10934    }
10935    set t3 [clock clicks -milliseconds]
10936    if {0 && $t3 - $t1 >= 100} {
10937        puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10938            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10939    }
10940    return $tags
10941}
10942
10943proc anctags {id} {
10944    global arcnos arcids arcout arcend arctags idtags allparents
10945    global growing cached_atags
10946
10947    if {![info exists allparents($id)]} {
10948        return {}
10949    }
10950    set t1 [clock clicks -milliseconds]
10951    set argid $id
10952    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10953        # part-way along an arc; check that arc first
10954        set a [lindex $arcnos($id) 0]
10955        if {$arctags($a) ne {}} {
10956            validate_arctags $a
10957            set i [lsearch -exact $arcids($a) $id]
10958            foreach t $arctags($a) {
10959                set j [lsearch -exact $arcids($a) $t]
10960                if {$j > $i} {
10961                    return $t
10962                }
10963            }
10964        }
10965        if {![info exists arcend($a)]} {
10966            return {}
10967        }
10968        set id $arcend($a)
10969        if {[info exists idtags($id)]} {
10970            return $id
10971        }
10972    }
10973    if {[info exists cached_atags($id)]} {
10974        return $cached_atags($id)
10975    }
10976
10977    set origid $id
10978    set todo [list $id]
10979    set queued($id) 1
10980    set taglist {}
10981    set nc 1
10982    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10983        set id [lindex $todo $i]
10984        set done($id) 1
10985        set td [info exists hastaggeddescendent($id)]
10986        if {!$td} {
10987            incr nc -1
10988        }
10989        # ignore tags on starting node
10990        if {!$td && $i > 0} {
10991            if {[info exists idtags($id)]} {
10992                set tagloc($id) $id
10993                set td 1
10994            } elseif {[info exists cached_atags($id)]} {
10995                set tagloc($id) $cached_atags($id)
10996                set td 1
10997            }
10998        }
10999        foreach a $arcout($id) {
11000            if {!$td && $arctags($a) ne {}} {
11001                validate_arctags $a
11002                if {$arctags($a) ne {}} {
11003                    lappend tagloc($id) [lindex $arctags($a) 0]
11004                }
11005            }
11006            if {![info exists arcend($a)]} continue
11007            set d $arcend($a)
11008            if {$td || $arctags($a) ne {}} {
11009                set tomark [list $d]
11010                for {set j 0} {$j < [llength $tomark]} {incr j} {
11011                    set dd [lindex $tomark $j]
11012                    if {![info exists hastaggeddescendent($dd)]} {
11013                        if {[info exists done($dd)]} {
11014                            foreach b $arcout($dd) {
11015                                if {[info exists arcend($b)]} {
11016                                    lappend tomark $arcend($b)
11017                                }
11018                            }
11019                            if {[info exists tagloc($dd)]} {
11020                                unset tagloc($dd)
11021                            }
11022                        } elseif {[info exists queued($dd)]} {
11023                            incr nc -1
11024                        }
11025                        set hastaggeddescendent($dd) 1
11026                    }
11027                }
11028            }
11029            if {![info exists queued($d)]} {
11030                lappend todo $d
11031                set queued($d) 1
11032                if {![info exists hastaggeddescendent($d)]} {
11033                    incr nc
11034                }
11035            }
11036        }
11037    }
11038    set t2 [clock clicks -milliseconds]
11039    set loopix $i
11040    set tags {}
11041    foreach id [array names tagloc] {
11042        if {![info exists hastaggeddescendent($id)]} {
11043            foreach t $tagloc($id) {
11044                if {[lsearch -exact $tags $t] < 0} {
11045                    lappend tags $t
11046                }
11047            }
11048        }
11049    }
11050
11051    # remove tags that are ancestors of other tags
11052    for {set i 0} {$i < [llength $tags]} {incr i} {
11053        set a [lindex $tags $i]
11054        for {set j 0} {$j < $i} {incr j} {
11055            set b [lindex $tags $j]
11056            set r [anc_or_desc $a $b]
11057            if {$r == -1} {
11058                set tags [lreplace $tags $j $j]
11059                incr j -1
11060                incr i -1
11061            } elseif {$r == 1} {
11062                set tags [lreplace $tags $i $i]
11063                incr i -1
11064                break
11065            }
11066        }
11067    }
11068
11069    if {[array names growing] ne {}} {
11070        # graph isn't finished, need to check if any tag could get
11071        # eclipsed by another tag coming later.  Simply ignore any
11072        # tags that could later get eclipsed.
11073        set ctags {}
11074        foreach t $tags {
11075            if {[is_certain $origid $t]} {
11076                lappend ctags $t
11077            }
11078        }
11079        if {$tags eq $ctags} {
11080            set cached_atags($origid) $tags
11081        } else {
11082            set tags $ctags
11083        }
11084    } else {
11085        set cached_atags($origid) $tags
11086    }
11087    set t3 [clock clicks -milliseconds]
11088    if {0 && $t3 - $t1 >= 100} {
11089        puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
11090            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
11091    }
11092    return $tags
11093}
11094
11095# Return the list of IDs that have heads that are descendents of id,
11096# including id itself if it has a head.
11097proc descheads {id} {
11098    global arcnos arcstart arcids archeads idheads cached_dheads
11099    global allparents arcout
11100
11101    if {![info exists allparents($id)]} {
11102        return {}
11103    }
11104    set aret {}
11105    if {![info exists arcout($id)]} {
11106        # part-way along an arc; check it first
11107        set a [lindex $arcnos($id) 0]
11108        if {$archeads($a) ne {}} {
11109            validate_archeads $a
11110            set i [lsearch -exact $arcids($a) $id]
11111            foreach t $archeads($a) {
11112                set j [lsearch -exact $arcids($a) $t]
11113                if {$j > $i} break
11114                lappend aret $t
11115            }
11116        }
11117        set id $arcstart($a)
11118    }
11119    set origid $id
11120    set todo [list $id]
11121    set seen($id) 1
11122    set ret {}
11123    for {set i 0} {$i < [llength $todo]} {incr i} {
11124        set id [lindex $todo $i]
11125        if {[info exists cached_dheads($id)]} {
11126            set ret [concat $ret $cached_dheads($id)]
11127        } else {
11128            if {[info exists idheads($id)]} {
11129                lappend ret $id
11130            }
11131            foreach a $arcnos($id) {
11132                if {$archeads($a) ne {}} {
11133                    validate_archeads $a
11134                    if {$archeads($a) ne {}} {
11135                        set ret [concat $ret $archeads($a)]
11136                    }
11137                }
11138                set d $arcstart($a)
11139                if {![info exists seen($d)]} {
11140                    lappend todo $d
11141                    set seen($d) 1
11142                }
11143            }
11144        }
11145    }
11146    set ret [lsort -unique $ret]
11147    set cached_dheads($origid) $ret
11148    return [concat $ret $aret]
11149}
11150
11151proc addedtag {id} {
11152    global arcnos arcout cached_dtags cached_atags
11153
11154    if {![info exists arcnos($id)]} return
11155    if {![info exists arcout($id)]} {
11156        recalcarc [lindex $arcnos($id) 0]
11157    }
11158    unset -nocomplain cached_dtags
11159    unset -nocomplain cached_atags
11160}
11161
11162proc addedhead {hid head} {
11163    global arcnos arcout cached_dheads
11164
11165    if {![info exists arcnos($hid)]} return
11166    if {![info exists arcout($hid)]} {
11167        recalcarc [lindex $arcnos($hid) 0]
11168    }
11169    unset -nocomplain cached_dheads
11170}
11171
11172proc removedhead {hid head} {
11173    global cached_dheads
11174
11175    unset -nocomplain cached_dheads
11176}
11177
11178proc movedhead {hid head} {
11179    global arcnos arcout cached_dheads
11180
11181    if {![info exists arcnos($hid)]} return
11182    if {![info exists arcout($hid)]} {
11183        recalcarc [lindex $arcnos($hid) 0]
11184    }
11185    unset -nocomplain cached_dheads
11186}
11187
11188proc changedrefs {} {
11189    global cached_dheads cached_dtags cached_atags cached_tagcontent
11190    global arctags archeads arcnos arcout idheads idtags
11191
11192    foreach id [concat [array names idheads] [array names idtags]] {
11193        if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
11194            set a [lindex $arcnos($id) 0]
11195            if {![info exists donearc($a)]} {
11196                recalcarc $a
11197                set donearc($a) 1
11198            }
11199        }
11200    }
11201    unset -nocomplain cached_tagcontent
11202    unset -nocomplain cached_dtags
11203    unset -nocomplain cached_atags
11204    unset -nocomplain cached_dheads
11205}
11206
11207proc rereadrefs {} {
11208    global idtags idheads idotherrefs mainheadid
11209
11210    set refids [concat [array names idtags] \
11211                    [array names idheads] [array names idotherrefs]]
11212    foreach id $refids {
11213        if {![info exists ref($id)]} {
11214            set ref($id) [listrefs $id]
11215        }
11216    }
11217    set oldmainhead $mainheadid
11218    readrefs
11219    changedrefs
11220    set refids [lsort -unique [concat $refids [array names idtags] \
11221                        [array names idheads] [array names idotherrefs]]]
11222    foreach id $refids {
11223        set v [listrefs $id]
11224        if {![info exists ref($id)] || $ref($id) != $v} {
11225            redrawtags $id
11226        }
11227    }
11228    if {$oldmainhead ne $mainheadid} {
11229        redrawtags $oldmainhead
11230        redrawtags $mainheadid
11231    }
11232    run refill_reflist
11233}
11234
11235proc listrefs {id} {
11236    global idtags idheads idotherrefs
11237
11238    set x {}
11239    if {[info exists idtags($id)]} {
11240        set x $idtags($id)
11241    }
11242    set y {}
11243    if {[info exists idheads($id)]} {
11244        set y $idheads($id)
11245    }
11246    set z {}
11247    if {[info exists idotherrefs($id)]} {
11248        set z $idotherrefs($id)
11249    }
11250    return [list $x $y $z]
11251}
11252
11253proc add_tag_ctext {tag} {
11254    global ctext cached_tagcontent tagids
11255
11256    if {![info exists cached_tagcontent($tag)]} {
11257        catch {
11258            set cached_tagcontent($tag) [exec git cat-file -p $tag]
11259        }
11260    }
11261    $ctext insert end "[mc "Tag"]: $tag\n" bold
11262    if {[info exists cached_tagcontent($tag)]} {
11263        set text $cached_tagcontent($tag)
11264    } else {
11265        set text "[mc "Id"]:  $tagids($tag)"
11266    }
11267    appendwithlinks $text {}
11268}
11269
11270proc showtag {tag isnew} {
11271    global ctext cached_tagcontent tagids linknum tagobjid
11272
11273    if {$isnew} {
11274        addtohistory [list showtag $tag 0] savectextpos
11275    }
11276    $ctext conf -state normal
11277    clear_ctext
11278    settabs 0
11279    set linknum 0
11280    add_tag_ctext $tag
11281    maybe_scroll_ctext 1
11282    $ctext conf -state disabled
11283    init_flist {}
11284}
11285
11286proc showtags {id isnew} {
11287    global idtags ctext linknum
11288
11289    if {$isnew} {
11290        addtohistory [list showtags $id 0] savectextpos
11291    }
11292    $ctext conf -state normal
11293    clear_ctext
11294    settabs 0
11295    set linknum 0
11296    set sep {}
11297    foreach tag $idtags($id) {
11298        $ctext insert end $sep
11299        add_tag_ctext $tag
11300        set sep "\n\n"
11301    }
11302    maybe_scroll_ctext 1
11303    $ctext conf -state disabled
11304    init_flist {}
11305}
11306
11307proc doquit {} {
11308    global stopped
11309    global gitktmpdir
11310
11311    set stopped 100
11312    savestuff .
11313    destroy .
11314
11315    if {[info exists gitktmpdir]} {
11316        catch {file delete -force $gitktmpdir}
11317    }
11318}
11319
11320proc mkfontdisp {font top which} {
11321    global fontattr fontpref $font NS use_ttk
11322
11323    set fontpref($font) [set $font]
11324    ${NS}::button $top.${font}but -text $which \
11325        -command [list choosefont $font $which]
11326    ${NS}::label $top.$font -relief flat -font $font \
11327        -text $fontattr($font,family) -justify left
11328    grid x $top.${font}but $top.$font -sticky w
11329}
11330
11331proc choosefont {font which} {
11332    global fontparam fontlist fonttop fontattr
11333    global prefstop NS
11334
11335    set fontparam(which) $which
11336    set fontparam(font) $font
11337    set fontparam(family) [font actual $font -family]
11338    set fontparam(size) $fontattr($font,size)
11339    set fontparam(weight) $fontattr($font,weight)
11340    set fontparam(slant) $fontattr($font,slant)
11341    set top .gitkfont
11342    set fonttop $top
11343    if {![winfo exists $top]} {
11344        font create sample
11345        eval font config sample [font actual $font]
11346        ttk_toplevel $top
11347        make_transient $top $prefstop
11348        wm title $top [mc "Gitk font chooser"]
11349        ${NS}::label $top.l -textvariable fontparam(which)
11350        pack $top.l -side top
11351        set fontlist [lsort [font families]]
11352        ${NS}::frame $top.f
11353        listbox $top.f.fam -listvariable fontlist \
11354            -yscrollcommand [list $top.f.sb set]
11355        bind $top.f.fam <<ListboxSelect>> selfontfam
11356        ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
11357        pack $top.f.sb -side right -fill y
11358        pack $top.f.fam -side left -fill both -expand 1
11359        pack $top.f -side top -fill both -expand 1
11360        ${NS}::frame $top.g
11361        spinbox $top.g.size -from 4 -to 40 -width 4 \
11362            -textvariable fontparam(size) \
11363            -validatecommand {string is integer -strict %s}
11364        checkbutton $top.g.bold -padx 5 \
11365            -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
11366            -variable fontparam(weight) -onvalue bold -offvalue normal
11367        checkbutton $top.g.ital -padx 5 \
11368            -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
11369            -variable fontparam(slant) -onvalue italic -offvalue roman
11370        pack $top.g.size $top.g.bold $top.g.ital -side left
11371        pack $top.g -side top
11372        canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
11373            -background white
11374        $top.c create text 100 25 -anchor center -text $which -font sample \
11375            -fill black -tags text
11376        bind $top.c <Configure> [list centertext $top.c]
11377        pack $top.c -side top -fill x
11378        ${NS}::frame $top.buts
11379        ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
11380        ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
11381        bind $top <Key-Return> fontok
11382        bind $top <Key-Escape> fontcan
11383        grid $top.buts.ok $top.buts.can
11384        grid columnconfigure $top.buts 0 -weight 1 -uniform a
11385        grid columnconfigure $top.buts 1 -weight 1 -uniform a
11386        pack $top.buts -side bottom -fill x
11387        trace add variable fontparam write chg_fontparam
11388    } else {
11389        raise $top
11390        $top.c itemconf text -text $which
11391    }
11392    set i [lsearch -exact $fontlist $fontparam(family)]
11393    if {$i >= 0} {
11394        $top.f.fam selection set $i
11395        $top.f.fam see $i
11396    }
11397}
11398
11399proc centertext {w} {
11400    $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
11401}
11402
11403proc fontok {} {
11404    global fontparam fontpref prefstop
11405
11406    set f $fontparam(font)
11407    set fontpref($f) [list $fontparam(family) $fontparam(size)]
11408    if {$fontparam(weight) eq "bold"} {
11409        lappend fontpref($f) "bold"
11410    }
11411    if {$fontparam(slant) eq "italic"} {
11412        lappend fontpref($f) "italic"
11413    }
11414    set w $prefstop.notebook.fonts.$f
11415    $w conf -text $fontparam(family) -font $fontpref($f)
11416
11417    fontcan
11418}
11419
11420proc fontcan {} {
11421    global fonttop fontparam
11422
11423    if {[info exists fonttop]} {
11424        catch {destroy $fonttop}
11425        catch {font delete sample}
11426        unset fonttop
11427        unset fontparam
11428    }
11429}
11430
11431if {[package vsatisfies [package provide Tk] 8.6]} {
11432    # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
11433    # function to make use of it.
11434    proc choosefont {font which} {
11435        tk fontchooser configure -title $which -font $font \
11436            -command [list on_choosefont $font $which]
11437        tk fontchooser show
11438    }
11439    proc on_choosefont {font which newfont} {
11440        global fontparam
11441        puts stderr "$font $newfont"
11442        array set f [font actual $newfont]
11443        set fontparam(which) $which
11444        set fontparam(font) $font
11445        set fontparam(family) $f(-family)
11446        set fontparam(size) $f(-size)
11447        set fontparam(weight) $f(-weight)
11448        set fontparam(slant) $f(-slant)
11449        fontok
11450    }
11451}
11452
11453proc selfontfam {} {
11454    global fonttop fontparam
11455
11456    set i [$fonttop.f.fam curselection]
11457    if {$i ne {}} {
11458        set fontparam(family) [$fonttop.f.fam get $i]
11459    }
11460}
11461
11462proc chg_fontparam {v sub op} {
11463    global fontparam
11464
11465    font config sample -$sub $fontparam($sub)
11466}
11467
11468# Create a property sheet tab page
11469proc create_prefs_page {w} {
11470    global NS
11471    set parent [join [lrange [split $w .] 0 end-1] .]
11472    if {[winfo class $parent] eq "TNotebook"} {
11473        ${NS}::frame $w
11474    } else {
11475        ${NS}::labelframe $w
11476    }
11477}
11478
11479proc prefspage_general {notebook} {
11480    global NS maxwidth maxgraphpct showneartags showlocalchanges
11481    global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11482    global hideremotes want_ttk have_ttk maxrefs
11483
11484    set page [create_prefs_page $notebook.general]
11485
11486    ${NS}::label $page.ldisp -text [mc "Commit list display options"]
11487    grid $page.ldisp - -sticky w -pady 10
11488    ${NS}::label $page.spacer -text " "
11489    ${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
11490    spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
11491    grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w
11492                                         #xgettext:no-tcl-format
11493    ${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
11494    spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
11495    grid x $page.maxpctl $page.maxpct -sticky w
11496    ${NS}::checkbutton $page.showlocal -text [mc "Show local changes"] \
11497        -variable showlocalchanges
11498    grid x $page.showlocal -sticky w
11499    ${NS}::checkbutton $page.autoselect -text [mc "Auto-select SHA1 (length)"] \
11500        -variable autoselect
11501    spinbox $page.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
11502    grid x $page.autoselect $page.autosellen -sticky w
11503    ${NS}::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \
11504        -variable hideremotes
11505    grid x $page.hideremotes -sticky w
11506
11507    ${NS}::label $page.ddisp -text [mc "Diff display options"]
11508    grid $page.ddisp - -sticky w -pady 10
11509    ${NS}::label $page.tabstopl -text [mc "Tab spacing"]
11510    spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
11511    grid x $page.tabstopl $page.tabstop -sticky w
11512    ${NS}::checkbutton $page.ntag -text [mc "Display nearby tags/heads"] \
11513        -variable showneartags
11514    grid x $page.ntag -sticky w
11515    ${NS}::label $page.maxrefsl -text [mc "Maximum # tags/heads to show"]
11516    spinbox $page.maxrefs -from 1 -to 1000 -width 4 -textvariable maxrefs
11517    grid x $page.maxrefsl $page.maxrefs -sticky w
11518    ${NS}::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \
11519        -variable limitdiffs
11520    grid x $page.ldiff -sticky w
11521    ${NS}::checkbutton $page.lattr -text [mc "Support per-file encodings"] \
11522        -variable perfile_attrs
11523    grid x $page.lattr -sticky w
11524
11525    ${NS}::entry $page.extdifft -textvariable extdifftool
11526    ${NS}::frame $page.extdifff
11527    ${NS}::label $page.extdifff.l -text [mc "External diff tool" ]
11528    ${NS}::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff
11529    pack $page.extdifff.l $page.extdifff.b -side left
11530    pack configure $page.extdifff.l -padx 10
11531    grid x $page.extdifff $page.extdifft -sticky ew
11532
11533    ${NS}::label $page.lgen -text [mc "General options"]
11534    grid $page.lgen - -sticky w -pady 10
11535    ${NS}::checkbutton $page.want_ttk -variable want_ttk \
11536        -text [mc "Use themed widgets"]
11537    if {$have_ttk} {
11538        ${NS}::label $page.ttk_note -text [mc "(change requires restart)"]
11539    } else {
11540        ${NS}::label $page.ttk_note -text [mc "(currently unavailable)"]
11541    }
11542    grid x $page.want_ttk $page.ttk_note -sticky w
11543    return $page
11544}
11545
11546proc prefspage_colors {notebook} {
11547    global NS uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11548
11549    set page [create_prefs_page $notebook.colors]
11550
11551    ${NS}::label $page.cdisp -text [mc "Colors: press to choose"]
11552    grid $page.cdisp - -sticky w -pady 10
11553    label $page.ui -padx 40 -relief sunk -background $uicolor
11554    ${NS}::button $page.uibut -text [mc "Interface"] \
11555       -command [list choosecolor uicolor {} $page.ui [mc "interface"] setui]
11556    grid x $page.uibut $page.ui -sticky w
11557    label $page.bg -padx 40 -relief sunk -background $bgcolor
11558    ${NS}::button $page.bgbut -text [mc "Background"] \
11559        -command [list choosecolor bgcolor {} $page.bg [mc "background"] setbg]
11560    grid x $page.bgbut $page.bg -sticky w
11561    label $page.fg -padx 40 -relief sunk -background $fgcolor
11562    ${NS}::button $page.fgbut -text [mc "Foreground"] \
11563        -command [list choosecolor fgcolor {} $page.fg [mc "foreground"] setfg]
11564    grid x $page.fgbut $page.fg -sticky w
11565    label $page.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
11566    ${NS}::button $page.diffoldbut -text [mc "Diff: old lines"] \
11567        -command [list choosecolor diffcolors 0 $page.diffold [mc "diff old lines"] \
11568                      [list $ctext tag conf d0 -foreground]]
11569    grid x $page.diffoldbut $page.diffold -sticky w
11570    label $page.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
11571    ${NS}::button $page.diffnewbut -text [mc "Diff: new lines"] \
11572        -command [list choosecolor diffcolors 1 $page.diffnew [mc "diff new lines"] \
11573                      [list $ctext tag conf dresult -foreground]]
11574    grid x $page.diffnewbut $page.diffnew -sticky w
11575    label $page.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
11576    ${NS}::button $page.hunksepbut -text [mc "Diff: hunk header"] \
11577        -command [list choosecolor diffcolors 2 $page.hunksep \
11578                      [mc "diff hunk header"] \
11579                      [list $ctext tag conf hunksep -foreground]]
11580    grid x $page.hunksepbut $page.hunksep -sticky w
11581    label $page.markbgsep -padx 40 -relief sunk -background $markbgcolor
11582    ${NS}::button $page.markbgbut -text [mc "Marked line bg"] \
11583        -command [list choosecolor markbgcolor {} $page.markbgsep \
11584                      [mc "marked line background"] \
11585                      [list $ctext tag conf omark -background]]
11586    grid x $page.markbgbut $page.markbgsep -sticky w
11587    label $page.selbgsep -padx 40 -relief sunk -background $selectbgcolor
11588    ${NS}::button $page.selbgbut -text [mc "Select bg"] \
11589        -command [list choosecolor selectbgcolor {} $page.selbgsep [mc "background"] setselbg]
11590    grid x $page.selbgbut $page.selbgsep -sticky w
11591    return $page
11592}
11593
11594proc prefspage_fonts {notebook} {
11595    global NS
11596    set page [create_prefs_page $notebook.fonts]
11597    ${NS}::label $page.cfont -text [mc "Fonts: press to choose"]
11598    grid $page.cfont - -sticky w -pady 10
11599    mkfontdisp mainfont $page [mc "Main font"]
11600    mkfontdisp textfont $page [mc "Diff display font"]
11601    mkfontdisp uifont $page [mc "User interface font"]
11602    return $page
11603}
11604
11605proc doprefs {} {
11606    global maxwidth maxgraphpct use_ttk NS
11607    global oldprefs prefstop showneartags showlocalchanges
11608    global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11609    global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11610    global hideremotes want_ttk have_ttk
11611
11612    set top .gitkprefs
11613    set prefstop $top
11614    if {[winfo exists $top]} {
11615        raise $top
11616        return
11617    }
11618    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11619                   limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11620        set oldprefs($v) [set $v]
11621    }
11622    ttk_toplevel $top
11623    wm title $top [mc "Gitk preferences"]
11624    make_transient $top .
11625
11626    if {[set use_notebook [expr {$use_ttk && [info command ::ttk::notebook] ne ""}]]} {
11627        set notebook [ttk::notebook $top.notebook]
11628    } else {
11629        set notebook [${NS}::frame $top.notebook -borderwidth 0 -relief flat]
11630    }
11631
11632    lappend pages [prefspage_general $notebook] [mc "General"]
11633    lappend pages [prefspage_colors $notebook] [mc "Colors"]
11634    lappend pages [prefspage_fonts $notebook] [mc "Fonts"]
11635    set col 0
11636    foreach {page title} $pages {
11637        if {$use_notebook} {
11638            $notebook add $page -text $title
11639        } else {
11640            set btn [${NS}::button $notebook.b_[string map {. X} $page] \
11641                         -text $title -command [list raise $page]]
11642            $page configure -text $title
11643            grid $btn -row 0 -column [incr col] -sticky w
11644            grid $page -row 1 -column 0 -sticky news -columnspan 100
11645        }
11646    }
11647
11648    if {!$use_notebook} {
11649        grid columnconfigure $notebook 0 -weight 1
11650        grid rowconfigure $notebook 1 -weight 1
11651        raise [lindex $pages 0]
11652    }
11653
11654    grid $notebook -sticky news -padx 2 -pady 2
11655    grid rowconfigure $top 0 -weight 1
11656    grid columnconfigure $top 0 -weight 1
11657
11658    ${NS}::frame $top.buts
11659    ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
11660    ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
11661    bind $top <Key-Return> prefsok
11662    bind $top <Key-Escape> prefscan
11663    grid $top.buts.ok $top.buts.can
11664    grid columnconfigure $top.buts 0 -weight 1 -uniform a
11665    grid columnconfigure $top.buts 1 -weight 1 -uniform a
11666    grid $top.buts - - -pady 10 -sticky ew
11667    grid columnconfigure $top 2 -weight 1
11668    bind $top <Visibility> [list focus $top.buts.ok]
11669}
11670
11671proc choose_extdiff {} {
11672    global extdifftool
11673
11674    set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
11675    if {$prog ne {}} {
11676        set extdifftool $prog
11677    }
11678}
11679
11680proc choosecolor {v vi w x cmd} {
11681    global $v
11682
11683    set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
11684               -title [mc "Gitk: choose color for %s" $x]]
11685    if {$c eq {}} return
11686    $w conf -background $c
11687    lset $v $vi $c
11688    eval $cmd $c
11689}
11690
11691proc setselbg {c} {
11692    global bglist cflist
11693    foreach w $bglist {
11694        if {[winfo exists $w]} {
11695            $w configure -selectbackground $c
11696        }
11697    }
11698    $cflist tag configure highlight \
11699        -background [$cflist cget -selectbackground]
11700    allcanvs itemconf secsel -fill $c
11701}
11702
11703# This sets the background color and the color scheme for the whole UI.
11704# For some reason, tk_setPalette chooses a nasty dark red for selectColor
11705# if we don't specify one ourselves, which makes the checkbuttons and
11706# radiobuttons look bad.  This chooses white for selectColor if the
11707# background color is light, or black if it is dark.
11708proc setui {c} {
11709    if {[tk windowingsystem] eq "win32"} { return }
11710    set bg [winfo rgb . $c]
11711    set selc black
11712    if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
11713        set selc white
11714    }
11715    tk_setPalette background $c selectColor $selc
11716}
11717
11718proc setbg {c} {
11719    global bglist
11720
11721    foreach w $bglist {
11722        if {[winfo exists $w]} {
11723            $w conf -background $c
11724        }
11725    }
11726}
11727
11728proc setfg {c} {
11729    global fglist canv
11730
11731    foreach w $fglist {
11732        if {[winfo exists $w]} {
11733            $w conf -foreground $c
11734        }
11735    }
11736    allcanvs itemconf text -fill $c
11737    $canv itemconf circle -outline $c
11738    $canv itemconf markid -outline $c
11739}
11740
11741proc prefscan {} {
11742    global oldprefs prefstop
11743
11744    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11745                   limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11746        global $v
11747        set $v $oldprefs($v)
11748    }
11749    catch {destroy $prefstop}
11750    unset prefstop
11751    fontcan
11752}
11753
11754proc prefsok {} {
11755    global maxwidth maxgraphpct
11756    global oldprefs prefstop showneartags showlocalchanges
11757    global fontpref mainfont textfont uifont
11758    global limitdiffs treediffs perfile_attrs
11759    global hideremotes
11760
11761    catch {destroy $prefstop}
11762    unset prefstop
11763    fontcan
11764    set fontchanged 0
11765    if {$mainfont ne $fontpref(mainfont)} {
11766        set mainfont $fontpref(mainfont)
11767        parsefont mainfont $mainfont
11768        eval font configure mainfont [fontflags mainfont]
11769        eval font configure mainfontbold [fontflags mainfont 1]
11770        setcoords
11771        set fontchanged 1
11772    }
11773    if {$textfont ne $fontpref(textfont)} {
11774        set textfont $fontpref(textfont)
11775        parsefont textfont $textfont
11776        eval font configure textfont [fontflags textfont]
11777        eval font configure textfontbold [fontflags textfont 1]
11778    }
11779    if {$uifont ne $fontpref(uifont)} {
11780        set uifont $fontpref(uifont)
11781        parsefont uifont $uifont
11782        eval font configure uifont [fontflags uifont]
11783    }
11784    settabs
11785    if {$showlocalchanges != $oldprefs(showlocalchanges)} {
11786        if {$showlocalchanges} {
11787            doshowlocalchanges
11788        } else {
11789            dohidelocalchanges
11790        }
11791    }
11792    if {$limitdiffs != $oldprefs(limitdiffs) ||
11793        ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11794        # treediffs elements are limited by path;
11795        # won't have encodings cached if perfile_attrs was just turned on
11796        unset -nocomplain treediffs
11797    }
11798    if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
11799        || $maxgraphpct != $oldprefs(maxgraphpct)} {
11800        redisplay
11801    } elseif {$showneartags != $oldprefs(showneartags) ||
11802          $limitdiffs != $oldprefs(limitdiffs)} {
11803        reselectline
11804    }
11805    if {$hideremotes != $oldprefs(hideremotes)} {
11806        rereadrefs
11807    }
11808}
11809
11810proc formatdate {d} {
11811    global datetimeformat
11812    if {$d ne {}} {
11813        # If $datetimeformat includes a timezone, display in the
11814        # timezone of the argument.  Otherwise, display in local time.
11815        if {[string match {*%[zZ]*} $datetimeformat]} {
11816            if {[catch {set d [clock format [lindex $d 0] -timezone [lindex $d 1] -format $datetimeformat]}]} {
11817                # Tcl < 8.5 does not support -timezone.  Emulate it by
11818                # setting TZ (e.g. TZ=<-0430>+04:30).
11819                global env
11820                if {[info exists env(TZ)]} {
11821                    set savedTZ $env(TZ)
11822                }
11823                set zone [lindex $d 1]
11824                set sign [string map {+ - - +} [string index $zone 0]]
11825                set env(TZ) <$zone>$sign[string range $zone 1 2]:[string range $zone 3 4]
11826                set d [clock format [lindex $d 0] -format $datetimeformat]
11827                if {[info exists savedTZ]} {
11828                    set env(TZ) $savedTZ
11829                } else {
11830                    unset env(TZ)
11831                }
11832            }
11833        } else {
11834            set d [clock format [lindex $d 0] -format $datetimeformat]
11835        }
11836    }
11837    return $d
11838}
11839
11840# This list of encoding names and aliases is distilled from
11841# http://www.iana.org/assignments/character-sets.
11842# Not all of them are supported by Tcl.
11843set encoding_aliases {
11844    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11845      ISO646-US US-ASCII us IBM367 cp367 csASCII }
11846    { ISO-10646-UTF-1 csISO10646UTF1 }
11847    { ISO_646.basic:1983 ref csISO646basic1983 }
11848    { INVARIANT csINVARIANT }
11849    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11850    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11851    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11852    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11853    { NATS-DANO iso-ir-9-1 csNATSDANO }
11854    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11855    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11856    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11857    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11858    { ISO-2022-KR csISO2022KR }
11859    { EUC-KR csEUCKR }
11860    { ISO-2022-JP csISO2022JP }
11861    { ISO-2022-JP-2 csISO2022JP2 }
11862    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11863      csISO13JISC6220jp }
11864    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11865    { IT iso-ir-15 ISO646-IT csISO15Italian }
11866    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11867    { ES iso-ir-17 ISO646-ES csISO17Spanish }
11868    { greek7-old iso-ir-18 csISO18Greek7Old }
11869    { latin-greek iso-ir-19 csISO19LatinGreek }
11870    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11871    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11872    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11873    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11874    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11875    { BS_viewdata iso-ir-47 csISO47BSViewdata }
11876    { INIS iso-ir-49 csISO49INIS }
11877    { INIS-8 iso-ir-50 csISO50INIS8 }
11878    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11879    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11880    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11881    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11882    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11883    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11884      csISO60Norwegian1 }
11885    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11886    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11887    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11888    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11889    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11890    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11891    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11892    { greek7 iso-ir-88 csISO88Greek7 }
11893    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11894    { iso-ir-90 csISO90 }
11895    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11896    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11897      csISO92JISC62991984b }
11898    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11899    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11900    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11901      csISO95JIS62291984handadd }
11902    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11903    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11904    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11905    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11906      CP819 csISOLatin1 }
11907    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11908    { T.61-7bit iso-ir-102 csISO102T617bit }
11909    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11910    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
11911    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
11912    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
11913    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
11914    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
11915    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
11916    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
11917      arabic csISOLatinArabic }
11918    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
11919    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
11920    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
11921      greek greek8 csISOLatinGreek }
11922    { T.101-G2 iso-ir-128 csISO128T101G2 }
11923    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
11924      csISOLatinHebrew }
11925    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
11926    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
11927    { CSN_369103 iso-ir-139 csISO139CSN369103 }
11928    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
11929    { ISO_6937-2-add iso-ir-142 csISOTextComm }
11930    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
11931    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
11932      csISOLatinCyrillic }
11933    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
11934    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
11935    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
11936    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
11937    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
11938    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
11939    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
11940    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
11941    { ISO_10367-box iso-ir-155 csISO10367Box }
11942    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
11943    { latin-lap lap iso-ir-158 csISO158Lap }
11944    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
11945    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
11946    { us-dk csUSDK }
11947    { dk-us csDKUS }
11948    { JIS_X0201 X0201 csHalfWidthKatakana }
11949    { KSC5636 ISO646-KR csKSC5636 }
11950    { ISO-10646-UCS-2 csUnicode }
11951    { ISO-10646-UCS-4 csUCS4 }
11952    { DEC-MCS dec csDECMCS }
11953    { hp-roman8 roman8 r8 csHPRoman8 }
11954    { macintosh mac csMacintosh }
11955    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
11956      csIBM037 }
11957    { IBM038 EBCDIC-INT cp038 csIBM038 }
11958    { IBM273 CP273 csIBM273 }
11959    { IBM274 EBCDIC-BE CP274 csIBM274 }
11960    { IBM275 EBCDIC-BR cp275 csIBM275 }
11961    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
11962    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
11963    { IBM280 CP280 ebcdic-cp-it csIBM280 }
11964    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
11965    { IBM284 CP284 ebcdic-cp-es csIBM284 }
11966    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
11967    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
11968    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
11969    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
11970    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
11971    { IBM424 cp424 ebcdic-cp-he csIBM424 }
11972    { IBM437 cp437 437 csPC8CodePage437 }
11973    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
11974    { IBM775 cp775 csPC775Baltic }
11975    { IBM850 cp850 850 csPC850Multilingual }
11976    { IBM851 cp851 851 csIBM851 }
11977    { IBM852 cp852 852 csPCp852 }
11978    { IBM855 cp855 855 csIBM855 }
11979    { IBM857 cp857 857 csIBM857 }
11980    { IBM860 cp860 860 csIBM860 }
11981    { IBM861 cp861 861 cp-is csIBM861 }
11982    { IBM862 cp862 862 csPC862LatinHebrew }
11983    { IBM863 cp863 863 csIBM863 }
11984    { IBM864 cp864 csIBM864 }
11985    { IBM865 cp865 865 csIBM865 }
11986    { IBM866 cp866 866 csIBM866 }
11987    { IBM868 CP868 cp-ar csIBM868 }
11988    { IBM869 cp869 869 cp-gr csIBM869 }
11989    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
11990    { IBM871 CP871 ebcdic-cp-is csIBM871 }
11991    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
11992    { IBM891 cp891 csIBM891 }
11993    { IBM903 cp903 csIBM903 }
11994    { IBM904 cp904 904 csIBBM904 }
11995    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
11996    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
11997    { IBM1026 CP1026 csIBM1026 }
11998    { EBCDIC-AT-DE csIBMEBCDICATDE }
11999    { EBCDIC-AT-DE-A csEBCDICATDEA }
12000    { EBCDIC-CA-FR csEBCDICCAFR }
12001    { EBCDIC-DK-NO csEBCDICDKNO }
12002    { EBCDIC-DK-NO-A csEBCDICDKNOA }
12003    { EBCDIC-FI-SE csEBCDICFISE }
12004    { EBCDIC-FI-SE-A csEBCDICFISEA }
12005    { EBCDIC-FR csEBCDICFR }
12006    { EBCDIC-IT csEBCDICIT }
12007    { EBCDIC-PT csEBCDICPT }
12008    { EBCDIC-ES csEBCDICES }
12009    { EBCDIC-ES-A csEBCDICESA }
12010    { EBCDIC-ES-S csEBCDICESS }
12011    { EBCDIC-UK csEBCDICUK }
12012    { EBCDIC-US csEBCDICUS }
12013    { UNKNOWN-8BIT csUnknown8BiT }
12014    { MNEMONIC csMnemonic }
12015    { MNEM csMnem }
12016    { VISCII csVISCII }
12017    { VIQR csVIQR }
12018    { KOI8-R csKOI8R }
12019    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
12020    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
12021    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
12022    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
12023    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
12024    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
12025    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
12026    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
12027    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
12028    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
12029    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
12030    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
12031    { IBM1047 IBM-1047 }
12032    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
12033    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
12034    { UNICODE-1-1 csUnicode11 }
12035    { CESU-8 csCESU-8 }
12036    { BOCU-1 csBOCU-1 }
12037    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
12038    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
12039      l8 }
12040    { ISO-8859-15 ISO_8859-15 Latin-9 }
12041    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
12042    { GBK CP936 MS936 windows-936 }
12043    { JIS_Encoding csJISEncoding }
12044    { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
12045    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
12046      EUC-JP }
12047    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
12048    { ISO-10646-UCS-Basic csUnicodeASCII }
12049    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
12050    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
12051    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
12052    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
12053    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
12054    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
12055    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
12056    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
12057    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
12058    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
12059    { Adobe-Standard-Encoding csAdobeStandardEncoding }
12060    { Ventura-US csVenturaUS }
12061    { Ventura-International csVenturaInternational }
12062    { PC8-Danish-Norwegian csPC8DanishNorwegian }
12063    { PC8-Turkish csPC8Turkish }
12064    { IBM-Symbols csIBMSymbols }
12065    { IBM-Thai csIBMThai }
12066    { HP-Legal csHPLegal }
12067    { HP-Pi-font csHPPiFont }
12068    { HP-Math8 csHPMath8 }
12069    { Adobe-Symbol-Encoding csHPPSMath }
12070    { HP-DeskTop csHPDesktop }
12071    { Ventura-Math csVenturaMath }
12072    { Microsoft-Publishing csMicrosoftPublishing }
12073    { Windows-31J csWindows31J }
12074    { GB2312 csGB2312 }
12075    { Big5 csBig5 }
12076}
12077
12078proc tcl_encoding {enc} {
12079    global encoding_aliases tcl_encoding_cache
12080    if {[info exists tcl_encoding_cache($enc)]} {
12081        return $tcl_encoding_cache($enc)
12082    }
12083    set names [encoding names]
12084    set lcnames [string tolower $names]
12085    set enc [string tolower $enc]
12086    set i [lsearch -exact $lcnames $enc]
12087    if {$i < 0} {
12088        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
12089        if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
12090            set i [lsearch -exact $lcnames $encx]
12091        }
12092    }
12093    if {$i < 0} {
12094        foreach l $encoding_aliases {
12095            set ll [string tolower $l]
12096            if {[lsearch -exact $ll $enc] < 0} continue
12097            # look through the aliases for one that tcl knows about
12098            foreach e $ll {
12099                set i [lsearch -exact $lcnames $e]
12100                if {$i < 0} {
12101                    if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
12102                        set i [lsearch -exact $lcnames $ex]
12103                    }
12104                }
12105                if {$i >= 0} break
12106            }
12107            break
12108        }
12109    }
12110    set tclenc {}
12111    if {$i >= 0} {
12112        set tclenc [lindex $names $i]
12113    }
12114    set tcl_encoding_cache($enc) $tclenc
12115    return $tclenc
12116}
12117
12118proc gitattr {path attr default} {
12119    global path_attr_cache
12120    if {[info exists path_attr_cache($attr,$path)]} {
12121        set r $path_attr_cache($attr,$path)
12122    } else {
12123        set r "unspecified"
12124        if {![catch {set line [exec git check-attr $attr -- $path]}]} {
12125            regexp "(.*): $attr: (.*)" $line m f r
12126        }
12127        set path_attr_cache($attr,$path) $r
12128    }
12129    if {$r eq "unspecified"} {
12130        return $default
12131    }
12132    return $r
12133}
12134
12135proc cache_gitattr {attr pathlist} {
12136    global path_attr_cache
12137    set newlist {}
12138    foreach path $pathlist {
12139        if {![info exists path_attr_cache($attr,$path)]} {
12140            lappend newlist $path
12141        }
12142    }
12143    set lim 1000
12144    if {[tk windowingsystem] == "win32"} {
12145        # windows has a 32k limit on the arguments to a command...
12146        set lim 30
12147    }
12148    while {$newlist ne {}} {
12149        set head [lrange $newlist 0 [expr {$lim - 1}]]
12150        set newlist [lrange $newlist $lim end]
12151        if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
12152            foreach row [split $rlist "\n"] {
12153                if {[regexp "(.*): $attr: (.*)" $row m path value]} {
12154                    if {[string index $path 0] eq "\""} {
12155                        set path [encoding convertfrom [lindex $path 0]]
12156                    }
12157                    set path_attr_cache($attr,$path) $value
12158                }
12159            }
12160        }
12161    }
12162}
12163
12164proc get_path_encoding {path} {
12165    global gui_encoding perfile_attrs
12166    set tcl_enc $gui_encoding
12167    if {$path ne {} && $perfile_attrs} {
12168        set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
12169        if {$enc2 ne {}} {
12170            set tcl_enc $enc2
12171        }
12172    }
12173    return $tcl_enc
12174}
12175
12176## For msgcat loading, first locate the installation location.
12177if { [info exists ::env(GITK_MSGSDIR)] } {
12178    ## Msgsdir was manually set in the environment.
12179    set gitk_msgsdir $::env(GITK_MSGSDIR)
12180} else {
12181    ## Let's guess the prefix from argv0.
12182    set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
12183    set gitk_libdir [file join $gitk_prefix share gitk lib]
12184    set gitk_msgsdir [file join $gitk_libdir msgs]
12185    unset gitk_prefix
12186}
12187
12188## Internationalization (i18n) through msgcat and gettext. See
12189## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
12190package require msgcat
12191namespace import ::msgcat::mc
12192## And eventually load the actual message catalog
12193::msgcat::mcload $gitk_msgsdir
12194
12195# First check that Tcl/Tk is recent enough
12196if {[catch {package require Tk 8.4} err]} {
12197    show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
12198                         Gitk requires at least Tcl/Tk 8.4."]
12199    exit 1
12200}
12201
12202# on OSX bring the current Wish process window to front
12203if {[tk windowingsystem] eq "aqua"} {
12204    exec osascript -e [format {
12205        tell application "System Events"
12206            set frontmost of processes whose unix id is %d to true
12207        end tell
12208    } [pid] ]
12209}
12210
12211# Unset GIT_TRACE var if set
12212if { [info exists ::env(GIT_TRACE)] } {
12213    unset ::env(GIT_TRACE)
12214}
12215
12216# defaults...
12217set wrcomcmd "git diff-tree --stdin -p --pretty=email"
12218
12219set gitencoding {}
12220catch {
12221    set gitencoding [exec git config --get i18n.commitencoding]
12222}
12223catch {
12224    set gitencoding [exec git config --get i18n.logoutputencoding]
12225}
12226if {$gitencoding == ""} {
12227    set gitencoding "utf-8"
12228}
12229set tclencoding [tcl_encoding $gitencoding]
12230if {$tclencoding == {}} {
12231    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
12232}
12233
12234set gui_encoding [encoding system]
12235catch {
12236    set enc [exec git config --get gui.encoding]
12237    if {$enc ne {}} {
12238        set tclenc [tcl_encoding $enc]
12239        if {$tclenc ne {}} {
12240            set gui_encoding $tclenc
12241        } else {
12242            puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
12243        }
12244    }
12245}
12246
12247set log_showroot true
12248catch {
12249    set log_showroot [exec git config --bool --get log.showroot]
12250}
12251
12252if {[tk windowingsystem] eq "aqua"} {
12253    set mainfont {{Lucida Grande} 9}
12254    set textfont {Monaco 9}
12255    set uifont {{Lucida Grande} 9 bold}
12256} elseif {![catch {::tk::pkgconfig get fontsystem} xft] && $xft eq "xft"} {
12257    # fontconfig!
12258    set mainfont {sans 9}
12259    set textfont {monospace 9}
12260    set uifont {sans 9 bold}
12261} else {
12262    set mainfont {Helvetica 9}
12263    set textfont {Courier 9}
12264    set uifont {Helvetica 9 bold}
12265}
12266set tabstop 8
12267set findmergefiles 0
12268set maxgraphpct 50
12269set maxwidth 16
12270set revlistorder 0
12271set fastdate 0
12272set uparrowlen 5
12273set downarrowlen 5
12274set mingaplen 100
12275set cmitmode "patch"
12276set wrapcomment "none"
12277set showneartags 1
12278set hideremotes 0
12279set maxrefs 20
12280set visiblerefs {"master"}
12281set maxlinelen 200
12282set showlocalchanges 1
12283set limitdiffs 1
12284set datetimeformat "%Y-%m-%d %H:%M:%S"
12285set autoselect 1
12286set autosellen 40
12287set perfile_attrs 0
12288set want_ttk 1
12289
12290if {[tk windowingsystem] eq "aqua"} {
12291    set extdifftool "opendiff"
12292} else {
12293    set extdifftool "meld"
12294}
12295
12296set colors {lime red blue magenta darkgrey brown orange}
12297if {[tk windowingsystem] eq "win32"} {
12298    set uicolor SystemButtonFace
12299    set uifgcolor SystemButtonText
12300    set uifgdisabledcolor SystemDisabledText
12301    set bgcolor SystemWindow
12302    set fgcolor SystemWindowText
12303    set selectbgcolor SystemHighlight
12304} else {
12305    set uicolor grey85
12306    set uifgcolor black
12307    set uifgdisabledcolor "#999"
12308    set bgcolor white
12309    set fgcolor black
12310    set selectbgcolor gray85
12311}
12312set diffcolors {red "#00a000" blue}
12313set diffcontext 3
12314set mergecolors {red blue lime purple brown "#009090" magenta "#808000" "#009000" "#ff0080" cyan "#b07070" "#70b0f0" "#70f0b0" "#f0b070" "#ff70b0"}
12315set ignorespace 0
12316set worddiff ""
12317set markbgcolor "#e0e0ff"
12318
12319set headbgcolor lime
12320set headfgcolor black
12321set headoutlinecolor black
12322set remotebgcolor #ffddaa
12323set tagbgcolor yellow
12324set tagfgcolor black
12325set tagoutlinecolor black
12326set reflinecolor black
12327set filesepbgcolor #aaaaaa
12328set filesepfgcolor black
12329set linehoverbgcolor #ffff80
12330set linehoverfgcolor black
12331set linehoveroutlinecolor black
12332set mainheadcirclecolor yellow
12333set workingfilescirclecolor red
12334set indexcirclecolor lime
12335set circlecolors {white blue gray blue blue}
12336set linkfgcolor blue
12337set circleoutlinecolor $fgcolor
12338set foundbgcolor yellow
12339set currentsearchhitbgcolor orange
12340
12341# button for popping up context menus
12342if {[tk windowingsystem] eq "aqua"} {
12343    set ctxbut <Button-2>
12344} else {
12345    set ctxbut <Button-3>
12346}
12347
12348catch {
12349    # follow the XDG base directory specification by default. See
12350    # http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html
12351    if {[info exists env(XDG_CONFIG_HOME)] && $env(XDG_CONFIG_HOME) ne ""} {
12352        # XDG_CONFIG_HOME environment variable is set
12353        set config_file [file join $env(XDG_CONFIG_HOME) git gitk]
12354        set config_file_tmp [file join $env(XDG_CONFIG_HOME) git gitk-tmp]
12355    } else {
12356        # default XDG_CONFIG_HOME
12357        set config_file "~/.config/git/gitk"
12358        set config_file_tmp "~/.config/git/gitk-tmp"
12359    }
12360    if {![file exists $config_file]} {
12361        # for backward compatibility use the old config file if it exists
12362        if {[file exists "~/.gitk"]} {
12363            set config_file "~/.gitk"
12364            set config_file_tmp "~/.gitk-tmp"
12365        } elseif {![file exists [file dirname $config_file]]} {
12366            file mkdir [file dirname $config_file]
12367        }
12368    }
12369    source $config_file
12370}
12371config_check_tmp_exists 50
12372
12373set config_variables {
12374    mainfont textfont uifont tabstop findmergefiles maxgraphpct maxwidth
12375    cmitmode wrapcomment autoselect autosellen showneartags maxrefs visiblerefs
12376    hideremotes showlocalchanges datetimeformat limitdiffs uicolor want_ttk
12377    bgcolor fgcolor uifgcolor uifgdisabledcolor colors diffcolors mergecolors
12378    markbgcolor diffcontext selectbgcolor foundbgcolor currentsearchhitbgcolor
12379    extdifftool perfile_attrs headbgcolor headfgcolor headoutlinecolor
12380    remotebgcolor tagbgcolor tagfgcolor tagoutlinecolor reflinecolor
12381    filesepbgcolor filesepfgcolor linehoverbgcolor linehoverfgcolor
12382    linehoveroutlinecolor mainheadcirclecolor workingfilescirclecolor
12383    indexcirclecolor circlecolors linkfgcolor circleoutlinecolor
12384}
12385foreach var $config_variables {
12386    config_init_trace $var
12387    trace add variable $var write config_variable_change_cb
12388}
12389
12390parsefont mainfont $mainfont
12391eval font create mainfont [fontflags mainfont]
12392eval font create mainfontbold [fontflags mainfont 1]
12393
12394parsefont textfont $textfont
12395eval font create textfont [fontflags textfont]
12396eval font create textfontbold [fontflags textfont 1]
12397
12398parsefont uifont $uifont
12399eval font create uifont [fontflags uifont]
12400
12401setui $uicolor
12402
12403setoptions
12404
12405# check that we can find a .git directory somewhere...
12406if {[catch {set gitdir [exec git rev-parse --git-dir]}]} {
12407    show_error {} . [mc "Cannot find a git repository here."]
12408    exit 1
12409}
12410
12411set selecthead {}
12412set selectheadid {}
12413
12414set revtreeargs {}
12415set cmdline_files {}
12416set i 0
12417set revtreeargscmd {}
12418foreach arg $argv {
12419    switch -glob -- $arg {
12420        "" { }
12421        "--" {
12422            set cmdline_files [lrange $argv [expr {$i + 1}] end]
12423            break
12424        }
12425        "--select-commit=*" {
12426            set selecthead [string range $arg 16 end]
12427        }
12428        "--argscmd=*" {
12429            set revtreeargscmd [string range $arg 10 end]
12430        }
12431        default {
12432            lappend revtreeargs $arg
12433        }
12434    }
12435    incr i
12436}
12437
12438if {$selecthead eq "HEAD"} {
12439    set selecthead {}
12440}
12441
12442if {$i >= [llength $argv] && $revtreeargs ne {}} {
12443    # no -- on command line, but some arguments (other than --argscmd)
12444    if {[catch {
12445        set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
12446        set cmdline_files [split $f "\n"]
12447        set n [llength $cmdline_files]
12448        set revtreeargs [lrange $revtreeargs 0 end-$n]
12449        # Unfortunately git rev-parse doesn't produce an error when
12450        # something is both a revision and a filename.  To be consistent
12451        # with git log and git rev-list, check revtreeargs for filenames.
12452        foreach arg $revtreeargs {
12453            if {[file exists $arg]} {
12454                show_error {} . [mc "Ambiguous argument '%s': both revision\
12455                                 and filename" $arg]
12456                exit 1
12457            }
12458        }
12459    } err]} {
12460        # unfortunately we get both stdout and stderr in $err,
12461        # so look for "fatal:".
12462        set i [string first "fatal:" $err]
12463        if {$i > 0} {
12464            set err [string range $err [expr {$i + 6}] end]
12465        }
12466        show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
12467        exit 1
12468    }
12469}
12470
12471set nullid "0000000000000000000000000000000000000000"
12472set nullid2 "0000000000000000000000000000000000000001"
12473set nullfile "/dev/null"
12474
12475set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
12476if {![info exists have_ttk]} {
12477    set have_ttk [llength [info commands ::ttk::style]]
12478}
12479set use_ttk [expr {$have_ttk && $want_ttk}]
12480set NS [expr {$use_ttk ? "ttk" : ""}]
12481
12482if {$use_ttk} {
12483    setttkstyle
12484}
12485
12486regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
12487
12488set show_notes {}
12489if {[package vcompare $git_version "1.6.6.2"] >= 0} {
12490    set show_notes "--show-notes"
12491}
12492
12493set appname "gitk"
12494
12495set runq {}
12496set history {}
12497set historyindex 0
12498set fh_serial 0
12499set nhl_names {}
12500set highlight_paths {}
12501set findpattern {}
12502set searchdirn -forwards
12503set boldids {}
12504set boldnameids {}
12505set diffelide {0 0}
12506set markingmatches 0
12507set linkentercount 0
12508set need_redisplay 0
12509set nrows_drawn 0
12510set firsttabstop 0
12511
12512set nextviewnum 1
12513set curview 0
12514set selectedview 0
12515set selectedhlview [mc "None"]
12516set highlight_related [mc "None"]
12517set highlight_files {}
12518set viewfiles(0) {}
12519set viewperm(0) 0
12520set viewchanged(0) 0
12521set viewargs(0) {}
12522set viewargscmd(0) {}
12523
12524set selectedline {}
12525set numcommits 0
12526set loginstance 0
12527set cmdlineok 0
12528set stopped 0
12529set stuffsaved 0
12530set patchnum 0
12531set lserial 0
12532set hasworktree [hasworktree]
12533set cdup {}
12534if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} {
12535    set cdup [exec git rev-parse --show-cdup]
12536}
12537set worktree [exec git rev-parse --show-toplevel]
12538setcoords
12539makewindow
12540catch {
12541    image create photo gitlogo      -width 16 -height 16
12542
12543    image create photo gitlogominus -width  4 -height  2
12544    gitlogominus put #C00000 -to 0 0 4 2
12545    gitlogo copy gitlogominus -to  1 5
12546    gitlogo copy gitlogominus -to  6 5
12547    gitlogo copy gitlogominus -to 11 5
12548    image delete gitlogominus
12549
12550    image create photo gitlogoplus  -width  4 -height  4
12551    gitlogoplus  put #008000 -to 1 0 3 4
12552    gitlogoplus  put #008000 -to 0 1 4 3
12553    gitlogo copy gitlogoplus  -to  1 9
12554    gitlogo copy gitlogoplus  -to  6 9
12555    gitlogo copy gitlogoplus  -to 11 9
12556    image delete gitlogoplus
12557
12558    image create photo gitlogo32    -width 32 -height 32
12559    gitlogo32 copy gitlogo -zoom 2 2
12560
12561    wm iconphoto . -default gitlogo gitlogo32
12562}
12563# wait for the window to become visible
12564tkwait visibility .
12565set_window_title
12566update
12567readrefs
12568
12569if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
12570    # create a view for the files/dirs specified on the command line
12571    set curview 1
12572    set selectedview 1
12573    set nextviewnum 2
12574    set viewname(1) [mc "Command line"]
12575    set viewfiles(1) $cmdline_files
12576    set viewargs(1) $revtreeargs
12577    set viewargscmd(1) $revtreeargscmd
12578    set viewperm(1) 0
12579    set viewchanged(1) 0
12580    set vdatemode(1) 0
12581    addviewmenu 1
12582    .bar.view entryconf [mca "&Edit view..."] -state normal
12583    .bar.view entryconf [mca "&Delete view"] -state normal
12584}
12585
12586if {[info exists permviews]} {
12587    foreach v $permviews {
12588        set n $nextviewnum
12589        incr nextviewnum
12590        set viewname($n) [lindex $v 0]
12591        set viewfiles($n) [lindex $v 1]
12592        set viewargs($n) [lindex $v 2]
12593        set viewargscmd($n) [lindex $v 3]
12594        set viewperm($n) 1
12595        set viewchanged($n) 0
12596        addviewmenu $n
12597    }
12598}
12599
12600if {[tk windowingsystem] eq "win32"} {
12601    focus -force .
12602}
12603
12604getcommits {}
12605
12606# Local variables:
12607# mode: tcl
12608# indent-tabs-mode: t
12609# tab-width: 8
12610# End: