gitkon commit gitk: Enable mouse horizontal scrolling in diff pane (122b807)
   1#!/bin/sh
   2# Tcl ignores the next line -*- tcl -*- \
   3exec wish "$0" -- "$@"
   4
   5# Copyright © 2005-2014 Paul Mackerras.  All rights reserved.
   6# This program is free software; it may be used, copied, modified
   7# and distributed under the terms of the GNU General Public Licence,
   8# either version 2, or (at your option) any later version.
   9
  10package require Tk
  11
  12proc hasworktree {} {
  13    return [expr {[exec git rev-parse --is-bare-repository] == "false" &&
  14                  [exec git rev-parse --is-inside-git-dir] == "false"}]
  15}
  16
  17proc reponame {} {
  18    global gitdir
  19    set n [file normalize $gitdir]
  20    if {[string match "*/.git" $n]} {
  21        set n [string range $n 0 end-5]
  22    }
  23    return [file tail $n]
  24}
  25
  26proc gitworktree {} {
  27    variable _gitworktree
  28    if {[info exists _gitworktree]} {
  29        return $_gitworktree
  30    }
  31    # v1.7.0 introduced --show-toplevel to return the canonical work-tree
  32    if {[catch {set _gitworktree [exec git rev-parse --show-toplevel]}]} {
  33        # try to set work tree from environment, core.worktree or use
  34        # cdup to obtain a relative path to the top of the worktree. If
  35        # run from the top, the ./ prefix ensures normalize expands pwd.
  36        if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
  37            catch {set _gitworktree [exec git config --get core.worktree]}
  38            if {$_gitworktree eq ""} {
  39                set _gitworktree [file normalize ./[exec git rev-parse --show-cdup]]
  40            }
  41        }
  42    }
  43    return $_gitworktree
  44}
  45
  46# A simple scheduler for compute-intensive stuff.
  47# The aim is to make sure that event handlers for GUI actions can
  48# run at least every 50-100 ms.  Unfortunately fileevent handlers are
  49# run before X event handlers, so reading from a fast source can
  50# make the GUI completely unresponsive.
  51proc run args {
  52    global isonrunq runq currunq
  53
  54    set script $args
  55    if {[info exists isonrunq($script)]} return
  56    if {$runq eq {} && ![info exists currunq]} {
  57        after idle dorunq
  58    }
  59    lappend runq [list {} $script]
  60    set isonrunq($script) 1
  61}
  62
  63proc filerun {fd script} {
  64    fileevent $fd readable [list filereadable $fd $script]
  65}
  66
  67proc filereadable {fd script} {
  68    global runq currunq
  69
  70    fileevent $fd readable {}
  71    if {$runq eq {} && ![info exists currunq]} {
  72        after idle dorunq
  73    }
  74    lappend runq [list $fd $script]
  75}
  76
  77proc nukefile {fd} {
  78    global runq
  79
  80    for {set i 0} {$i < [llength $runq]} {} {
  81        if {[lindex $runq $i 0] eq $fd} {
  82            set runq [lreplace $runq $i $i]
  83        } else {
  84            incr i
  85        }
  86    }
  87}
  88
  89proc dorunq {} {
  90    global isonrunq runq currunq
  91
  92    set tstart [clock clicks -milliseconds]
  93    set t0 $tstart
  94    while {[llength $runq] > 0} {
  95        set fd [lindex $runq 0 0]
  96        set script [lindex $runq 0 1]
  97        set currunq [lindex $runq 0]
  98        set runq [lrange $runq 1 end]
  99        set repeat [eval $script]
 100        unset currunq
 101        set t1 [clock clicks -milliseconds]
 102        set t [expr {$t1 - $t0}]
 103        if {$repeat ne {} && $repeat} {
 104            if {$fd eq {} || $repeat == 2} {
 105                # script returns 1 if it wants to be readded
 106                # file readers return 2 if they could do more straight away
 107                lappend runq [list $fd $script]
 108            } else {
 109                fileevent $fd readable [list filereadable $fd $script]
 110            }
 111        } elseif {$fd eq {}} {
 112            unset isonrunq($script)
 113        }
 114        set t0 $t1
 115        if {$t1 - $tstart >= 80} break
 116    }
 117    if {$runq ne {}} {
 118        after idle dorunq
 119    }
 120}
 121
 122proc reg_instance {fd} {
 123    global commfd leftover loginstance
 124
 125    set i [incr loginstance]
 126    set commfd($i) $fd
 127    set leftover($i) {}
 128    return $i
 129}
 130
 131proc unmerged_files {files} {
 132    global nr_unmerged
 133
 134    # find the list of unmerged files
 135    set mlist {}
 136    set nr_unmerged 0
 137    if {[catch {
 138        set fd [open "| git ls-files -u" r]
 139    } err]} {
 140        show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
 141        exit 1
 142    }
 143    while {[gets $fd line] >= 0} {
 144        set i [string first "\t" $line]
 145        if {$i < 0} continue
 146        set fname [string range $line [expr {$i+1}] end]
 147        if {[lsearch -exact $mlist $fname] >= 0} continue
 148        incr nr_unmerged
 149        if {$files eq {} || [path_filter $files $fname]} {
 150            lappend mlist $fname
 151        }
 152    }
 153    catch {close $fd}
 154    return $mlist
 155}
 156
 157proc parseviewargs {n arglist} {
 158    global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs env
 159    global vinlinediff
 160    global worddiff git_version
 161
 162    set vdatemode($n) 0
 163    set vmergeonly($n) 0
 164    set vinlinediff($n) 0
 165    set glflags {}
 166    set diffargs {}
 167    set nextisval 0
 168    set revargs {}
 169    set origargs $arglist
 170    set allknown 1
 171    set filtered 0
 172    set i -1
 173    foreach arg $arglist {
 174        incr i
 175        if {$nextisval} {
 176            lappend glflags $arg
 177            set nextisval 0
 178            continue
 179        }
 180        switch -glob -- $arg {
 181            "-d" -
 182            "--date-order" {
 183                set vdatemode($n) 1
 184                # remove from origargs in case we hit an unknown option
 185                set origargs [lreplace $origargs $i $i]
 186                incr i -1
 187            }
 188            "-[puabwcrRBMC]" -
 189            "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
 190            "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
 191            "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
 192            "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
 193            "--ignore-space-change" - "-U*" - "--unified=*" {
 194                # These request or affect diff output, which we don't want.
 195                # Some could be used to set our defaults for diff display.
 196                lappend diffargs $arg
 197            }
 198            "--raw" - "--patch-with-raw" - "--patch-with-stat" -
 199            "--name-only" - "--name-status" - "--color" -
 200            "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
 201            "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
 202            "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
 203            "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
 204            "--objects" - "--objects-edge" - "--reverse" {
 205                # These cause our parsing of git log's output to fail, or else
 206                # they're options we want to set ourselves, so ignore them.
 207            }
 208            "--color-words*" - "--word-diff=color" {
 209                # These trigger a word diff in the console interface,
 210                # so help the user by enabling our own support
 211                if {[package vcompare $git_version "1.7.2"] >= 0} {
 212                    set worddiff [mc "Color words"]
 213                }
 214            }
 215            "--word-diff*" {
 216                if {[package vcompare $git_version "1.7.2"] >= 0} {
 217                    set worddiff [mc "Markup words"]
 218                }
 219            }
 220            "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
 221            "--check" - "--exit-code" - "--quiet" - "--topo-order" -
 222            "--full-history" - "--dense" - "--sparse" -
 223            "--follow" - "--left-right" - "--encoding=*" {
 224                # These are harmless, and some are even useful
 225                lappend glflags $arg
 226            }
 227            "--diff-filter=*" - "--no-merges" - "--unpacked" -
 228            "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
 229            "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
 230            "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
 231            "--remove-empty" - "--first-parent" - "--cherry-pick" -
 232            "-S*" - "-G*" - "--pickaxe-all" - "--pickaxe-regex" -
 233            "--simplify-by-decoration" {
 234                # These mean that we get a subset of the commits
 235                set filtered 1
 236                lappend glflags $arg
 237            }
 238            "-L*" {
 239                # Line-log with 'stuck' argument (unstuck form is
 240                # not supported)
 241                set filtered 1
 242                set vinlinediff($n) 1
 243                set allknown 0
 244                lappend glflags $arg
 245            }
 246            "-n" {
 247                # This appears to be the only one that has a value as a
 248                # separate word following it
 249                set filtered 1
 250                set nextisval 1
 251                lappend glflags $arg
 252            }
 253            "--not" - "--all" {
 254                lappend revargs $arg
 255            }
 256            "--merge" {
 257                set vmergeonly($n) 1
 258                # git rev-parse doesn't understand --merge
 259                lappend revargs --gitk-symmetric-diff-marker MERGE_HEAD...HEAD
 260            }
 261            "--no-replace-objects" {
 262                set env(GIT_NO_REPLACE_OBJECTS) "1"
 263            }
 264            "-*" {
 265                # Other flag arguments including -<n>
 266                if {[string is digit -strict [string range $arg 1 end]]} {
 267                    set filtered 1
 268                } else {
 269                    # a flag argument that we don't recognize;
 270                    # that means we can't optimize
 271                    set allknown 0
 272                }
 273                lappend glflags $arg
 274            }
 275            default {
 276                # Non-flag arguments specify commits or ranges of commits
 277                if {[string match "*...*" $arg]} {
 278                    lappend revargs --gitk-symmetric-diff-marker
 279                }
 280                lappend revargs $arg
 281            }
 282        }
 283    }
 284    set vdflags($n) $diffargs
 285    set vflags($n) $glflags
 286    set vrevs($n) $revargs
 287    set vfiltered($n) $filtered
 288    set vorigargs($n) $origargs
 289    return $allknown
 290}
 291
 292proc parseviewrevs {view revs} {
 293    global vposids vnegids
 294
 295    if {$revs eq {}} {
 296        set revs HEAD
 297    } elseif {[lsearch -exact $revs --all] >= 0} {
 298        lappend revs HEAD
 299    }
 300    if {[catch {set ids [eval exec git rev-parse $revs]} err]} {
 301        # we get stdout followed by stderr in $err
 302        # for an unknown rev, git rev-parse echoes it and then errors out
 303        set errlines [split $err "\n"]
 304        set badrev {}
 305        for {set l 0} {$l < [llength $errlines]} {incr l} {
 306            set line [lindex $errlines $l]
 307            if {!([string length $line] == 40 && [string is xdigit $line])} {
 308                if {[string match "fatal:*" $line]} {
 309                    if {[string match "fatal: ambiguous argument*" $line]
 310                        && $badrev ne {}} {
 311                        if {[llength $badrev] == 1} {
 312                            set err "unknown revision $badrev"
 313                        } else {
 314                            set err "unknown revisions: [join $badrev ", "]"
 315                        }
 316                    } else {
 317                        set err [join [lrange $errlines $l end] "\n"]
 318                    }
 319                    break
 320                }
 321                lappend badrev $line
 322            }
 323        }
 324        error_popup "[mc "Error parsing revisions:"] $err"
 325        return {}
 326    }
 327    set ret {}
 328    set pos {}
 329    set neg {}
 330    set sdm 0
 331    foreach id [split $ids "\n"] {
 332        if {$id eq "--gitk-symmetric-diff-marker"} {
 333            set sdm 4
 334        } elseif {[string match "^*" $id]} {
 335            if {$sdm != 1} {
 336                lappend ret $id
 337                if {$sdm == 3} {
 338                    set sdm 0
 339                }
 340            }
 341            lappend neg [string range $id 1 end]
 342        } else {
 343            if {$sdm != 2} {
 344                lappend ret $id
 345            } else {
 346                lset ret end $id...[lindex $ret end]
 347            }
 348            lappend pos $id
 349        }
 350        incr sdm -1
 351    }
 352    set vposids($view) $pos
 353    set vnegids($view) $neg
 354    return $ret
 355}
 356
 357# Start off a git log process and arrange to read its output
 358proc start_rev_list {view} {
 359    global startmsecs commitidx viewcomplete curview
 360    global tclencoding
 361    global viewargs viewargscmd viewfiles vfilelimit
 362    global showlocalchanges
 363    global viewactive viewinstances vmergeonly
 364    global mainheadid viewmainheadid viewmainheadid_orig
 365    global vcanopt vflags vrevs vorigargs
 366    global show_notes
 367
 368    set startmsecs [clock clicks -milliseconds]
 369    set commitidx($view) 0
 370    # these are set this way for the error exits
 371    set viewcomplete($view) 1
 372    set viewactive($view) 0
 373    varcinit $view
 374
 375    set args $viewargs($view)
 376    if {$viewargscmd($view) ne {}} {
 377        if {[catch {
 378            set str [exec sh -c $viewargscmd($view)]
 379        } err]} {
 380            error_popup "[mc "Error executing --argscmd command:"] $err"
 381            return 0
 382        }
 383        set args [concat $args [split $str "\n"]]
 384    }
 385    set vcanopt($view) [parseviewargs $view $args]
 386
 387    set files $viewfiles($view)
 388    if {$vmergeonly($view)} {
 389        set files [unmerged_files $files]
 390        if {$files eq {}} {
 391            global nr_unmerged
 392            if {$nr_unmerged == 0} {
 393                error_popup [mc "No files selected: --merge specified but\
 394                             no files are unmerged."]
 395            } else {
 396                error_popup [mc "No files selected: --merge specified but\
 397                             no unmerged files are within file limit."]
 398            }
 399            return 0
 400        }
 401    }
 402    set vfilelimit($view) $files
 403
 404    if {$vcanopt($view)} {
 405        set revs [parseviewrevs $view $vrevs($view)]
 406        if {$revs eq {}} {
 407            return 0
 408        }
 409        set args [concat $vflags($view) $revs]
 410    } else {
 411        set args $vorigargs($view)
 412    }
 413
 414    if {[catch {
 415        set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
 416                        --parents --boundary $args "--" $files] r]
 417    } err]} {
 418        error_popup "[mc "Error executing git log:"] $err"
 419        return 0
 420    }
 421    set i [reg_instance $fd]
 422    set viewinstances($view) [list $i]
 423    set viewmainheadid($view) $mainheadid
 424    set viewmainheadid_orig($view) $mainheadid
 425    if {$files ne {} && $mainheadid ne {}} {
 426        get_viewmainhead $view
 427    }
 428    if {$showlocalchanges && $viewmainheadid($view) ne {}} {
 429        interestedin $viewmainheadid($view) dodiffindex
 430    }
 431    fconfigure $fd -blocking 0 -translation lf -eofchar {}
 432    if {$tclencoding != {}} {
 433        fconfigure $fd -encoding $tclencoding
 434    }
 435    filerun $fd [list getcommitlines $fd $i $view 0]
 436    nowbusy $view [mc "Reading"]
 437    set viewcomplete($view) 0
 438    set viewactive($view) 1
 439    return 1
 440}
 441
 442proc stop_instance {inst} {
 443    global commfd leftover
 444
 445    set fd $commfd($inst)
 446    catch {
 447        set pid [pid $fd]
 448
 449        if {$::tcl_platform(platform) eq {windows}} {
 450            exec taskkill /pid $pid
 451        } else {
 452            exec kill $pid
 453        }
 454    }
 455    catch {close $fd}
 456    nukefile $fd
 457    unset commfd($inst)
 458    unset leftover($inst)
 459}
 460
 461proc stop_backends {} {
 462    global commfd
 463
 464    foreach inst [array names commfd] {
 465        stop_instance $inst
 466    }
 467}
 468
 469proc stop_rev_list {view} {
 470    global viewinstances
 471
 472    foreach inst $viewinstances($view) {
 473        stop_instance $inst
 474    }
 475    set viewinstances($view) {}
 476}
 477
 478proc reset_pending_select {selid} {
 479    global pending_select mainheadid selectheadid
 480
 481    if {$selid ne {}} {
 482        set pending_select $selid
 483    } elseif {$selectheadid ne {}} {
 484        set pending_select $selectheadid
 485    } else {
 486        set pending_select $mainheadid
 487    }
 488}
 489
 490proc getcommits {selid} {
 491    global canv curview need_redisplay viewactive
 492
 493    initlayout
 494    if {[start_rev_list $curview]} {
 495        reset_pending_select $selid
 496        show_status [mc "Reading commits..."]
 497        set need_redisplay 1
 498    } else {
 499        show_status [mc "No commits selected"]
 500    }
 501}
 502
 503proc updatecommits {} {
 504    global curview vcanopt vorigargs vfilelimit viewinstances
 505    global viewactive viewcomplete tclencoding
 506    global startmsecs showneartags showlocalchanges
 507    global mainheadid viewmainheadid viewmainheadid_orig pending_select
 508    global hasworktree
 509    global varcid vposids vnegids vflags vrevs
 510    global show_notes
 511
 512    set hasworktree [hasworktree]
 513    rereadrefs
 514    set view $curview
 515    if {$mainheadid ne $viewmainheadid_orig($view)} {
 516        if {$showlocalchanges} {
 517            dohidelocalchanges
 518        }
 519        set viewmainheadid($view) $mainheadid
 520        set viewmainheadid_orig($view) $mainheadid
 521        if {$vfilelimit($view) ne {}} {
 522            get_viewmainhead $view
 523        }
 524    }
 525    if {$showlocalchanges} {
 526        doshowlocalchanges
 527    }
 528    if {$vcanopt($view)} {
 529        set oldpos $vposids($view)
 530        set oldneg $vnegids($view)
 531        set revs [parseviewrevs $view $vrevs($view)]
 532        if {$revs eq {}} {
 533            return
 534        }
 535        # note: getting the delta when negative refs change is hard,
 536        # and could require multiple git log invocations, so in that
 537        # case we ask git log for all the commits (not just the delta)
 538        if {$oldneg eq $vnegids($view)} {
 539            set newrevs {}
 540            set npos 0
 541            # take out positive refs that we asked for before or
 542            # that we have already seen
 543            foreach rev $revs {
 544                if {[string length $rev] == 40} {
 545                    if {[lsearch -exact $oldpos $rev] < 0
 546                        && ![info exists varcid($view,$rev)]} {
 547                        lappend newrevs $rev
 548                        incr npos
 549                    }
 550                } else {
 551                    lappend $newrevs $rev
 552                }
 553            }
 554            if {$npos == 0} return
 555            set revs $newrevs
 556            set vposids($view) [lsort -unique [concat $oldpos $vposids($view)]]
 557        }
 558        set args [concat $vflags($view) $revs --not $oldpos]
 559    } else {
 560        set args $vorigargs($view)
 561    }
 562    if {[catch {
 563        set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
 564                        --parents --boundary $args "--" $vfilelimit($view)] r]
 565    } err]} {
 566        error_popup "[mc "Error executing git log:"] $err"
 567        return
 568    }
 569    if {$viewactive($view) == 0} {
 570        set startmsecs [clock clicks -milliseconds]
 571    }
 572    set i [reg_instance $fd]
 573    lappend viewinstances($view) $i
 574    fconfigure $fd -blocking 0 -translation lf -eofchar {}
 575    if {$tclencoding != {}} {
 576        fconfigure $fd -encoding $tclencoding
 577    }
 578    filerun $fd [list getcommitlines $fd $i $view 1]
 579    incr viewactive($view)
 580    set viewcomplete($view) 0
 581    reset_pending_select {}
 582    nowbusy $view [mc "Reading"]
 583    if {$showneartags} {
 584        getallcommits
 585    }
 586}
 587
 588proc reloadcommits {} {
 589    global curview viewcomplete selectedline currentid thickerline
 590    global showneartags treediffs commitinterest cached_commitrow
 591    global targetid
 592
 593    set selid {}
 594    if {$selectedline ne {}} {
 595        set selid $currentid
 596    }
 597
 598    if {!$viewcomplete($curview)} {
 599        stop_rev_list $curview
 600    }
 601    resetvarcs $curview
 602    set selectedline {}
 603    catch {unset currentid}
 604    catch {unset thickerline}
 605    catch {unset treediffs}
 606    readrefs
 607    changedrefs
 608    if {$showneartags} {
 609        getallcommits
 610    }
 611    clear_display
 612    catch {unset commitinterest}
 613    catch {unset cached_commitrow}
 614    catch {unset targetid}
 615    setcanvscroll
 616    getcommits $selid
 617    return 0
 618}
 619
 620# This makes a string representation of a positive integer which
 621# sorts as a string in numerical order
 622proc strrep {n} {
 623    if {$n < 16} {
 624        return [format "%x" $n]
 625    } elseif {$n < 256} {
 626        return [format "x%.2x" $n]
 627    } elseif {$n < 65536} {
 628        return [format "y%.4x" $n]
 629    }
 630    return [format "z%.8x" $n]
 631}
 632
 633# Procedures used in reordering commits from git log (without
 634# --topo-order) into the order for display.
 635
 636proc varcinit {view} {
 637    global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
 638    global vtokmod varcmod vrowmod varcix vlastins
 639
 640    set varcstart($view) {{}}
 641    set vupptr($view) {0}
 642    set vdownptr($view) {0}
 643    set vleftptr($view) {0}
 644    set vbackptr($view) {0}
 645    set varctok($view) {{}}
 646    set varcrow($view) {{}}
 647    set vtokmod($view) {}
 648    set varcmod($view) 0
 649    set vrowmod($view) 0
 650    set varcix($view) {{}}
 651    set vlastins($view) {0}
 652}
 653
 654proc resetvarcs {view} {
 655    global varcid varccommits parents children vseedcount ordertok
 656    global vshortids
 657
 658    foreach vid [array names varcid $view,*] {
 659        unset varcid($vid)
 660        unset children($vid)
 661        unset parents($vid)
 662    }
 663    foreach vid [array names vshortids $view,*] {
 664        unset vshortids($vid)
 665    }
 666    # some commits might have children but haven't been seen yet
 667    foreach vid [array names children $view,*] {
 668        unset children($vid)
 669    }
 670    foreach va [array names varccommits $view,*] {
 671        unset varccommits($va)
 672    }
 673    foreach vd [array names vseedcount $view,*] {
 674        unset vseedcount($vd)
 675    }
 676    catch {unset ordertok}
 677}
 678
 679# returns a list of the commits with no children
 680proc seeds {v} {
 681    global vdownptr vleftptr varcstart
 682
 683    set ret {}
 684    set a [lindex $vdownptr($v) 0]
 685    while {$a != 0} {
 686        lappend ret [lindex $varcstart($v) $a]
 687        set a [lindex $vleftptr($v) $a]
 688    }
 689    return $ret
 690}
 691
 692proc newvarc {view id} {
 693    global varcid varctok parents children vdatemode
 694    global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
 695    global commitdata commitinfo vseedcount varccommits vlastins
 696
 697    set a [llength $varctok($view)]
 698    set vid $view,$id
 699    if {[llength $children($vid)] == 0 || $vdatemode($view)} {
 700        if {![info exists commitinfo($id)]} {
 701            parsecommit $id $commitdata($id) 1
 702        }
 703        set cdate [lindex [lindex $commitinfo($id) 4] 0]
 704        if {![string is integer -strict $cdate]} {
 705            set cdate 0
 706        }
 707        if {![info exists vseedcount($view,$cdate)]} {
 708            set vseedcount($view,$cdate) -1
 709        }
 710        set c [incr vseedcount($view,$cdate)]
 711        set cdate [expr {$cdate ^ 0xffffffff}]
 712        set tok "s[strrep $cdate][strrep $c]"
 713    } else {
 714        set tok {}
 715    }
 716    set ka 0
 717    if {[llength $children($vid)] > 0} {
 718        set kid [lindex $children($vid) end]
 719        set k $varcid($view,$kid)
 720        if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
 721            set ki $kid
 722            set ka $k
 723            set tok [lindex $varctok($view) $k]
 724        }
 725    }
 726    if {$ka != 0} {
 727        set i [lsearch -exact $parents($view,$ki) $id]
 728        set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
 729        append tok [strrep $j]
 730    }
 731    set c [lindex $vlastins($view) $ka]
 732    if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
 733        set c $ka
 734        set b [lindex $vdownptr($view) $ka]
 735    } else {
 736        set b [lindex $vleftptr($view) $c]
 737    }
 738    while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
 739        set c $b
 740        set b [lindex $vleftptr($view) $c]
 741    }
 742    if {$c == $ka} {
 743        lset vdownptr($view) $ka $a
 744        lappend vbackptr($view) 0
 745    } else {
 746        lset vleftptr($view) $c $a
 747        lappend vbackptr($view) $c
 748    }
 749    lset vlastins($view) $ka $a
 750    lappend vupptr($view) $ka
 751    lappend vleftptr($view) $b
 752    if {$b != 0} {
 753        lset vbackptr($view) $b $a
 754    }
 755    lappend varctok($view) $tok
 756    lappend varcstart($view) $id
 757    lappend vdownptr($view) 0
 758    lappend varcrow($view) {}
 759    lappend varcix($view) {}
 760    set varccommits($view,$a) {}
 761    lappend vlastins($view) 0
 762    return $a
 763}
 764
 765proc splitvarc {p v} {
 766    global varcid varcstart varccommits varctok vtokmod
 767    global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
 768
 769    set oa $varcid($v,$p)
 770    set otok [lindex $varctok($v) $oa]
 771    set ac $varccommits($v,$oa)
 772    set i [lsearch -exact $varccommits($v,$oa) $p]
 773    if {$i <= 0} return
 774    set na [llength $varctok($v)]
 775    # "%" sorts before "0"...
 776    set tok "$otok%[strrep $i]"
 777    lappend varctok($v) $tok
 778    lappend varcrow($v) {}
 779    lappend varcix($v) {}
 780    set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
 781    set varccommits($v,$na) [lrange $ac $i end]
 782    lappend varcstart($v) $p
 783    foreach id $varccommits($v,$na) {
 784        set varcid($v,$id) $na
 785    }
 786    lappend vdownptr($v) [lindex $vdownptr($v) $oa]
 787    lappend vlastins($v) [lindex $vlastins($v) $oa]
 788    lset vdownptr($v) $oa $na
 789    lset vlastins($v) $oa 0
 790    lappend vupptr($v) $oa
 791    lappend vleftptr($v) 0
 792    lappend vbackptr($v) 0
 793    for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
 794        lset vupptr($v) $b $na
 795    }
 796    if {[string compare $otok $vtokmod($v)] <= 0} {
 797        modify_arc $v $oa
 798    }
 799}
 800
 801proc renumbervarc {a v} {
 802    global parents children varctok varcstart varccommits
 803    global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
 804
 805    set t1 [clock clicks -milliseconds]
 806    set todo {}
 807    set isrelated($a) 1
 808    set kidchanged($a) 1
 809    set ntot 0
 810    while {$a != 0} {
 811        if {[info exists isrelated($a)]} {
 812            lappend todo $a
 813            set id [lindex $varccommits($v,$a) end]
 814            foreach p $parents($v,$id) {
 815                if {[info exists varcid($v,$p)]} {
 816                    set isrelated($varcid($v,$p)) 1
 817                }
 818            }
 819        }
 820        incr ntot
 821        set b [lindex $vdownptr($v) $a]
 822        if {$b == 0} {
 823            while {$a != 0} {
 824                set b [lindex $vleftptr($v) $a]
 825                if {$b != 0} break
 826                set a [lindex $vupptr($v) $a]
 827            }
 828        }
 829        set a $b
 830    }
 831    foreach a $todo {
 832        if {![info exists kidchanged($a)]} continue
 833        set id [lindex $varcstart($v) $a]
 834        if {[llength $children($v,$id)] > 1} {
 835            set children($v,$id) [lsort -command [list vtokcmp $v] \
 836                                      $children($v,$id)]
 837        }
 838        set oldtok [lindex $varctok($v) $a]
 839        if {!$vdatemode($v)} {
 840            set tok {}
 841        } else {
 842            set tok $oldtok
 843        }
 844        set ka 0
 845        set kid [last_real_child $v,$id]
 846        if {$kid ne {}} {
 847            set k $varcid($v,$kid)
 848            if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
 849                set ki $kid
 850                set ka $k
 851                set tok [lindex $varctok($v) $k]
 852            }
 853        }
 854        if {$ka != 0} {
 855            set i [lsearch -exact $parents($v,$ki) $id]
 856            set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
 857            append tok [strrep $j]
 858        }
 859        if {$tok eq $oldtok} {
 860            continue
 861        }
 862        set id [lindex $varccommits($v,$a) end]
 863        foreach p $parents($v,$id) {
 864            if {[info exists varcid($v,$p)]} {
 865                set kidchanged($varcid($v,$p)) 1
 866            } else {
 867                set sortkids($p) 1
 868            }
 869        }
 870        lset varctok($v) $a $tok
 871        set b [lindex $vupptr($v) $a]
 872        if {$b != $ka} {
 873            if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
 874                modify_arc $v $ka
 875            }
 876            if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
 877                modify_arc $v $b
 878            }
 879            set c [lindex $vbackptr($v) $a]
 880            set d [lindex $vleftptr($v) $a]
 881            if {$c == 0} {
 882                lset vdownptr($v) $b $d
 883            } else {
 884                lset vleftptr($v) $c $d
 885            }
 886            if {$d != 0} {
 887                lset vbackptr($v) $d $c
 888            }
 889            if {[lindex $vlastins($v) $b] == $a} {
 890                lset vlastins($v) $b $c
 891            }
 892            lset vupptr($v) $a $ka
 893            set c [lindex $vlastins($v) $ka]
 894            if {$c == 0 || \
 895                    [string compare $tok [lindex $varctok($v) $c]] < 0} {
 896                set c $ka
 897                set b [lindex $vdownptr($v) $ka]
 898            } else {
 899                set b [lindex $vleftptr($v) $c]
 900            }
 901            while {$b != 0 && \
 902                      [string compare $tok [lindex $varctok($v) $b]] >= 0} {
 903                set c $b
 904                set b [lindex $vleftptr($v) $c]
 905            }
 906            if {$c == $ka} {
 907                lset vdownptr($v) $ka $a
 908                lset vbackptr($v) $a 0
 909            } else {
 910                lset vleftptr($v) $c $a
 911                lset vbackptr($v) $a $c
 912            }
 913            lset vleftptr($v) $a $b
 914            if {$b != 0} {
 915                lset vbackptr($v) $b $a
 916            }
 917            lset vlastins($v) $ka $a
 918        }
 919    }
 920    foreach id [array names sortkids] {
 921        if {[llength $children($v,$id)] > 1} {
 922            set children($v,$id) [lsort -command [list vtokcmp $v] \
 923                                      $children($v,$id)]
 924        }
 925    }
 926    set t2 [clock clicks -milliseconds]
 927    #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
 928}
 929
 930# Fix up the graph after we have found out that in view $v,
 931# $p (a commit that we have already seen) is actually the parent
 932# of the last commit in arc $a.
 933proc fix_reversal {p a v} {
 934    global varcid varcstart varctok vupptr
 935
 936    set pa $varcid($v,$p)
 937    if {$p ne [lindex $varcstart($v) $pa]} {
 938        splitvarc $p $v
 939        set pa $varcid($v,$p)
 940    }
 941    # seeds always need to be renumbered
 942    if {[lindex $vupptr($v) $pa] == 0 ||
 943        [string compare [lindex $varctok($v) $a] \
 944             [lindex $varctok($v) $pa]] > 0} {
 945        renumbervarc $pa $v
 946    }
 947}
 948
 949proc insertrow {id p v} {
 950    global cmitlisted children parents varcid varctok vtokmod
 951    global varccommits ordertok commitidx numcommits curview
 952    global targetid targetrow vshortids
 953
 954    readcommit $id
 955    set vid $v,$id
 956    set cmitlisted($vid) 1
 957    set children($vid) {}
 958    set parents($vid) [list $p]
 959    set a [newvarc $v $id]
 960    set varcid($vid) $a
 961    lappend vshortids($v,[string range $id 0 3]) $id
 962    if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
 963        modify_arc $v $a
 964    }
 965    lappend varccommits($v,$a) $id
 966    set vp $v,$p
 967    if {[llength [lappend children($vp) $id]] > 1} {
 968        set children($vp) [lsort -command [list vtokcmp $v] $children($vp)]
 969        catch {unset ordertok}
 970    }
 971    fix_reversal $p $a $v
 972    incr commitidx($v)
 973    if {$v == $curview} {
 974        set numcommits $commitidx($v)
 975        setcanvscroll
 976        if {[info exists targetid]} {
 977            if {![comes_before $targetid $p]} {
 978                incr targetrow
 979            }
 980        }
 981    }
 982}
 983
 984proc insertfakerow {id p} {
 985    global varcid varccommits parents children cmitlisted
 986    global commitidx varctok vtokmod targetid targetrow curview numcommits
 987
 988    set v $curview
 989    set a $varcid($v,$p)
 990    set i [lsearch -exact $varccommits($v,$a) $p]
 991    if {$i < 0} {
 992        puts "oops: insertfakerow can't find [shortids $p] on arc $a"
 993        return
 994    }
 995    set children($v,$id) {}
 996    set parents($v,$id) [list $p]
 997    set varcid($v,$id) $a
 998    lappend children($v,$p) $id
 999    set cmitlisted($v,$id) 1
1000    set numcommits [incr commitidx($v)]
1001    # note we deliberately don't update varcstart($v) even if $i == 0
1002    set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
1003    modify_arc $v $a $i
1004    if {[info exists targetid]} {
1005        if {![comes_before $targetid $p]} {
1006            incr targetrow
1007        }
1008    }
1009    setcanvscroll
1010    drawvisible
1011}
1012
1013proc removefakerow {id} {
1014    global varcid varccommits parents children commitidx
1015    global varctok vtokmod cmitlisted currentid selectedline
1016    global targetid curview numcommits
1017
1018    set v $curview
1019    if {[llength $parents($v,$id)] != 1} {
1020        puts "oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
1021        return
1022    }
1023    set p [lindex $parents($v,$id) 0]
1024    set a $varcid($v,$id)
1025    set i [lsearch -exact $varccommits($v,$a) $id]
1026    if {$i < 0} {
1027        puts "oops: removefakerow can't find [shortids $id] on arc $a"
1028        return
1029    }
1030    unset varcid($v,$id)
1031    set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
1032    unset parents($v,$id)
1033    unset children($v,$id)
1034    unset cmitlisted($v,$id)
1035    set numcommits [incr commitidx($v) -1]
1036    set j [lsearch -exact $children($v,$p) $id]
1037    if {$j >= 0} {
1038        set children($v,$p) [lreplace $children($v,$p) $j $j]
1039    }
1040    modify_arc $v $a $i
1041    if {[info exist currentid] && $id eq $currentid} {
1042        unset currentid
1043        set selectedline {}
1044    }
1045    if {[info exists targetid] && $targetid eq $id} {
1046        set targetid $p
1047    }
1048    setcanvscroll
1049    drawvisible
1050}
1051
1052proc real_children {vp} {
1053    global children nullid nullid2
1054
1055    set kids {}
1056    foreach id $children($vp) {
1057        if {$id ne $nullid && $id ne $nullid2} {
1058            lappend kids $id
1059        }
1060    }
1061    return $kids
1062}
1063
1064proc first_real_child {vp} {
1065    global children nullid nullid2
1066
1067    foreach id $children($vp) {
1068        if {$id ne $nullid && $id ne $nullid2} {
1069            return $id
1070        }
1071    }
1072    return {}
1073}
1074
1075proc last_real_child {vp} {
1076    global children nullid nullid2
1077
1078    set kids $children($vp)
1079    for {set i [llength $kids]} {[incr i -1] >= 0} {} {
1080        set id [lindex $kids $i]
1081        if {$id ne $nullid && $id ne $nullid2} {
1082            return $id
1083        }
1084    }
1085    return {}
1086}
1087
1088proc vtokcmp {v a b} {
1089    global varctok varcid
1090
1091    return [string compare [lindex $varctok($v) $varcid($v,$a)] \
1092                [lindex $varctok($v) $varcid($v,$b)]]
1093}
1094
1095# This assumes that if lim is not given, the caller has checked that
1096# arc a's token is less than $vtokmod($v)
1097proc modify_arc {v a {lim {}}} {
1098    global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
1099
1100    if {$lim ne {}} {
1101        set c [string compare [lindex $varctok($v) $a] $vtokmod($v)]
1102        if {$c > 0} return
1103        if {$c == 0} {
1104            set r [lindex $varcrow($v) $a]
1105            if {$r ne {} && $vrowmod($v) <= $r + $lim} return
1106        }
1107    }
1108    set vtokmod($v) [lindex $varctok($v) $a]
1109    set varcmod($v) $a
1110    if {$v == $curview} {
1111        while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
1112            set a [lindex $vupptr($v) $a]
1113            set lim {}
1114        }
1115        set r 0
1116        if {$a != 0} {
1117            if {$lim eq {}} {
1118                set lim [llength $varccommits($v,$a)]
1119            }
1120            set r [expr {[lindex $varcrow($v) $a] + $lim}]
1121        }
1122        set vrowmod($v) $r
1123        undolayout $r
1124    }
1125}
1126
1127proc update_arcrows {v} {
1128    global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
1129    global varcid vrownum varcorder varcix varccommits
1130    global vupptr vdownptr vleftptr varctok
1131    global displayorder parentlist curview cached_commitrow
1132
1133    if {$vrowmod($v) == $commitidx($v)} return
1134    if {$v == $curview} {
1135        if {[llength $displayorder] > $vrowmod($v)} {
1136            set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
1137            set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
1138        }
1139        catch {unset cached_commitrow}
1140    }
1141    set narctot [expr {[llength $varctok($v)] - 1}]
1142    set a $varcmod($v)
1143    while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
1144        # go up the tree until we find something that has a row number,
1145        # or we get to a seed
1146        set a [lindex $vupptr($v) $a]
1147    }
1148    if {$a == 0} {
1149        set a [lindex $vdownptr($v) 0]
1150        if {$a == 0} return
1151        set vrownum($v) {0}
1152        set varcorder($v) [list $a]
1153        lset varcix($v) $a 0
1154        lset varcrow($v) $a 0
1155        set arcn 0
1156        set row 0
1157    } else {
1158        set arcn [lindex $varcix($v) $a]
1159        if {[llength $vrownum($v)] > $arcn + 1} {
1160            set vrownum($v) [lrange $vrownum($v) 0 $arcn]
1161            set varcorder($v) [lrange $varcorder($v) 0 $arcn]
1162        }
1163        set row [lindex $varcrow($v) $a]
1164    }
1165    while {1} {
1166        set p $a
1167        incr row [llength $varccommits($v,$a)]
1168        # go down if possible
1169        set b [lindex $vdownptr($v) $a]
1170        if {$b == 0} {
1171            # if not, go left, or go up until we can go left
1172            while {$a != 0} {
1173                set b [lindex $vleftptr($v) $a]
1174                if {$b != 0} break
1175                set a [lindex $vupptr($v) $a]
1176            }
1177            if {$a == 0} break
1178        }
1179        set a $b
1180        incr arcn
1181        lappend vrownum($v) $row
1182        lappend varcorder($v) $a
1183        lset varcix($v) $a $arcn
1184        lset varcrow($v) $a $row
1185    }
1186    set vtokmod($v) [lindex $varctok($v) $p]
1187    set varcmod($v) $p
1188    set vrowmod($v) $row
1189    if {[info exists currentid]} {
1190        set selectedline [rowofcommit $currentid]
1191    }
1192}
1193
1194# Test whether view $v contains commit $id
1195proc commitinview {id v} {
1196    global varcid
1197
1198    return [info exists varcid($v,$id)]
1199}
1200
1201# Return the row number for commit $id in the current view
1202proc rowofcommit {id} {
1203    global varcid varccommits varcrow curview cached_commitrow
1204    global varctok vtokmod
1205
1206    set v $curview
1207    if {![info exists varcid($v,$id)]} {
1208        puts "oops rowofcommit no arc for [shortids $id]"
1209        return {}
1210    }
1211    set a $varcid($v,$id)
1212    if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
1213        update_arcrows $v
1214    }
1215    if {[info exists cached_commitrow($id)]} {
1216        return $cached_commitrow($id)
1217    }
1218    set i [lsearch -exact $varccommits($v,$a) $id]
1219    if {$i < 0} {
1220        puts "oops didn't find commit [shortids $id] in arc $a"
1221        return {}
1222    }
1223    incr i [lindex $varcrow($v) $a]
1224    set cached_commitrow($id) $i
1225    return $i
1226}
1227
1228# Returns 1 if a is on an earlier row than b, otherwise 0
1229proc comes_before {a b} {
1230    global varcid varctok curview
1231
1232    set v $curview
1233    if {$a eq $b || ![info exists varcid($v,$a)] || \
1234            ![info exists varcid($v,$b)]} {
1235        return 0
1236    }
1237    if {$varcid($v,$a) != $varcid($v,$b)} {
1238        return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
1239                           [lindex $varctok($v) $varcid($v,$b)]] < 0}]
1240    }
1241    return [expr {[rowofcommit $a] < [rowofcommit $b]}]
1242}
1243
1244proc bsearch {l elt} {
1245    if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
1246        return 0
1247    }
1248    set lo 0
1249    set hi [llength $l]
1250    while {$hi - $lo > 1} {
1251        set mid [expr {int(($lo + $hi) / 2)}]
1252        set t [lindex $l $mid]
1253        if {$elt < $t} {
1254            set hi $mid
1255        } elseif {$elt > $t} {
1256            set lo $mid
1257        } else {
1258            return $mid
1259        }
1260    }
1261    return $lo
1262}
1263
1264# Make sure rows $start..$end-1 are valid in displayorder and parentlist
1265proc make_disporder {start end} {
1266    global vrownum curview commitidx displayorder parentlist
1267    global varccommits varcorder parents vrowmod varcrow
1268    global d_valid_start d_valid_end
1269
1270    if {$end > $vrowmod($curview)} {
1271        update_arcrows $curview
1272    }
1273    set ai [bsearch $vrownum($curview) $start]
1274    set start [lindex $vrownum($curview) $ai]
1275    set narc [llength $vrownum($curview)]
1276    for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
1277        set a [lindex $varcorder($curview) $ai]
1278        set l [llength $displayorder]
1279        set al [llength $varccommits($curview,$a)]
1280        if {$l < $r + $al} {
1281            if {$l < $r} {
1282                set pad [ntimes [expr {$r - $l}] {}]
1283                set displayorder [concat $displayorder $pad]
1284                set parentlist [concat $parentlist $pad]
1285            } elseif {$l > $r} {
1286                set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
1287                set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
1288            }
1289            foreach id $varccommits($curview,$a) {
1290                lappend displayorder $id
1291                lappend parentlist $parents($curview,$id)
1292            }
1293        } elseif {[lindex $displayorder [expr {$r + $al - 1}]] eq {}} {
1294            set i $r
1295            foreach id $varccommits($curview,$a) {
1296                lset displayorder $i $id
1297                lset parentlist $i $parents($curview,$id)
1298                incr i
1299            }
1300        }
1301        incr r $al
1302    }
1303}
1304
1305proc commitonrow {row} {
1306    global displayorder
1307
1308    set id [lindex $displayorder $row]
1309    if {$id eq {}} {
1310        make_disporder $row [expr {$row + 1}]
1311        set id [lindex $displayorder $row]
1312    }
1313    return $id
1314}
1315
1316proc closevarcs {v} {
1317    global varctok varccommits varcid parents children
1318    global cmitlisted commitidx vtokmod
1319
1320    set missing_parents 0
1321    set scripts {}
1322    set narcs [llength $varctok($v)]
1323    for {set a 1} {$a < $narcs} {incr a} {
1324        set id [lindex $varccommits($v,$a) end]
1325        foreach p $parents($v,$id) {
1326            if {[info exists varcid($v,$p)]} continue
1327            # add p as a new commit
1328            incr missing_parents
1329            set cmitlisted($v,$p) 0
1330            set parents($v,$p) {}
1331            if {[llength $children($v,$p)] == 1 &&
1332                [llength $parents($v,$id)] == 1} {
1333                set b $a
1334            } else {
1335                set b [newvarc $v $p]
1336            }
1337            set varcid($v,$p) $b
1338            if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
1339                modify_arc $v $b
1340            }
1341            lappend varccommits($v,$b) $p
1342            incr commitidx($v)
1343            set scripts [check_interest $p $scripts]
1344        }
1345    }
1346    if {$missing_parents > 0} {
1347        foreach s $scripts {
1348            eval $s
1349        }
1350    }
1351}
1352
1353# Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1354# Assumes we already have an arc for $rwid.
1355proc rewrite_commit {v id rwid} {
1356    global children parents varcid varctok vtokmod varccommits
1357
1358    foreach ch $children($v,$id) {
1359        # make $rwid be $ch's parent in place of $id
1360        set i [lsearch -exact $parents($v,$ch) $id]
1361        if {$i < 0} {
1362            puts "oops rewrite_commit didn't find $id in parent list for $ch"
1363        }
1364        set parents($v,$ch) [lreplace $parents($v,$ch) $i $i $rwid]
1365        # add $ch to $rwid's children and sort the list if necessary
1366        if {[llength [lappend children($v,$rwid) $ch]] > 1} {
1367            set children($v,$rwid) [lsort -command [list vtokcmp $v] \
1368                                        $children($v,$rwid)]
1369        }
1370        # fix the graph after joining $id to $rwid
1371        set a $varcid($v,$ch)
1372        fix_reversal $rwid $a $v
1373        # parentlist is wrong for the last element of arc $a
1374        # even if displayorder is right, hence the 3rd arg here
1375        modify_arc $v $a [expr {[llength $varccommits($v,$a)] - 1}]
1376    }
1377}
1378
1379# Mechanism for registering a command to be executed when we come
1380# across a particular commit.  To handle the case when only the
1381# prefix of the commit is known, the commitinterest array is now
1382# indexed by the first 4 characters of the ID.  Each element is a
1383# list of id, cmd pairs.
1384proc interestedin {id cmd} {
1385    global commitinterest
1386
1387    lappend commitinterest([string range $id 0 3]) $id $cmd
1388}
1389
1390proc check_interest {id scripts} {
1391    global commitinterest
1392
1393    set prefix [string range $id 0 3]
1394    if {[info exists commitinterest($prefix)]} {
1395        set newlist {}
1396        foreach {i script} $commitinterest($prefix) {
1397            if {[string match "$i*" $id]} {
1398                lappend scripts [string map [list "%I" $id "%P" $i] $script]
1399            } else {
1400                lappend newlist $i $script
1401            }
1402        }
1403        if {$newlist ne {}} {
1404            set commitinterest($prefix) $newlist
1405        } else {
1406            unset commitinterest($prefix)
1407        }
1408    }
1409    return $scripts
1410}
1411
1412proc getcommitlines {fd inst view updating}  {
1413    global cmitlisted leftover
1414    global commitidx commitdata vdatemode
1415    global parents children curview hlview
1416    global idpending ordertok
1417    global varccommits varcid varctok vtokmod vfilelimit vshortids
1418
1419    set stuff [read $fd 500000]
1420    # git log doesn't terminate the last commit with a null...
1421    if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
1422        set stuff "\0"
1423    }
1424    if {$stuff == {}} {
1425        if {![eof $fd]} {
1426            return 1
1427        }
1428        global commfd viewcomplete viewactive viewname
1429        global viewinstances
1430        unset commfd($inst)
1431        set i [lsearch -exact $viewinstances($view) $inst]
1432        if {$i >= 0} {
1433            set viewinstances($view) [lreplace $viewinstances($view) $i $i]
1434        }
1435        # set it blocking so we wait for the process to terminate
1436        fconfigure $fd -blocking 1
1437        if {[catch {close $fd} err]} {
1438            set fv {}
1439            if {$view != $curview} {
1440                set fv " for the \"$viewname($view)\" view"
1441            }
1442            if {[string range $err 0 4] == "usage"} {
1443                set err "Gitk: error reading commits$fv:\
1444                        bad arguments to git log."
1445                if {$viewname($view) eq "Command line"} {
1446                    append err \
1447                        "  (Note: arguments to gitk are passed to git log\
1448                         to allow selection of commits to be displayed.)"
1449                }
1450            } else {
1451                set err "Error reading commits$fv: $err"
1452            }
1453            error_popup $err
1454        }
1455        if {[incr viewactive($view) -1] <= 0} {
1456            set viewcomplete($view) 1
1457            # Check if we have seen any ids listed as parents that haven't
1458            # appeared in the list
1459            closevarcs $view
1460            notbusy $view
1461        }
1462        if {$view == $curview} {
1463            run chewcommits
1464        }
1465        return 0
1466    }
1467    set start 0
1468    set gotsome 0
1469    set scripts {}
1470    while 1 {
1471        set i [string first "\0" $stuff $start]
1472        if {$i < 0} {
1473            append leftover($inst) [string range $stuff $start end]
1474            break
1475        }
1476        if {$start == 0} {
1477            set cmit $leftover($inst)
1478            append cmit [string range $stuff 0 [expr {$i - 1}]]
1479            set leftover($inst) {}
1480        } else {
1481            set cmit [string range $stuff $start [expr {$i - 1}]]
1482        }
1483        set start [expr {$i + 1}]
1484        set j [string first "\n" $cmit]
1485        set ok 0
1486        set listed 1
1487        if {$j >= 0 && [string match "commit *" $cmit]} {
1488            set ids [string range $cmit 7 [expr {$j - 1}]]
1489            if {[string match {[-^<>]*} $ids]} {
1490                switch -- [string index $ids 0] {
1491                    "-" {set listed 0}
1492                    "^" {set listed 2}
1493                    "<" {set listed 3}
1494                    ">" {set listed 4}
1495                }
1496                set ids [string range $ids 1 end]
1497            }
1498            set ok 1
1499            foreach id $ids {
1500                if {[string length $id] != 40} {
1501                    set ok 0
1502                    break
1503                }
1504            }
1505        }
1506        if {!$ok} {
1507            set shortcmit $cmit
1508            if {[string length $shortcmit] > 80} {
1509                set shortcmit "[string range $shortcmit 0 80]..."
1510            }
1511            error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
1512            exit 1
1513        }
1514        set id [lindex $ids 0]
1515        set vid $view,$id
1516
1517        lappend vshortids($view,[string range $id 0 3]) $id
1518
1519        if {!$listed && $updating && ![info exists varcid($vid)] &&
1520            $vfilelimit($view) ne {}} {
1521            # git log doesn't rewrite parents for unlisted commits
1522            # when doing path limiting, so work around that here
1523            # by working out the rewritten parent with git rev-list
1524            # and if we already know about it, using the rewritten
1525            # parent as a substitute parent for $id's children.
1526            if {![catch {
1527                set rwid [exec git rev-list --first-parent --max-count=1 \
1528                              $id -- $vfilelimit($view)]
1529            }]} {
1530                if {$rwid ne {} && [info exists varcid($view,$rwid)]} {
1531                    # use $rwid in place of $id
1532                    rewrite_commit $view $id $rwid
1533                    continue
1534                }
1535            }
1536        }
1537
1538        set a 0
1539        if {[info exists varcid($vid)]} {
1540            if {$cmitlisted($vid) || !$listed} continue
1541            set a $varcid($vid)
1542        }
1543        if {$listed} {
1544            set olds [lrange $ids 1 end]
1545        } else {
1546            set olds {}
1547        }
1548        set commitdata($id) [string range $cmit [expr {$j + 1}] end]
1549        set cmitlisted($vid) $listed
1550        set parents($vid) $olds
1551        if {![info exists children($vid)]} {
1552            set children($vid) {}
1553        } elseif {$a == 0 && [llength $children($vid)] == 1} {
1554            set k [lindex $children($vid) 0]
1555            if {[llength $parents($view,$k)] == 1 &&
1556                (!$vdatemode($view) ||
1557                 $varcid($view,$k) == [llength $varctok($view)] - 1)} {
1558                set a $varcid($view,$k)
1559            }
1560        }
1561        if {$a == 0} {
1562            # new arc
1563            set a [newvarc $view $id]
1564        }
1565        if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
1566            modify_arc $view $a
1567        }
1568        if {![info exists varcid($vid)]} {
1569            set varcid($vid) $a
1570            lappend varccommits($view,$a) $id
1571            incr commitidx($view)
1572        }
1573
1574        set i 0
1575        foreach p $olds {
1576            if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
1577                set vp $view,$p
1578                if {[llength [lappend children($vp) $id]] > 1 &&
1579                    [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
1580                    set children($vp) [lsort -command [list vtokcmp $view] \
1581                                           $children($vp)]
1582                    catch {unset ordertok}
1583                }
1584                if {[info exists varcid($view,$p)]} {
1585                    fix_reversal $p $a $view
1586                }
1587            }
1588            incr i
1589        }
1590
1591        set scripts [check_interest $id $scripts]
1592        set gotsome 1
1593    }
1594    if {$gotsome} {
1595        global numcommits hlview
1596
1597        if {$view == $curview} {
1598            set numcommits $commitidx($view)
1599            run chewcommits
1600        }
1601        if {[info exists hlview] && $view == $hlview} {
1602            # we never actually get here...
1603            run vhighlightmore
1604        }
1605        foreach s $scripts {
1606            eval $s
1607        }
1608    }
1609    return 2
1610}
1611
1612proc chewcommits {} {
1613    global curview hlview viewcomplete
1614    global pending_select
1615
1616    layoutmore
1617    if {$viewcomplete($curview)} {
1618        global commitidx varctok
1619        global numcommits startmsecs
1620
1621        if {[info exists pending_select]} {
1622            update
1623            reset_pending_select {}
1624
1625            if {[commitinview $pending_select $curview]} {
1626                selectline [rowofcommit $pending_select] 1
1627            } else {
1628                set row [first_real_row]
1629                selectline $row 1
1630            }
1631        }
1632        if {$commitidx($curview) > 0} {
1633            #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1634            #puts "overall $ms ms for $numcommits commits"
1635            #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1636        } else {
1637            show_status [mc "No commits selected"]
1638        }
1639        notbusy layout
1640    }
1641    return 0
1642}
1643
1644proc do_readcommit {id} {
1645    global tclencoding
1646
1647    # Invoke git-log to handle automatic encoding conversion
1648    set fd [open [concat | git log --no-color --pretty=raw -1 $id] r]
1649    # Read the results using i18n.logoutputencoding
1650    fconfigure $fd -translation lf -eofchar {}
1651    if {$tclencoding != {}} {
1652        fconfigure $fd -encoding $tclencoding
1653    }
1654    set contents [read $fd]
1655    close $fd
1656    # Remove the heading line
1657    regsub {^commit [0-9a-f]+\n} $contents {} contents
1658
1659    return $contents
1660}
1661
1662proc readcommit {id} {
1663    if {[catch {set contents [do_readcommit $id]}]} return
1664    parsecommit $id $contents 1
1665}
1666
1667proc parsecommit {id contents listed} {
1668    global commitinfo
1669
1670    set inhdr 1
1671    set comment {}
1672    set headline {}
1673    set auname {}
1674    set audate {}
1675    set comname {}
1676    set comdate {}
1677    set hdrend [string first "\n\n" $contents]
1678    if {$hdrend < 0} {
1679        # should never happen...
1680        set hdrend [string length $contents]
1681    }
1682    set header [string range $contents 0 [expr {$hdrend - 1}]]
1683    set comment [string range $contents [expr {$hdrend + 2}] end]
1684    foreach line [split $header "\n"] {
1685        set line [split $line " "]
1686        set tag [lindex $line 0]
1687        if {$tag == "author"} {
1688            set audate [lrange $line end-1 end]
1689            set auname [join [lrange $line 1 end-2] " "]
1690        } elseif {$tag == "committer"} {
1691            set comdate [lrange $line end-1 end]
1692            set comname [join [lrange $line 1 end-2] " "]
1693        }
1694    }
1695    set headline {}
1696    # take the first non-blank line of the comment as the headline
1697    set headline [string trimleft $comment]
1698    set i [string first "\n" $headline]
1699    if {$i >= 0} {
1700        set headline [string range $headline 0 $i]
1701    }
1702    set headline [string trimright $headline]
1703    set i [string first "\r" $headline]
1704    if {$i >= 0} {
1705        set headline [string trimright [string range $headline 0 $i]]
1706    }
1707    if {!$listed} {
1708        # git log indents the comment by 4 spaces;
1709        # if we got this via git cat-file, add the indentation
1710        set newcomment {}
1711        foreach line [split $comment "\n"] {
1712            append newcomment "    "
1713            append newcomment $line
1714            append newcomment "\n"
1715        }
1716        set comment $newcomment
1717    }
1718    set hasnote [string first "\nNotes:\n" $contents]
1719    set diff ""
1720    # If there is diff output shown in the git-log stream, split it
1721    # out.  But get rid of the empty line that always precedes the
1722    # diff.
1723    set i [string first "\n\ndiff" $comment]
1724    if {$i >= 0} {
1725        set diff [string range $comment $i+1 end]
1726        set comment [string range $comment 0 $i-1]
1727    }
1728    set commitinfo($id) [list $headline $auname $audate \
1729                             $comname $comdate $comment $hasnote $diff]
1730}
1731
1732proc getcommit {id} {
1733    global commitdata commitinfo
1734
1735    if {[info exists commitdata($id)]} {
1736        parsecommit $id $commitdata($id) 1
1737    } else {
1738        readcommit $id
1739        if {![info exists commitinfo($id)]} {
1740            set commitinfo($id) [list [mc "No commit information available"]]
1741        }
1742    }
1743    return 1
1744}
1745
1746# Expand an abbreviated commit ID to a list of full 40-char IDs that match
1747# and are present in the current view.
1748# This is fairly slow...
1749proc longid {prefix} {
1750    global varcid curview vshortids
1751
1752    set ids {}
1753    if {[string length $prefix] >= 4} {
1754        set vshortid $curview,[string range $prefix 0 3]
1755        if {[info exists vshortids($vshortid)]} {
1756            foreach id $vshortids($vshortid) {
1757                if {[string match "$prefix*" $id]} {
1758                    if {[lsearch -exact $ids $id] < 0} {
1759                        lappend ids $id
1760                        if {[llength $ids] >= 2} break
1761                    }
1762                }
1763            }
1764        }
1765    } else {
1766        foreach match [array names varcid "$curview,$prefix*"] {
1767            lappend ids [lindex [split $match ","] 1]
1768            if {[llength $ids] >= 2} break
1769        }
1770    }
1771    return $ids
1772}
1773
1774proc readrefs {} {
1775    global tagids idtags headids idheads tagobjid
1776    global otherrefids idotherrefs mainhead mainheadid
1777    global selecthead selectheadid
1778    global hideremotes
1779
1780    foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
1781        catch {unset $v}
1782    }
1783    set refd [open [list | git show-ref -d] r]
1784    while {[gets $refd line] >= 0} {
1785        if {[string index $line 40] ne " "} continue
1786        set id [string range $line 0 39]
1787        set ref [string range $line 41 end]
1788        if {![string match "refs/*" $ref]} continue
1789        set name [string range $ref 5 end]
1790        if {[string match "remotes/*" $name]} {
1791            if {![string match "*/HEAD" $name] && !$hideremotes} {
1792                set headids($name) $id
1793                lappend idheads($id) $name
1794            }
1795        } elseif {[string match "heads/*" $name]} {
1796            set name [string range $name 6 end]
1797            set headids($name) $id
1798            lappend idheads($id) $name
1799        } elseif {[string match "tags/*" $name]} {
1800            # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1801            # which is what we want since the former is the commit ID
1802            set name [string range $name 5 end]
1803            if {[string match "*^{}" $name]} {
1804                set name [string range $name 0 end-3]
1805            } else {
1806                set tagobjid($name) $id
1807            }
1808            set tagids($name) $id
1809            lappend idtags($id) $name
1810        } else {
1811            set otherrefids($name) $id
1812            lappend idotherrefs($id) $name
1813        }
1814    }
1815    catch {close $refd}
1816    set mainhead {}
1817    set mainheadid {}
1818    catch {
1819        set mainheadid [exec git rev-parse HEAD]
1820        set thehead [exec git symbolic-ref HEAD]
1821        if {[string match "refs/heads/*" $thehead]} {
1822            set mainhead [string range $thehead 11 end]
1823        }
1824    }
1825    set selectheadid {}
1826    if {$selecthead ne {}} {
1827        catch {
1828            set selectheadid [exec git rev-parse --verify $selecthead]
1829        }
1830    }
1831}
1832
1833# skip over fake commits
1834proc first_real_row {} {
1835    global nullid nullid2 numcommits
1836
1837    for {set row 0} {$row < $numcommits} {incr row} {
1838        set id [commitonrow $row]
1839        if {$id ne $nullid && $id ne $nullid2} {
1840            break
1841        }
1842    }
1843    return $row
1844}
1845
1846# update things for a head moved to a child of its previous location
1847proc movehead {id name} {
1848    global headids idheads
1849
1850    removehead $headids($name) $name
1851    set headids($name) $id
1852    lappend idheads($id) $name
1853}
1854
1855# update things when a head has been removed
1856proc removehead {id name} {
1857    global headids idheads
1858
1859    if {$idheads($id) eq $name} {
1860        unset idheads($id)
1861    } else {
1862        set i [lsearch -exact $idheads($id) $name]
1863        if {$i >= 0} {
1864            set idheads($id) [lreplace $idheads($id) $i $i]
1865        }
1866    }
1867    unset headids($name)
1868}
1869
1870proc ttk_toplevel {w args} {
1871    global use_ttk
1872    eval [linsert $args 0 ::toplevel $w]
1873    if {$use_ttk} {
1874        place [ttk::frame $w._toplevel_background] -x 0 -y 0 -relwidth 1 -relheight 1
1875    }
1876    return $w
1877}
1878
1879proc make_transient {window origin} {
1880    global have_tk85
1881
1882    # In MacOS Tk 8.4 transient appears to work by setting
1883    # overrideredirect, which is utterly useless, since the
1884    # windows get no border, and are not even kept above
1885    # the parent.
1886    if {!$have_tk85 && [tk windowingsystem] eq {aqua}} return
1887
1888    wm transient $window $origin
1889
1890    # Windows fails to place transient windows normally, so
1891    # schedule a callback to center them on the parent.
1892    if {[tk windowingsystem] eq {win32}} {
1893        after idle [list tk::PlaceWindow $window widget $origin]
1894    }
1895}
1896
1897proc show_error {w top msg {mc mc}} {
1898    global NS
1899    if {![info exists NS]} {set NS ""}
1900    if {[wm state $top] eq "withdrawn"} { wm deiconify $top }
1901    message $w.m -text $msg -justify center -aspect 400
1902    pack $w.m -side top -fill x -padx 20 -pady 20
1903    ${NS}::button $w.ok -default active -text [$mc OK] -command "destroy $top"
1904    pack $w.ok -side bottom -fill x
1905    bind $top <Visibility> "grab $top; focus $top"
1906    bind $top <Key-Return> "destroy $top"
1907    bind $top <Key-space>  "destroy $top"
1908    bind $top <Key-Escape> "destroy $top"
1909    tkwait window $top
1910}
1911
1912proc error_popup {msg {owner .}} {
1913    if {[tk windowingsystem] eq "win32"} {
1914        tk_messageBox -icon error -type ok -title [wm title .] \
1915            -parent $owner -message $msg
1916    } else {
1917        set w .error
1918        ttk_toplevel $w
1919        make_transient $w $owner
1920        show_error $w $w $msg
1921    }
1922}
1923
1924proc confirm_popup {msg {owner .}} {
1925    global confirm_ok NS
1926    set confirm_ok 0
1927    set w .confirm
1928    ttk_toplevel $w
1929    make_transient $w $owner
1930    message $w.m -text $msg -justify center -aspect 400
1931    pack $w.m -side top -fill x -padx 20 -pady 20
1932    ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
1933    pack $w.ok -side left -fill x
1934    ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
1935    pack $w.cancel -side right -fill x
1936    bind $w <Visibility> "grab $w; focus $w"
1937    bind $w <Key-Return> "set confirm_ok 1; destroy $w"
1938    bind $w <Key-space>  "set confirm_ok 1; destroy $w"
1939    bind $w <Key-Escape> "destroy $w"
1940    tk::PlaceWindow $w widget $owner
1941    tkwait window $w
1942    return $confirm_ok
1943}
1944
1945proc setoptions {} {
1946    if {[tk windowingsystem] ne "win32"} {
1947        option add *Panedwindow.showHandle 1 startupFile
1948        option add *Panedwindow.sashRelief raised startupFile
1949        if {[tk windowingsystem] ne "aqua"} {
1950            option add *Menu.font uifont startupFile
1951        }
1952    } else {
1953        option add *Menu.TearOff 0 startupFile
1954    }
1955    option add *Button.font uifont startupFile
1956    option add *Checkbutton.font uifont startupFile
1957    option add *Radiobutton.font uifont startupFile
1958    option add *Menubutton.font uifont startupFile
1959    option add *Label.font uifont startupFile
1960    option add *Message.font uifont startupFile
1961    option add *Entry.font textfont startupFile
1962    option add *Text.font textfont startupFile
1963    option add *Labelframe.font uifont startupFile
1964    option add *Spinbox.font textfont startupFile
1965    option add *Listbox.font mainfont startupFile
1966}
1967
1968# Make a menu and submenus.
1969# m is the window name for the menu, items is the list of menu items to add.
1970# Each item is a list {mc label type description options...}
1971# mc is ignored; it's so we can put mc there to alert xgettext
1972# label is the string that appears in the menu
1973# type is cascade, command or radiobutton (should add checkbutton)
1974# description depends on type; it's the sublist for cascade, the
1975# command to invoke for command, or {variable value} for radiobutton
1976proc makemenu {m items} {
1977    menu $m
1978    if {[tk windowingsystem] eq {aqua}} {
1979        set Meta1 Cmd
1980    } else {
1981        set Meta1 Ctrl
1982    }
1983    foreach i $items {
1984        set name [mc [lindex $i 1]]
1985        set type [lindex $i 2]
1986        set thing [lindex $i 3]
1987        set params [list $type]
1988        if {$name ne {}} {
1989            set u [string first "&" [string map {&& x} $name]]
1990            lappend params -label [string map {&& & & {}} $name]
1991            if {$u >= 0} {
1992                lappend params -underline $u
1993            }
1994        }
1995        switch -- $type {
1996            "cascade" {
1997                set submenu [string tolower [string map {& ""} [lindex $i 1]]]
1998                lappend params -menu $m.$submenu
1999            }
2000            "command" {
2001                lappend params -command $thing
2002            }
2003            "radiobutton" {
2004                lappend params -variable [lindex $thing 0] \
2005                    -value [lindex $thing 1]
2006            }
2007        }
2008        set tail [lrange $i 4 end]
2009        regsub -all {\yMeta1\y} $tail $Meta1 tail
2010        eval $m add $params $tail
2011        if {$type eq "cascade"} {
2012            makemenu $m.$submenu $thing
2013        }
2014    }
2015}
2016
2017# translate string and remove ampersands
2018proc mca {str} {
2019    return [string map {&& & & {}} [mc $str]]
2020}
2021
2022proc cleardropsel {w} {
2023    $w selection clear
2024}
2025proc makedroplist {w varname args} {
2026    global use_ttk
2027    if {$use_ttk} {
2028        set width 0
2029        foreach label $args {
2030            set cx [string length $label]
2031            if {$cx > $width} {set width $cx}
2032        }
2033        set gm [ttk::combobox $w -width $width -state readonly\
2034                    -textvariable $varname -values $args \
2035                    -exportselection false]
2036        bind $gm <<ComboboxSelected>> [list $gm selection clear]
2037    } else {
2038        set gm [eval [linsert $args 0 tk_optionMenu $w $varname]]
2039    }
2040    return $gm
2041}
2042
2043proc makewindow {} {
2044    global canv canv2 canv3 linespc charspc ctext cflist cscroll
2045    global tabstop
2046    global findtype findtypemenu findloc findstring fstring geometry
2047    global entries sha1entry sha1string sha1but
2048    global diffcontextstring diffcontext
2049    global ignorespace
2050    global maincursor textcursor curtextcursor
2051    global rowctxmenu fakerowmenu mergemax wrapcomment
2052    global highlight_files gdttype
2053    global searchstring sstring
2054    global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
2055    global uifgcolor uifgdisabledcolor
2056    global filesepbgcolor filesepfgcolor
2057    global mergecolors foundbgcolor currentsearchhitbgcolor
2058    global headctxmenu progresscanv progressitem progresscoords statusw
2059    global fprogitem fprogcoord lastprogupdate progupdatepending
2060    global rprogitem rprogcoord rownumsel numcommits
2061    global have_tk85 use_ttk NS
2062    global git_version
2063    global worddiff
2064
2065    # The "mc" arguments here are purely so that xgettext
2066    # sees the following string as needing to be translated
2067    set file {
2068        mc "File" cascade {
2069            {mc "Update" command updatecommits -accelerator F5}
2070            {mc "Reload" command reloadcommits -accelerator Shift-F5}
2071            {mc "Reread references" command rereadrefs}
2072            {mc "List references" command showrefs -accelerator F2}
2073            {xx "" separator}
2074            {mc "Start git gui" command {exec git gui &}}
2075            {xx "" separator}
2076            {mc "Quit" command doquit -accelerator Meta1-Q}
2077        }}
2078    set edit {
2079        mc "Edit" cascade {
2080            {mc "Preferences" command doprefs}
2081        }}
2082    set view {
2083        mc "View" cascade {
2084            {mc "New view..." command {newview 0} -accelerator Shift-F4}
2085            {mc "Edit view..." command editview -state disabled -accelerator F4}
2086            {mc "Delete view" command delview -state disabled}
2087            {xx "" separator}
2088            {mc "All files" radiobutton {selectedview 0} -command {showview 0}}
2089        }}
2090    if {[tk windowingsystem] ne "aqua"} {
2091        set help {
2092        mc "Help" cascade {
2093            {mc "About gitk" command about}
2094            {mc "Key bindings" command keys}
2095        }}
2096        set bar [list $file $edit $view $help]
2097    } else {
2098        proc ::tk::mac::ShowPreferences {} {doprefs}
2099        proc ::tk::mac::Quit {} {doquit}
2100        lset file end [lreplace [lindex $file end] end-1 end]
2101        set apple {
2102        xx "Apple" cascade {
2103            {mc "About gitk" command about}
2104            {xx "" separator}
2105        }}
2106        set help {
2107        mc "Help" cascade {
2108            {mc "Key bindings" command keys}
2109        }}
2110        set bar [list $apple $file $view $help]
2111    }
2112    makemenu .bar $bar
2113    . configure -menu .bar
2114
2115    if {$use_ttk} {
2116        # cover the non-themed toplevel with a themed frame.
2117        place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1
2118    }
2119
2120    # the gui has upper and lower half, parts of a paned window.
2121    ${NS}::panedwindow .ctop -orient vertical
2122
2123    # possibly use assumed geometry
2124    if {![info exists geometry(pwsash0)]} {
2125        set geometry(topheight) [expr {15 * $linespc}]
2126        set geometry(topwidth) [expr {80 * $charspc}]
2127        set geometry(botheight) [expr {15 * $linespc}]
2128        set geometry(botwidth) [expr {50 * $charspc}]
2129        set geometry(pwsash0) [list [expr {40 * $charspc}] 2]
2130        set geometry(pwsash1) [list [expr {60 * $charspc}] 2]
2131    }
2132
2133    # the upper half will have a paned window, a scroll bar to the right, and some stuff below
2134    ${NS}::frame .tf -height $geometry(topheight) -width $geometry(topwidth)
2135    ${NS}::frame .tf.histframe
2136    ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal
2137    if {!$use_ttk} {
2138        .tf.histframe.pwclist configure -sashpad 0 -handlesize 4
2139    }
2140
2141    # create three canvases
2142    set cscroll .tf.histframe.csb
2143    set canv .tf.histframe.pwclist.canv
2144    canvas $canv \
2145        -selectbackground $selectbgcolor \
2146        -background $bgcolor -bd 0 \
2147        -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
2148    .tf.histframe.pwclist add $canv
2149    set canv2 .tf.histframe.pwclist.canv2
2150    canvas $canv2 \
2151        -selectbackground $selectbgcolor \
2152        -background $bgcolor -bd 0 -yscrollincr $linespc
2153    .tf.histframe.pwclist add $canv2
2154    set canv3 .tf.histframe.pwclist.canv3
2155    canvas $canv3 \
2156        -selectbackground $selectbgcolor \
2157        -background $bgcolor -bd 0 -yscrollincr $linespc
2158    .tf.histframe.pwclist add $canv3
2159    if {$use_ttk} {
2160        bind .tf.histframe.pwclist <Map> {
2161            bind %W <Map> {}
2162            .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0]
2163            .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0]
2164        }
2165    } else {
2166        eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
2167        eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
2168    }
2169
2170    # a scroll bar to rule them
2171    ${NS}::scrollbar $cscroll -command {allcanvs yview}
2172    if {!$use_ttk} {$cscroll configure -highlightthickness 0}
2173    pack $cscroll -side right -fill y
2174    bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
2175    lappend bglist $canv $canv2 $canv3
2176    pack .tf.histframe.pwclist -fill both -expand 1 -side left
2177
2178    # we have two button bars at bottom of top frame. Bar 1
2179    ${NS}::frame .tf.bar
2180    ${NS}::frame .tf.lbar -height 15
2181
2182    set sha1entry .tf.bar.sha1
2183    set entries $sha1entry
2184    set sha1but .tf.bar.sha1label
2185    button $sha1but -text "[mc "SHA1 ID:"] " -state disabled -relief flat \
2186        -command gotocommit -width 8
2187    $sha1but conf -disabledforeground [$sha1but cget -foreground]
2188    pack .tf.bar.sha1label -side left
2189    ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string
2190    trace add variable sha1string write sha1change
2191    pack $sha1entry -side left -pady 2
2192
2193    set bm_left_data {
2194        #define left_width 16
2195        #define left_height 16
2196        static unsigned char left_bits[] = {
2197        0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
2198        0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
2199        0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
2200    }
2201    set bm_right_data {
2202        #define right_width 16
2203        #define right_height 16
2204        static unsigned char right_bits[] = {
2205        0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
2206        0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
2207        0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
2208    }
2209    image create bitmap bm-left -data $bm_left_data -foreground $uifgcolor
2210    image create bitmap bm-left-gray -data $bm_left_data -foreground $uifgdisabledcolor
2211    image create bitmap bm-right -data $bm_right_data -foreground $uifgcolor
2212    image create bitmap bm-right-gray -data $bm_right_data -foreground $uifgdisabledcolor
2213
2214    ${NS}::button .tf.bar.leftbut -command goback -state disabled -width 26
2215    if {$use_ttk} {
2216        .tf.bar.leftbut configure -image [list bm-left disabled bm-left-gray]
2217    } else {
2218        .tf.bar.leftbut configure -image bm-left
2219    }
2220    pack .tf.bar.leftbut -side left -fill y
2221    ${NS}::button .tf.bar.rightbut -command goforw -state disabled -width 26
2222    if {$use_ttk} {
2223        .tf.bar.rightbut configure -image [list bm-right disabled bm-right-gray]
2224    } else {
2225        .tf.bar.rightbut configure -image bm-right
2226    }
2227    pack .tf.bar.rightbut -side left -fill y
2228
2229    ${NS}::label .tf.bar.rowlabel -text [mc "Row"]
2230    set rownumsel {}
2231    ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \
2232        -relief sunken -anchor e
2233    ${NS}::label .tf.bar.rowlabel2 -text "/"
2234    ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \
2235        -relief sunken -anchor e
2236    pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
2237        -side left
2238    if {!$use_ttk} {
2239        foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont}
2240    }
2241    global selectedline
2242    trace add variable selectedline write selectedline_change
2243
2244    # Status label and progress bar
2245    set statusw .tf.bar.status
2246    ${NS}::label $statusw -width 15 -relief sunken
2247    pack $statusw -side left -padx 5
2248    if {$use_ttk} {
2249        set progresscanv [ttk::progressbar .tf.bar.progress]
2250    } else {
2251        set h [expr {[font metrics uifont -linespace] + 2}]
2252        set progresscanv .tf.bar.progress
2253        canvas $progresscanv -relief sunken -height $h -borderwidth 2
2254        set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
2255        set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
2256        set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
2257    }
2258    pack $progresscanv -side right -expand 1 -fill x -padx {0 2}
2259    set progresscoords {0 0}
2260    set fprogcoord 0
2261    set rprogcoord 0
2262    bind $progresscanv <Configure> adjustprogress
2263    set lastprogupdate [clock clicks -milliseconds]
2264    set progupdatepending 0
2265
2266    # build up the bottom bar of upper window
2267    ${NS}::label .tf.lbar.flabel -text "[mc "Find"] "
2268
2269    set bm_down_data {
2270        #define down_width 16
2271        #define down_height 16
2272        static unsigned char down_bits[] = {
2273        0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2274        0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2275        0x87, 0xe1, 0x8e, 0x71, 0x9c, 0x39, 0xb8, 0x1d,
2276        0xf0, 0x0f, 0xe0, 0x07, 0xc0, 0x03, 0x80, 0x01};
2277    }
2278    image create bitmap bm-down -data $bm_down_data -foreground $uifgcolor
2279    ${NS}::button .tf.lbar.fnext -width 26 -command {dofind 1 1}
2280    .tf.lbar.fnext configure -image bm-down
2281
2282    set bm_up_data {
2283        #define up_width 16
2284        #define up_height 16
2285        static unsigned char up_bits[] = {
2286        0x80, 0x01, 0xc0, 0x03, 0xe0, 0x07, 0xf0, 0x0f,
2287        0xb8, 0x1d, 0x9c, 0x39, 0x8e, 0x71, 0x87, 0xe1,
2288        0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2289        0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01};
2290    }
2291    image create bitmap bm-up -data $bm_up_data -foreground $uifgcolor
2292    ${NS}::button .tf.lbar.fprev -width 26 -command {dofind -1 1}
2293    .tf.lbar.fprev configure -image bm-up
2294
2295    ${NS}::label .tf.lbar.flab2 -text " [mc "commit"] "
2296
2297    pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
2298        -side left -fill y
2299    set gdttype [mc "containing:"]
2300    set gm [makedroplist .tf.lbar.gdttype gdttype \
2301                [mc "containing:"] \
2302                [mc "touching paths:"] \
2303                [mc "adding/removing string:"] \
2304                [mc "changing lines matching:"]]
2305    trace add variable gdttype write gdttype_change
2306    pack .tf.lbar.gdttype -side left -fill y
2307
2308    set findstring {}
2309    set fstring .tf.lbar.findstring
2310    lappend entries $fstring
2311    ${NS}::entry $fstring -width 30 -textvariable findstring
2312    trace add variable findstring write find_change
2313    set findtype [mc "Exact"]
2314    set findtypemenu [makedroplist .tf.lbar.findtype \
2315                          findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
2316    trace add variable findtype write findcom_change
2317    set findloc [mc "All fields"]
2318    makedroplist .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
2319        [mc "Comments"] [mc "Author"] [mc "Committer"]
2320    trace add variable findloc write find_change
2321    pack .tf.lbar.findloc -side right
2322    pack .tf.lbar.findtype -side right
2323    pack $fstring -side left -expand 1 -fill x
2324
2325    # Finish putting the upper half of the viewer together
2326    pack .tf.lbar -in .tf -side bottom -fill x
2327    pack .tf.bar -in .tf -side bottom -fill x
2328    pack .tf.histframe -fill both -side top -expand 1
2329    .ctop add .tf
2330    if {!$use_ttk} {
2331        .ctop paneconfigure .tf -height $geometry(topheight)
2332        .ctop paneconfigure .tf -width $geometry(topwidth)
2333    }
2334
2335    # now build up the bottom
2336    ${NS}::panedwindow .pwbottom -orient horizontal
2337
2338    # lower left, a text box over search bar, scroll bar to the right
2339    # if we know window height, then that will set the lower text height, otherwise
2340    # we set lower text height which will drive window height
2341    if {[info exists geometry(main)]} {
2342        ${NS}::frame .bleft -width $geometry(botwidth)
2343    } else {
2344        ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
2345    }
2346    ${NS}::frame .bleft.top
2347    ${NS}::frame .bleft.mid
2348    ${NS}::frame .bleft.bottom
2349
2350    ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch
2351    pack .bleft.top.search -side left -padx 5
2352    set sstring .bleft.top.sstring
2353    set searchstring ""
2354    ${NS}::entry $sstring -width 20 -textvariable searchstring
2355    lappend entries $sstring
2356    trace add variable searchstring write incrsearch
2357    pack $sstring -side left -expand 1 -fill x
2358    ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \
2359        -command changediffdisp -variable diffelide -value {0 0}
2360    ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \
2361        -command changediffdisp -variable diffelide -value {0 1}
2362    ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \
2363        -command changediffdisp -variable diffelide -value {1 0}
2364    ${NS}::label .bleft.mid.labeldiffcontext -text "      [mc "Lines of context"]: "
2365    pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
2366    spinbox .bleft.mid.diffcontext -width 5 \
2367        -from 0 -increment 1 -to 10000000 \
2368        -validate all -validatecommand "diffcontextvalidate %P" \
2369        -textvariable diffcontextstring
2370    .bleft.mid.diffcontext set $diffcontext
2371    trace add variable diffcontextstring write diffcontextchange
2372    lappend entries .bleft.mid.diffcontext
2373    pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
2374    ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
2375        -command changeignorespace -variable ignorespace
2376    pack .bleft.mid.ignspace -side left -padx 5
2377
2378    set worddiff [mc "Line diff"]
2379    if {[package vcompare $git_version "1.7.2"] >= 0} {
2380        makedroplist .bleft.mid.worddiff worddiff [mc "Line diff"] \
2381            [mc "Markup words"] [mc "Color words"]
2382        trace add variable worddiff write changeworddiff
2383        pack .bleft.mid.worddiff -side left -padx 5
2384    }
2385
2386    set ctext .bleft.bottom.ctext
2387    text $ctext -background $bgcolor -foreground $fgcolor \
2388        -state disabled -font textfont \
2389        -yscrollcommand scrolltext -wrap none \
2390        -xscrollcommand ".bleft.bottom.sbhorizontal set"
2391    if {$have_tk85} {
2392        $ctext conf -tabstyle wordprocessor
2393    }
2394    ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview"
2395    ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h
2396    pack .bleft.top -side top -fill x
2397    pack .bleft.mid -side top -fill x
2398    grid $ctext .bleft.bottom.sb -sticky nsew
2399    grid .bleft.bottom.sbhorizontal -sticky ew
2400    grid columnconfigure .bleft.bottom 0 -weight 1
2401    grid rowconfigure .bleft.bottom 0 -weight 1
2402    grid rowconfigure .bleft.bottom 1 -weight 0
2403    pack .bleft.bottom -side top -fill both -expand 1
2404    lappend bglist $ctext
2405    lappend fglist $ctext
2406
2407    $ctext tag conf comment -wrap $wrapcomment
2408    $ctext tag conf filesep -font textfontbold -fore $filesepfgcolor -back $filesepbgcolor
2409    $ctext tag conf hunksep -fore [lindex $diffcolors 2]
2410    $ctext tag conf d0 -fore [lindex $diffcolors 0]
2411    $ctext tag conf dresult -fore [lindex $diffcolors 1]
2412    $ctext tag conf m0 -fore [lindex $mergecolors 0]
2413    $ctext tag conf m1 -fore [lindex $mergecolors 1]
2414    $ctext tag conf m2 -fore [lindex $mergecolors 2]
2415    $ctext tag conf m3 -fore [lindex $mergecolors 3]
2416    $ctext tag conf m4 -fore [lindex $mergecolors 4]
2417    $ctext tag conf m5 -fore [lindex $mergecolors 5]
2418    $ctext tag conf m6 -fore [lindex $mergecolors 6]
2419    $ctext tag conf m7 -fore [lindex $mergecolors 7]
2420    $ctext tag conf m8 -fore [lindex $mergecolors 8]
2421    $ctext tag conf m9 -fore [lindex $mergecolors 9]
2422    $ctext tag conf m10 -fore [lindex $mergecolors 10]
2423    $ctext tag conf m11 -fore [lindex $mergecolors 11]
2424    $ctext tag conf m12 -fore [lindex $mergecolors 12]
2425    $ctext tag conf m13 -fore [lindex $mergecolors 13]
2426    $ctext tag conf m14 -fore [lindex $mergecolors 14]
2427    $ctext tag conf m15 -fore [lindex $mergecolors 15]
2428    $ctext tag conf mmax -fore darkgrey
2429    set mergemax 16
2430    $ctext tag conf mresult -font textfontbold
2431    $ctext tag conf msep -font textfontbold
2432    $ctext tag conf found -back $foundbgcolor
2433    $ctext tag conf currentsearchhit -back $currentsearchhitbgcolor
2434    $ctext tag conf wwrap -wrap word -lmargin2 1c
2435    $ctext tag conf bold -font textfontbold
2436
2437    .pwbottom add .bleft
2438    if {!$use_ttk} {
2439        .pwbottom paneconfigure .bleft -width $geometry(botwidth)
2440    }
2441
2442    # lower right
2443    ${NS}::frame .bright
2444    ${NS}::frame .bright.mode
2445    ${NS}::radiobutton .bright.mode.patch -text [mc "Patch"] \
2446        -command reselectline -variable cmitmode -value "patch"
2447    ${NS}::radiobutton .bright.mode.tree -text [mc "Tree"] \
2448        -command reselectline -variable cmitmode -value "tree"
2449    grid .bright.mode.patch .bright.mode.tree -sticky ew
2450    pack .bright.mode -side top -fill x
2451    set cflist .bright.cfiles
2452    set indent [font measure mainfont "nn"]
2453    text $cflist \
2454        -selectbackground $selectbgcolor \
2455        -background $bgcolor -foreground $fgcolor \
2456        -font mainfont \
2457        -tabs [list $indent [expr {2 * $indent}]] \
2458        -yscrollcommand ".bright.sb set" \
2459        -cursor [. cget -cursor] \
2460        -spacing1 1 -spacing3 1
2461    lappend bglist $cflist
2462    lappend fglist $cflist
2463    ${NS}::scrollbar .bright.sb -command "$cflist yview"
2464    pack .bright.sb -side right -fill y
2465    pack $cflist -side left -fill both -expand 1
2466    $cflist tag configure highlight \
2467        -background [$cflist cget -selectbackground]
2468    $cflist tag configure bold -font mainfontbold
2469
2470    .pwbottom add .bright
2471    .ctop add .pwbottom
2472
2473    # restore window width & height if known
2474    if {[info exists geometry(main)]} {
2475        if {[scan $geometry(main) "%dx%d" w h] >= 2} {
2476            if {$w > [winfo screenwidth .]} {
2477                set w [winfo screenwidth .]
2478            }
2479            if {$h > [winfo screenheight .]} {
2480                set h [winfo screenheight .]
2481            }
2482            wm geometry . "${w}x$h"
2483        }
2484    }
2485
2486    if {[info exists geometry(state)] && $geometry(state) eq "zoomed"} {
2487        wm state . $geometry(state)
2488    }
2489
2490    if {[tk windowingsystem] eq {aqua}} {
2491        set M1B M1
2492        set ::BM "3"
2493    } else {
2494        set M1B Control
2495        set ::BM "2"
2496    }
2497
2498    if {$use_ttk} {
2499        bind .ctop <Map> {
2500            bind %W <Map> {}
2501            %W sashpos 0 $::geometry(topheight)
2502        }
2503        bind .pwbottom <Map> {
2504            bind %W <Map> {}
2505            %W sashpos 0 $::geometry(botwidth)
2506        }
2507    }
2508
2509    bind .pwbottom <Configure> {resizecdetpanes %W %w}
2510    pack .ctop -fill both -expand 1
2511    bindall <1> {selcanvline %W %x %y}
2512    #bindall <B1-Motion> {selcanvline %W %x %y}
2513    if {[tk windowingsystem] == "win32"} {
2514        bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
2515        bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
2516    } else {
2517        bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
2518        bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
2519        bind $ctext <Button> {
2520            if {"%b" eq 6} {
2521                $ctext xview scroll -5 units
2522            } elseif {"%b" eq 7} {
2523                $ctext xview scroll 5 units
2524            }
2525        }
2526        if {[tk windowingsystem] eq "aqua"} {
2527            bindall <MouseWheel> {
2528                set delta [expr {- (%D)}]
2529                allcanvs yview scroll $delta units
2530            }
2531            bindall <Shift-MouseWheel> {
2532                set delta [expr {- (%D)}]
2533                $canv xview scroll $delta units
2534            }
2535        }
2536    }
2537    bindall <$::BM> "canvscan mark %W %x %y"
2538    bindall <B$::BM-Motion> "canvscan dragto %W %x %y"
2539    bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2540    bind . <$M1B-Key-w> doquit
2541    bindkey <Home> selfirstline
2542    bindkey <End> sellastline
2543    bind . <Key-Up> "selnextline -1"
2544    bind . <Key-Down> "selnextline 1"
2545    bind . <Shift-Key-Up> "dofind -1 0"
2546    bind . <Shift-Key-Down> "dofind 1 0"
2547    bindkey <Key-Right> "goforw"
2548    bindkey <Key-Left> "goback"
2549    bind . <Key-Prior> "selnextpage -1"
2550    bind . <Key-Next> "selnextpage 1"
2551    bind . <$M1B-Home> "allcanvs yview moveto 0.0"
2552    bind . <$M1B-End> "allcanvs yview moveto 1.0"
2553    bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
2554    bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
2555    bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2556    bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
2557    bindkey <Key-Delete> "$ctext yview scroll -1 pages"
2558    bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
2559    bindkey <Key-space> "$ctext yview scroll 1 pages"
2560    bindkey p "selnextline -1"
2561    bindkey n "selnextline 1"
2562    bindkey z "goback"
2563    bindkey x "goforw"
2564    bindkey k "selnextline -1"
2565    bindkey j "selnextline 1"
2566    bindkey h "goback"
2567    bindkey l "goforw"
2568    bindkey b prevfile
2569    bindkey d "$ctext yview scroll 18 units"
2570    bindkey u "$ctext yview scroll -18 units"
2571    bindkey / {focus $fstring}
2572    bindkey <Key-KP_Divide> {focus $fstring}
2573    bindkey <Key-Return> {dofind 1 1}
2574    bindkey ? {dofind -1 1}
2575    bindkey f nextfile
2576    bind . <F5> updatecommits
2577    bindmodfunctionkey Shift 5 reloadcommits
2578    bind . <F2> showrefs
2579    bindmodfunctionkey Shift 4 {newview 0}
2580    bind . <F4> edit_or_newview
2581    bind . <$M1B-q> doquit
2582    bind . <$M1B-f> {dofind 1 1}
2583    bind . <$M1B-g> {dofind 1 0}
2584    bind . <$M1B-r> dosearchback
2585    bind . <$M1B-s> dosearch
2586    bind . <$M1B-equal> {incrfont 1}
2587    bind . <$M1B-plus> {incrfont 1}
2588    bind . <$M1B-KP_Add> {incrfont 1}
2589    bind . <$M1B-minus> {incrfont -1}
2590    bind . <$M1B-KP_Subtract> {incrfont -1}
2591    wm protocol . WM_DELETE_WINDOW doquit
2592    bind . <Destroy> {stop_backends}
2593    bind . <Button-1> "click %W"
2594    bind $fstring <Key-Return> {dofind 1 1}
2595    bind $sha1entry <Key-Return> {gotocommit; break}
2596    bind $sha1entry <<PasteSelection>> clearsha1
2597    bind $sha1entry <<Paste>> clearsha1
2598    bind $cflist <1> {sel_flist %W %x %y; break}
2599    bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
2600    bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
2601    global ctxbut
2602    bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
2603    bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
2604    bind $ctext <Button-1> {focus %W}
2605    bind $ctext <<Selection>> rehighlight_search_results
2606    for {set i 1} {$i < 10} {incr i} {
2607        bind . <$M1B-Key-$i> [list go_to_parent $i]
2608    }
2609
2610    set maincursor [. cget -cursor]
2611    set textcursor [$ctext cget -cursor]
2612    set curtextcursor $textcursor
2613
2614    set rowctxmenu .rowctxmenu
2615    makemenu $rowctxmenu {
2616        {mc "Diff this -> selected" command {diffvssel 0}}
2617        {mc "Diff selected -> this" command {diffvssel 1}}
2618        {mc "Make patch" command mkpatch}
2619        {mc "Create tag" command mktag}
2620        {mc "Write commit to file" command writecommit}
2621        {mc "Create new branch" command mkbranch}
2622        {mc "Cherry-pick this commit" command cherrypick}
2623        {mc "Reset HEAD branch to here" command resethead}
2624        {mc "Mark this commit" command markhere}
2625        {mc "Return to mark" command gotomark}
2626        {mc "Find descendant of this and mark" command find_common_desc}
2627        {mc "Compare with marked commit" command compare_commits}
2628        {mc "Diff this -> marked commit" command {diffvsmark 0}}
2629        {mc "Diff marked commit -> this" command {diffvsmark 1}}
2630        {mc "Revert this commit" command revert}
2631    }
2632    $rowctxmenu configure -tearoff 0
2633
2634    set fakerowmenu .fakerowmenu
2635    makemenu $fakerowmenu {
2636        {mc "Diff this -> selected" command {diffvssel 0}}
2637        {mc "Diff selected -> this" command {diffvssel 1}}
2638        {mc "Make patch" command mkpatch}
2639        {mc "Diff this -> marked commit" command {diffvsmark 0}}
2640        {mc "Diff marked commit -> this" command {diffvsmark 1}}
2641    }
2642    $fakerowmenu configure -tearoff 0
2643
2644    set headctxmenu .headctxmenu
2645    makemenu $headctxmenu {
2646        {mc "Check out this branch" command cobranch}
2647        {mc "Remove this branch" command rmbranch}
2648    }
2649    $headctxmenu configure -tearoff 0
2650
2651    global flist_menu
2652    set flist_menu .flistctxmenu
2653    makemenu $flist_menu {
2654        {mc "Highlight this too" command {flist_hl 0}}
2655        {mc "Highlight this only" command {flist_hl 1}}
2656        {mc "External diff" command {external_diff}}
2657        {mc "Blame parent commit" command {external_blame 1}}
2658    }
2659    $flist_menu configure -tearoff 0
2660
2661    global diff_menu
2662    set diff_menu .diffctxmenu
2663    makemenu $diff_menu {
2664        {mc "Show origin of this line" command show_line_source}
2665        {mc "Run git gui blame on this line" command {external_blame_diff}}
2666    }
2667    $diff_menu configure -tearoff 0
2668}
2669
2670# Windows sends all mouse wheel events to the current focused window, not
2671# the one where the mouse hovers, so bind those events here and redirect
2672# to the correct window
2673proc windows_mousewheel_redirector {W X Y D} {
2674    global canv canv2 canv3
2675    set w [winfo containing -displayof $W $X $Y]
2676    if {$w ne ""} {
2677        set u [expr {$D < 0 ? 5 : -5}]
2678        if {$w == $canv || $w == $canv2 || $w == $canv3} {
2679            allcanvs yview scroll $u units
2680        } else {
2681            catch {
2682                $w yview scroll $u units
2683            }
2684        }
2685    }
2686}
2687
2688# Update row number label when selectedline changes
2689proc selectedline_change {n1 n2 op} {
2690    global selectedline rownumsel
2691
2692    if {$selectedline eq {}} {
2693        set rownumsel {}
2694    } else {
2695        set rownumsel [expr {$selectedline + 1}]
2696    }
2697}
2698
2699# mouse-2 makes all windows scan vertically, but only the one
2700# the cursor is in scans horizontally
2701proc canvscan {op w x y} {
2702    global canv canv2 canv3
2703    foreach c [list $canv $canv2 $canv3] {
2704        if {$c == $w} {
2705            $c scan $op $x $y
2706        } else {
2707            $c scan $op 0 $y
2708        }
2709    }
2710}
2711
2712proc scrollcanv {cscroll f0 f1} {
2713    $cscroll set $f0 $f1
2714    drawvisible
2715    flushhighlights
2716}
2717
2718# when we make a key binding for the toplevel, make sure
2719# it doesn't get triggered when that key is pressed in the
2720# find string entry widget.
2721proc bindkey {ev script} {
2722    global entries
2723    bind . $ev $script
2724    set escript [bind Entry $ev]
2725    if {$escript == {}} {
2726        set escript [bind Entry <Key>]
2727    }
2728    foreach e $entries {
2729        bind $e $ev "$escript; break"
2730    }
2731}
2732
2733proc bindmodfunctionkey {mod n script} {
2734    bind . <$mod-F$n> $script
2735    catch { bind . <$mod-XF86_Switch_VT_$n> $script }
2736}
2737
2738# set the focus back to the toplevel for any click outside
2739# the entry widgets
2740proc click {w} {
2741    global ctext entries
2742    foreach e [concat $entries $ctext] {
2743        if {$w == $e} return
2744    }
2745    focus .
2746}
2747
2748# Adjust the progress bar for a change in requested extent or canvas size
2749proc adjustprogress {} {
2750    global progresscanv progressitem progresscoords
2751    global fprogitem fprogcoord lastprogupdate progupdatepending
2752    global rprogitem rprogcoord use_ttk
2753
2754    if {$use_ttk} {
2755        $progresscanv configure -value [expr {int($fprogcoord * 100)}]
2756        return
2757    }
2758
2759    set w [expr {[winfo width $progresscanv] - 4}]
2760    set x0 [expr {$w * [lindex $progresscoords 0]}]
2761    set x1 [expr {$w * [lindex $progresscoords 1]}]
2762    set h [winfo height $progresscanv]
2763    $progresscanv coords $progressitem $x0 0 $x1 $h
2764    $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2765    $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2766    set now [clock clicks -milliseconds]
2767    if {$now >= $lastprogupdate + 100} {
2768        set progupdatepending 0
2769        update
2770    } elseif {!$progupdatepending} {
2771        set progupdatepending 1
2772        after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2773    }
2774}
2775
2776proc doprogupdate {} {
2777    global lastprogupdate progupdatepending
2778
2779    if {$progupdatepending} {
2780        set progupdatepending 0
2781        set lastprogupdate [clock clicks -milliseconds]
2782        update
2783    }
2784}
2785
2786proc savestuff {w} {
2787    global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
2788    global use_ttk
2789    global stuffsaved
2790    global config_file config_file_tmp
2791    global config_variables
2792
2793    if {$stuffsaved} return
2794    if {![winfo viewable .]} return
2795    catch {
2796        if {[file exists $config_file_tmp]} {
2797            file delete -force $config_file_tmp
2798        }
2799        set f [open $config_file_tmp w]
2800        if {$::tcl_platform(platform) eq {windows}} {
2801            file attributes $config_file_tmp -hidden true
2802        }
2803        foreach var_name $config_variables {
2804            upvar #0 $var_name var
2805            puts $f [list set $var_name $var]
2806        }
2807
2808        puts $f "set geometry(main) [wm geometry .]"
2809        puts $f "set geometry(state) [wm state .]"
2810        puts $f "set geometry(topwidth) [winfo width .tf]"
2811        puts $f "set geometry(topheight) [winfo height .tf]"
2812        if {$use_ttk} {
2813            puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
2814            puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
2815        } else {
2816            puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2817            puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2818        }
2819        puts $f "set geometry(botwidth) [winfo width .bleft]"
2820        puts $f "set geometry(botheight) [winfo height .bleft]"
2821
2822        puts -nonewline $f "set permviews {"
2823        for {set v 0} {$v < $nextviewnum} {incr v} {
2824            if {$viewperm($v)} {
2825                puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
2826            }
2827        }
2828        puts $f "}"
2829        close $f
2830        file rename -force $config_file_tmp $config_file
2831    }
2832    set stuffsaved 1
2833}
2834
2835proc resizeclistpanes {win w} {
2836    global oldwidth use_ttk
2837    if {[info exists oldwidth($win)]} {
2838        if {$use_ttk} {
2839            set s0 [$win sashpos 0]
2840            set s1 [$win sashpos 1]
2841        } else {
2842            set s0 [$win sash coord 0]
2843            set s1 [$win sash coord 1]
2844        }
2845        if {$w < 60} {
2846            set sash0 [expr {int($w/2 - 2)}]
2847            set sash1 [expr {int($w*5/6 - 2)}]
2848        } else {
2849            set factor [expr {1.0 * $w / $oldwidth($win)}]
2850            set sash0 [expr {int($factor * [lindex $s0 0])}]
2851            set sash1 [expr {int($factor * [lindex $s1 0])}]
2852            if {$sash0 < 30} {
2853                set sash0 30
2854            }
2855            if {$sash1 < $sash0 + 20} {
2856                set sash1 [expr {$sash0 + 20}]
2857            }
2858            if {$sash1 > $w - 10} {
2859                set sash1 [expr {$w - 10}]
2860                if {$sash0 > $sash1 - 20} {
2861                    set sash0 [expr {$sash1 - 20}]
2862                }
2863            }
2864        }
2865        if {$use_ttk} {
2866            $win sashpos 0 $sash0
2867            $win sashpos 1 $sash1
2868        } else {
2869            $win sash place 0 $sash0 [lindex $s0 1]
2870            $win sash place 1 $sash1 [lindex $s1 1]
2871        }
2872    }
2873    set oldwidth($win) $w
2874}
2875
2876proc resizecdetpanes {win w} {
2877    global oldwidth use_ttk
2878    if {[info exists oldwidth($win)]} {
2879        if {$use_ttk} {
2880            set s0 [$win sashpos 0]
2881        } else {
2882            set s0 [$win sash coord 0]
2883        }
2884        if {$w < 60} {
2885            set sash0 [expr {int($w*3/4 - 2)}]
2886        } else {
2887            set factor [expr {1.0 * $w / $oldwidth($win)}]
2888            set sash0 [expr {int($factor * [lindex $s0 0])}]
2889            if {$sash0 < 45} {
2890                set sash0 45
2891            }
2892            if {$sash0 > $w - 15} {
2893                set sash0 [expr {$w - 15}]
2894            }
2895        }
2896        if {$use_ttk} {
2897            $win sashpos 0 $sash0
2898        } else {
2899            $win sash place 0 $sash0 [lindex $s0 1]
2900        }
2901    }
2902    set oldwidth($win) $w
2903}
2904
2905proc allcanvs args {
2906    global canv canv2 canv3
2907    eval $canv $args
2908    eval $canv2 $args
2909    eval $canv3 $args
2910}
2911
2912proc bindall {event action} {
2913    global canv canv2 canv3
2914    bind $canv $event $action
2915    bind $canv2 $event $action
2916    bind $canv3 $event $action
2917}
2918
2919proc about {} {
2920    global uifont NS
2921    set w .about
2922    if {[winfo exists $w]} {
2923        raise $w
2924        return
2925    }
2926    ttk_toplevel $w
2927    wm title $w [mc "About gitk"]
2928    make_transient $w .
2929    message $w.m -text [mc "
2930Gitk - a commit viewer for git
2931
2932Copyright \u00a9 2005-2014 Paul Mackerras
2933
2934Use and redistribute under the terms of the GNU General Public License"] \
2935            -justify center -aspect 400 -border 2 -bg white -relief groove
2936    pack $w.m -side top -fill x -padx 2 -pady 2
2937    ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2938    pack $w.ok -side bottom
2939    bind $w <Visibility> "focus $w.ok"
2940    bind $w <Key-Escape> "destroy $w"
2941    bind $w <Key-Return> "destroy $w"
2942    tk::PlaceWindow $w widget .
2943}
2944
2945proc keys {} {
2946    global NS
2947    set w .keys
2948    if {[winfo exists $w]} {
2949        raise $w
2950        return
2951    }
2952    if {[tk windowingsystem] eq {aqua}} {
2953        set M1T Cmd
2954    } else {
2955        set M1T Ctrl
2956    }
2957    ttk_toplevel $w
2958    wm title $w [mc "Gitk key bindings"]
2959    make_transient $w .
2960    message $w.m -text "
2961[mc "Gitk key bindings:"]
2962
2963[mc "<%s-Q>             Quit" $M1T]
2964[mc "<%s-W>             Close window" $M1T]
2965[mc "<Home>             Move to first commit"]
2966[mc "<End>              Move to last commit"]
2967[mc "<Up>, p, k Move up one commit"]
2968[mc "<Down>, n, j       Move down one commit"]
2969[mc "<Left>, z, h       Go back in history list"]
2970[mc "<Right>, x, l      Go forward in history list"]
2971[mc "<%s-n>     Go to n-th parent of current commit in history list" $M1T]
2972[mc "<PageUp>   Move up one page in commit list"]
2973[mc "<PageDown> Move down one page in commit list"]
2974[mc "<%s-Home>  Scroll to top of commit list" $M1T]
2975[mc "<%s-End>   Scroll to bottom of commit list" $M1T]
2976[mc "<%s-Up>    Scroll commit list up one line" $M1T]
2977[mc "<%s-Down>  Scroll commit list down one line" $M1T]
2978[mc "<%s-PageUp>        Scroll commit list up one page" $M1T]
2979[mc "<%s-PageDown>      Scroll commit list down one page" $M1T]
2980[mc "<Shift-Up> Find backwards (upwards, later commits)"]
2981[mc "<Shift-Down>       Find forwards (downwards, earlier commits)"]
2982[mc "<Delete>, b        Scroll diff view up one page"]
2983[mc "<Backspace>        Scroll diff view up one page"]
2984[mc "<Space>            Scroll diff view down one page"]
2985[mc "u          Scroll diff view up 18 lines"]
2986[mc "d          Scroll diff view down 18 lines"]
2987[mc "<%s-F>             Find" $M1T]
2988[mc "<%s-G>             Move to next find hit" $M1T]
2989[mc "<Return>   Move to next find hit"]
2990[mc "/          Focus the search box"]
2991[mc "?          Move to previous find hit"]
2992[mc "f          Scroll diff view to next file"]
2993[mc "<%s-S>             Search for next hit in diff view" $M1T]
2994[mc "<%s-R>             Search for previous hit in diff view" $M1T]
2995[mc "<%s-KP+>   Increase font size" $M1T]
2996[mc "<%s-plus>  Increase font size" $M1T]
2997[mc "<%s-KP->   Decrease font size" $M1T]
2998[mc "<%s-minus> Decrease font size" $M1T]
2999[mc "<F5>               Update"]
3000" \
3001            -justify left -bg white -border 2 -relief groove
3002    pack $w.m -side top -fill both -padx 2 -pady 2
3003    ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
3004    bind $w <Key-Escape> [list destroy $w]
3005    pack $w.ok -side bottom
3006    bind $w <Visibility> "focus $w.ok"
3007    bind $w <Key-Escape> "destroy $w"
3008    bind $w <Key-Return> "destroy $w"
3009}
3010
3011# Procedures for manipulating the file list window at the
3012# bottom right of the overall window.
3013
3014proc treeview {w l openlevs} {
3015    global treecontents treediropen treeheight treeparent treeindex
3016
3017    set ix 0
3018    set treeindex() 0
3019    set lev 0
3020    set prefix {}
3021    set prefixend -1
3022    set prefendstack {}
3023    set htstack {}
3024    set ht 0
3025    set treecontents() {}
3026    $w conf -state normal
3027    foreach f $l {
3028        while {[string range $f 0 $prefixend] ne $prefix} {
3029            if {$lev <= $openlevs} {
3030                $w mark set e:$treeindex($prefix) "end -1c"
3031                $w mark gravity e:$treeindex($prefix) left
3032            }
3033            set treeheight($prefix) $ht
3034            incr ht [lindex $htstack end]
3035            set htstack [lreplace $htstack end end]
3036            set prefixend [lindex $prefendstack end]
3037            set prefendstack [lreplace $prefendstack end end]
3038            set prefix [string range $prefix 0 $prefixend]
3039            incr lev -1
3040        }
3041        set tail [string range $f [expr {$prefixend+1}] end]
3042        while {[set slash [string first "/" $tail]] >= 0} {
3043            lappend htstack $ht
3044            set ht 0
3045            lappend prefendstack $prefixend
3046            incr prefixend [expr {$slash + 1}]
3047            set d [string range $tail 0 $slash]
3048            lappend treecontents($prefix) $d
3049            set oldprefix $prefix
3050            append prefix $d
3051            set treecontents($prefix) {}
3052            set treeindex($prefix) [incr ix]
3053            set treeparent($prefix) $oldprefix
3054            set tail [string range $tail [expr {$slash+1}] end]
3055            if {$lev <= $openlevs} {
3056                set ht 1
3057                set treediropen($prefix) [expr {$lev < $openlevs}]
3058                set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
3059                $w mark set d:$ix "end -1c"
3060                $w mark gravity d:$ix left
3061                set str "\n"
3062                for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3063                $w insert end $str
3064                $w image create end -align center -image $bm -padx 1 \
3065                    -name a:$ix
3066                $w insert end $d [highlight_tag $prefix]
3067                $w mark set s:$ix "end -1c"
3068                $w mark gravity s:$ix left
3069            }
3070            incr lev
3071        }
3072        if {$tail ne {}} {
3073            if {$lev <= $openlevs} {
3074                incr ht
3075                set str "\n"
3076                for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3077                $w insert end $str
3078                $w insert end $tail [highlight_tag $f]
3079            }
3080            lappend treecontents($prefix) $tail
3081        }
3082    }
3083    while {$htstack ne {}} {
3084        set treeheight($prefix) $ht
3085        incr ht [lindex $htstack end]
3086        set htstack [lreplace $htstack end end]
3087        set prefixend [lindex $prefendstack end]
3088        set prefendstack [lreplace $prefendstack end end]
3089        set prefix [string range $prefix 0 $prefixend]
3090    }
3091    $w conf -state disabled
3092}
3093
3094proc linetoelt {l} {
3095    global treeheight treecontents
3096
3097    set y 2
3098    set prefix {}
3099    while {1} {
3100        foreach e $treecontents($prefix) {
3101            if {$y == $l} {
3102                return "$prefix$e"
3103            }
3104            set n 1
3105            if {[string index $e end] eq "/"} {
3106                set n $treeheight($prefix$e)
3107                if {$y + $n > $l} {
3108                    append prefix $e
3109                    incr y
3110                    break
3111                }
3112            }
3113            incr y $n
3114        }
3115    }
3116}
3117
3118proc highlight_tree {y prefix} {
3119    global treeheight treecontents cflist
3120
3121    foreach e $treecontents($prefix) {
3122        set path $prefix$e
3123        if {[highlight_tag $path] ne {}} {
3124            $cflist tag add bold $y.0 "$y.0 lineend"
3125        }
3126        incr y
3127        if {[string index $e end] eq "/" && $treeheight($path) > 1} {
3128            set y [highlight_tree $y $path]
3129        }
3130    }
3131    return $y
3132}
3133
3134proc treeclosedir {w dir} {
3135    global treediropen treeheight treeparent treeindex
3136
3137    set ix $treeindex($dir)
3138    $w conf -state normal
3139    $w delete s:$ix e:$ix
3140    set treediropen($dir) 0
3141    $w image configure a:$ix -image tri-rt
3142    $w conf -state disabled
3143    set n [expr {1 - $treeheight($dir)}]
3144    while {$dir ne {}} {
3145        incr treeheight($dir) $n
3146        set dir $treeparent($dir)
3147    }
3148}
3149
3150proc treeopendir {w dir} {
3151    global treediropen treeheight treeparent treecontents treeindex
3152
3153    set ix $treeindex($dir)
3154    $w conf -state normal
3155    $w image configure a:$ix -image tri-dn
3156    $w mark set e:$ix s:$ix
3157    $w mark gravity e:$ix right
3158    set lev 0
3159    set str "\n"
3160    set n [llength $treecontents($dir)]
3161    for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
3162        incr lev
3163        append str "\t"
3164        incr treeheight($x) $n
3165    }
3166    foreach e $treecontents($dir) {
3167        set de $dir$e
3168        if {[string index $e end] eq "/"} {
3169            set iy $treeindex($de)
3170            $w mark set d:$iy e:$ix
3171            $w mark gravity d:$iy left
3172            $w insert e:$ix $str
3173            set treediropen($de) 0
3174            $w image create e:$ix -align center -image tri-rt -padx 1 \
3175                -name a:$iy
3176            $w insert e:$ix $e [highlight_tag $de]
3177            $w mark set s:$iy e:$ix
3178            $w mark gravity s:$iy left
3179            set treeheight($de) 1
3180        } else {
3181            $w insert e:$ix $str
3182            $w insert e:$ix $e [highlight_tag $de]
3183        }
3184    }
3185    $w mark gravity e:$ix right
3186    $w conf -state disabled
3187    set treediropen($dir) 1
3188    set top [lindex [split [$w index @0,0] .] 0]
3189    set ht [$w cget -height]
3190    set l [lindex [split [$w index s:$ix] .] 0]
3191    if {$l < $top} {
3192        $w yview $l.0
3193    } elseif {$l + $n + 1 > $top + $ht} {
3194        set top [expr {$l + $n + 2 - $ht}]
3195        if {$l < $top} {
3196            set top $l
3197        }
3198        $w yview $top.0
3199    }
3200}
3201
3202proc treeclick {w x y} {
3203    global treediropen cmitmode ctext cflist cflist_top
3204
3205    if {$cmitmode ne "tree"} return
3206    if {![info exists cflist_top]} return
3207    set l [lindex [split [$w index "@$x,$y"] "."] 0]
3208    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3209    $cflist tag add highlight $l.0 "$l.0 lineend"
3210    set cflist_top $l
3211    if {$l == 1} {
3212        $ctext yview 1.0
3213        return
3214    }
3215    set e [linetoelt $l]
3216    if {[string index $e end] ne "/"} {
3217        showfile $e
3218    } elseif {$treediropen($e)} {
3219        treeclosedir $w $e
3220    } else {
3221        treeopendir $w $e
3222    }
3223}
3224
3225proc setfilelist {id} {
3226    global treefilelist cflist jump_to_here
3227
3228    treeview $cflist $treefilelist($id) 0
3229    if {$jump_to_here ne {}} {
3230        set f [lindex $jump_to_here 0]
3231        if {[lsearch -exact $treefilelist($id) $f] >= 0} {
3232            showfile $f
3233        }
3234    }
3235}
3236
3237image create bitmap tri-rt -background black -foreground blue -data {
3238    #define tri-rt_width 13
3239    #define tri-rt_height 13
3240    static unsigned char tri-rt_bits[] = {
3241       0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
3242       0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
3243       0x00, 0x00};
3244} -maskdata {
3245    #define tri-rt-mask_width 13
3246    #define tri-rt-mask_height 13
3247    static unsigned char tri-rt-mask_bits[] = {
3248       0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
3249       0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
3250       0x08, 0x00};
3251}
3252image create bitmap tri-dn -background black -foreground blue -data {
3253    #define tri-dn_width 13
3254    #define tri-dn_height 13
3255    static unsigned char tri-dn_bits[] = {
3256       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
3257       0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3258       0x00, 0x00};
3259} -maskdata {
3260    #define tri-dn-mask_width 13
3261    #define tri-dn-mask_height 13
3262    static unsigned char tri-dn-mask_bits[] = {
3263       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
3264       0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
3265       0x00, 0x00};
3266}
3267
3268image create bitmap reficon-T -background black -foreground yellow -data {
3269    #define tagicon_width 13
3270    #define tagicon_height 9
3271    static unsigned char tagicon_bits[] = {
3272       0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
3273       0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
3274} -maskdata {
3275    #define tagicon-mask_width 13
3276    #define tagicon-mask_height 9
3277    static unsigned char tagicon-mask_bits[] = {
3278       0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
3279       0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
3280}
3281set rectdata {
3282    #define headicon_width 13
3283    #define headicon_height 9
3284    static unsigned char headicon_bits[] = {
3285       0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3286       0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3287}
3288set rectmask {
3289    #define headicon-mask_width 13
3290    #define headicon-mask_height 9
3291    static unsigned char headicon-mask_bits[] = {
3292       0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3293       0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3294}
3295image create bitmap reficon-H -background black -foreground green \
3296    -data $rectdata -maskdata $rectmask
3297image create bitmap reficon-o -background black -foreground "#ddddff" \
3298    -data $rectdata -maskdata $rectmask
3299
3300proc init_flist {first} {
3301    global cflist cflist_top difffilestart
3302
3303    $cflist conf -state normal
3304    $cflist delete 0.0 end
3305    if {$first ne {}} {
3306        $cflist insert end $first
3307        set cflist_top 1
3308        $cflist tag add highlight 1.0 "1.0 lineend"
3309    } else {
3310        catch {unset cflist_top}
3311    }
3312    $cflist conf -state disabled
3313    set difffilestart {}
3314}
3315
3316proc highlight_tag {f} {
3317    global highlight_paths
3318
3319    foreach p $highlight_paths {
3320        if {[string match $p $f]} {
3321            return "bold"
3322        }
3323    }
3324    return {}
3325}
3326
3327proc highlight_filelist {} {
3328    global cmitmode cflist
3329
3330    $cflist conf -state normal
3331    if {$cmitmode ne "tree"} {
3332        set end [lindex [split [$cflist index end] .] 0]
3333        for {set l 2} {$l < $end} {incr l} {
3334            set line [$cflist get $l.0 "$l.0 lineend"]
3335            if {[highlight_tag $line] ne {}} {
3336                $cflist tag add bold $l.0 "$l.0 lineend"
3337            }
3338        }
3339    } else {
3340        highlight_tree 2 {}
3341    }
3342    $cflist conf -state disabled
3343}
3344
3345proc unhighlight_filelist {} {
3346    global cflist
3347
3348    $cflist conf -state normal
3349    $cflist tag remove bold 1.0 end
3350    $cflist conf -state disabled
3351}
3352
3353proc add_flist {fl} {
3354    global cflist
3355
3356    $cflist conf -state normal
3357    foreach f $fl {
3358        $cflist insert end "\n"
3359        $cflist insert end $f [highlight_tag $f]
3360    }
3361    $cflist conf -state disabled
3362}
3363
3364proc sel_flist {w x y} {
3365    global ctext difffilestart cflist cflist_top cmitmode
3366
3367    if {$cmitmode eq "tree"} return
3368    if {![info exists cflist_top]} return
3369    set l [lindex [split [$w index "@$x,$y"] "."] 0]
3370    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3371    $cflist tag add highlight $l.0 "$l.0 lineend"
3372    set cflist_top $l
3373    if {$l == 1} {
3374        $ctext yview 1.0
3375    } else {
3376        catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
3377    }
3378    suppress_highlighting_file_for_current_scrollpos
3379}
3380
3381proc pop_flist_menu {w X Y x y} {
3382    global ctext cflist cmitmode flist_menu flist_menu_file
3383    global treediffs diffids
3384
3385    stopfinding
3386    set l [lindex [split [$w index "@$x,$y"] "."] 0]
3387    if {$l <= 1} return
3388    if {$cmitmode eq "tree"} {
3389        set e [linetoelt $l]
3390        if {[string index $e end] eq "/"} return
3391    } else {
3392        set e [lindex $treediffs($diffids) [expr {$l-2}]]
3393    }
3394    set flist_menu_file $e
3395    set xdiffstate "normal"
3396    if {$cmitmode eq "tree"} {
3397        set xdiffstate "disabled"
3398    }
3399    # Disable "External diff" item in tree mode
3400    $flist_menu entryconf 2 -state $xdiffstate
3401    tk_popup $flist_menu $X $Y
3402}
3403
3404proc find_ctext_fileinfo {line} {
3405    global ctext_file_names ctext_file_lines
3406
3407    set ok [bsearch $ctext_file_lines $line]
3408    set tline [lindex $ctext_file_lines $ok]
3409
3410    if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3411        return {}
3412    } else {
3413        return [list [lindex $ctext_file_names $ok] $tline]
3414    }
3415}
3416
3417proc pop_diff_menu {w X Y x y} {
3418    global ctext diff_menu flist_menu_file
3419    global diff_menu_txtpos diff_menu_line
3420    global diff_menu_filebase
3421
3422    set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3423    set diff_menu_line [lindex $diff_menu_txtpos 0]
3424    # don't pop up the menu on hunk-separator or file-separator lines
3425    if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3426        return
3427    }
3428    stopfinding
3429    set f [find_ctext_fileinfo $diff_menu_line]
3430    if {$f eq {}} return
3431    set flist_menu_file [lindex $f 0]
3432    set diff_menu_filebase [lindex $f 1]
3433    tk_popup $diff_menu $X $Y
3434}
3435
3436proc flist_hl {only} {
3437    global flist_menu_file findstring gdttype
3438
3439    set x [shellquote $flist_menu_file]
3440    if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
3441        set findstring $x
3442    } else {
3443        append findstring " " $x
3444    }
3445    set gdttype [mc "touching paths:"]
3446}
3447
3448proc gitknewtmpdir {} {
3449    global diffnum gitktmpdir gitdir env
3450
3451    if {![info exists gitktmpdir]} {
3452        if {[info exists env(GITK_TMPDIR)]} {
3453            set tmpdir $env(GITK_TMPDIR)
3454        } elseif {[info exists env(TMPDIR)]} {
3455            set tmpdir $env(TMPDIR)
3456        } else {
3457            set tmpdir $gitdir
3458        }
3459        set gitktmpformat [file join $tmpdir ".gitk-tmp.XXXXXX"]
3460        if {[catch {set gitktmpdir [exec mktemp -d $gitktmpformat]}]} {
3461            set gitktmpdir [file join $gitdir [format ".gitk-tmp.%s" [pid]]]
3462        }
3463        if {[catch {file mkdir $gitktmpdir} err]} {
3464            error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3465            unset gitktmpdir
3466            return {}
3467        }
3468        set diffnum 0
3469    }
3470    incr diffnum
3471    set diffdir [file join $gitktmpdir $diffnum]
3472    if {[catch {file mkdir $diffdir} err]} {
3473        error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3474        return {}
3475    }
3476    return $diffdir
3477}
3478
3479proc save_file_from_commit {filename output what} {
3480    global nullfile
3481
3482    if {[catch {exec git show $filename -- > $output} err]} {
3483        if {[string match "fatal: bad revision *" $err]} {
3484            return $nullfile
3485        }
3486        error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
3487        return {}
3488    }
3489    return $output
3490}
3491
3492proc external_diff_get_one_file {diffid filename diffdir} {
3493    global nullid nullid2 nullfile
3494    global worktree
3495
3496    if {$diffid == $nullid} {
3497        set difffile [file join $worktree $filename]
3498        if {[file exists $difffile]} {
3499            return $difffile
3500        }
3501        return $nullfile
3502    }
3503    if {$diffid == $nullid2} {
3504        set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3505        return [save_file_from_commit :$filename $difffile index]
3506    }
3507    set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3508    return [save_file_from_commit $diffid:$filename $difffile \
3509               "revision $diffid"]
3510}
3511
3512proc external_diff {} {
3513    global nullid nullid2
3514    global flist_menu_file
3515    global diffids
3516    global extdifftool
3517
3518    if {[llength $diffids] == 1} {
3519        # no reference commit given
3520        set diffidto [lindex $diffids 0]
3521        if {$diffidto eq $nullid} {
3522            # diffing working copy with index
3523            set diffidfrom $nullid2
3524        } elseif {$diffidto eq $nullid2} {
3525            # diffing index with HEAD
3526            set diffidfrom "HEAD"
3527        } else {
3528            # use first parent commit
3529            global parentlist selectedline
3530            set diffidfrom [lindex $parentlist $selectedline 0]
3531        }
3532    } else {
3533        set diffidfrom [lindex $diffids 0]
3534        set diffidto [lindex $diffids 1]
3535    }
3536
3537    # make sure that several diffs wont collide
3538    set diffdir [gitknewtmpdir]
3539    if {$diffdir eq {}} return
3540
3541    # gather files to diff
3542    set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3543    set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3544
3545    if {$difffromfile ne {} && $difftofile ne {}} {
3546        set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
3547        if {[catch {set fl [open |$cmd r]} err]} {
3548            file delete -force $diffdir
3549            error_popup "$extdifftool: [mc "command failed:"] $err"
3550        } else {
3551            fconfigure $fl -blocking 0
3552            filerun $fl [list delete_at_eof $fl $diffdir]
3553        }
3554    }
3555}
3556
3557proc find_hunk_blamespec {base line} {
3558    global ctext
3559
3560    # Find and parse the hunk header
3561    set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3562    if {$s_lix eq {}} return
3563
3564    set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3565    if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3566            s_line old_specs osz osz1 new_line nsz]} {
3567        return
3568    }
3569
3570    # base lines for the parents
3571    set base_lines [list $new_line]
3572    foreach old_spec [lrange [split $old_specs " "] 1 end] {
3573        if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3574                old_spec old_line osz]} {
3575            return
3576        }
3577        lappend base_lines $old_line
3578    }
3579
3580    # Now scan the lines to determine offset within the hunk
3581    set max_parent [expr {[llength $base_lines]-2}]
3582    set dline 0
3583    set s_lno [lindex [split $s_lix "."] 0]
3584
3585    # Determine if the line is removed
3586    set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3587    if {[string match {[-+ ]*} $chunk]} {
3588        set removed_idx [string first "-" $chunk]
3589        # Choose a parent index
3590        if {$removed_idx >= 0} {
3591            set parent $removed_idx
3592        } else {
3593            set unchanged_idx [string first " " $chunk]
3594            if {$unchanged_idx >= 0} {
3595                set parent $unchanged_idx
3596            } else {
3597                # blame the current commit
3598                set parent -1
3599            }
3600        }
3601        # then count other lines that belong to it
3602        for {set i $line} {[incr i -1] > $s_lno} {} {
3603            set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3604            # Determine if the line is removed
3605            set removed_idx [string first "-" $chunk]
3606            if {$parent >= 0} {
3607                set code [string index $chunk $parent]
3608                if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3609                    incr dline
3610                }
3611            } else {
3612                if {$removed_idx < 0} {
3613                    incr dline
3614                }
3615            }
3616        }
3617        incr parent
3618    } else {
3619        set parent 0
3620    }
3621
3622    incr dline [lindex $base_lines $parent]
3623    return [list $parent $dline]
3624}
3625
3626proc external_blame_diff {} {
3627    global currentid cmitmode
3628    global diff_menu_txtpos diff_menu_line
3629    global diff_menu_filebase flist_menu_file
3630
3631    if {$cmitmode eq "tree"} {
3632        set parent_idx 0
3633        set line [expr {$diff_menu_line - $diff_menu_filebase}]
3634    } else {
3635        set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3636        if {$hinfo ne {}} {
3637            set parent_idx [lindex $hinfo 0]
3638            set line [lindex $hinfo 1]
3639        } else {
3640            set parent_idx 0
3641            set line 0
3642        }
3643    }
3644
3645    external_blame $parent_idx $line
3646}
3647
3648# Find the SHA1 ID of the blob for file $fname in the index
3649# at stage 0 or 2
3650proc index_sha1 {fname} {
3651    set f [open [list | git ls-files -s $fname] r]
3652    while {[gets $f line] >= 0} {
3653        set info [lindex [split $line "\t"] 0]
3654        set stage [lindex $info 2]
3655        if {$stage eq "0" || $stage eq "2"} {
3656            close $f
3657            return [lindex $info 1]
3658        }
3659    }
3660    close $f
3661    return {}
3662}
3663
3664# Turn an absolute path into one relative to the current directory
3665proc make_relative {f} {
3666    if {[file pathtype $f] eq "relative"} {
3667        return $f
3668    }
3669    set elts [file split $f]
3670    set here [file split [pwd]]
3671    set ei 0
3672    set hi 0
3673    set res {}
3674    foreach d $here {
3675        if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3676            lappend res ".."
3677        } else {
3678            incr ei
3679        }
3680        incr hi
3681    }
3682    set elts [concat $res [lrange $elts $ei end]]
3683    return [eval file join $elts]
3684}
3685
3686proc external_blame {parent_idx {line {}}} {
3687    global flist_menu_file cdup
3688    global nullid nullid2
3689    global parentlist selectedline currentid
3690
3691    if {$parent_idx > 0} {
3692        set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3693    } else {
3694        set base_commit $currentid
3695    }
3696
3697    if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3698        error_popup [mc "No such commit"]
3699        return
3700    }
3701
3702    set cmdline [list git gui blame]
3703    if {$line ne {} && $line > 1} {
3704        lappend cmdline "--line=$line"
3705    }
3706    set f [file join $cdup $flist_menu_file]
3707    # Unfortunately it seems git gui blame doesn't like
3708    # being given an absolute path...
3709    set f [make_relative $f]
3710    lappend cmdline $base_commit $f
3711    if {[catch {eval exec $cmdline &} err]} {
3712        error_popup "[mc "git gui blame: command failed:"] $err"
3713    }
3714}
3715
3716proc show_line_source {} {
3717    global cmitmode currentid parents curview blamestuff blameinst
3718    global diff_menu_line diff_menu_filebase flist_menu_file
3719    global nullid nullid2 gitdir cdup
3720
3721    set from_index {}
3722    if {$cmitmode eq "tree"} {
3723        set id $currentid
3724        set line [expr {$diff_menu_line - $diff_menu_filebase}]
3725    } else {
3726        set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3727        if {$h eq {}} return
3728        set pi [lindex $h 0]
3729        if {$pi == 0} {
3730            mark_ctext_line $diff_menu_line
3731            return
3732        }
3733        incr pi -1
3734        if {$currentid eq $nullid} {
3735            if {$pi > 0} {
3736                # must be a merge in progress...
3737                if {[catch {
3738                    # get the last line from .git/MERGE_HEAD
3739                    set f [open [file join $gitdir MERGE_HEAD] r]
3740                    set id [lindex [split [read $f] "\n"] end-1]
3741                    close $f
3742                } err]} {
3743                    error_popup [mc "Couldn't read merge head: %s" $err]
3744                    return
3745                }
3746            } elseif {$parents($curview,$currentid) eq $nullid2} {
3747                # need to do the blame from the index
3748                if {[catch {
3749                    set from_index [index_sha1 $flist_menu_file]
3750                } err]} {
3751                    error_popup [mc "Error reading index: %s" $err]
3752                    return
3753                }
3754            } else {
3755                set id $parents($curview,$currentid)
3756            }
3757        } else {
3758            set id [lindex $parents($curview,$currentid) $pi]
3759        }
3760        set line [lindex $h 1]
3761    }
3762    set blameargs {}
3763    if {$from_index ne {}} {
3764        lappend blameargs | git cat-file blob $from_index
3765    }
3766    lappend blameargs | git blame -p -L$line,+1
3767    if {$from_index ne {}} {
3768        lappend blameargs --contents -
3769    } else {
3770        lappend blameargs $id
3771    }
3772    lappend blameargs -- [file join $cdup $flist_menu_file]
3773    if {[catch {
3774        set f [open $blameargs r]
3775    } err]} {
3776        error_popup [mc "Couldn't start git blame: %s" $err]
3777        return
3778    }
3779    nowbusy blaming [mc "Searching"]
3780    fconfigure $f -blocking 0
3781    set i [reg_instance $f]
3782    set blamestuff($i) {}
3783    set blameinst $i
3784    filerun $f [list read_line_source $f $i]
3785}
3786
3787proc stopblaming {} {
3788    global blameinst
3789
3790    if {[info exists blameinst]} {
3791        stop_instance $blameinst
3792        unset blameinst
3793        notbusy blaming
3794    }
3795}
3796
3797proc read_line_source {fd inst} {
3798    global blamestuff curview commfd blameinst nullid nullid2
3799
3800    while {[gets $fd line] >= 0} {
3801        lappend blamestuff($inst) $line
3802    }
3803    if {![eof $fd]} {
3804        return 1
3805    }
3806    unset commfd($inst)
3807    unset blameinst
3808    notbusy blaming
3809    fconfigure $fd -blocking 1
3810    if {[catch {close $fd} err]} {
3811        error_popup [mc "Error running git blame: %s" $err]
3812        return 0
3813    }
3814
3815    set fname {}
3816    set line [split [lindex $blamestuff($inst) 0] " "]
3817    set id [lindex $line 0]
3818    set lnum [lindex $line 1]
3819    if {[string length $id] == 40 && [string is xdigit $id] &&
3820        [string is digit -strict $lnum]} {
3821        # look for "filename" line
3822        foreach l $blamestuff($inst) {
3823            if {[string match "filename *" $l]} {
3824                set fname [string range $l 9 end]
3825                break
3826            }
3827        }
3828    }
3829    if {$fname ne {}} {
3830        # all looks good, select it
3831        if {$id eq $nullid} {
3832            # blame uses all-zeroes to mean not committed,
3833            # which would mean a change in the index
3834            set id $nullid2
3835        }
3836        if {[commitinview $id $curview]} {
3837            selectline [rowofcommit $id] 1 [list $fname $lnum] 1
3838        } else {
3839            error_popup [mc "That line comes from commit %s, \
3840                             which is not in this view" [shortids $id]]
3841        }
3842    } else {
3843        puts "oops couldn't parse git blame output"
3844    }
3845    return 0
3846}
3847
3848# delete $dir when we see eof on $f (presumably because the child has exited)
3849proc delete_at_eof {f dir} {
3850    while {[gets $f line] >= 0} {}
3851    if {[eof $f]} {
3852        if {[catch {close $f} err]} {
3853            error_popup "[mc "External diff viewer failed:"] $err"
3854        }
3855        file delete -force $dir
3856        return 0
3857    }
3858    return 1
3859}
3860
3861# Functions for adding and removing shell-type quoting
3862
3863proc shellquote {str} {
3864    if {![string match "*\['\"\\ \t]*" $str]} {
3865        return $str
3866    }
3867    if {![string match "*\['\"\\]*" $str]} {
3868        return "\"$str\""
3869    }
3870    if {![string match "*'*" $str]} {
3871        return "'$str'"
3872    }
3873    return "\"[string map {\" \\\" \\ \\\\} $str]\""
3874}
3875
3876proc shellarglist {l} {
3877    set str {}
3878    foreach a $l {
3879        if {$str ne {}} {
3880            append str " "
3881        }
3882        append str [shellquote $a]
3883    }
3884    return $str
3885}
3886
3887proc shelldequote {str} {
3888    set ret {}
3889    set used -1
3890    while {1} {
3891        incr used
3892        if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
3893            append ret [string range $str $used end]
3894            set used [string length $str]
3895            break
3896        }
3897        set first [lindex $first 0]
3898        set ch [string index $str $first]
3899        if {$first > $used} {
3900            append ret [string range $str $used [expr {$first - 1}]]
3901            set used $first
3902        }
3903        if {$ch eq " " || $ch eq "\t"} break
3904        incr used
3905        if {$ch eq "'"} {
3906            set first [string first "'" $str $used]
3907            if {$first < 0} {
3908                error "unmatched single-quote"
3909            }
3910            append ret [string range $str $used [expr {$first - 1}]]
3911            set used $first
3912            continue
3913        }
3914        if {$ch eq "\\"} {
3915            if {$used >= [string length $str]} {
3916                error "trailing backslash"
3917            }
3918            append ret [string index $str $used]
3919            continue
3920        }
3921        # here ch == "\""
3922        while {1} {
3923            if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
3924                error "unmatched double-quote"
3925            }
3926            set first [lindex $first 0]
3927            set ch [string index $str $first]
3928            if {$first > $used} {
3929                append ret [string range $str $used [expr {$first - 1}]]
3930                set used $first
3931            }
3932            if {$ch eq "\""} break
3933            incr used
3934            append ret [string index $str $used]
3935            incr used
3936        }
3937    }
3938    return [list $used $ret]
3939}
3940
3941proc shellsplit {str} {
3942    set l {}
3943    while {1} {
3944        set str [string trimleft $str]
3945        if {$str eq {}} break
3946        set dq [shelldequote $str]
3947        set n [lindex $dq 0]
3948        set word [lindex $dq 1]
3949        set str [string range $str $n end]
3950        lappend l $word
3951    }
3952    return $l
3953}
3954
3955# Code to implement multiple views
3956
3957proc newview {ishighlight} {
3958    global nextviewnum newviewname newishighlight
3959    global revtreeargs viewargscmd newviewopts curview
3960
3961    set newishighlight $ishighlight
3962    set top .gitkview
3963    if {[winfo exists $top]} {
3964        raise $top
3965        return
3966    }
3967    decode_view_opts $nextviewnum $revtreeargs
3968    set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
3969    set newviewopts($nextviewnum,perm) 0
3970    set newviewopts($nextviewnum,cmd)  $viewargscmd($curview)
3971    vieweditor $top $nextviewnum [mc "Gitk view definition"]
3972}
3973
3974set known_view_options {
3975    {perm      b    .  {}               {mc "Remember this view"}}
3976    {reflabel  l    +  {}               {mc "References (space separated list):"}}
3977    {refs      t15  .. {}               {mc "Branches & tags:"}}
3978    {allrefs   b    *. "--all"          {mc "All refs"}}
3979    {branches  b    .  "--branches"     {mc "All (local) branches"}}
3980    {tags      b    .  "--tags"         {mc "All tags"}}
3981    {remotes   b    .  "--remotes"      {mc "All remote-tracking branches"}}
3982    {commitlbl l    +  {}               {mc "Commit Info (regular expressions):"}}
3983    {author    t15  .. "--author=*"     {mc "Author:"}}
3984    {committer t15  .  "--committer=*"  {mc "Committer:"}}
3985    {loginfo   t15  .. "--grep=*"       {mc "Commit Message:"}}
3986    {allmatch  b    .. "--all-match"    {mc "Matches all Commit Info criteria"}}
3987    {changes_l l    +  {}               {mc "Changes to Files:"}}
3988    {pickaxe_s r0   .  {}               {mc "Fixed String"}}
3989    {pickaxe_t r1   .  "--pickaxe-regex"  {mc "Regular Expression"}}
3990    {pickaxe   t15  .. "-S*"            {mc "Search string:"}}
3991    {datelabel l    +  {}               {mc "Commit Dates (\"2 weeks ago\", \"2009-03-17 15:27:38\", \"March 17, 2009 15:27:38\"):"}}
3992    {since     t15  ..  {"--since=*" "--after=*"}  {mc "Since:"}}
3993    {until     t15  .   {"--until=*" "--before=*"} {mc "Until:"}}
3994    {limit_lbl l    +  {}               {mc "Limit and/or skip a number of revisions (positive integer):"}}
3995    {limit     t10  *. "--max-count=*"  {mc "Number to show:"}}
3996    {skip      t10  .  "--skip=*"       {mc "Number to skip:"}}
3997    {misc_lbl  l    +  {}               {mc "Miscellaneous options:"}}
3998    {dorder    b    *. {"--date-order" "-d"}      {mc "Strictly sort by date"}}
3999    {lright    b    .  "--left-right"   {mc "Mark branch sides"}}
4000    {first     b    .  "--first-parent" {mc "Limit to first parent"}}
4001    {smplhst   b    .  "--simplify-by-decoration"   {mc "Simple history"}}
4002    {args      t50  *. {}               {mc "Additional arguments to git log:"}}
4003    {allpaths  path +  {}               {mc "Enter files and directories to include, one per line:"}}
4004    {cmd       t50= +  {}               {mc "Command to generate more commits to include:"}}
4005    }
4006
4007# Convert $newviewopts($n, ...) into args for git log.
4008proc encode_view_opts {n} {
4009    global known_view_options newviewopts
4010
4011    set rargs [list]
4012    foreach opt $known_view_options {
4013        set patterns [lindex $opt 3]
4014        if {$patterns eq {}} continue
4015        set pattern [lindex $patterns 0]
4016
4017        if {[lindex $opt 1] eq "b"} {
4018            set val $newviewopts($n,[lindex $opt 0])
4019            if {$val} {
4020                lappend rargs $pattern
4021            }
4022        } elseif {[regexp {^r(\d+)$} [lindex $opt 1] type value]} {
4023            regexp {^(.*_)} [lindex $opt 0] uselessvar button_id
4024            set val $newviewopts($n,$button_id)
4025            if {$val eq $value} {
4026                lappend rargs $pattern
4027            }
4028        } else {
4029            set val $newviewopts($n,[lindex $opt 0])
4030            set val [string trim $val]
4031            if {$val ne {}} {
4032                set pfix [string range $pattern 0 end-1]
4033                lappend rargs $pfix$val
4034            }
4035        }
4036    }
4037    set rargs [concat $rargs [shellsplit $newviewopts($n,refs)]]
4038    return [concat $rargs [shellsplit $newviewopts($n,args)]]
4039}
4040
4041# Fill $newviewopts($n, ...) based on args for git log.
4042proc decode_view_opts {n view_args} {
4043    global known_view_options newviewopts
4044
4045    foreach opt $known_view_options {
4046        set id [lindex $opt 0]
4047        if {[lindex $opt 1] eq "b"} {
4048            # Checkboxes
4049            set val 0
4050        } elseif {[regexp {^r(\d+)$} [lindex $opt 1]]} {
4051            # Radiobuttons
4052            regexp {^(.*_)} $id uselessvar id
4053            set val 0
4054        } else {
4055            # Text fields
4056            set val {}
4057        }
4058        set newviewopts($n,$id) $val
4059    }
4060    set oargs [list]
4061    set refargs [list]
4062    foreach arg $view_args {
4063        if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
4064            && ![info exists found(limit)]} {
4065            set newviewopts($n,limit) $cnt
4066            set found(limit) 1
4067            continue
4068        }
4069        catch { unset val }
4070        foreach opt $known_view_options {
4071            set id [lindex $opt 0]
4072            if {[info exists found($id)]} continue
4073            foreach pattern [lindex $opt 3] {
4074                if {![string match $pattern $arg]} continue
4075                if {[lindex $opt 1] eq "b"} {
4076                    # Check buttons
4077                    set val 1
4078                } elseif {[regexp {^r(\d+)$} [lindex $opt 1] match num]} {
4079                    # Radio buttons
4080                    regexp {^(.*_)} $id uselessvar id
4081                    set val $num
4082                } else {
4083                    # Text input fields
4084                    set size [string length $pattern]
4085                    set val [string range $arg [expr {$size-1}] end]
4086                }
4087                set newviewopts($n,$id) $val
4088                set found($id) 1
4089                break
4090            }
4091            if {[info exists val]} break
4092        }
4093        if {[info exists val]} continue
4094        if {[regexp {^-} $arg]} {
4095            lappend oargs $arg
4096        } else {
4097            lappend refargs $arg
4098        }
4099    }
4100    set newviewopts($n,refs) [shellarglist $refargs]
4101    set newviewopts($n,args) [shellarglist $oargs]
4102}
4103
4104proc edit_or_newview {} {
4105    global curview
4106
4107    if {$curview > 0} {
4108        editview
4109    } else {
4110        newview 0
4111    }
4112}
4113
4114proc editview {} {
4115    global curview
4116    global viewname viewperm newviewname newviewopts
4117    global viewargs viewargscmd
4118
4119    set top .gitkvedit-$curview
4120    if {[winfo exists $top]} {
4121        raise $top
4122        return
4123    }
4124    decode_view_opts $curview $viewargs($curview)
4125    set newviewname($curview)      $viewname($curview)
4126    set newviewopts($curview,perm) $viewperm($curview)
4127    set newviewopts($curview,cmd)  $viewargscmd($curview)
4128    vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
4129}
4130
4131proc vieweditor {top n title} {
4132    global newviewname newviewopts viewfiles bgcolor
4133    global known_view_options NS
4134
4135    ttk_toplevel $top
4136    wm title $top [concat $title [mc "-- criteria for selecting revisions"]]
4137    make_transient $top .
4138
4139    # View name
4140    ${NS}::frame $top.nfr
4141    ${NS}::label $top.nl -text [mc "View Name"]
4142    ${NS}::entry $top.name -width 20 -textvariable newviewname($n)
4143    pack $top.nfr -in $top -fill x -pady 5 -padx 3
4144    pack $top.nl -in $top.nfr -side left -padx {0 5}
4145    pack $top.name -in $top.nfr -side left -padx {0 25}
4146
4147    # View options
4148    set cframe $top.nfr
4149    set cexpand 0
4150    set cnt 0
4151    foreach opt $known_view_options {
4152        set id [lindex $opt 0]
4153        set type [lindex $opt 1]
4154        set flags [lindex $opt 2]
4155        set title [eval [lindex $opt 4]]
4156        set lxpad 0
4157
4158        if {$flags eq "+" || $flags eq "*"} {
4159            set cframe $top.fr$cnt
4160            incr cnt
4161            ${NS}::frame $cframe
4162            pack $cframe -in $top -fill x -pady 3 -padx 3
4163            set cexpand [expr {$flags eq "*"}]
4164        } elseif {$flags eq ".." || $flags eq "*."} {
4165            set cframe $top.fr$cnt
4166            incr cnt
4167            ${NS}::frame $cframe
4168            pack $cframe -in $top -fill x -pady 3 -padx [list 15 3]
4169            set cexpand [expr {$flags eq "*."}]
4170        } else {
4171            set lxpad 5
4172        }
4173
4174        if {$type eq "l"} {
4175            ${NS}::label $cframe.l_$id -text $title
4176            pack $cframe.l_$id -in $cframe -side left -pady [list 3 0] -anchor w
4177        } elseif {$type eq "b"} {
4178            ${NS}::checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
4179            pack $cframe.c_$id -in $cframe -side left \
4180                -padx [list $lxpad 0] -expand $cexpand -anchor w
4181        } elseif {[regexp {^r(\d+)$} $type type sz]} {
4182            regexp {^(.*_)} $id uselessvar button_id
4183            ${NS}::radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz
4184            pack $cframe.c_$id -in $cframe -side left \
4185                -padx [list $lxpad 0] -expand $cexpand -anchor w
4186        } elseif {[regexp {^t(\d+)$} $type type sz]} {
4187            ${NS}::label $cframe.l_$id -text $title
4188            ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4189                -textvariable newviewopts($n,$id)
4190            pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
4191            pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
4192        } elseif {[regexp {^t(\d+)=$} $type type sz]} {
4193            ${NS}::label $cframe.l_$id -text $title
4194            ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4195                -textvariable newviewopts($n,$id)
4196            pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
4197            pack $cframe.e_$id -in $cframe -side top -fill x
4198        } elseif {$type eq "path"} {
4199            ${NS}::label $top.l -text $title
4200            pack $top.l -in $top -side top -pady [list 3 0] -anchor w -padx 3
4201            text $top.t -width 40 -height 5 -background $bgcolor
4202            if {[info exists viewfiles($n)]} {
4203                foreach f $viewfiles($n) {
4204                    $top.t insert end $f
4205                    $top.t insert end "\n"
4206                }
4207                $top.t delete {end - 1c} end
4208                $top.t mark set insert 0.0
4209            }
4210            pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
4211        }
4212    }
4213
4214    ${NS}::frame $top.buts
4215    ${NS}::button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
4216    ${NS}::button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
4217    ${NS}::button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
4218    bind $top <Control-Return> [list newviewok $top $n]
4219    bind $top <F5> [list newviewok $top $n 1]
4220    bind $top <Escape> [list destroy $top]
4221    grid $top.buts.ok $top.buts.apply $top.buts.can
4222    grid columnconfigure $top.buts 0 -weight 1 -uniform a
4223    grid columnconfigure $top.buts 1 -weight 1 -uniform a
4224    grid columnconfigure $top.buts 2 -weight 1 -uniform a
4225    pack $top.buts -in $top -side top -fill x
4226    focus $top.t
4227}
4228
4229proc doviewmenu {m first cmd op argv} {
4230    set nmenu [$m index end]
4231    for {set i $first} {$i <= $nmenu} {incr i} {
4232        if {[$m entrycget $i -command] eq $cmd} {
4233            eval $m $op $i $argv
4234            break
4235        }
4236    }
4237}
4238
4239proc allviewmenus {n op args} {
4240    # global viewhlmenu
4241
4242    doviewmenu .bar.view 5 [list showview $n] $op $args
4243    # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
4244}
4245
4246proc newviewok {top n {apply 0}} {
4247    global nextviewnum newviewperm newviewname newishighlight
4248    global viewname viewfiles viewperm selectedview curview
4249    global viewargs viewargscmd newviewopts viewhlmenu
4250
4251    if {[catch {
4252        set newargs [encode_view_opts $n]
4253    } err]} {
4254        error_popup "[mc "Error in commit selection arguments:"] $err" $top
4255        return
4256    }
4257    set files {}
4258    foreach f [split [$top.t get 0.0 end] "\n"] {
4259        set ft [string trim $f]
4260        if {$ft ne {}} {
4261            lappend files $ft
4262        }
4263    }
4264    if {![info exists viewfiles($n)]} {
4265        # creating a new view
4266        incr nextviewnum
4267        set viewname($n) $newviewname($n)
4268        set viewperm($n) $newviewopts($n,perm)
4269        set viewfiles($n) $files
4270        set viewargs($n) $newargs
4271        set viewargscmd($n) $newviewopts($n,cmd)
4272        addviewmenu $n
4273        if {!$newishighlight} {
4274            run showview $n
4275        } else {
4276            run addvhighlight $n
4277        }
4278    } else {
4279        # editing an existing view
4280        set viewperm($n) $newviewopts($n,perm)
4281        if {$newviewname($n) ne $viewname($n)} {
4282            set viewname($n) $newviewname($n)
4283            doviewmenu .bar.view 5 [list showview $n] \
4284                entryconf [list -label $viewname($n)]
4285            # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
4286                # entryconf [list -label $viewname($n) -value $viewname($n)]
4287        }
4288        if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
4289                $newviewopts($n,cmd) ne $viewargscmd($n)} {
4290            set viewfiles($n) $files
4291            set viewargs($n) $newargs
4292            set viewargscmd($n) $newviewopts($n,cmd)
4293            if {$curview == $n} {
4294                run reloadcommits
4295            }
4296        }
4297    }
4298    if {$apply} return
4299    catch {destroy $top}
4300}
4301
4302proc delview {} {
4303    global curview viewperm hlview selectedhlview
4304
4305    if {$curview == 0} return
4306    if {[info exists hlview] && $hlview == $curview} {
4307        set selectedhlview [mc "None"]
4308        unset hlview
4309    }
4310    allviewmenus $curview delete
4311    set viewperm($curview) 0
4312    showview 0
4313}
4314
4315proc addviewmenu {n} {
4316    global viewname viewhlmenu
4317
4318    .bar.view add radiobutton -label $viewname($n) \
4319        -command [list showview $n] -variable selectedview -value $n
4320    #$viewhlmenu add radiobutton -label $viewname($n) \
4321    #   -command [list addvhighlight $n] -variable selectedhlview
4322}
4323
4324proc showview {n} {
4325    global curview cached_commitrow ordertok
4326    global displayorder parentlist rowidlist rowisopt rowfinal
4327    global colormap rowtextx nextcolor canvxmax
4328    global numcommits viewcomplete
4329    global selectedline currentid canv canvy0
4330    global treediffs
4331    global pending_select mainheadid
4332    global commitidx
4333    global selectedview
4334    global hlview selectedhlview commitinterest
4335
4336    if {$n == $curview} return
4337    set selid {}
4338    set ymax [lindex [$canv cget -scrollregion] 3]
4339    set span [$canv yview]
4340    set ytop [expr {[lindex $span 0] * $ymax}]
4341    set ybot [expr {[lindex $span 1] * $ymax}]
4342    set yscreen [expr {($ybot - $ytop) / 2}]
4343    if {$selectedline ne {}} {
4344        set selid $currentid
4345        set y [yc $selectedline]
4346        if {$ytop < $y && $y < $ybot} {
4347            set yscreen [expr {$y - $ytop}]
4348        }
4349    } elseif {[info exists pending_select]} {
4350        set selid $pending_select
4351        unset pending_select
4352    }
4353    unselectline
4354    normalline
4355    catch {unset treediffs}
4356    clear_display
4357    if {[info exists hlview] && $hlview == $n} {
4358        unset hlview
4359        set selectedhlview [mc "None"]
4360    }
4361    catch {unset commitinterest}
4362    catch {unset cached_commitrow}
4363    catch {unset ordertok}
4364
4365    set curview $n
4366    set selectedview $n
4367    .bar.view entryconf [mca "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
4368    .bar.view entryconf [mca "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
4369
4370    run refill_reflist
4371    if {![info exists viewcomplete($n)]} {
4372        getcommits $selid
4373        return
4374    }
4375
4376    set displayorder {}
4377    set parentlist {}
4378    set rowidlist {}
4379    set rowisopt {}
4380    set rowfinal {}
4381    set numcommits $commitidx($n)
4382
4383    catch {unset colormap}
4384    catch {unset rowtextx}
4385    set nextcolor 0
4386    set canvxmax [$canv cget -width]
4387    set curview $n
4388    set row 0
4389    setcanvscroll
4390    set yf 0
4391    set row {}
4392    if {$selid ne {} && [commitinview $selid $n]} {
4393        set row [rowofcommit $selid]
4394        # try to get the selected row in the same position on the screen
4395        set ymax [lindex [$canv cget -scrollregion] 3]
4396        set ytop [expr {[yc $row] - $yscreen}]
4397        if {$ytop < 0} {
4398            set ytop 0
4399        }
4400        set yf [expr {$ytop * 1.0 / $ymax}]
4401    }
4402    allcanvs yview moveto $yf
4403    drawvisible
4404    if {$row ne {}} {
4405        selectline $row 0
4406    } elseif {!$viewcomplete($n)} {
4407        reset_pending_select $selid
4408    } else {
4409        reset_pending_select {}
4410
4411        if {[commitinview $pending_select $curview]} {
4412            selectline [rowofcommit $pending_select] 1
4413        } else {
4414            set row [first_real_row]
4415            if {$row < $numcommits} {
4416                selectline $row 0
4417            }
4418        }
4419    }
4420    if {!$viewcomplete($n)} {
4421        if {$numcommits == 0} {
4422            show_status [mc "Reading commits..."]
4423        }
4424    } elseif {$numcommits == 0} {
4425        show_status [mc "No commits selected"]
4426    }
4427}
4428
4429# Stuff relating to the highlighting facility
4430
4431proc ishighlighted {id} {
4432    global vhighlights fhighlights nhighlights rhighlights
4433
4434    if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
4435        return $nhighlights($id)
4436    }
4437    if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
4438        return $vhighlights($id)
4439    }
4440    if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
4441        return $fhighlights($id)
4442    }
4443    if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4444        return $rhighlights($id)
4445    }
4446    return 0
4447}
4448
4449proc bolden {id font} {
4450    global canv linehtag currentid boldids need_redisplay markedid
4451
4452    # need_redisplay = 1 means the display is stale and about to be redrawn
4453    if {$need_redisplay} return
4454    lappend boldids $id
4455    $canv itemconf $linehtag($id) -font $font
4456    if {[info exists currentid] && $id eq $currentid} {
4457        $canv delete secsel
4458        set t [eval $canv create rect [$canv bbox $linehtag($id)] \
4459                   -outline {{}} -tags secsel \
4460                   -fill [$canv cget -selectbackground]]
4461        $canv lower $t
4462    }
4463    if {[info exists markedid] && $id eq $markedid} {
4464        make_idmark $id
4465    }
4466}
4467
4468proc bolden_name {id font} {
4469    global canv2 linentag currentid boldnameids need_redisplay
4470
4471    if {$need_redisplay} return
4472    lappend boldnameids $id
4473    $canv2 itemconf $linentag($id) -font $font
4474    if {[info exists currentid] && $id eq $currentid} {
4475        $canv2 delete secsel
4476        set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
4477                   -outline {{}} -tags secsel \
4478                   -fill [$canv2 cget -selectbackground]]
4479        $canv2 lower $t
4480    }
4481}
4482
4483proc unbolden {} {
4484    global boldids
4485
4486    set stillbold {}
4487    foreach id $boldids {
4488        if {![ishighlighted $id]} {
4489            bolden $id mainfont
4490        } else {
4491            lappend stillbold $id
4492        }
4493    }
4494    set boldids $stillbold
4495}
4496
4497proc addvhighlight {n} {
4498    global hlview viewcomplete curview vhl_done commitidx
4499
4500    if {[info exists hlview]} {
4501        delvhighlight
4502    }
4503    set hlview $n
4504    if {$n != $curview && ![info exists viewcomplete($n)]} {
4505        start_rev_list $n
4506    }
4507    set vhl_done $commitidx($hlview)
4508    if {$vhl_done > 0} {
4509        drawvisible
4510    }
4511}
4512
4513proc delvhighlight {} {
4514    global hlview vhighlights
4515
4516    if {![info exists hlview]} return
4517    unset hlview
4518    catch {unset vhighlights}
4519    unbolden
4520}
4521
4522proc vhighlightmore {} {
4523    global hlview vhl_done commitidx vhighlights curview
4524
4525    set max $commitidx($hlview)
4526    set vr [visiblerows]
4527    set r0 [lindex $vr 0]
4528    set r1 [lindex $vr 1]
4529    for {set i $vhl_done} {$i < $max} {incr i} {
4530        set id [commitonrow $i $hlview]
4531        if {[commitinview $id $curview]} {
4532            set row [rowofcommit $id]
4533            if {$r0 <= $row && $row <= $r1} {
4534                if {![highlighted $row]} {
4535                    bolden $id mainfontbold
4536                }
4537                set vhighlights($id) 1
4538            }
4539        }
4540    }
4541    set vhl_done $max
4542    return 0
4543}
4544
4545proc askvhighlight {row id} {
4546    global hlview vhighlights iddrawn
4547
4548    if {[commitinview $id $hlview]} {
4549        if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
4550            bolden $id mainfontbold
4551        }
4552        set vhighlights($id) 1
4553    } else {
4554        set vhighlights($id) 0
4555    }
4556}
4557
4558proc hfiles_change {} {
4559    global highlight_files filehighlight fhighlights fh_serial
4560    global highlight_paths
4561
4562    if {[info exists filehighlight]} {
4563        # delete previous highlights
4564        catch {close $filehighlight}
4565        unset filehighlight
4566        catch {unset fhighlights}
4567        unbolden
4568        unhighlight_filelist
4569    }
4570    set highlight_paths {}
4571    after cancel do_file_hl $fh_serial
4572    incr fh_serial
4573    if {$highlight_files ne {}} {
4574        after 300 do_file_hl $fh_serial
4575    }
4576}
4577
4578proc gdttype_change {name ix op} {
4579    global gdttype highlight_files findstring findpattern
4580
4581    stopfinding
4582    if {$findstring ne {}} {
4583        if {$gdttype eq [mc "containing:"]} {
4584            if {$highlight_files ne {}} {
4585                set highlight_files {}
4586                hfiles_change
4587            }
4588            findcom_change
4589        } else {
4590            if {$findpattern ne {}} {
4591                set findpattern {}
4592                findcom_change
4593            }
4594            set highlight_files $findstring
4595            hfiles_change
4596        }
4597        drawvisible
4598    }
4599    # enable/disable findtype/findloc menus too
4600}
4601
4602proc find_change {name ix op} {
4603    global gdttype findstring highlight_files
4604
4605    stopfinding
4606    if {$gdttype eq [mc "containing:"]} {
4607        findcom_change
4608    } else {
4609        if {$highlight_files ne $findstring} {
4610            set highlight_files $findstring
4611            hfiles_change
4612        }
4613    }
4614    drawvisible
4615}
4616
4617proc findcom_change args {
4618    global nhighlights boldnameids
4619    global findpattern findtype findstring gdttype
4620
4621    stopfinding
4622    # delete previous highlights, if any
4623    foreach id $boldnameids {
4624        bolden_name $id mainfont
4625    }
4626    set boldnameids {}
4627    catch {unset nhighlights}
4628    unbolden
4629    unmarkmatches
4630    if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
4631        set findpattern {}
4632    } elseif {$findtype eq [mc "Regexp"]} {
4633        set findpattern $findstring
4634    } else {
4635        set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4636                   $findstring]
4637        set findpattern "*$e*"
4638    }
4639}
4640
4641proc makepatterns {l} {
4642    set ret {}
4643    foreach e $l {
4644        set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4645        if {[string index $ee end] eq "/"} {
4646            lappend ret "$ee*"
4647        } else {
4648            lappend ret $ee
4649            lappend ret "$ee/*"
4650        }
4651    }
4652    return $ret
4653}
4654
4655proc do_file_hl {serial} {
4656    global highlight_files filehighlight highlight_paths gdttype fhl_list
4657    global cdup findtype
4658
4659    if {$gdttype eq [mc "touching paths:"]} {
4660        # If "exact" match then convert backslashes to forward slashes.
4661        # Most useful to support Windows-flavoured file paths.
4662        if {$findtype eq [mc "Exact"]} {
4663            set highlight_files [string map {"\\" "/"} $highlight_files]
4664        }
4665        if {[catch {set paths [shellsplit $highlight_files]}]} return
4666        set highlight_paths [makepatterns $paths]
4667        highlight_filelist
4668        set relative_paths {}
4669        foreach path $paths {
4670            lappend relative_paths [file join $cdup $path]
4671        }
4672        set gdtargs [concat -- $relative_paths]
4673    } elseif {$gdttype eq [mc "adding/removing string:"]} {
4674        set gdtargs [list "-S$highlight_files"]
4675    } elseif {$gdttype eq [mc "changing lines matching:"]} {
4676        set gdtargs [list "-G$highlight_files"]
4677    } else {
4678        # must be "containing:", i.e. we're searching commit info
4679        return
4680    }
4681    set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
4682    set filehighlight [open $cmd r+]
4683    fconfigure $filehighlight -blocking 0
4684    filerun $filehighlight readfhighlight
4685    set fhl_list {}
4686    drawvisible
4687    flushhighlights
4688}
4689
4690proc flushhighlights {} {
4691    global filehighlight fhl_list
4692
4693    if {[info exists filehighlight]} {
4694        lappend fhl_list {}
4695        puts $filehighlight ""
4696        flush $filehighlight
4697    }
4698}
4699
4700proc askfilehighlight {row id} {
4701    global filehighlight fhighlights fhl_list
4702
4703    lappend fhl_list $id
4704    set fhighlights($id) -1
4705    puts $filehighlight $id
4706}
4707
4708proc readfhighlight {} {
4709    global filehighlight fhighlights curview iddrawn
4710    global fhl_list find_dirn
4711
4712    if {![info exists filehighlight]} {
4713        return 0
4714    }
4715    set nr 0
4716    while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4717        set line [string trim $line]
4718        set i [lsearch -exact $fhl_list $line]
4719        if {$i < 0} continue
4720        for {set j 0} {$j < $i} {incr j} {
4721            set id [lindex $fhl_list $j]
4722            set fhighlights($id) 0
4723        }
4724        set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4725        if {$line eq {}} continue
4726        if {![commitinview $line $curview]} continue
4727        if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4728            bolden $line mainfontbold
4729        }
4730        set fhighlights($line) 1
4731    }
4732    if {[eof $filehighlight]} {
4733        # strange...
4734        puts "oops, git diff-tree died"
4735        catch {close $filehighlight}
4736        unset filehighlight
4737        return 0
4738    }
4739    if {[info exists find_dirn]} {
4740        run findmore
4741    }
4742    return 1
4743}
4744
4745proc doesmatch {f} {
4746    global findtype findpattern
4747
4748    if {$findtype eq [mc "Regexp"]} {
4749        return [regexp $findpattern $f]
4750    } elseif {$findtype eq [mc "IgnCase"]} {
4751        return [string match -nocase $findpattern $f]
4752    } else {
4753        return [string match $findpattern $f]
4754    }
4755}
4756
4757proc askfindhighlight {row id} {
4758    global nhighlights commitinfo iddrawn
4759    global findloc
4760    global markingmatches
4761
4762    if {![info exists commitinfo($id)]} {
4763        getcommit $id
4764    }
4765    set info $commitinfo($id)
4766    set isbold 0
4767    set fldtypes [list [mc Headline] [mc Author] "" [mc Committer] "" [mc Comments]]
4768    foreach f $info ty $fldtypes {
4769        if {$ty eq ""} continue
4770        if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4771            [doesmatch $f]} {
4772            if {$ty eq [mc "Author"]} {
4773                set isbold 2
4774                break
4775            }
4776            set isbold 1
4777        }
4778    }
4779    if {$isbold && [info exists iddrawn($id)]} {
4780        if {![ishighlighted $id]} {
4781            bolden $id mainfontbold
4782            if {$isbold > 1} {
4783                bolden_name $id mainfontbold
4784            }
4785        }
4786        if {$markingmatches} {
4787            markrowmatches $row $id
4788        }
4789    }
4790    set nhighlights($id) $isbold
4791}
4792
4793proc markrowmatches {row id} {
4794    global canv canv2 linehtag linentag commitinfo findloc
4795
4796    set headline [lindex $commitinfo($id) 0]
4797    set author [lindex $commitinfo($id) 1]
4798    $canv delete match$row
4799    $canv2 delete match$row
4800    if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4801        set m [findmatches $headline]
4802        if {$m ne {}} {
4803            markmatches $canv $row $headline $linehtag($id) $m \
4804                [$canv itemcget $linehtag($id) -font] $row
4805        }
4806    }
4807    if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4808        set m [findmatches $author]
4809        if {$m ne {}} {
4810            markmatches $canv2 $row $author $linentag($id) $m \
4811                [$canv2 itemcget $linentag($id) -font] $row
4812        }
4813    }
4814}
4815
4816proc vrel_change {name ix op} {
4817    global highlight_related
4818
4819    rhighlight_none
4820    if {$highlight_related ne [mc "None"]} {
4821        run drawvisible
4822    }
4823}
4824
4825# prepare for testing whether commits are descendents or ancestors of a
4826proc rhighlight_sel {a} {
4827    global descendent desc_todo ancestor anc_todo
4828    global highlight_related
4829
4830    catch {unset descendent}
4831    set desc_todo [list $a]
4832    catch {unset ancestor}
4833    set anc_todo [list $a]
4834    if {$highlight_related ne [mc "None"]} {
4835        rhighlight_none
4836        run drawvisible
4837    }
4838}
4839
4840proc rhighlight_none {} {
4841    global rhighlights
4842
4843    catch {unset rhighlights}
4844    unbolden
4845}
4846
4847proc is_descendent {a} {
4848    global curview children descendent desc_todo
4849
4850    set v $curview
4851    set la [rowofcommit $a]
4852    set todo $desc_todo
4853    set leftover {}
4854    set done 0
4855    for {set i 0} {$i < [llength $todo]} {incr i} {
4856        set do [lindex $todo $i]
4857        if {[rowofcommit $do] < $la} {
4858            lappend leftover $do
4859            continue
4860        }
4861        foreach nk $children($v,$do) {
4862            if {![info exists descendent($nk)]} {
4863                set descendent($nk) 1
4864                lappend todo $nk
4865                if {$nk eq $a} {
4866                    set done 1
4867                }
4868            }
4869        }
4870        if {$done} {
4871            set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4872            return
4873        }
4874    }
4875    set descendent($a) 0
4876    set desc_todo $leftover
4877}
4878
4879proc is_ancestor {a} {
4880    global curview parents ancestor anc_todo
4881
4882    set v $curview
4883    set la [rowofcommit $a]
4884    set todo $anc_todo
4885    set leftover {}
4886    set done 0
4887    for {set i 0} {$i < [llength $todo]} {incr i} {
4888        set do [lindex $todo $i]
4889        if {![commitinview $do $v] || [rowofcommit $do] > $la} {
4890            lappend leftover $do
4891            continue
4892        }
4893        foreach np $parents($v,$do) {
4894            if {![info exists ancestor($np)]} {
4895                set ancestor($np) 1
4896                lappend todo $np
4897                if {$np eq $a} {
4898                    set done 1
4899                }
4900            }
4901        }
4902        if {$done} {
4903            set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4904            return
4905        }
4906    }
4907    set ancestor($a) 0
4908    set anc_todo $leftover
4909}
4910
4911proc askrelhighlight {row id} {
4912    global descendent highlight_related iddrawn rhighlights
4913    global selectedline ancestor
4914
4915    if {$selectedline eq {}} return
4916    set isbold 0
4917    if {$highlight_related eq [mc "Descendant"] ||
4918        $highlight_related eq [mc "Not descendant"]} {
4919        if {![info exists descendent($id)]} {
4920            is_descendent $id
4921        }
4922        if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
4923            set isbold 1
4924        }
4925    } elseif {$highlight_related eq [mc "Ancestor"] ||
4926              $highlight_related eq [mc "Not ancestor"]} {
4927        if {![info exists ancestor($id)]} {
4928            is_ancestor $id
4929        }
4930        if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
4931            set isbold 1
4932        }
4933    }
4934    if {[info exists iddrawn($id)]} {
4935        if {$isbold && ![ishighlighted $id]} {
4936            bolden $id mainfontbold
4937        }
4938    }
4939    set rhighlights($id) $isbold
4940}
4941
4942# Graph layout functions
4943
4944proc shortids {ids} {
4945    set res {}
4946    foreach id $ids {
4947        if {[llength $id] > 1} {
4948            lappend res [shortids $id]
4949        } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
4950            lappend res [string range $id 0 7]
4951        } else {
4952            lappend res $id
4953        }
4954    }
4955    return $res
4956}
4957
4958proc ntimes {n o} {
4959    set ret {}
4960    set o [list $o]
4961    for {set mask 1} {$mask <= $n} {incr mask $mask} {
4962        if {($n & $mask) != 0} {
4963            set ret [concat $ret $o]
4964        }
4965        set o [concat $o $o]
4966    }
4967    return $ret
4968}
4969
4970proc ordertoken {id} {
4971    global ordertok curview varcid varcstart varctok curview parents children
4972    global nullid nullid2
4973
4974    if {[info exists ordertok($id)]} {
4975        return $ordertok($id)
4976    }
4977    set origid $id
4978    set todo {}
4979    while {1} {
4980        if {[info exists varcid($curview,$id)]} {
4981            set a $varcid($curview,$id)
4982            set p [lindex $varcstart($curview) $a]
4983        } else {
4984            set p [lindex $children($curview,$id) 0]
4985        }
4986        if {[info exists ordertok($p)]} {
4987            set tok $ordertok($p)
4988            break
4989        }
4990        set id [first_real_child $curview,$p]
4991        if {$id eq {}} {
4992            # it's a root
4993            set tok [lindex $varctok($curview) $varcid($curview,$p)]
4994            break
4995        }
4996        if {[llength $parents($curview,$id)] == 1} {
4997            lappend todo [list $p {}]
4998        } else {
4999            set j [lsearch -exact $parents($curview,$id) $p]
5000            if {$j < 0} {
5001                puts "oops didn't find [shortids $p] in parents of [shortids $id]"
5002            }
5003            lappend todo [list $p [strrep $j]]
5004        }
5005    }
5006    for {set i [llength $todo]} {[incr i -1] >= 0} {} {
5007        set p [lindex $todo $i 0]
5008        append tok [lindex $todo $i 1]
5009        set ordertok($p) $tok
5010    }
5011    set ordertok($origid) $tok
5012    return $tok
5013}
5014
5015# Work out where id should go in idlist so that order-token
5016# values increase from left to right
5017proc idcol {idlist id {i 0}} {
5018    set t [ordertoken $id]
5019    if {$i < 0} {
5020        set i 0
5021    }
5022    if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
5023        if {$i > [llength $idlist]} {
5024            set i [llength $idlist]
5025        }
5026        while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
5027        incr i
5028    } else {
5029        if {$t > [ordertoken [lindex $idlist $i]]} {
5030            while {[incr i] < [llength $idlist] &&
5031                   $t >= [ordertoken [lindex $idlist $i]]} {}
5032        }
5033    }
5034    return $i
5035}
5036
5037proc initlayout {} {
5038    global rowidlist rowisopt rowfinal displayorder parentlist
5039    global numcommits canvxmax canv
5040    global nextcolor
5041    global colormap rowtextx
5042
5043    set numcommits 0
5044    set displayorder {}
5045    set parentlist {}
5046    set nextcolor 0
5047    set rowidlist {}
5048    set rowisopt {}
5049    set rowfinal {}
5050    set canvxmax [$canv cget -width]
5051    catch {unset colormap}
5052    catch {unset rowtextx}
5053    setcanvscroll
5054}
5055
5056proc setcanvscroll {} {
5057    global canv canv2 canv3 numcommits linespc canvxmax canvy0
5058    global lastscrollset lastscrollrows
5059
5060    set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
5061    $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
5062    $canv2 conf -scrollregion [list 0 0 0 $ymax]
5063    $canv3 conf -scrollregion [list 0 0 0 $ymax]
5064    set lastscrollset [clock clicks -milliseconds]
5065    set lastscrollrows $numcommits
5066}
5067
5068proc visiblerows {} {
5069    global canv numcommits linespc
5070
5071    set ymax [lindex [$canv cget -scrollregion] 3]
5072    if {$ymax eq {} || $ymax == 0} return
5073    set f [$canv yview]
5074    set y0 [expr {int([lindex $f 0] * $ymax)}]
5075    set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
5076    if {$r0 < 0} {
5077        set r0 0
5078    }
5079    set y1 [expr {int([lindex $f 1] * $ymax)}]
5080    set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
5081    if {$r1 >= $numcommits} {
5082        set r1 [expr {$numcommits - 1}]
5083    }
5084    return [list $r0 $r1]
5085}
5086
5087proc layoutmore {} {
5088    global commitidx viewcomplete curview
5089    global numcommits pending_select curview
5090    global lastscrollset lastscrollrows
5091
5092    if {$lastscrollrows < 100 || $viewcomplete($curview) ||
5093        [clock clicks -milliseconds] - $lastscrollset > 500} {
5094        setcanvscroll
5095    }
5096    if {[info exists pending_select] &&
5097        [commitinview $pending_select $curview]} {
5098        update
5099        selectline [rowofcommit $pending_select] 1
5100    }
5101    drawvisible
5102}
5103
5104# With path limiting, we mightn't get the actual HEAD commit,
5105# so ask git rev-list what is the first ancestor of HEAD that
5106# touches a file in the path limit.
5107proc get_viewmainhead {view} {
5108    global viewmainheadid vfilelimit viewinstances mainheadid
5109
5110    catch {
5111        set rfd [open [concat | git rev-list -1 $mainheadid \
5112                           -- $vfilelimit($view)] r]
5113        set j [reg_instance $rfd]
5114        lappend viewinstances($view) $j
5115        fconfigure $rfd -blocking 0
5116        filerun $rfd [list getviewhead $rfd $j $view]
5117        set viewmainheadid($curview) {}
5118    }
5119}
5120
5121# git rev-list should give us just 1 line to use as viewmainheadid($view)
5122proc getviewhead {fd inst view} {
5123    global viewmainheadid commfd curview viewinstances showlocalchanges
5124
5125    set id {}
5126    if {[gets $fd line] < 0} {
5127        if {![eof $fd]} {
5128            return 1
5129        }
5130    } elseif {[string length $line] == 40 && [string is xdigit $line]} {
5131        set id $line
5132    }
5133    set viewmainheadid($view) $id
5134    close $fd
5135    unset commfd($inst)
5136    set i [lsearch -exact $viewinstances($view) $inst]
5137    if {$i >= 0} {
5138        set viewinstances($view) [lreplace $viewinstances($view) $i $i]
5139    }
5140    if {$showlocalchanges && $id ne {} && $view == $curview} {
5141        doshowlocalchanges
5142    }
5143    return 0
5144}
5145
5146proc doshowlocalchanges {} {
5147    global curview viewmainheadid
5148
5149    if {$viewmainheadid($curview) eq {}} return
5150    if {[commitinview $viewmainheadid($curview) $curview]} {
5151        dodiffindex
5152    } else {
5153        interestedin $viewmainheadid($curview) dodiffindex
5154    }
5155}
5156
5157proc dohidelocalchanges {} {
5158    global nullid nullid2 lserial curview
5159
5160    if {[commitinview $nullid $curview]} {
5161        removefakerow $nullid
5162    }
5163    if {[commitinview $nullid2 $curview]} {
5164        removefakerow $nullid2
5165    }
5166    incr lserial
5167}
5168
5169# spawn off a process to do git diff-index --cached HEAD
5170proc dodiffindex {} {
5171    global lserial showlocalchanges vfilelimit curview
5172    global hasworktree git_version
5173
5174    if {!$showlocalchanges || !$hasworktree} return
5175    incr lserial
5176    if {[package vcompare $git_version "1.7.2"] >= 0} {
5177        set cmd "|git diff-index --cached --ignore-submodules=dirty HEAD"
5178    } else {
5179        set cmd "|git diff-index --cached HEAD"
5180    }
5181    if {$vfilelimit($curview) ne {}} {
5182        set cmd [concat $cmd -- $vfilelimit($curview)]
5183    }
5184    set fd [open $cmd r]
5185    fconfigure $fd -blocking 0
5186    set i [reg_instance $fd]
5187    filerun $fd [list readdiffindex $fd $lserial $i]
5188}
5189
5190proc readdiffindex {fd serial inst} {
5191    global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
5192    global vfilelimit
5193
5194    set isdiff 1
5195    if {[gets $fd line] < 0} {
5196        if {![eof $fd]} {
5197            return 1
5198        }
5199        set isdiff 0
5200    }
5201    # we only need to see one line and we don't really care what it says...
5202    stop_instance $inst
5203
5204    if {$serial != $lserial} {
5205        return 0
5206    }
5207
5208    # now see if there are any local changes not checked in to the index
5209    set cmd "|git diff-files"
5210    if {$vfilelimit($curview) ne {}} {
5211        set cmd [concat $cmd -- $vfilelimit($curview)]
5212    }
5213    set fd [open $cmd r]
5214    fconfigure $fd -blocking 0
5215    set i [reg_instance $fd]
5216    filerun $fd [list readdifffiles $fd $serial $i]
5217
5218    if {$isdiff && ![commitinview $nullid2 $curview]} {
5219        # add the line for the changes in the index to the graph
5220        set hl [mc "Local changes checked in to index but not committed"]
5221        set commitinfo($nullid2) [list  $hl {} {} {} {} "    $hl\n"]
5222        set commitdata($nullid2) "\n    $hl\n"
5223        if {[commitinview $nullid $curview]} {
5224            removefakerow $nullid
5225        }
5226        insertfakerow $nullid2 $viewmainheadid($curview)
5227    } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
5228        if {[commitinview $nullid $curview]} {
5229            removefakerow $nullid
5230        }
5231        removefakerow $nullid2
5232    }
5233    return 0
5234}
5235
5236proc readdifffiles {fd serial inst} {
5237    global viewmainheadid nullid nullid2 curview
5238    global commitinfo commitdata lserial
5239
5240    set isdiff 1
5241    if {[gets $fd line] < 0} {
5242        if {![eof $fd]} {
5243            return 1
5244        }
5245        set isdiff 0
5246    }
5247    # we only need to see one line and we don't really care what it says...
5248    stop_instance $inst
5249
5250    if {$serial != $lserial} {
5251        return 0
5252    }
5253
5254    if {$isdiff && ![commitinview $nullid $curview]} {
5255        # add the line for the local diff to the graph
5256        set hl [mc "Local uncommitted changes, not checked in to index"]
5257        set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
5258        set commitdata($nullid) "\n    $hl\n"
5259        if {[commitinview $nullid2 $curview]} {
5260            set p $nullid2
5261        } else {
5262            set p $viewmainheadid($curview)
5263        }
5264        insertfakerow $nullid $p
5265    } elseif {!$isdiff && [commitinview $nullid $curview]} {
5266        removefakerow $nullid
5267    }
5268    return 0
5269}
5270
5271proc nextuse {id row} {
5272    global curview children
5273
5274    if {[info exists children($curview,$id)]} {
5275        foreach kid $children($curview,$id) {
5276            if {![commitinview $kid $curview]} {
5277                return -1
5278            }
5279            if {[rowofcommit $kid] > $row} {
5280                return [rowofcommit $kid]
5281            }
5282        }
5283    }
5284    if {[commitinview $id $curview]} {
5285        return [rowofcommit $id]
5286    }
5287    return -1
5288}
5289
5290proc prevuse {id row} {
5291    global curview children
5292
5293    set ret -1
5294    if {[info exists children($curview,$id)]} {
5295        foreach kid $children($curview,$id) {
5296            if {![commitinview $kid $curview]} break
5297            if {[rowofcommit $kid] < $row} {
5298                set ret [rowofcommit $kid]
5299            }
5300        }
5301    }
5302    return $ret
5303}
5304
5305proc make_idlist {row} {
5306    global displayorder parentlist uparrowlen downarrowlen mingaplen
5307    global commitidx curview children
5308
5309    set r [expr {$row - $mingaplen - $downarrowlen - 1}]
5310    if {$r < 0} {
5311        set r 0
5312    }
5313    set ra [expr {$row - $downarrowlen}]
5314    if {$ra < 0} {
5315        set ra 0
5316    }
5317    set rb [expr {$row + $uparrowlen}]
5318    if {$rb > $commitidx($curview)} {
5319        set rb $commitidx($curview)
5320    }
5321    make_disporder $r [expr {$rb + 1}]
5322    set ids {}
5323    for {} {$r < $ra} {incr r} {
5324        set nextid [lindex $displayorder [expr {$r + 1}]]
5325        foreach p [lindex $parentlist $r] {
5326            if {$p eq $nextid} continue
5327            set rn [nextuse $p $r]
5328            if {$rn >= $row &&
5329                $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
5330                lappend ids [list [ordertoken $p] $p]
5331            }
5332        }
5333    }
5334    for {} {$r < $row} {incr r} {
5335        set nextid [lindex $displayorder [expr {$r + 1}]]
5336        foreach p [lindex $parentlist $r] {
5337            if {$p eq $nextid} continue
5338            set rn [nextuse $p $r]
5339            if {$rn < 0 || $rn >= $row} {
5340                lappend ids [list [ordertoken $p] $p]
5341            }
5342        }
5343    }
5344    set id [lindex $displayorder $row]
5345    lappend ids [list [ordertoken $id] $id]
5346    while {$r < $rb} {
5347        foreach p [lindex $parentlist $r] {
5348            set firstkid [lindex $children($curview,$p) 0]
5349            if {[rowofcommit $firstkid] < $row} {
5350                lappend ids [list [ordertoken $p] $p]
5351            }
5352        }
5353        incr r
5354        set id [lindex $displayorder $r]
5355        if {$id ne {}} {
5356            set firstkid [lindex $children($curview,$id) 0]
5357            if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
5358                lappend ids [list [ordertoken $id] $id]
5359            }
5360        }
5361    }
5362    set idlist {}
5363    foreach idx [lsort -unique $ids] {
5364        lappend idlist [lindex $idx 1]
5365    }
5366    return $idlist
5367}
5368
5369proc rowsequal {a b} {
5370    while {[set i [lsearch -exact $a {}]] >= 0} {
5371        set a [lreplace $a $i $i]
5372    }
5373    while {[set i [lsearch -exact $b {}]] >= 0} {
5374        set b [lreplace $b $i $i]
5375    }
5376    return [expr {$a eq $b}]
5377}
5378
5379proc makeupline {id row rend col} {
5380    global rowidlist uparrowlen downarrowlen mingaplen
5381
5382    for {set r $rend} {1} {set r $rstart} {
5383        set rstart [prevuse $id $r]
5384        if {$rstart < 0} return
5385        if {$rstart < $row} break
5386    }
5387    if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5388        set rstart [expr {$rend - $uparrowlen - 1}]
5389    }
5390    for {set r $rstart} {[incr r] <= $row} {} {
5391        set idlist [lindex $rowidlist $r]
5392        if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5393            set col [idcol $idlist $id $col]
5394            lset rowidlist $r [linsert $idlist $col $id]
5395            changedrow $r
5396        }
5397    }
5398}
5399
5400proc layoutrows {row endrow} {
5401    global rowidlist rowisopt rowfinal displayorder
5402    global uparrowlen downarrowlen maxwidth mingaplen
5403    global children parentlist
5404    global commitidx viewcomplete curview
5405
5406    make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
5407    set idlist {}
5408    if {$row > 0} {
5409        set rm1 [expr {$row - 1}]
5410        foreach id [lindex $rowidlist $rm1] {
5411            if {$id ne {}} {
5412                lappend idlist $id
5413            }
5414        }
5415        set final [lindex $rowfinal $rm1]
5416    }
5417    for {} {$row < $endrow} {incr row} {
5418        set rm1 [expr {$row - 1}]
5419        if {$rm1 < 0 || $idlist eq {}} {
5420            set idlist [make_idlist $row]
5421            set final 1
5422        } else {
5423            set id [lindex $displayorder $rm1]
5424            set col [lsearch -exact $idlist $id]
5425            set idlist [lreplace $idlist $col $col]
5426            foreach p [lindex $parentlist $rm1] {
5427                if {[lsearch -exact $idlist $p] < 0} {
5428                    set col [idcol $idlist $p $col]
5429                    set idlist [linsert $idlist $col $p]
5430                    # if not the first child, we have to insert a line going up
5431                    if {$id ne [lindex $children($curview,$p) 0]} {
5432                        makeupline $p $rm1 $row $col
5433                    }
5434                }
5435            }
5436            set id [lindex $displayorder $row]
5437            if {$row > $downarrowlen} {
5438                set termrow [expr {$row - $downarrowlen - 1}]
5439                foreach p [lindex $parentlist $termrow] {
5440                    set i [lsearch -exact $idlist $p]
5441                    if {$i < 0} continue
5442                    set nr [nextuse $p $termrow]
5443                    if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5444                        set idlist [lreplace $idlist $i $i]
5445                    }
5446                }
5447            }
5448            set col [lsearch -exact $idlist $id]
5449            if {$col < 0} {
5450                set col [idcol $idlist $id]
5451                set idlist [linsert $idlist $col $id]
5452                if {$children($curview,$id) ne {}} {
5453                    makeupline $id $rm1 $row $col
5454                }
5455            }
5456            set r [expr {$row + $uparrowlen - 1}]
5457            if {$r < $commitidx($curview)} {
5458                set x $col
5459                foreach p [lindex $parentlist $r] {
5460                    if {[lsearch -exact $idlist $p] >= 0} continue
5461                    set fk [lindex $children($curview,$p) 0]
5462                    if {[rowofcommit $fk] < $row} {
5463                        set x [idcol $idlist $p $x]
5464                        set idlist [linsert $idlist $x $p]
5465                    }
5466                }
5467                if {[incr r] < $commitidx($curview)} {
5468                    set p [lindex $displayorder $r]
5469                    if {[lsearch -exact $idlist $p] < 0} {
5470                        set fk [lindex $children($curview,$p) 0]
5471                        if {$fk ne {} && [rowofcommit $fk] < $row} {
5472                            set x [idcol $idlist $p $x]
5473                            set idlist [linsert $idlist $x $p]
5474                        }
5475                    }
5476                }
5477            }
5478        }
5479        if {$final && !$viewcomplete($curview) &&
5480            $row + $uparrowlen + $mingaplen + $downarrowlen
5481                >= $commitidx($curview)} {
5482            set final 0
5483        }
5484        set l [llength $rowidlist]
5485        if {$row == $l} {
5486            lappend rowidlist $idlist
5487            lappend rowisopt 0
5488            lappend rowfinal $final
5489        } elseif {$row < $l} {
5490            if {![rowsequal $idlist [lindex $rowidlist $row]]} {
5491                lset rowidlist $row $idlist
5492                changedrow $row
5493            }
5494            lset rowfinal $row $final
5495        } else {
5496            set pad [ntimes [expr {$row - $l}] {}]
5497            set rowidlist [concat $rowidlist $pad]
5498            lappend rowidlist $idlist
5499            set rowfinal [concat $rowfinal $pad]
5500            lappend rowfinal $final
5501            set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5502        }
5503    }
5504    return $row
5505}
5506
5507proc changedrow {row} {
5508    global displayorder iddrawn rowisopt need_redisplay
5509
5510    set l [llength $rowisopt]
5511    if {$row < $l} {
5512        lset rowisopt $row 0
5513        if {$row + 1 < $l} {
5514            lset rowisopt [expr {$row + 1}] 0
5515            if {$row + 2 < $l} {
5516                lset rowisopt [expr {$row + 2}] 0
5517            }
5518        }
5519    }
5520    set id [lindex $displayorder $row]
5521    if {[info exists iddrawn($id)]} {
5522        set need_redisplay 1
5523    }
5524}
5525
5526proc insert_pad {row col npad} {
5527    global rowidlist
5528
5529    set pad [ntimes $npad {}]
5530    set idlist [lindex $rowidlist $row]
5531    set bef [lrange $idlist 0 [expr {$col - 1}]]
5532    set aft [lrange $idlist $col end]
5533    set i [lsearch -exact $aft {}]
5534    if {$i > 0} {
5535        set aft [lreplace $aft $i $i]
5536    }
5537    lset rowidlist $row [concat $bef $pad $aft]
5538    changedrow $row
5539}
5540
5541proc optimize_rows {row col endrow} {
5542    global rowidlist rowisopt displayorder curview children
5543
5544    if {$row < 1} {
5545        set row 1
5546    }
5547    for {} {$row < $endrow} {incr row; set col 0} {
5548        if {[lindex $rowisopt $row]} continue
5549        set haspad 0
5550        set y0 [expr {$row - 1}]
5551        set ym [expr {$row - 2}]
5552        set idlist [lindex $rowidlist $row]
5553        set previdlist [lindex $rowidlist $y0]
5554        if {$idlist eq {} || $previdlist eq {}} continue
5555        if {$ym >= 0} {
5556            set pprevidlist [lindex $rowidlist $ym]
5557            if {$pprevidlist eq {}} continue
5558        } else {
5559            set pprevidlist {}
5560        }
5561        set x0 -1
5562        set xm -1
5563        for {} {$col < [llength $idlist]} {incr col} {
5564            set id [lindex $idlist $col]
5565            if {[lindex $previdlist $col] eq $id} continue
5566            if {$id eq {}} {
5567                set haspad 1
5568                continue
5569            }
5570            set x0 [lsearch -exact $previdlist $id]
5571            if {$x0 < 0} continue
5572            set z [expr {$x0 - $col}]
5573            set isarrow 0
5574            set z0 {}
5575            if {$ym >= 0} {
5576                set xm [lsearch -exact $pprevidlist $id]
5577                if {$xm >= 0} {
5578                    set z0 [expr {$xm - $x0}]
5579                }
5580            }
5581            if {$z0 eq {}} {
5582                # if row y0 is the first child of $id then it's not an arrow
5583                if {[lindex $children($curview,$id) 0] ne
5584                    [lindex $displayorder $y0]} {
5585                    set isarrow 1
5586                }
5587            }
5588            if {!$isarrow && $id ne [lindex $displayorder $row] &&
5589                [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5590                set isarrow 1
5591            }
5592            # Looking at lines from this row to the previous row,
5593            # make them go straight up if they end in an arrow on
5594            # the previous row; otherwise make them go straight up
5595            # or at 45 degrees.
5596            if {$z < -1 || ($z < 0 && $isarrow)} {
5597                # Line currently goes left too much;
5598                # insert pads in the previous row, then optimize it
5599                set npad [expr {-1 - $z + $isarrow}]
5600                insert_pad $y0 $x0 $npad
5601                if {$y0 > 0} {
5602                    optimize_rows $y0 $x0 $row
5603                }
5604                set previdlist [lindex $rowidlist $y0]
5605                set x0 [lsearch -exact $previdlist $id]
5606                set z [expr {$x0 - $col}]
5607                if {$z0 ne {}} {
5608                    set pprevidlist [lindex $rowidlist $ym]
5609                    set xm [lsearch -exact $pprevidlist $id]
5610                    set z0 [expr {$xm - $x0}]
5611                }
5612            } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5613                # Line currently goes right too much;
5614                # insert pads in this line
5615                set npad [expr {$z - 1 + $isarrow}]
5616                insert_pad $row $col $npad
5617                set idlist [lindex $rowidlist $row]
5618                incr col $npad
5619                set z [expr {$x0 - $col}]
5620                set haspad 1
5621            }
5622            if {$z0 eq {} && !$isarrow && $ym >= 0} {
5623                # this line links to its first child on row $row-2
5624                set id [lindex $displayorder $ym]
5625                set xc [lsearch -exact $pprevidlist $id]
5626                if {$xc >= 0} {
5627                    set z0 [expr {$xc - $x0}]
5628                }
5629            }
5630            # avoid lines jigging left then immediately right
5631            if {$z0 ne {} && $z < 0 && $z0 > 0} {
5632                insert_pad $y0 $x0 1
5633                incr x0
5634                optimize_rows $y0 $x0 $row
5635                set previdlist [lindex $rowidlist $y0]
5636            }
5637        }
5638        if {!$haspad} {
5639            # Find the first column that doesn't have a line going right
5640            for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5641                set id [lindex $idlist $col]
5642                if {$id eq {}} break
5643                set x0 [lsearch -exact $previdlist $id]
5644                if {$x0 < 0} {
5645                    # check if this is the link to the first child
5646                    set kid [lindex $displayorder $y0]
5647                    if {[lindex $children($curview,$id) 0] eq $kid} {
5648                        # it is, work out offset to child
5649                        set x0 [lsearch -exact $previdlist $kid]
5650                    }
5651                }
5652                if {$x0 <= $col} break
5653            }
5654            # Insert a pad at that column as long as it has a line and
5655            # isn't the last column
5656            if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5657                set idlist [linsert $idlist $col {}]
5658                lset rowidlist $row $idlist
5659                changedrow $row
5660            }
5661        }
5662    }
5663}
5664
5665proc xc {row col} {
5666    global canvx0 linespc
5667    return [expr {$canvx0 + $col * $linespc}]
5668}
5669
5670proc yc {row} {
5671    global canvy0 linespc
5672    return [expr {$canvy0 + $row * $linespc}]
5673}
5674
5675proc linewidth {id} {
5676    global thickerline lthickness
5677
5678    set wid $lthickness
5679    if {[info exists thickerline] && $id eq $thickerline} {
5680        set wid [expr {2 * $lthickness}]
5681    }
5682    return $wid
5683}
5684
5685proc rowranges {id} {
5686    global curview children uparrowlen downarrowlen
5687    global rowidlist
5688
5689    set kids $children($curview,$id)
5690    if {$kids eq {}} {
5691        return {}
5692    }
5693    set ret {}
5694    lappend kids $id
5695    foreach child $kids {
5696        if {![commitinview $child $curview]} break
5697        set row [rowofcommit $child]
5698        if {![info exists prev]} {
5699            lappend ret [expr {$row + 1}]
5700        } else {
5701            if {$row <= $prevrow} {
5702                puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5703            }
5704            # see if the line extends the whole way from prevrow to row
5705            if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5706                [lsearch -exact [lindex $rowidlist \
5707                            [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5708                # it doesn't, see where it ends
5709                set r [expr {$prevrow + $downarrowlen}]
5710                if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5711                    while {[incr r -1] > $prevrow &&
5712                           [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5713                } else {
5714                    while {[incr r] <= $row &&
5715                           [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5716                    incr r -1
5717                }
5718                lappend ret $r
5719                # see where it starts up again
5720                set r [expr {$row - $uparrowlen}]
5721                if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5722                    while {[incr r] < $row &&
5723                           [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5724                } else {
5725                    while {[incr r -1] >= $prevrow &&
5726                           [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5727                    incr r
5728                }
5729                lappend ret $r
5730            }
5731        }
5732        if {$child eq $id} {
5733            lappend ret $row
5734        }
5735        set prev $child
5736        set prevrow $row
5737    }
5738    return $ret
5739}
5740
5741proc drawlineseg {id row endrow arrowlow} {
5742    global rowidlist displayorder iddrawn linesegs
5743    global canv colormap linespc curview maxlinelen parentlist
5744
5745    set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5746    set le [expr {$row + 1}]
5747    set arrowhigh 1
5748    while {1} {
5749        set c [lsearch -exact [lindex $rowidlist $le] $id]
5750        if {$c < 0} {
5751            incr le -1
5752            break
5753        }
5754        lappend cols $c
5755        set x [lindex $displayorder $le]
5756        if {$x eq $id} {
5757            set arrowhigh 0
5758            break
5759        }
5760        if {[info exists iddrawn($x)] || $le == $endrow} {
5761            set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5762            if {$c >= 0} {
5763                lappend cols $c
5764                set arrowhigh 0
5765            }
5766            break
5767        }
5768        incr le
5769    }
5770    if {$le <= $row} {
5771        return $row
5772    }
5773
5774    set lines {}
5775    set i 0
5776    set joinhigh 0
5777    if {[info exists linesegs($id)]} {
5778        set lines $linesegs($id)
5779        foreach li $lines {
5780            set r0 [lindex $li 0]
5781            if {$r0 > $row} {
5782                if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5783                    set joinhigh 1
5784                }
5785                break
5786            }
5787            incr i
5788        }
5789    }
5790    set joinlow 0
5791    if {$i > 0} {
5792        set li [lindex $lines [expr {$i-1}]]
5793        set r1 [lindex $li 1]
5794        if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5795            set joinlow 1
5796        }
5797    }
5798
5799    set x [lindex $cols [expr {$le - $row}]]
5800    set xp [lindex $cols [expr {$le - 1 - $row}]]
5801    set dir [expr {$xp - $x}]
5802    if {$joinhigh} {
5803        set ith [lindex $lines $i 2]
5804        set coords [$canv coords $ith]
5805        set ah [$canv itemcget $ith -arrow]
5806        set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5807        set x2 [lindex $cols [expr {$le + 1 - $row}]]
5808        if {$x2 ne {} && $x - $x2 == $dir} {
5809            set coords [lrange $coords 0 end-2]
5810        }
5811    } else {
5812        set coords [list [xc $le $x] [yc $le]]
5813    }
5814    if {$joinlow} {
5815        set itl [lindex $lines [expr {$i-1}] 2]
5816        set al [$canv itemcget $itl -arrow]
5817        set arrowlow [expr {$al eq "last" || $al eq "both"}]
5818    } elseif {$arrowlow} {
5819        if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5820            [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5821            set arrowlow 0
5822        }
5823    }
5824    set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5825    for {set y $le} {[incr y -1] > $row} {} {
5826        set x $xp
5827        set xp [lindex $cols [expr {$y - 1 - $row}]]
5828        set ndir [expr {$xp - $x}]
5829        if {$dir != $ndir || $xp < 0} {
5830            lappend coords [xc $y $x] [yc $y]
5831        }
5832        set dir $ndir
5833    }
5834    if {!$joinlow} {
5835        if {$xp < 0} {
5836            # join parent line to first child
5837            set ch [lindex $displayorder $row]
5838            set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5839            if {$xc < 0} {
5840                puts "oops: drawlineseg: child $ch not on row $row"
5841            } elseif {$xc != $x} {
5842                if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5843                    set d [expr {int(0.5 * $linespc)}]
5844                    set x1 [xc $row $x]
5845                    if {$xc < $x} {
5846                        set x2 [expr {$x1 - $d}]
5847                    } else {
5848                        set x2 [expr {$x1 + $d}]
5849                    }
5850                    set y2 [yc $row]
5851                    set y1 [expr {$y2 + $d}]
5852                    lappend coords $x1 $y1 $x2 $y2
5853                } elseif {$xc < $x - 1} {
5854                    lappend coords [xc $row [expr {$x-1}]] [yc $row]
5855                } elseif {$xc > $x + 1} {
5856                    lappend coords [xc $row [expr {$x+1}]] [yc $row]
5857                }
5858                set x $xc
5859            }
5860            lappend coords [xc $row $x] [yc $row]
5861        } else {
5862            set xn [xc $row $xp]
5863            set yn [yc $row]
5864            lappend coords $xn $yn
5865        }
5866        if {!$joinhigh} {
5867            assigncolor $id
5868            set t [$canv create line $coords -width [linewidth $id] \
5869                       -fill $colormap($id) -tags lines.$id -arrow $arrow]
5870            $canv lower $t
5871            bindline $t $id
5872            set lines [linsert $lines $i [list $row $le $t]]
5873        } else {
5874            $canv coords $ith $coords
5875            if {$arrow ne $ah} {
5876                $canv itemconf $ith -arrow $arrow
5877            }
5878            lset lines $i 0 $row
5879        }
5880    } else {
5881        set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
5882        set ndir [expr {$xo - $xp}]
5883        set clow [$canv coords $itl]
5884        if {$dir == $ndir} {
5885            set clow [lrange $clow 2 end]
5886        }
5887        set coords [concat $coords $clow]
5888        if {!$joinhigh} {
5889            lset lines [expr {$i-1}] 1 $le
5890        } else {
5891            # coalesce two pieces
5892            $canv delete $ith
5893            set b [lindex $lines [expr {$i-1}] 0]
5894            set e [lindex $lines $i 1]
5895            set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
5896        }
5897        $canv coords $itl $coords
5898        if {$arrow ne $al} {
5899            $canv itemconf $itl -arrow $arrow
5900        }
5901    }
5902
5903    set linesegs($id) $lines
5904    return $le
5905}
5906
5907proc drawparentlinks {id row} {
5908    global rowidlist canv colormap curview parentlist
5909    global idpos linespc
5910
5911    set rowids [lindex $rowidlist $row]
5912    set col [lsearch -exact $rowids $id]
5913    if {$col < 0} return
5914    set olds [lindex $parentlist $row]
5915    set row2 [expr {$row + 1}]
5916    set x [xc $row $col]
5917    set y [yc $row]
5918    set y2 [yc $row2]
5919    set d [expr {int(0.5 * $linespc)}]
5920    set ymid [expr {$y + $d}]
5921    set ids [lindex $rowidlist $row2]
5922    # rmx = right-most X coord used
5923    set rmx 0
5924    foreach p $olds {
5925        set i [lsearch -exact $ids $p]
5926        if {$i < 0} {
5927            puts "oops, parent $p of $id not in list"
5928            continue
5929        }
5930        set x2 [xc $row2 $i]
5931        if {$x2 > $rmx} {
5932            set rmx $x2
5933        }
5934        set j [lsearch -exact $rowids $p]
5935        if {$j < 0} {
5936            # drawlineseg will do this one for us
5937            continue
5938        }
5939        assigncolor $p
5940        # should handle duplicated parents here...
5941        set coords [list $x $y]
5942        if {$i != $col} {
5943            # if attaching to a vertical segment, draw a smaller
5944            # slant for visual distinctness
5945            if {$i == $j} {
5946                if {$i < $col} {
5947                    lappend coords [expr {$x2 + $d}] $y $x2 $ymid
5948                } else {
5949                    lappend coords [expr {$x2 - $d}] $y $x2 $ymid
5950                }
5951            } elseif {$i < $col && $i < $j} {
5952                # segment slants towards us already
5953                lappend coords [xc $row $j] $y
5954            } else {
5955                if {$i < $col - 1} {
5956                    lappend coords [expr {$x2 + $linespc}] $y
5957                } elseif {$i > $col + 1} {
5958                    lappend coords [expr {$x2 - $linespc}] $y
5959                }
5960                lappend coords $x2 $y2
5961            }
5962        } else {
5963            lappend coords $x2 $y2
5964        }
5965        set t [$canv create line $coords -width [linewidth $p] \
5966                   -fill $colormap($p) -tags lines.$p]
5967        $canv lower $t
5968        bindline $t $p
5969    }
5970    if {$rmx > [lindex $idpos($id) 1]} {
5971        lset idpos($id) 1 $rmx
5972        redrawtags $id
5973    }
5974}
5975
5976proc drawlines {id} {
5977    global canv
5978
5979    $canv itemconf lines.$id -width [linewidth $id]
5980}
5981
5982proc drawcmittext {id row col} {
5983    global linespc canv canv2 canv3 fgcolor curview
5984    global cmitlisted commitinfo rowidlist parentlist
5985    global rowtextx idpos idtags idheads idotherrefs
5986    global linehtag linentag linedtag selectedline
5987    global canvxmax boldids boldnameids fgcolor markedid
5988    global mainheadid nullid nullid2 circleitem circlecolors ctxbut
5989    global mainheadcirclecolor workingfilescirclecolor indexcirclecolor
5990    global circleoutlinecolor
5991
5992    # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
5993    set listed $cmitlisted($curview,$id)
5994    if {$id eq $nullid} {
5995        set ofill $workingfilescirclecolor
5996    } elseif {$id eq $nullid2} {
5997        set ofill $indexcirclecolor
5998    } elseif {$id eq $mainheadid} {
5999        set ofill $mainheadcirclecolor
6000    } else {
6001        set ofill [lindex $circlecolors $listed]
6002    }
6003    set x [xc $row $col]
6004    set y [yc $row]
6005    set orad [expr {$linespc / 3}]
6006    if {$listed <= 2} {
6007        set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
6008                   [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6009                   -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6010    } elseif {$listed == 3} {
6011        # triangle pointing left for left-side commits
6012        set t [$canv create polygon \
6013                   [expr {$x - $orad}] $y \
6014                   [expr {$x + $orad - 1}] [expr {$y - $orad}] \
6015                   [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6016                   -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6017    } else {
6018        # triangle pointing right for right-side commits
6019        set t [$canv create polygon \
6020                   [expr {$x + $orad - 1}] $y \
6021                   [expr {$x - $orad}] [expr {$y - $orad}] \
6022                   [expr {$x - $orad}] [expr {$y + $orad - 1}] \
6023                   -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6024    }
6025    set circleitem($row) $t
6026    $canv raise $t
6027    $canv bind $t <1> {selcanvline {} %x %y}
6028    set rmx [llength [lindex $rowidlist $row]]
6029    set olds [lindex $parentlist $row]
6030    if {$olds ne {}} {
6031        set nextids [lindex $rowidlist [expr {$row + 1}]]
6032        foreach p $olds {
6033            set i [lsearch -exact $nextids $p]
6034            if {$i > $rmx} {
6035                set rmx $i
6036            }
6037        }
6038    }
6039    set xt [xc $row $rmx]
6040    set rowtextx($row) $xt
6041    set idpos($id) [list $x $xt $y]
6042    if {[info exists idtags($id)] || [info exists idheads($id)]
6043        || [info exists idotherrefs($id)]} {
6044        set xt [drawtags $id $x $xt $y]
6045    }
6046    if {[lindex $commitinfo($id) 6] > 0} {
6047        set xt [drawnotesign $xt $y]
6048    }
6049    set headline [lindex $commitinfo($id) 0]
6050    set name [lindex $commitinfo($id) 1]
6051    set date [lindex $commitinfo($id) 2]
6052    set date [formatdate $date]
6053    set font mainfont
6054    set nfont mainfont
6055    set isbold [ishighlighted $id]
6056    if {$isbold > 0} {
6057        lappend boldids $id
6058        set font mainfontbold
6059        if {$isbold > 1} {
6060            lappend boldnameids $id
6061            set nfont mainfontbold
6062        }
6063    }
6064    set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
6065                           -text $headline -font $font -tags text]
6066    $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
6067    set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
6068                           -text $name -font $nfont -tags text]
6069    set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
6070                           -text $date -font mainfont -tags text]
6071    if {$selectedline == $row} {
6072        make_secsel $id
6073    }
6074    if {[info exists markedid] && $markedid eq $id} {
6075        make_idmark $id
6076    }
6077    set xr [expr {$xt + [font measure $font $headline]}]
6078    if {$xr > $canvxmax} {
6079        set canvxmax $xr
6080        setcanvscroll
6081    }
6082}
6083
6084proc drawcmitrow {row} {
6085    global displayorder rowidlist nrows_drawn
6086    global iddrawn markingmatches
6087    global commitinfo numcommits
6088    global filehighlight fhighlights findpattern nhighlights
6089    global hlview vhighlights
6090    global highlight_related rhighlights
6091
6092    if {$row >= $numcommits} return
6093
6094    set id [lindex $displayorder $row]
6095    if {[info exists hlview] && ![info exists vhighlights($id)]} {
6096        askvhighlight $row $id
6097    }
6098    if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
6099        askfilehighlight $row $id
6100    }
6101    if {$findpattern ne {} && ![info exists nhighlights($id)]} {
6102        askfindhighlight $row $id
6103    }
6104    if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
6105        askrelhighlight $row $id
6106    }
6107    if {![info exists iddrawn($id)]} {
6108        set col [lsearch -exact [lindex $rowidlist $row] $id]
6109        if {$col < 0} {
6110            puts "oops, row $row id $id not in list"
6111            return
6112        }
6113        if {![info exists commitinfo($id)]} {
6114            getcommit $id
6115        }
6116        assigncolor $id
6117        drawcmittext $id $row $col
6118        set iddrawn($id) 1
6119        incr nrows_drawn
6120    }
6121    if {$markingmatches} {
6122        markrowmatches $row $id
6123    }
6124}
6125
6126proc drawcommits {row {endrow {}}} {
6127    global numcommits iddrawn displayorder curview need_redisplay
6128    global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
6129
6130    if {$row < 0} {
6131        set row 0
6132    }
6133    if {$endrow eq {}} {
6134        set endrow $row
6135    }
6136    if {$endrow >= $numcommits} {
6137        set endrow [expr {$numcommits - 1}]
6138    }
6139
6140    set rl1 [expr {$row - $downarrowlen - 3}]
6141    if {$rl1 < 0} {
6142        set rl1 0
6143    }
6144    set ro1 [expr {$row - 3}]
6145    if {$ro1 < 0} {
6146        set ro1 0
6147    }
6148    set r2 [expr {$endrow + $uparrowlen + 3}]
6149    if {$r2 > $numcommits} {
6150        set r2 $numcommits
6151    }
6152    for {set r $rl1} {$r < $r2} {incr r} {
6153        if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
6154            if {$rl1 < $r} {
6155                layoutrows $rl1 $r
6156            }
6157            set rl1 [expr {$r + 1}]
6158        }
6159    }
6160    if {$rl1 < $r} {
6161        layoutrows $rl1 $r
6162    }
6163    optimize_rows $ro1 0 $r2
6164    if {$need_redisplay || $nrows_drawn > 2000} {
6165        clear_display
6166    }
6167
6168    # make the lines join to already-drawn rows either side
6169    set r [expr {$row - 1}]
6170    if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
6171        set r $row
6172    }
6173    set er [expr {$endrow + 1}]
6174    if {$er >= $numcommits ||
6175        ![info exists iddrawn([lindex $displayorder $er])]} {
6176        set er $endrow
6177    }
6178    for {} {$r <= $er} {incr r} {
6179        set id [lindex $displayorder $r]
6180        set wasdrawn [info exists iddrawn($id)]
6181        drawcmitrow $r
6182        if {$r == $er} break
6183        set nextid [lindex $displayorder [expr {$r + 1}]]
6184        if {$wasdrawn && [info exists iddrawn($nextid)]} continue
6185        drawparentlinks $id $r
6186
6187        set rowids [lindex $rowidlist $r]
6188        foreach lid $rowids {
6189            if {$lid eq {}} continue
6190            if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
6191            if {$lid eq $id} {
6192                # see if this is the first child of any of its parents
6193                foreach p [lindex $parentlist $r] {
6194                    if {[lsearch -exact $rowids $p] < 0} {
6195                        # make this line extend up to the child
6196                        set lineend($p) [drawlineseg $p $r $er 0]
6197                    }
6198                }
6199            } else {
6200                set lineend($lid) [drawlineseg $lid $r $er 1]
6201            }
6202        }
6203    }
6204}
6205
6206proc undolayout {row} {
6207    global uparrowlen mingaplen downarrowlen
6208    global rowidlist rowisopt rowfinal need_redisplay
6209
6210    set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
6211    if {$r < 0} {
6212        set r 0
6213    }
6214    if {[llength $rowidlist] > $r} {
6215        incr r -1
6216        set rowidlist [lrange $rowidlist 0 $r]
6217        set rowfinal [lrange $rowfinal 0 $r]
6218        set rowisopt [lrange $rowisopt 0 $r]
6219        set need_redisplay 1
6220        run drawvisible
6221    }
6222}
6223
6224proc drawvisible {} {
6225    global canv linespc curview vrowmod selectedline targetrow targetid
6226    global need_redisplay cscroll numcommits
6227
6228    set fs [$canv yview]
6229    set ymax [lindex [$canv cget -scrollregion] 3]
6230    if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
6231    set f0 [lindex $fs 0]
6232    set f1 [lindex $fs 1]
6233    set y0 [expr {int($f0 * $ymax)}]
6234    set y1 [expr {int($f1 * $ymax)}]
6235
6236    if {[info exists targetid]} {
6237        if {[commitinview $targetid $curview]} {
6238            set r [rowofcommit $targetid]
6239            if {$r != $targetrow} {
6240                # Fix up the scrollregion and change the scrolling position
6241                # now that our target row has moved.
6242                set diff [expr {($r - $targetrow) * $linespc}]
6243                set targetrow $r
6244                setcanvscroll
6245                set ymax [lindex [$canv cget -scrollregion] 3]
6246                incr y0 $diff
6247                incr y1 $diff
6248                set f0 [expr {$y0 / $ymax}]
6249                set f1 [expr {$y1 / $ymax}]
6250                allcanvs yview moveto $f0
6251                $cscroll set $f0 $f1
6252                set need_redisplay 1
6253            }
6254        } else {
6255            unset targetid
6256        }
6257    }
6258
6259    set row [expr {int(($y0 - 3) / $linespc) - 1}]
6260    set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
6261    if {$endrow >= $vrowmod($curview)} {
6262        update_arcrows $curview
6263    }
6264    if {$selectedline ne {} &&
6265        $row <= $selectedline && $selectedline <= $endrow} {
6266        set targetrow $selectedline
6267    } elseif {[info exists targetid]} {
6268        set targetrow [expr {int(($row + $endrow) / 2)}]
6269    }
6270    if {[info exists targetrow]} {
6271        if {$targetrow >= $numcommits} {
6272            set targetrow [expr {$numcommits - 1}]
6273        }
6274        set targetid [commitonrow $targetrow]
6275    }
6276    drawcommits $row $endrow
6277}
6278
6279proc clear_display {} {
6280    global iddrawn linesegs need_redisplay nrows_drawn
6281    global vhighlights fhighlights nhighlights rhighlights
6282    global linehtag linentag linedtag boldids boldnameids
6283
6284    allcanvs delete all
6285    catch {unset iddrawn}
6286    catch {unset linesegs}
6287    catch {unset linehtag}
6288    catch {unset linentag}
6289    catch {unset linedtag}
6290    set boldids {}
6291    set boldnameids {}
6292    catch {unset vhighlights}
6293    catch {unset fhighlights}
6294    catch {unset nhighlights}
6295    catch {unset rhighlights}
6296    set need_redisplay 0
6297    set nrows_drawn 0
6298}
6299
6300proc findcrossings {id} {
6301    global rowidlist parentlist numcommits displayorder
6302
6303    set cross {}
6304    set ccross {}
6305    foreach {s e} [rowranges $id] {
6306        if {$e >= $numcommits} {
6307            set e [expr {$numcommits - 1}]
6308        }
6309        if {$e <= $s} continue
6310        for {set row $e} {[incr row -1] >= $s} {} {
6311            set x [lsearch -exact [lindex $rowidlist $row] $id]
6312            if {$x < 0} break
6313            set olds [lindex $parentlist $row]
6314            set kid [lindex $displayorder $row]
6315            set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
6316            if {$kidx < 0} continue
6317            set nextrow [lindex $rowidlist [expr {$row + 1}]]
6318            foreach p $olds {
6319                set px [lsearch -exact $nextrow $p]
6320                if {$px < 0} continue
6321                if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
6322                    if {[lsearch -exact $ccross $p] >= 0} continue
6323                    if {$x == $px + ($kidx < $px? -1: 1)} {
6324                        lappend ccross $p
6325                    } elseif {[lsearch -exact $cross $p] < 0} {
6326                        lappend cross $p
6327                    }
6328                }
6329            }
6330        }
6331    }
6332    return [concat $ccross {{}} $cross]
6333}
6334
6335proc assigncolor {id} {
6336    global colormap colors nextcolor
6337    global parents children children curview
6338
6339    if {[info exists colormap($id)]} return
6340    set ncolors [llength $colors]
6341    if {[info exists children($curview,$id)]} {
6342        set kids $children($curview,$id)
6343    } else {
6344        set kids {}
6345    }
6346    if {[llength $kids] == 1} {
6347        set child [lindex $kids 0]
6348        if {[info exists colormap($child)]
6349            && [llength $parents($curview,$child)] == 1} {
6350            set colormap($id) $colormap($child)
6351            return
6352        }
6353    }
6354    set badcolors {}
6355    set origbad {}
6356    foreach x [findcrossings $id] {
6357        if {$x eq {}} {
6358            # delimiter between corner crossings and other crossings
6359            if {[llength $badcolors] >= $ncolors - 1} break
6360            set origbad $badcolors
6361        }
6362        if {[info exists colormap($x)]
6363            && [lsearch -exact $badcolors $colormap($x)] < 0} {
6364            lappend badcolors $colormap($x)
6365        }
6366    }
6367    if {[llength $badcolors] >= $ncolors} {
6368        set badcolors $origbad
6369    }
6370    set origbad $badcolors
6371    if {[llength $badcolors] < $ncolors - 1} {
6372        foreach child $kids {
6373            if {[info exists colormap($child)]
6374                && [lsearch -exact $badcolors $colormap($child)] < 0} {
6375                lappend badcolors $colormap($child)
6376            }
6377            foreach p $parents($curview,$child) {
6378                if {[info exists colormap($p)]
6379                    && [lsearch -exact $badcolors $colormap($p)] < 0} {
6380                    lappend badcolors $colormap($p)
6381                }
6382            }
6383        }
6384        if {[llength $badcolors] >= $ncolors} {
6385            set badcolors $origbad
6386        }
6387    }
6388    for {set i 0} {$i <= $ncolors} {incr i} {
6389        set c [lindex $colors $nextcolor]
6390        if {[incr nextcolor] >= $ncolors} {
6391            set nextcolor 0
6392        }
6393        if {[lsearch -exact $badcolors $c]} break
6394    }
6395    set colormap($id) $c
6396}
6397
6398proc bindline {t id} {
6399    global canv
6400
6401    $canv bind $t <Enter> "lineenter %x %y $id"
6402    $canv bind $t <Motion> "linemotion %x %y $id"
6403    $canv bind $t <Leave> "lineleave $id"
6404    $canv bind $t <Button-1> "lineclick %x %y $id 1"
6405}
6406
6407proc graph_pane_width {} {
6408    global use_ttk
6409
6410    if {$use_ttk} {
6411        set g [.tf.histframe.pwclist sashpos 0]
6412    } else {
6413        set g [.tf.histframe.pwclist sash coord 0]
6414    }
6415    return [lindex $g 0]
6416}
6417
6418proc totalwidth {l font extra} {
6419    set tot 0
6420    foreach str $l {
6421        set tot [expr {$tot + [font measure $font $str] + $extra}]
6422    }
6423    return $tot
6424}
6425
6426proc drawtags {id x xt y1} {
6427    global idtags idheads idotherrefs mainhead
6428    global linespc lthickness
6429    global canv rowtextx curview fgcolor bgcolor ctxbut
6430    global headbgcolor headfgcolor headoutlinecolor remotebgcolor
6431    global tagbgcolor tagfgcolor tagoutlinecolor
6432    global reflinecolor
6433
6434    set marks {}
6435    set ntags 0
6436    set nheads 0
6437    set singletag 0
6438    set maxtags 3
6439    set maxtagpct 25
6440    set maxwidth [expr {[graph_pane_width] * $maxtagpct / 100}]
6441    set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6442    set extra [expr {$delta + $lthickness + $linespc}]
6443
6444    if {[info exists idtags($id)]} {
6445        set marks $idtags($id)
6446        set ntags [llength $marks]
6447        if {$ntags > $maxtags ||
6448            [totalwidth $marks mainfont $extra] > $maxwidth} {
6449            # show just a single "n tags..." tag
6450            set singletag 1
6451            if {$ntags == 1} {
6452                set marks [list "tag..."]
6453            } else {
6454                set marks [list [format "%d tags..." $ntags]]
6455            }
6456            set ntags 1
6457        }
6458    }
6459    if {[info exists idheads($id)]} {
6460        set marks [concat $marks $idheads($id)]
6461        set nheads [llength $idheads($id)]
6462    }
6463    if {[info exists idotherrefs($id)]} {
6464        set marks [concat $marks $idotherrefs($id)]
6465    }
6466    if {$marks eq {}} {
6467        return $xt
6468    }
6469
6470    set yt [expr {$y1 - 0.5 * $linespc}]
6471    set yb [expr {$yt + $linespc - 1}]
6472    set xvals {}
6473    set wvals {}
6474    set i -1
6475    foreach tag $marks {
6476        incr i
6477        if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
6478            set wid [font measure mainfontbold $tag]
6479        } else {
6480            set wid [font measure mainfont $tag]
6481        }
6482        lappend xvals $xt
6483        lappend wvals $wid
6484        set xt [expr {$xt + $wid + $extra}]
6485    }
6486    set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
6487               -width $lthickness -fill $reflinecolor -tags tag.$id]
6488    $canv lower $t
6489    foreach tag $marks x $xvals wid $wvals {
6490        set tag_quoted [string map {% %%} $tag]
6491        set xl [expr {$x + $delta}]
6492        set xr [expr {$x + $delta + $wid + $lthickness}]
6493        set font mainfont
6494        if {[incr ntags -1] >= 0} {
6495            # draw a tag
6496            set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6497                       $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
6498                       -width 1 -outline $tagoutlinecolor -fill $tagbgcolor \
6499                       -tags tag.$id]
6500            if {$singletag} {
6501                set tagclick [list showtags $id 1]
6502            } else {
6503                set tagclick [list showtag $tag_quoted 1]
6504            }
6505            $canv bind $t <1> $tagclick
6506            set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
6507        } else {
6508            # draw a head or other ref
6509            if {[incr nheads -1] >= 0} {
6510                set col $headbgcolor
6511                if {$tag eq $mainhead} {
6512                    set font mainfontbold
6513                }
6514            } else {
6515                set col "#ddddff"
6516            }
6517            set xl [expr {$xl - $delta/2}]
6518            $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
6519                -width 1 -outline black -fill $col -tags tag.$id
6520            if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
6521                set rwid [font measure mainfont $remoteprefix]
6522                set xi [expr {$x + 1}]
6523                set yti [expr {$yt + 1}]
6524                set xri [expr {$x + $rwid}]
6525                $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6526                        -width 0 -fill $remotebgcolor -tags tag.$id
6527            }
6528        }
6529        set t [$canv create text $xl $y1 -anchor w -text $tag -fill $headfgcolor \
6530                   -font $font -tags [list tag.$id text]]
6531        if {$ntags >= 0} {
6532            $canv bind $t <1> $tagclick
6533        } elseif {$nheads >= 0} {
6534            $canv bind $t $ctxbut [list headmenu %X %Y $id $tag_quoted]
6535        }
6536    }
6537    return $xt
6538}
6539
6540proc drawnotesign {xt y} {
6541    global linespc canv fgcolor
6542
6543    set orad [expr {$linespc / 3}]
6544    set t [$canv create rectangle [expr {$xt - $orad}] [expr {$y - $orad}] \
6545               [expr {$xt + $orad - 1}] [expr {$y + $orad - 1}] \
6546               -fill yellow -outline $fgcolor -width 1 -tags circle]
6547    set xt [expr {$xt + $orad * 3}]
6548    return $xt
6549}
6550
6551proc xcoord {i level ln} {
6552    global canvx0 xspc1 xspc2
6553
6554    set x [expr {$canvx0 + $i * $xspc1($ln)}]
6555    if {$i > 0 && $i == $level} {
6556        set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6557    } elseif {$i > $level} {
6558        set x [expr {$x + $xspc2 - $xspc1($ln)}]
6559    }
6560    return $x
6561}
6562
6563proc show_status {msg} {
6564    global canv fgcolor
6565
6566    clear_display
6567    $canv create text 3 3 -anchor nw -text $msg -font mainfont \
6568        -tags text -fill $fgcolor
6569}
6570
6571# Don't change the text pane cursor if it is currently the hand cursor,
6572# showing that we are over a sha1 ID link.
6573proc settextcursor {c} {
6574    global ctext curtextcursor
6575
6576    if {[$ctext cget -cursor] == $curtextcursor} {
6577        $ctext config -cursor $c
6578    }
6579    set curtextcursor $c
6580}
6581
6582proc nowbusy {what {name {}}} {
6583    global isbusy busyname statusw
6584
6585    if {[array names isbusy] eq {}} {
6586        . config -cursor watch
6587        settextcursor watch
6588    }
6589    set isbusy($what) 1
6590    set busyname($what) $name
6591    if {$name ne {}} {
6592        $statusw conf -text $name
6593    }
6594}
6595
6596proc notbusy {what} {
6597    global isbusy maincursor textcursor busyname statusw
6598
6599    catch {
6600        unset isbusy($what)
6601        if {$busyname($what) ne {} &&
6602            [$statusw cget -text] eq $busyname($what)} {
6603            $statusw conf -text {}
6604        }
6605    }
6606    if {[array names isbusy] eq {}} {
6607        . config -cursor $maincursor
6608        settextcursor $textcursor
6609    }
6610}
6611
6612proc findmatches {f} {
6613    global findtype findstring
6614    if {$findtype == [mc "Regexp"]} {
6615        set matches [regexp -indices -all -inline $findstring $f]
6616    } else {
6617        set fs $findstring
6618        if {$findtype == [mc "IgnCase"]} {
6619            set f [string tolower $f]
6620            set fs [string tolower $fs]
6621        }
6622        set matches {}
6623        set i 0
6624        set l [string length $fs]
6625        while {[set j [string first $fs $f $i]] >= 0} {
6626            lappend matches [list $j [expr {$j+$l-1}]]
6627            set i [expr {$j + $l}]
6628        }
6629    }
6630    return $matches
6631}
6632
6633proc dofind {{dirn 1} {wrap 1}} {
6634    global findstring findstartline findcurline selectedline numcommits
6635    global gdttype filehighlight fh_serial find_dirn findallowwrap
6636
6637    if {[info exists find_dirn]} {
6638        if {$find_dirn == $dirn} return
6639        stopfinding
6640    }
6641    focus .
6642    if {$findstring eq {} || $numcommits == 0} return
6643    if {$selectedline eq {}} {
6644        set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6645    } else {
6646        set findstartline $selectedline
6647    }
6648    set findcurline $findstartline
6649    nowbusy finding [mc "Searching"]
6650    if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6651        after cancel do_file_hl $fh_serial
6652        do_file_hl $fh_serial
6653    }
6654    set find_dirn $dirn
6655    set findallowwrap $wrap
6656    run findmore
6657}
6658
6659proc stopfinding {} {
6660    global find_dirn findcurline fprogcoord
6661
6662    if {[info exists find_dirn]} {
6663        unset find_dirn
6664        unset findcurline
6665        notbusy finding
6666        set fprogcoord 0
6667        adjustprogress
6668    }
6669    stopblaming
6670}
6671
6672proc findmore {} {
6673    global commitdata commitinfo numcommits findpattern findloc
6674    global findstartline findcurline findallowwrap
6675    global find_dirn gdttype fhighlights fprogcoord
6676    global curview varcorder vrownum varccommits vrowmod
6677
6678    if {![info exists find_dirn]} {
6679        return 0
6680    }
6681    set fldtypes [list [mc "Headline"] [mc "Author"] "" [mc "Committer"] "" [mc "Comments"]]
6682    set l $findcurline
6683    set moretodo 0
6684    if {$find_dirn > 0} {
6685        incr l
6686        if {$l >= $numcommits} {
6687            set l 0
6688        }
6689        if {$l <= $findstartline} {
6690            set lim [expr {$findstartline + 1}]
6691        } else {
6692            set lim $numcommits
6693            set moretodo $findallowwrap
6694        }
6695    } else {
6696        if {$l == 0} {
6697            set l $numcommits
6698        }
6699        incr l -1
6700        if {$l >= $findstartline} {
6701            set lim [expr {$findstartline - 1}]
6702        } else {
6703            set lim -1
6704            set moretodo $findallowwrap
6705        }
6706    }
6707    set n [expr {($lim - $l) * $find_dirn}]
6708    if {$n > 500} {
6709        set n 500
6710        set moretodo 1
6711    }
6712    if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6713        update_arcrows $curview
6714    }
6715    set found 0
6716    set domore 1
6717    set ai [bsearch $vrownum($curview) $l]
6718    set a [lindex $varcorder($curview) $ai]
6719    set arow [lindex $vrownum($curview) $ai]
6720    set ids [lindex $varccommits($curview,$a)]
6721    set arowend [expr {$arow + [llength $ids]}]
6722    if {$gdttype eq [mc "containing:"]} {
6723        for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6724            if {$l < $arow || $l >= $arowend} {
6725                incr ai $find_dirn
6726                set a [lindex $varcorder($curview) $ai]
6727                set arow [lindex $vrownum($curview) $ai]
6728                set ids [lindex $varccommits($curview,$a)]
6729                set arowend [expr {$arow + [llength $ids]}]
6730            }
6731            set id [lindex $ids [expr {$l - $arow}]]
6732            # shouldn't happen unless git log doesn't give all the commits...
6733            if {![info exists commitdata($id)] ||
6734                ![doesmatch $commitdata($id)]} {
6735                continue
6736            }
6737            if {![info exists commitinfo($id)]} {
6738                getcommit $id
6739            }
6740            set info $commitinfo($id)
6741            foreach f $info ty $fldtypes {
6742                if {$ty eq ""} continue
6743                if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6744                    [doesmatch $f]} {
6745                    set found 1
6746                    break
6747                }
6748            }
6749            if {$found} break
6750        }
6751    } else {
6752        for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6753            if {$l < $arow || $l >= $arowend} {
6754                incr ai $find_dirn
6755                set a [lindex $varcorder($curview) $ai]
6756                set arow [lindex $vrownum($curview) $ai]
6757                set ids [lindex $varccommits($curview,$a)]
6758                set arowend [expr {$arow + [llength $ids]}]
6759            }
6760            set id [lindex $ids [expr {$l - $arow}]]
6761            if {![info exists fhighlights($id)]} {
6762                # this sets fhighlights($id) to -1
6763                askfilehighlight $l $id
6764            }
6765            if {$fhighlights($id) > 0} {
6766                set found $domore
6767                break
6768            }
6769            if {$fhighlights($id) < 0} {
6770                if {$domore} {
6771                    set domore 0
6772                    set findcurline [expr {$l - $find_dirn}]
6773                }
6774            }
6775        }
6776    }
6777    if {$found || ($domore && !$moretodo)} {
6778        unset findcurline
6779        unset find_dirn
6780        notbusy finding
6781        set fprogcoord 0
6782        adjustprogress
6783        if {$found} {
6784            findselectline $l
6785        } else {
6786            bell
6787        }
6788        return 0
6789    }
6790    if {!$domore} {
6791        flushhighlights
6792    } else {
6793        set findcurline [expr {$l - $find_dirn}]
6794    }
6795    set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6796    if {$n < 0} {
6797        incr n $numcommits
6798    }
6799    set fprogcoord [expr {$n * 1.0 / $numcommits}]
6800    adjustprogress
6801    return $domore
6802}
6803
6804proc findselectline {l} {
6805    global findloc commentend ctext findcurline markingmatches gdttype
6806
6807    set markingmatches [expr {$gdttype eq [mc "containing:"]}]
6808    set findcurline $l
6809    selectline $l 1
6810    if {$markingmatches &&
6811        ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
6812        # highlight the matches in the comments
6813        set f [$ctext get 1.0 $commentend]
6814        set matches [findmatches $f]
6815        foreach match $matches {
6816            set start [lindex $match 0]
6817            set end [expr {[lindex $match 1] + 1}]
6818            $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6819        }
6820    }
6821    drawvisible
6822}
6823
6824# mark the bits of a headline or author that match a find string
6825proc markmatches {canv l str tag matches font row} {
6826    global selectedline
6827
6828    set bbox [$canv bbox $tag]
6829    set x0 [lindex $bbox 0]
6830    set y0 [lindex $bbox 1]
6831    set y1 [lindex $bbox 3]
6832    foreach match $matches {
6833        set start [lindex $match 0]
6834        set end [lindex $match 1]
6835        if {$start > $end} continue
6836        set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6837        set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6838        set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6839                   [expr {$x0+$xlen+2}] $y1 \
6840                   -outline {} -tags [list match$l matches] -fill yellow]
6841        $canv lower $t
6842        if {$row == $selectedline} {
6843            $canv raise $t secsel
6844        }
6845    }
6846}
6847
6848proc unmarkmatches {} {
6849    global markingmatches
6850
6851    allcanvs delete matches
6852    set markingmatches 0
6853    stopfinding
6854}
6855
6856proc selcanvline {w x y} {
6857    global canv canvy0 ctext linespc
6858    global rowtextx
6859    set ymax [lindex [$canv cget -scrollregion] 3]
6860    if {$ymax == {}} return
6861    set yfrac [lindex [$canv yview] 0]
6862    set y [expr {$y + $yfrac * $ymax}]
6863    set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6864    if {$l < 0} {
6865        set l 0
6866    }
6867    if {$w eq $canv} {
6868        set xmax [lindex [$canv cget -scrollregion] 2]
6869        set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6870        if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
6871    }
6872    unmarkmatches
6873    selectline $l 1
6874}
6875
6876proc commit_descriptor {p} {
6877    global commitinfo
6878    if {![info exists commitinfo($p)]} {
6879        getcommit $p
6880    }
6881    set l "..."
6882    if {[llength $commitinfo($p)] > 1} {
6883        set l [lindex $commitinfo($p) 0]
6884    }
6885    return "$p ($l)\n"
6886}
6887
6888# append some text to the ctext widget, and make any SHA1 ID
6889# that we know about be a clickable link.
6890proc appendwithlinks {text tags} {
6891    global ctext linknum curview
6892
6893    set start [$ctext index "end - 1c"]
6894    $ctext insert end $text $tags
6895    set links [regexp -indices -all -inline {(?:\m|-g)[0-9a-f]{6,40}\M} $text]
6896    foreach l $links {
6897        set s [lindex $l 0]
6898        set e [lindex $l 1]
6899        set linkid [string range $text $s $e]
6900        incr e
6901        $ctext tag delete link$linknum
6902        $ctext tag add link$linknum "$start + $s c" "$start + $e c"
6903        setlink $linkid link$linknum
6904        incr linknum
6905    }
6906}
6907
6908proc setlink {id lk} {
6909    global curview ctext pendinglinks
6910    global linkfgcolor
6911
6912    if {[string range $id 0 1] eq "-g"} {
6913      set id [string range $id 2 end]
6914    }
6915
6916    set known 0
6917    if {[string length $id] < 40} {
6918        set matches [longid $id]
6919        if {[llength $matches] > 0} {
6920            if {[llength $matches] > 1} return
6921            set known 1
6922            set id [lindex $matches 0]
6923        }
6924    } else {
6925        set known [commitinview $id $curview]
6926    }
6927    if {$known} {
6928        $ctext tag conf $lk -foreground $linkfgcolor -underline 1
6929        $ctext tag bind $lk <1> [list selbyid $id]
6930        $ctext tag bind $lk <Enter> {linkcursor %W 1}
6931        $ctext tag bind $lk <Leave> {linkcursor %W -1}
6932    } else {
6933        lappend pendinglinks($id) $lk
6934        interestedin $id {makelink %P}
6935    }
6936}
6937
6938proc appendshortlink {id {pre {}} {post {}}} {
6939    global ctext linknum
6940
6941    $ctext insert end $pre
6942    $ctext tag delete link$linknum
6943    $ctext insert end [string range $id 0 7] link$linknum
6944    $ctext insert end $post
6945    setlink $id link$linknum
6946    incr linknum
6947}
6948
6949proc makelink {id} {
6950    global pendinglinks
6951
6952    if {![info exists pendinglinks($id)]} return
6953    foreach lk $pendinglinks($id) {
6954        setlink $id $lk
6955    }
6956    unset pendinglinks($id)
6957}
6958
6959proc linkcursor {w inc} {
6960    global linkentercount curtextcursor
6961
6962    if {[incr linkentercount $inc] > 0} {
6963        $w configure -cursor hand2
6964    } else {
6965        $w configure -cursor $curtextcursor
6966        if {$linkentercount < 0} {
6967            set linkentercount 0
6968        }
6969    }
6970}
6971
6972proc viewnextline {dir} {
6973    global canv linespc
6974
6975    $canv delete hover
6976    set ymax [lindex [$canv cget -scrollregion] 3]
6977    set wnow [$canv yview]
6978    set wtop [expr {[lindex $wnow 0] * $ymax}]
6979    set newtop [expr {$wtop + $dir * $linespc}]
6980    if {$newtop < 0} {
6981        set newtop 0
6982    } elseif {$newtop > $ymax} {
6983        set newtop $ymax
6984    }
6985    allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6986}
6987
6988# add a list of tag or branch names at position pos
6989# returns the number of names inserted
6990proc appendrefs {pos ids var} {
6991    global ctext linknum curview $var maxrefs visiblerefs mainheadid
6992
6993    if {[catch {$ctext index $pos}]} {
6994        return 0
6995    }
6996    $ctext conf -state normal
6997    $ctext delete $pos "$pos lineend"
6998    set tags {}
6999    foreach id $ids {
7000        foreach tag [set $var\($id\)] {
7001            lappend tags [list $tag $id]
7002        }
7003    }
7004
7005    set sep {}
7006    set tags [lsort -index 0 -decreasing $tags]
7007    set nutags 0
7008
7009    if {[llength $tags] > $maxrefs} {
7010        # If we are displaying heads, and there are too many,
7011        # see if there are some important heads to display.
7012        # Currently that are the current head and heads listed in $visiblerefs option
7013        set itags {}
7014        if {$var eq "idheads"} {
7015            set utags {}
7016            foreach ti $tags {
7017                set hname [lindex $ti 0]
7018                set id [lindex $ti 1]
7019                if {([lsearch -exact $visiblerefs $hname] != -1 || $id eq $mainheadid) &&
7020                    [llength $itags] < $maxrefs} {
7021                    lappend itags $ti
7022                } else {
7023                    lappend utags $ti
7024                }
7025            }
7026            set tags $utags
7027        }
7028        if {$itags ne {}} {
7029            set str [mc "and many more"]
7030            set sep " "
7031        } else {
7032            set str [mc "many"]
7033        }
7034        $ctext insert $pos "$str ([llength $tags])"
7035        set nutags [llength $tags]
7036        set tags $itags
7037    }
7038
7039    foreach ti $tags {
7040        set id [lindex $ti 1]
7041        set lk link$linknum
7042        incr linknum
7043        $ctext tag delete $lk
7044        $ctext insert $pos $sep
7045        $ctext insert $pos [lindex $ti 0] $lk
7046        setlink $id $lk
7047        set sep ", "
7048    }
7049    $ctext tag add wwrap "$pos linestart" "$pos lineend"
7050    $ctext conf -state disabled
7051    return [expr {[llength $tags] + $nutags}]
7052}
7053
7054# called when we have finished computing the nearby tags
7055proc dispneartags {delay} {
7056    global selectedline currentid showneartags tagphase
7057
7058    if {$selectedline eq {} || !$showneartags} return
7059    after cancel dispnexttag
7060    if {$delay} {
7061        after 200 dispnexttag
7062        set tagphase -1
7063    } else {
7064        after idle dispnexttag
7065        set tagphase 0
7066    }
7067}
7068
7069proc dispnexttag {} {
7070    global selectedline currentid showneartags tagphase ctext
7071
7072    if {$selectedline eq {} || !$showneartags} return
7073    switch -- $tagphase {
7074        0 {
7075            set dtags [desctags $currentid]
7076            if {$dtags ne {}} {
7077                appendrefs precedes $dtags idtags
7078            }
7079        }
7080        1 {
7081            set atags [anctags $currentid]
7082            if {$atags ne {}} {
7083                appendrefs follows $atags idtags
7084            }
7085        }
7086        2 {
7087            set dheads [descheads $currentid]
7088            if {$dheads ne {}} {
7089                if {[appendrefs branch $dheads idheads] > 1
7090                    && [$ctext get "branch -3c"] eq "h"} {
7091                    # turn "Branch" into "Branches"
7092                    $ctext conf -state normal
7093                    $ctext insert "branch -2c" "es"
7094                    $ctext conf -state disabled
7095                }
7096            }
7097        }
7098    }
7099    if {[incr tagphase] <= 2} {
7100        after idle dispnexttag
7101    }
7102}
7103
7104proc make_secsel {id} {
7105    global linehtag linentag linedtag canv canv2 canv3
7106
7107    if {![info exists linehtag($id)]} return
7108    $canv delete secsel
7109    set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
7110               -tags secsel -fill [$canv cget -selectbackground]]
7111    $canv lower $t
7112    $canv2 delete secsel
7113    set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
7114               -tags secsel -fill [$canv2 cget -selectbackground]]
7115    $canv2 lower $t
7116    $canv3 delete secsel
7117    set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
7118               -tags secsel -fill [$canv3 cget -selectbackground]]
7119    $canv3 lower $t
7120}
7121
7122proc make_idmark {id} {
7123    global linehtag canv fgcolor
7124
7125    if {![info exists linehtag($id)]} return
7126    $canv delete markid
7127    set t [eval $canv create rect [$canv bbox $linehtag($id)] \
7128               -tags markid -outline $fgcolor]
7129    $canv raise $t
7130}
7131
7132proc selectline {l isnew {desired_loc {}} {switch_to_patch 0}} {
7133    global canv ctext commitinfo selectedline
7134    global canvy0 linespc parents children curview
7135    global currentid sha1entry
7136    global commentend idtags linknum
7137    global mergemax numcommits pending_select
7138    global cmitmode showneartags allcommits
7139    global targetrow targetid lastscrollrows
7140    global autoselect autosellen jump_to_here
7141    global vinlinediff
7142
7143    catch {unset pending_select}
7144    $canv delete hover
7145    normalline
7146    unsel_reflist
7147    stopfinding
7148    if {$l < 0 || $l >= $numcommits} return
7149    set id [commitonrow $l]
7150    set targetid $id
7151    set targetrow $l
7152    set selectedline $l
7153    set currentid $id
7154    if {$lastscrollrows < $numcommits} {
7155        setcanvscroll
7156    }
7157
7158    if {$cmitmode ne "patch" && $switch_to_patch} {
7159        set cmitmode "patch"
7160    }
7161
7162    set y [expr {$canvy0 + $l * $linespc}]
7163    set ymax [lindex [$canv cget -scrollregion] 3]
7164    set ytop [expr {$y - $linespc - 1}]
7165    set ybot [expr {$y + $linespc + 1}]
7166    set wnow [$canv yview]
7167    set wtop [expr {[lindex $wnow 0] * $ymax}]
7168    set wbot [expr {[lindex $wnow 1] * $ymax}]
7169    set wh [expr {$wbot - $wtop}]
7170    set newtop $wtop
7171    if {$ytop < $wtop} {
7172        if {$ybot < $wtop} {
7173            set newtop [expr {$y - $wh / 2.0}]
7174        } else {
7175            set newtop $ytop
7176            if {$newtop > $wtop - $linespc} {
7177                set newtop [expr {$wtop - $linespc}]
7178            }
7179        }
7180    } elseif {$ybot > $wbot} {
7181        if {$ytop > $wbot} {
7182            set newtop [expr {$y - $wh / 2.0}]
7183        } else {
7184            set newtop [expr {$ybot - $wh}]
7185            if {$newtop < $wtop + $linespc} {
7186                set newtop [expr {$wtop + $linespc}]
7187            }
7188        }
7189    }
7190    if {$newtop != $wtop} {
7191        if {$newtop < 0} {
7192            set newtop 0
7193        }
7194        allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7195        drawvisible
7196    }
7197
7198    make_secsel $id
7199
7200    if {$isnew} {
7201        addtohistory [list selbyid $id 0] savecmitpos
7202    }
7203
7204    $sha1entry delete 0 end
7205    $sha1entry insert 0 $id
7206    if {$autoselect} {
7207        $sha1entry selection range 0 $autosellen
7208    }
7209    rhighlight_sel $id
7210
7211    $ctext conf -state normal
7212    clear_ctext
7213    set linknum 0
7214    if {![info exists commitinfo($id)]} {
7215        getcommit $id
7216    }
7217    set info $commitinfo($id)
7218    set date [formatdate [lindex $info 2]]
7219    $ctext insert end "[mc "Author"]: [lindex $info 1]  $date\n"
7220    set date [formatdate [lindex $info 4]]
7221    $ctext insert end "[mc "Committer"]: [lindex $info 3]  $date\n"
7222    if {[info exists idtags($id)]} {
7223        $ctext insert end [mc "Tags:"]
7224        foreach tag $idtags($id) {
7225            $ctext insert end " $tag"
7226        }
7227        $ctext insert end "\n"
7228    }
7229
7230    set headers {}
7231    set olds $parents($curview,$id)
7232    if {[llength $olds] > 1} {
7233        set np 0
7234        foreach p $olds {
7235            if {$np >= $mergemax} {
7236                set tag mmax
7237            } else {
7238                set tag m$np
7239            }
7240            $ctext insert end "[mc "Parent"]: " $tag
7241            appendwithlinks [commit_descriptor $p] {}
7242            incr np
7243        }
7244    } else {
7245        foreach p $olds {
7246            append headers "[mc "Parent"]: [commit_descriptor $p]"
7247        }
7248    }
7249
7250    foreach c $children($curview,$id) {
7251        append headers "[mc "Child"]:  [commit_descriptor $c]"
7252    }
7253
7254    # make anything that looks like a SHA1 ID be a clickable link
7255    appendwithlinks $headers {}
7256    if {$showneartags} {
7257        if {![info exists allcommits]} {
7258            getallcommits
7259        }
7260        $ctext insert end "[mc "Branch"]: "
7261        $ctext mark set branch "end -1c"
7262        $ctext mark gravity branch left
7263        $ctext insert end "\n[mc "Follows"]: "
7264        $ctext mark set follows "end -1c"
7265        $ctext mark gravity follows left
7266        $ctext insert end "\n[mc "Precedes"]: "
7267        $ctext mark set precedes "end -1c"
7268        $ctext mark gravity precedes left
7269        $ctext insert end "\n"
7270        dispneartags 1
7271    }
7272    $ctext insert end "\n"
7273    set comment [lindex $info 5]
7274    if {[string first "\r" $comment] >= 0} {
7275        set comment [string map {"\r" "\n    "} $comment]
7276    }
7277    appendwithlinks $comment {comment}
7278
7279    $ctext tag remove found 1.0 end
7280    $ctext conf -state disabled
7281    set commentend [$ctext index "end - 1c"]
7282
7283    set jump_to_here $desired_loc
7284    init_flist [mc "Comments"]
7285    if {$cmitmode eq "tree"} {
7286        gettree $id
7287    } elseif {$vinlinediff($curview) == 1} {
7288        showinlinediff $id
7289    } elseif {[llength $olds] <= 1} {
7290        startdiff $id
7291    } else {
7292        mergediff $id
7293    }
7294}
7295
7296proc selfirstline {} {
7297    unmarkmatches
7298    selectline 0 1
7299}
7300
7301proc sellastline {} {
7302    global numcommits
7303    unmarkmatches
7304    set l [expr {$numcommits - 1}]
7305    selectline $l 1
7306}
7307
7308proc selnextline {dir} {
7309    global selectedline
7310    focus .
7311    if {$selectedline eq {}} return
7312    set l [expr {$selectedline + $dir}]
7313    unmarkmatches
7314    selectline $l 1
7315}
7316
7317proc selnextpage {dir} {
7318    global canv linespc selectedline numcommits
7319
7320    set lpp [expr {([winfo height $canv] - 2) / $linespc}]
7321    if {$lpp < 1} {
7322        set lpp 1
7323    }
7324    allcanvs yview scroll [expr {$dir * $lpp}] units
7325    drawvisible
7326    if {$selectedline eq {}} return
7327    set l [expr {$selectedline + $dir * $lpp}]
7328    if {$l < 0} {
7329        set l 0
7330    } elseif {$l >= $numcommits} {
7331        set l [expr $numcommits - 1]
7332    }
7333    unmarkmatches
7334    selectline $l 1
7335}
7336
7337proc unselectline {} {
7338    global selectedline currentid
7339
7340    set selectedline {}
7341    catch {unset currentid}
7342    allcanvs delete secsel
7343    rhighlight_none
7344}
7345
7346proc reselectline {} {
7347    global selectedline
7348
7349    if {$selectedline ne {}} {
7350        selectline $selectedline 0
7351    }
7352}
7353
7354proc addtohistory {cmd {saveproc {}}} {
7355    global history historyindex curview
7356
7357    unset_posvars
7358    save_position
7359    set elt [list $curview $cmd $saveproc {}]
7360    if {$historyindex > 0
7361        && [lindex $history [expr {$historyindex - 1}]] == $elt} {
7362        return
7363    }
7364
7365    if {$historyindex < [llength $history]} {
7366        set history [lreplace $history $historyindex end $elt]
7367    } else {
7368        lappend history $elt
7369    }
7370    incr historyindex
7371    if {$historyindex > 1} {
7372        .tf.bar.leftbut conf -state normal
7373    } else {
7374        .tf.bar.leftbut conf -state disabled
7375    }
7376    .tf.bar.rightbut conf -state disabled
7377}
7378
7379# save the scrolling position of the diff display pane
7380proc save_position {} {
7381    global historyindex history
7382
7383    if {$historyindex < 1} return
7384    set hi [expr {$historyindex - 1}]
7385    set fn [lindex $history $hi 2]
7386    if {$fn ne {}} {
7387        lset history $hi 3 [eval $fn]
7388    }
7389}
7390
7391proc unset_posvars {} {
7392    global last_posvars
7393
7394    if {[info exists last_posvars]} {
7395        foreach {var val} $last_posvars {
7396            global $var
7397            catch {unset $var}
7398        }
7399        unset last_posvars
7400    }
7401}
7402
7403proc godo {elt} {
7404    global curview last_posvars
7405
7406    set view [lindex $elt 0]
7407    set cmd [lindex $elt 1]
7408    set pv [lindex $elt 3]
7409    if {$curview != $view} {
7410        showview $view
7411    }
7412    unset_posvars
7413    foreach {var val} $pv {
7414        global $var
7415        set $var $val
7416    }
7417    set last_posvars $pv
7418    eval $cmd
7419}
7420
7421proc goback {} {
7422    global history historyindex
7423    focus .
7424
7425    if {$historyindex > 1} {
7426        save_position
7427        incr historyindex -1
7428        godo [lindex $history [expr {$historyindex - 1}]]
7429        .tf.bar.rightbut conf -state normal
7430    }
7431    if {$historyindex <= 1} {
7432        .tf.bar.leftbut conf -state disabled
7433    }
7434}
7435
7436proc goforw {} {
7437    global history historyindex
7438    focus .
7439
7440    if {$historyindex < [llength $history]} {
7441        save_position
7442        set cmd [lindex $history $historyindex]
7443        incr historyindex
7444        godo $cmd
7445        .tf.bar.leftbut conf -state normal
7446    }
7447    if {$historyindex >= [llength $history]} {
7448        .tf.bar.rightbut conf -state disabled
7449    }
7450}
7451
7452proc go_to_parent {i} {
7453    global parents curview targetid
7454    set ps $parents($curview,$targetid)
7455    if {[llength $ps] >= $i} {
7456        selbyid [lindex $ps [expr $i - 1]]
7457    }
7458}
7459
7460proc gettree {id} {
7461    global treefilelist treeidlist diffids diffmergeid treepending
7462    global nullid nullid2
7463
7464    set diffids $id
7465    catch {unset diffmergeid}
7466    if {![info exists treefilelist($id)]} {
7467        if {![info exists treepending]} {
7468            if {$id eq $nullid} {
7469                set cmd [list | git ls-files]
7470            } elseif {$id eq $nullid2} {
7471                set cmd [list | git ls-files --stage -t]
7472            } else {
7473                set cmd [list | git ls-tree -r $id]
7474            }
7475            if {[catch {set gtf [open $cmd r]}]} {
7476                return
7477            }
7478            set treepending $id
7479            set treefilelist($id) {}
7480            set treeidlist($id) {}
7481            fconfigure $gtf -blocking 0 -encoding binary
7482            filerun $gtf [list gettreeline $gtf $id]
7483        }
7484    } else {
7485        setfilelist $id
7486    }
7487}
7488
7489proc gettreeline {gtf id} {
7490    global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
7491
7492    set nl 0
7493    while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
7494        if {$diffids eq $nullid} {
7495            set fname $line
7496        } else {
7497            set i [string first "\t" $line]
7498            if {$i < 0} continue
7499            set fname [string range $line [expr {$i+1}] end]
7500            set line [string range $line 0 [expr {$i-1}]]
7501            if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7502            set sha1 [lindex $line 2]
7503            lappend treeidlist($id) $sha1
7504        }
7505        if {[string index $fname 0] eq "\""} {
7506            set fname [lindex $fname 0]
7507        }
7508        set fname [encoding convertfrom $fname]
7509        lappend treefilelist($id) $fname
7510    }
7511    if {![eof $gtf]} {
7512        return [expr {$nl >= 1000? 2: 1}]
7513    }
7514    close $gtf
7515    unset treepending
7516    if {$cmitmode ne "tree"} {
7517        if {![info exists diffmergeid]} {
7518            gettreediffs $diffids
7519        }
7520    } elseif {$id ne $diffids} {
7521        gettree $diffids
7522    } else {
7523        setfilelist $id
7524    }
7525    return 0
7526}
7527
7528proc showfile {f} {
7529    global treefilelist treeidlist diffids nullid nullid2
7530    global ctext_file_names ctext_file_lines
7531    global ctext commentend
7532
7533    set i [lsearch -exact $treefilelist($diffids) $f]
7534    if {$i < 0} {
7535        puts "oops, $f not in list for id $diffids"
7536        return
7537    }
7538    if {$diffids eq $nullid} {
7539        if {[catch {set bf [open $f r]} err]} {
7540            puts "oops, can't read $f: $err"
7541            return
7542        }
7543    } else {
7544        set blob [lindex $treeidlist($diffids) $i]
7545        if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7546            puts "oops, error reading blob $blob: $err"
7547            return
7548        }
7549    }
7550    fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7551    filerun $bf [list getblobline $bf $diffids]
7552    $ctext config -state normal
7553    clear_ctext $commentend
7554    lappend ctext_file_names $f
7555    lappend ctext_file_lines [lindex [split $commentend "."] 0]
7556    $ctext insert end "\n"
7557    $ctext insert end "$f\n" filesep
7558    $ctext config -state disabled
7559    $ctext yview $commentend
7560    settabs 0
7561}
7562
7563proc getblobline {bf id} {
7564    global diffids cmitmode ctext
7565
7566    if {$id ne $diffids || $cmitmode ne "tree"} {
7567        catch {close $bf}
7568        return 0
7569    }
7570    $ctext config -state normal
7571    set nl 0
7572    while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7573        $ctext insert end "$line\n"
7574    }
7575    if {[eof $bf]} {
7576        global jump_to_here ctext_file_names commentend
7577
7578        # delete last newline
7579        $ctext delete "end - 2c" "end - 1c"
7580        close $bf
7581        if {$jump_to_here ne {} &&
7582            [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7583            set lnum [expr {[lindex $jump_to_here 1] +
7584                            [lindex [split $commentend .] 0]}]
7585            mark_ctext_line $lnum
7586        }
7587        $ctext config -state disabled
7588        return 0
7589    }
7590    $ctext config -state disabled
7591    return [expr {$nl >= 1000? 2: 1}]
7592}
7593
7594proc mark_ctext_line {lnum} {
7595    global ctext markbgcolor
7596
7597    $ctext tag delete omark
7598    $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7599    $ctext tag conf omark -background $markbgcolor
7600    $ctext see $lnum.0
7601}
7602
7603proc mergediff {id} {
7604    global diffmergeid
7605    global diffids treediffs
7606    global parents curview
7607
7608    set diffmergeid $id
7609    set diffids $id
7610    set treediffs($id) {}
7611    set np [llength $parents($curview,$id)]
7612    settabs $np
7613    getblobdiffs $id
7614}
7615
7616proc startdiff {ids} {
7617    global treediffs diffids treepending diffmergeid nullid nullid2
7618
7619    settabs 1
7620    set diffids $ids
7621    catch {unset diffmergeid}
7622    if {![info exists treediffs($ids)] ||
7623        [lsearch -exact $ids $nullid] >= 0 ||
7624        [lsearch -exact $ids $nullid2] >= 0} {
7625        if {![info exists treepending]} {
7626            gettreediffs $ids
7627        }
7628    } else {
7629        addtocflist $ids
7630    }
7631}
7632
7633proc showinlinediff {ids} {
7634    global commitinfo commitdata ctext
7635    global treediffs
7636
7637    set info $commitinfo($ids)
7638    set diff [lindex $info 7]
7639    set difflines [split $diff "\n"]
7640
7641    initblobdiffvars
7642    set treediff {}
7643
7644    set inhdr 0
7645    foreach line $difflines {
7646        if {![string compare -length 5 "diff " $line]} {
7647            set inhdr 1
7648        } elseif {$inhdr && ![string compare -length 4 "+++ " $line]} {
7649            # offset also accounts for the b/ prefix
7650            lappend treediff [string range $line 6 end]
7651            set inhdr 0
7652        }
7653    }
7654
7655    set treediffs($ids) $treediff
7656    add_flist $treediff
7657
7658    $ctext conf -state normal
7659    foreach line $difflines {
7660        parseblobdiffline $ids $line
7661    }
7662    maybe_scroll_ctext 1
7663    $ctext conf -state disabled
7664}
7665
7666# If the filename (name) is under any of the passed filter paths
7667# then return true to include the file in the listing.
7668proc path_filter {filter name} {
7669    set worktree [gitworktree]
7670    foreach p $filter {
7671        set fq_p [file normalize $p]
7672        set fq_n [file normalize [file join $worktree $name]]
7673        if {[string match [file normalize $fq_p]* $fq_n]} {
7674            return 1
7675        }
7676    }
7677    return 0
7678}
7679
7680proc addtocflist {ids} {
7681    global treediffs
7682
7683    add_flist $treediffs($ids)
7684    getblobdiffs $ids
7685}
7686
7687proc diffcmd {ids flags} {
7688    global log_showroot nullid nullid2 git_version
7689
7690    set i [lsearch -exact $ids $nullid]
7691    set j [lsearch -exact $ids $nullid2]
7692    if {$i >= 0} {
7693        if {[llength $ids] > 1 && $j < 0} {
7694            # comparing working directory with some specific revision
7695            set cmd [concat | git diff-index $flags]
7696            if {$i == 0} {
7697                lappend cmd -R [lindex $ids 1]
7698            } else {
7699                lappend cmd [lindex $ids 0]
7700            }
7701        } else {
7702            # comparing working directory with index
7703            set cmd [concat | git diff-files $flags]
7704            if {$j == 1} {
7705                lappend cmd -R
7706            }
7707        }
7708    } elseif {$j >= 0} {
7709        if {[package vcompare $git_version "1.7.2"] >= 0} {
7710            set flags "$flags --ignore-submodules=dirty"
7711        }
7712        set cmd [concat | git diff-index --cached $flags]
7713        if {[llength $ids] > 1} {
7714            # comparing index with specific revision
7715            if {$j == 0} {
7716                lappend cmd -R [lindex $ids 1]
7717            } else {
7718                lappend cmd [lindex $ids 0]
7719            }
7720        } else {
7721            # comparing index with HEAD
7722            lappend cmd HEAD
7723        }
7724    } else {
7725        if {$log_showroot} {
7726            lappend flags --root
7727        }
7728        set cmd [concat | git diff-tree -r $flags $ids]
7729    }
7730    return $cmd
7731}
7732
7733proc gettreediffs {ids} {
7734    global treediff treepending limitdiffs vfilelimit curview
7735
7736    set cmd [diffcmd $ids {--no-commit-id}]
7737    if {$limitdiffs && $vfilelimit($curview) ne {}} {
7738            set cmd [concat $cmd -- $vfilelimit($curview)]
7739    }
7740    if {[catch {set gdtf [open $cmd r]}]} return
7741
7742    set treepending $ids
7743    set treediff {}
7744    fconfigure $gdtf -blocking 0 -encoding binary
7745    filerun $gdtf [list gettreediffline $gdtf $ids]
7746}
7747
7748proc gettreediffline {gdtf ids} {
7749    global treediff treediffs treepending diffids diffmergeid
7750    global cmitmode vfilelimit curview limitdiffs perfile_attrs
7751
7752    set nr 0
7753    set sublist {}
7754    set max 1000
7755    if {$perfile_attrs} {
7756        # cache_gitattr is slow, and even slower on win32 where we
7757        # have to invoke it for only about 30 paths at a time
7758        set max 500
7759        if {[tk windowingsystem] == "win32"} {
7760            set max 120
7761        }
7762    }
7763    while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7764        set i [string first "\t" $line]
7765        if {$i >= 0} {
7766            set file [string range $line [expr {$i+1}] end]
7767            if {[string index $file 0] eq "\""} {
7768                set file [lindex $file 0]
7769            }
7770            set file [encoding convertfrom $file]
7771            if {$file ne [lindex $treediff end]} {
7772                lappend treediff $file
7773                lappend sublist $file
7774            }
7775        }
7776    }
7777    if {$perfile_attrs} {
7778        cache_gitattr encoding $sublist
7779    }
7780    if {![eof $gdtf]} {
7781        return [expr {$nr >= $max? 2: 1}]
7782    }
7783    close $gdtf
7784    set treediffs($ids) $treediff
7785    unset treepending
7786    if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7787        gettree $diffids
7788    } elseif {$ids != $diffids} {
7789        if {![info exists diffmergeid]} {
7790            gettreediffs $diffids
7791        }
7792    } else {
7793        addtocflist $ids
7794    }
7795    return 0
7796}
7797
7798# empty string or positive integer
7799proc diffcontextvalidate {v} {
7800    return [regexp {^(|[1-9][0-9]*)$} $v]
7801}
7802
7803proc diffcontextchange {n1 n2 op} {
7804    global diffcontextstring diffcontext
7805
7806    if {[string is integer -strict $diffcontextstring]} {
7807        if {$diffcontextstring >= 0} {
7808            set diffcontext $diffcontextstring
7809            reselectline
7810        }
7811    }
7812}
7813
7814proc changeignorespace {} {
7815    reselectline
7816}
7817
7818proc changeworddiff {name ix op} {
7819    reselectline
7820}
7821
7822proc initblobdiffvars {} {
7823    global diffencoding targetline diffnparents
7824    global diffinhdr currdiffsubmod diffseehere
7825    set targetline {}
7826    set diffnparents 0
7827    set diffinhdr 0
7828    set diffencoding [get_path_encoding {}]
7829    set currdiffsubmod ""
7830    set diffseehere -1
7831}
7832
7833proc getblobdiffs {ids} {
7834    global blobdifffd diffids env
7835    global treediffs
7836    global diffcontext
7837    global ignorespace
7838    global worddiff
7839    global limitdiffs vfilelimit curview
7840    global git_version
7841
7842    set textconv {}
7843    if {[package vcompare $git_version "1.6.1"] >= 0} {
7844        set textconv "--textconv"
7845    }
7846    set submodule {}
7847    if {[package vcompare $git_version "1.6.6"] >= 0} {
7848        set submodule "--submodule"
7849    }
7850    set cmd [diffcmd $ids "-p $textconv $submodule  -C --cc --no-commit-id -U$diffcontext"]
7851    if {$ignorespace} {
7852        append cmd " -w"
7853    }
7854    if {$worddiff ne [mc "Line diff"]} {
7855        append cmd " --word-diff=porcelain"
7856    }
7857    if {$limitdiffs && $vfilelimit($curview) ne {}} {
7858        set cmd [concat $cmd -- $vfilelimit($curview)]
7859    }
7860    if {[catch {set bdf [open $cmd r]} err]} {
7861        error_popup [mc "Error getting diffs: %s" $err]
7862        return
7863    }
7864    fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
7865    set blobdifffd($ids) $bdf
7866    initblobdiffvars
7867    filerun $bdf [list getblobdiffline $bdf $diffids]
7868}
7869
7870proc savecmitpos {} {
7871    global ctext cmitmode
7872
7873    if {$cmitmode eq "tree"} {
7874        return {}
7875    }
7876    return [list target_scrollpos [$ctext index @0,0]]
7877}
7878
7879proc savectextpos {} {
7880    global ctext
7881
7882    return [list target_scrollpos [$ctext index @0,0]]
7883}
7884
7885proc maybe_scroll_ctext {ateof} {
7886    global ctext target_scrollpos
7887
7888    if {![info exists target_scrollpos]} return
7889    if {!$ateof} {
7890        set nlines [expr {[winfo height $ctext]
7891                          / [font metrics textfont -linespace]}]
7892        if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
7893    }
7894    $ctext yview $target_scrollpos
7895    unset target_scrollpos
7896}
7897
7898proc setinlist {var i val} {
7899    global $var
7900
7901    while {[llength [set $var]] < $i} {
7902        lappend $var {}
7903    }
7904    if {[llength [set $var]] == $i} {
7905        lappend $var $val
7906    } else {
7907        lset $var $i $val
7908    }
7909}
7910
7911proc makediffhdr {fname ids} {
7912    global ctext curdiffstart treediffs diffencoding
7913    global ctext_file_names jump_to_here targetline diffline
7914
7915    set fname [encoding convertfrom $fname]
7916    set diffencoding [get_path_encoding $fname]
7917    set i [lsearch -exact $treediffs($ids) $fname]
7918    if {$i >= 0} {
7919        setinlist difffilestart $i $curdiffstart
7920    }
7921    lset ctext_file_names end $fname
7922    set l [expr {(78 - [string length $fname]) / 2}]
7923    set pad [string range "----------------------------------------" 1 $l]
7924    $ctext insert $curdiffstart "$pad $fname $pad" filesep
7925    set targetline {}
7926    if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
7927        set targetline [lindex $jump_to_here 1]
7928    }
7929    set diffline 0
7930}
7931
7932proc blobdiffmaybeseehere {ateof} {
7933    global diffseehere
7934    if {$diffseehere >= 0} {
7935        mark_ctext_line [lindex [split $diffseehere .] 0]
7936    }
7937    maybe_scroll_ctext $ateof
7938}
7939
7940proc getblobdiffline {bdf ids} {
7941    global diffids blobdifffd
7942    global ctext
7943
7944    set nr 0
7945    $ctext conf -state normal
7946    while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
7947        if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
7948            catch {close $bdf}
7949            return 0
7950        }
7951        parseblobdiffline $ids $line
7952    }
7953    $ctext conf -state disabled
7954    blobdiffmaybeseehere [eof $bdf]
7955    if {[eof $bdf]} {
7956        catch {close $bdf}
7957        return 0
7958    }
7959    return [expr {$nr >= 1000? 2: 1}]
7960}
7961
7962proc parseblobdiffline {ids line} {
7963    global ctext curdiffstart
7964    global diffnexthead diffnextnote difffilestart
7965    global ctext_file_names ctext_file_lines
7966    global diffinhdr treediffs mergemax diffnparents
7967    global diffencoding jump_to_here targetline diffline currdiffsubmod
7968    global worddiff diffseehere
7969
7970    if {![string compare -length 5 "diff " $line]} {
7971        if {![regexp {^diff (--cc|--git) } $line m type]} {
7972            set line [encoding convertfrom $line]
7973            $ctext insert end "$line\n" hunksep
7974            continue
7975        }
7976        # start of a new file
7977        set diffinhdr 1
7978        $ctext insert end "\n"
7979        set curdiffstart [$ctext index "end - 1c"]
7980        lappend ctext_file_names ""
7981        lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7982        $ctext insert end "\n" filesep
7983
7984        if {$type eq "--cc"} {
7985            # start of a new file in a merge diff
7986            set fname [string range $line 10 end]
7987            if {[lsearch -exact $treediffs($ids) $fname] < 0} {
7988                lappend treediffs($ids) $fname
7989                add_flist [list $fname]
7990            }
7991
7992        } else {
7993            set line [string range $line 11 end]
7994            # If the name hasn't changed the length will be odd,
7995            # the middle char will be a space, and the two bits either
7996            # side will be a/name and b/name, or "a/name" and "b/name".
7997            # If the name has changed we'll get "rename from" and
7998            # "rename to" or "copy from" and "copy to" lines following
7999            # this, and we'll use them to get the filenames.
8000            # This complexity is necessary because spaces in the
8001            # filename(s) don't get escaped.
8002            set l [string length $line]
8003            set i [expr {$l / 2}]
8004            if {!(($l & 1) && [string index $line $i] eq " " &&
8005                  [string range $line 2 [expr {$i - 1}]] eq \
8006                      [string range $line [expr {$i + 3}] end])} {
8007                return
8008            }
8009            # unescape if quoted and chop off the a/ from the front
8010            if {[string index $line 0] eq "\""} {
8011                set fname [string range [lindex $line 0] 2 end]
8012            } else {
8013                set fname [string range $line 2 [expr {$i - 1}]]
8014            }
8015        }
8016        makediffhdr $fname $ids
8017
8018    } elseif {![string compare -length 16 "* Unmerged path " $line]} {
8019        set fname [encoding convertfrom [string range $line 16 end]]
8020        $ctext insert end "\n"
8021        set curdiffstart [$ctext index "end - 1c"]
8022        lappend ctext_file_names $fname
8023        lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8024        $ctext insert end "$line\n" filesep
8025        set i [lsearch -exact $treediffs($ids) $fname]
8026        if {$i >= 0} {
8027            setinlist difffilestart $i $curdiffstart
8028        }
8029
8030    } elseif {![string compare -length 2 "@@" $line]} {
8031        regexp {^@@+} $line ats
8032        set line [encoding convertfrom $diffencoding $line]
8033        $ctext insert end "$line\n" hunksep
8034        if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
8035            set diffline $nl
8036        }
8037        set diffnparents [expr {[string length $ats] - 1}]
8038        set diffinhdr 0
8039
8040    } elseif {![string compare -length 10 "Submodule " $line]} {
8041        # start of a new submodule
8042        if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
8043            set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
8044        } else {
8045            set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
8046        }
8047        if {$currdiffsubmod != $fname} {
8048            $ctext insert end "\n";     # Add newline after commit message
8049        }
8050        set curdiffstart [$ctext index "end - 1c"]
8051        lappend ctext_file_names ""
8052        if {$currdiffsubmod != $fname} {
8053            lappend ctext_file_lines $fname
8054            makediffhdr $fname $ids
8055            set currdiffsubmod $fname
8056            $ctext insert end "\n$line\n" filesep
8057        } else {
8058            $ctext insert end "$line\n" filesep
8059        }
8060    } elseif {![string compare -length 3 "  >" $line]} {
8061        set $currdiffsubmod ""
8062        set line [encoding convertfrom $diffencoding $line]
8063        $ctext insert end "$line\n" dresult
8064    } elseif {![string compare -length 3 "  <" $line]} {
8065        set $currdiffsubmod ""
8066        set line [encoding convertfrom $diffencoding $line]
8067        $ctext insert end "$line\n" d0
8068    } elseif {$diffinhdr} {
8069        if {![string compare -length 12 "rename from " $line]} {
8070            set fname [string range $line [expr 6 + [string first " from " $line] ] end]
8071            if {[string index $fname 0] eq "\""} {
8072                set fname [lindex $fname 0]
8073            }
8074            set fname [encoding convertfrom $fname]
8075            set i [lsearch -exact $treediffs($ids) $fname]
8076            if {$i >= 0} {
8077                setinlist difffilestart $i $curdiffstart
8078            }
8079        } elseif {![string compare -length 10 $line "rename to "] ||
8080                  ![string compare -length 8 $line "copy to "]} {
8081            set fname [string range $line [expr 4 + [string first " to " $line] ] end]
8082            if {[string index $fname 0] eq "\""} {
8083                set fname [lindex $fname 0]
8084            }
8085            makediffhdr $fname $ids
8086        } elseif {[string compare -length 3 $line "---"] == 0} {
8087            # do nothing
8088            return
8089        } elseif {[string compare -length 3 $line "+++"] == 0} {
8090            set diffinhdr 0
8091            return
8092        }
8093        $ctext insert end "$line\n" filesep
8094
8095    } else {
8096        set line [string map {\x1A ^Z} \
8097                      [encoding convertfrom $diffencoding $line]]
8098        # parse the prefix - one ' ', '-' or '+' for each parent
8099        set prefix [string range $line 0 [expr {$diffnparents - 1}]]
8100        set tag [expr {$diffnparents > 1? "m": "d"}]
8101        set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
8102        set words_pre_markup ""
8103        set words_post_markup ""
8104        if {[string trim $prefix " -+"] eq {}} {
8105            # prefix only has " ", "-" and "+" in it: normal diff line
8106            set num [string first "-" $prefix]
8107            if {$dowords} {
8108                set line [string range $line 1 end]
8109            }
8110            if {$num >= 0} {
8111                # removed line, first parent with line is $num
8112                if {$num >= $mergemax} {
8113                    set num "max"
8114                }
8115                if {$dowords && $worddiff eq [mc "Markup words"]} {
8116                    $ctext insert end "\[-$line-\]" $tag$num
8117                } else {
8118                    $ctext insert end "$line" $tag$num
8119                }
8120                if {!$dowords} {
8121                    $ctext insert end "\n" $tag$num
8122                }
8123            } else {
8124                set tags {}
8125                if {[string first "+" $prefix] >= 0} {
8126                    # added line
8127                    lappend tags ${tag}result
8128                    if {$diffnparents > 1} {
8129                        set num [string first " " $prefix]
8130                        if {$num >= 0} {
8131                            if {$num >= $mergemax} {
8132                                set num "max"
8133                            }
8134                            lappend tags m$num
8135                        }
8136                    }
8137                    set words_pre_markup "{+"
8138                    set words_post_markup "+}"
8139                }
8140                if {$targetline ne {}} {
8141                    if {$diffline == $targetline} {
8142                        set diffseehere [$ctext index "end - 1 chars"]
8143                        set targetline {}
8144                    } else {
8145                        incr diffline
8146                    }
8147                }
8148                if {$dowords && $worddiff eq [mc "Markup words"]} {
8149                    $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
8150                } else {
8151                    $ctext insert end "$line" $tags
8152                }
8153                if {!$dowords} {
8154                    $ctext insert end "\n" $tags
8155                }
8156            }
8157        } elseif {$dowords && $prefix eq "~"} {
8158            $ctext insert end "\n" {}
8159        } else {
8160            # "\ No newline at end of file",
8161            # or something else we don't recognize
8162            $ctext insert end "$line\n" hunksep
8163        }
8164    }
8165}
8166
8167proc changediffdisp {} {
8168    global ctext diffelide
8169
8170    $ctext tag conf d0 -elide [lindex $diffelide 0]
8171    $ctext tag conf dresult -elide [lindex $diffelide 1]
8172}
8173
8174proc highlightfile {cline} {
8175    global cflist cflist_top
8176
8177    if {![info exists cflist_top]} return
8178
8179    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
8180    $cflist tag add highlight $cline.0 "$cline.0 lineend"
8181    $cflist see $cline.0
8182    set cflist_top $cline
8183}
8184
8185proc highlightfile_for_scrollpos {topidx} {
8186    global cmitmode difffilestart
8187
8188    if {$cmitmode eq "tree"} return
8189    if {![info exists difffilestart]} return
8190
8191    set top [lindex [split $topidx .] 0]
8192    if {$difffilestart eq {} || $top < [lindex $difffilestart 0]} {
8193        highlightfile 0
8194    } else {
8195        highlightfile [expr {[bsearch $difffilestart $top] + 2}]
8196    }
8197}
8198
8199proc prevfile {} {
8200    global difffilestart ctext cmitmode
8201
8202    if {$cmitmode eq "tree"} return
8203    set prev 0.0
8204    set here [$ctext index @0,0]
8205    foreach loc $difffilestart {
8206        if {[$ctext compare $loc >= $here]} {
8207            $ctext yview $prev
8208            return
8209        }
8210        set prev $loc
8211    }
8212    $ctext yview $prev
8213}
8214
8215proc nextfile {} {
8216    global difffilestart ctext cmitmode
8217
8218    if {$cmitmode eq "tree"} return
8219    set here [$ctext index @0,0]
8220    foreach loc $difffilestart {
8221        if {[$ctext compare $loc > $here]} {
8222            $ctext yview $loc
8223            return
8224        }
8225    }
8226}
8227
8228proc clear_ctext {{first 1.0}} {
8229    global ctext smarktop smarkbot
8230    global ctext_file_names ctext_file_lines
8231    global pendinglinks
8232
8233    set l [lindex [split $first .] 0]
8234    if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
8235        set smarktop $l
8236    }
8237    if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
8238        set smarkbot $l
8239    }
8240    $ctext delete $first end
8241    if {$first eq "1.0"} {
8242        catch {unset pendinglinks}
8243    }
8244    set ctext_file_names {}
8245    set ctext_file_lines {}
8246}
8247
8248proc settabs {{firstab {}}} {
8249    global firsttabstop tabstop ctext have_tk85
8250
8251    if {$firstab ne {} && $have_tk85} {
8252        set firsttabstop $firstab
8253    }
8254    set w [font measure textfont "0"]
8255    if {$firsttabstop != 0} {
8256        $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
8257                               [expr {($firsttabstop + 2 * $tabstop) * $w}]]
8258    } elseif {$have_tk85 || $tabstop != 8} {
8259        $ctext conf -tabs [expr {$tabstop * $w}]
8260    } else {
8261        $ctext conf -tabs {}
8262    }
8263}
8264
8265proc incrsearch {name ix op} {
8266    global ctext searchstring searchdirn
8267
8268    if {[catch {$ctext index anchor}]} {
8269        # no anchor set, use start of selection, or of visible area
8270        set sel [$ctext tag ranges sel]
8271        if {$sel ne {}} {
8272            $ctext mark set anchor [lindex $sel 0]
8273        } elseif {$searchdirn eq "-forwards"} {
8274            $ctext mark set anchor @0,0
8275        } else {
8276            $ctext mark set anchor @0,[winfo height $ctext]
8277        }
8278    }
8279    if {$searchstring ne {}} {
8280        set here [$ctext search -count mlen $searchdirn -- $searchstring anchor]
8281        if {$here ne {}} {
8282            $ctext see $here
8283            set mend "$here + $mlen c"
8284            $ctext tag remove sel 1.0 end
8285            $ctext tag add sel $here $mend
8286            suppress_highlighting_file_for_current_scrollpos
8287            highlightfile_for_scrollpos $here
8288        }
8289    }
8290    rehighlight_search_results
8291}
8292
8293proc dosearch {} {
8294    global sstring ctext searchstring searchdirn
8295
8296    focus $sstring
8297    $sstring icursor end
8298    set searchdirn -forwards
8299    if {$searchstring ne {}} {
8300        set sel [$ctext tag ranges sel]
8301        if {$sel ne {}} {
8302            set start "[lindex $sel 0] + 1c"
8303        } elseif {[catch {set start [$ctext index anchor]}]} {
8304            set start "@0,0"
8305        }
8306        set match [$ctext search -count mlen -- $searchstring $start]
8307        $ctext tag remove sel 1.0 end
8308        if {$match eq {}} {
8309            bell
8310            return
8311        }
8312        $ctext see $match
8313        suppress_highlighting_file_for_current_scrollpos
8314        highlightfile_for_scrollpos $match
8315        set mend "$match + $mlen c"
8316        $ctext tag add sel $match $mend
8317        $ctext mark unset anchor
8318        rehighlight_search_results
8319    }
8320}
8321
8322proc dosearchback {} {
8323    global sstring ctext searchstring searchdirn
8324
8325    focus $sstring
8326    $sstring icursor end
8327    set searchdirn -backwards
8328    if {$searchstring ne {}} {
8329        set sel [$ctext tag ranges sel]
8330        if {$sel ne {}} {
8331            set start [lindex $sel 0]
8332        } elseif {[catch {set start [$ctext index anchor]}]} {
8333            set start @0,[winfo height $ctext]
8334        }
8335        set match [$ctext search -backwards -count ml -- $searchstring $start]
8336        $ctext tag remove sel 1.0 end
8337        if {$match eq {}} {
8338            bell
8339            return
8340        }
8341        $ctext see $match
8342        suppress_highlighting_file_for_current_scrollpos
8343        highlightfile_for_scrollpos $match
8344        set mend "$match + $ml c"
8345        $ctext tag add sel $match $mend
8346        $ctext mark unset anchor
8347        rehighlight_search_results
8348    }
8349}
8350
8351proc rehighlight_search_results {} {
8352    global ctext searchstring
8353
8354    $ctext tag remove found 1.0 end
8355    $ctext tag remove currentsearchhit 1.0 end
8356
8357    if {$searchstring ne {}} {
8358        searchmarkvisible 1
8359    }
8360}
8361
8362proc searchmark {first last} {
8363    global ctext searchstring
8364
8365    set sel [$ctext tag ranges sel]
8366
8367    set mend $first.0
8368    while {1} {
8369        set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8370        if {$match eq {}} break
8371        set mend "$match + $mlen c"
8372        if {$sel ne {} && [$ctext compare $match == [lindex $sel 0]]} {
8373            $ctext tag add currentsearchhit $match $mend
8374        } else {
8375            $ctext tag add found $match $mend
8376        }
8377    }
8378}
8379
8380proc searchmarkvisible {doall} {
8381    global ctext smarktop smarkbot
8382
8383    set topline [lindex [split [$ctext index @0,0] .] 0]
8384    set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8385    if {$doall || $botline < $smarktop || $topline > $smarkbot} {
8386        # no overlap with previous
8387        searchmark $topline $botline
8388        set smarktop $topline
8389        set smarkbot $botline
8390    } else {
8391        if {$topline < $smarktop} {
8392            searchmark $topline [expr {$smarktop-1}]
8393            set smarktop $topline
8394        }
8395        if {$botline > $smarkbot} {
8396            searchmark [expr {$smarkbot+1}] $botline
8397            set smarkbot $botline
8398        }
8399    }
8400}
8401
8402proc suppress_highlighting_file_for_current_scrollpos {} {
8403    global ctext suppress_highlighting_file_for_this_scrollpos
8404
8405    set suppress_highlighting_file_for_this_scrollpos [$ctext index @0,0]
8406}
8407
8408proc scrolltext {f0 f1} {
8409    global searchstring cmitmode ctext
8410    global suppress_highlighting_file_for_this_scrollpos
8411
8412    set topidx [$ctext index @0,0]
8413    if {![info exists suppress_highlighting_file_for_this_scrollpos]
8414        || $topidx ne $suppress_highlighting_file_for_this_scrollpos} {
8415        highlightfile_for_scrollpos $topidx
8416    }
8417
8418    catch {unset suppress_highlighting_file_for_this_scrollpos}
8419
8420    .bleft.bottom.sb set $f0 $f1
8421    if {$searchstring ne {}} {
8422        searchmarkvisible 0
8423    }
8424}
8425
8426proc setcoords {} {
8427    global linespc charspc canvx0 canvy0
8428    global xspc1 xspc2 lthickness
8429
8430    set linespc [font metrics mainfont -linespace]
8431    set charspc [font measure mainfont "m"]
8432    set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8433    set canvx0 [expr {int(3 + 0.5 * $linespc)}]
8434    set lthickness [expr {int($linespc / 9) + 1}]
8435    set xspc1(0) $linespc
8436    set xspc2 $linespc
8437}
8438
8439proc redisplay {} {
8440    global canv
8441    global selectedline
8442
8443    set ymax [lindex [$canv cget -scrollregion] 3]
8444    if {$ymax eq {} || $ymax == 0} return
8445    set span [$canv yview]
8446    clear_display
8447    setcanvscroll
8448    allcanvs yview moveto [lindex $span 0]
8449    drawvisible
8450    if {$selectedline ne {}} {
8451        selectline $selectedline 0
8452        allcanvs yview moveto [lindex $span 0]
8453    }
8454}
8455
8456proc parsefont {f n} {
8457    global fontattr
8458
8459    set fontattr($f,family) [lindex $n 0]
8460    set s [lindex $n 1]
8461    if {$s eq {} || $s == 0} {
8462        set s 10
8463    } elseif {$s < 0} {
8464        set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
8465    }
8466    set fontattr($f,size) $s
8467    set fontattr($f,weight) normal
8468    set fontattr($f,slant) roman
8469    foreach style [lrange $n 2 end] {
8470        switch -- $style {
8471            "normal" -
8472            "bold"   {set fontattr($f,weight) $style}
8473            "roman" -
8474            "italic" {set fontattr($f,slant) $style}
8475        }
8476    }
8477}
8478
8479proc fontflags {f {isbold 0}} {
8480    global fontattr
8481
8482    return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8483                -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8484                -slant $fontattr($f,slant)]
8485}
8486
8487proc fontname {f} {
8488    global fontattr
8489
8490    set n [list $fontattr($f,family) $fontattr($f,size)]
8491    if {$fontattr($f,weight) eq "bold"} {
8492        lappend n "bold"
8493    }
8494    if {$fontattr($f,slant) eq "italic"} {
8495        lappend n "italic"
8496    }
8497    return $n
8498}
8499
8500proc incrfont {inc} {
8501    global mainfont textfont ctext canv cflist showrefstop
8502    global stopped entries fontattr
8503
8504    unmarkmatches
8505    set s $fontattr(mainfont,size)
8506    incr s $inc
8507    if {$s < 1} {
8508        set s 1
8509    }
8510    set fontattr(mainfont,size) $s
8511    font config mainfont -size $s
8512    font config mainfontbold -size $s
8513    set mainfont [fontname mainfont]
8514    set s $fontattr(textfont,size)
8515    incr s $inc
8516    if {$s < 1} {
8517        set s 1
8518    }
8519    set fontattr(textfont,size) $s
8520    font config textfont -size $s
8521    font config textfontbold -size $s
8522    set textfont [fontname textfont]
8523    setcoords
8524    settabs
8525    redisplay
8526}
8527
8528proc clearsha1 {} {
8529    global sha1entry sha1string
8530    if {[string length $sha1string] == 40} {
8531        $sha1entry delete 0 end
8532    }
8533}
8534
8535proc sha1change {n1 n2 op} {
8536    global sha1string currentid sha1but
8537    if {$sha1string == {}
8538        || ([info exists currentid] && $sha1string == $currentid)} {
8539        set state disabled
8540    } else {
8541        set state normal
8542    }
8543    if {[$sha1but cget -state] == $state} return
8544    if {$state == "normal"} {
8545        $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
8546    } else {
8547        $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
8548    }
8549}
8550
8551proc gotocommit {} {
8552    global sha1string tagids headids curview varcid
8553
8554    if {$sha1string == {}
8555        || ([info exists currentid] && $sha1string == $currentid)} return
8556    if {[info exists tagids($sha1string)]} {
8557        set id $tagids($sha1string)
8558    } elseif {[info exists headids($sha1string)]} {
8559        set id $headids($sha1string)
8560    } else {
8561        set id [string tolower $sha1string]
8562        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
8563            set matches [longid $id]
8564            if {$matches ne {}} {
8565                if {[llength $matches] > 1} {
8566                    error_popup [mc "Short SHA1 id %s is ambiguous" $id]
8567                    return
8568                }
8569                set id [lindex $matches 0]
8570            }
8571        } else {
8572            if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8573                error_popup [mc "Revision %s is not known" $sha1string]
8574                return
8575            }
8576        }
8577    }
8578    if {[commitinview $id $curview]} {
8579        selectline [rowofcommit $id] 1
8580        return
8581    }
8582    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
8583        set msg [mc "SHA1 id %s is not known" $sha1string]
8584    } else {
8585        set msg [mc "Revision %s is not in the current view" $sha1string]
8586    }
8587    error_popup $msg
8588}
8589
8590proc lineenter {x y id} {
8591    global hoverx hovery hoverid hovertimer
8592    global commitinfo canv
8593
8594    if {![info exists commitinfo($id)] && ![getcommit $id]} return
8595    set hoverx $x
8596    set hovery $y
8597    set hoverid $id
8598    if {[info exists hovertimer]} {
8599        after cancel $hovertimer
8600    }
8601    set hovertimer [after 500 linehover]
8602    $canv delete hover
8603}
8604
8605proc linemotion {x y id} {
8606    global hoverx hovery hoverid hovertimer
8607
8608    if {[info exists hoverid] && $id == $hoverid} {
8609        set hoverx $x
8610        set hovery $y
8611        if {[info exists hovertimer]} {
8612            after cancel $hovertimer
8613        }
8614        set hovertimer [after 500 linehover]
8615    }
8616}
8617
8618proc lineleave {id} {
8619    global hoverid hovertimer canv
8620
8621    if {[info exists hoverid] && $id == $hoverid} {
8622        $canv delete hover
8623        if {[info exists hovertimer]} {
8624            after cancel $hovertimer
8625            unset hovertimer
8626        }
8627        unset hoverid
8628    }
8629}
8630
8631proc linehover {} {
8632    global hoverx hovery hoverid hovertimer
8633    global canv linespc lthickness
8634    global linehoverbgcolor linehoverfgcolor linehoveroutlinecolor
8635
8636    global commitinfo
8637
8638    set text [lindex $commitinfo($hoverid) 0]
8639    set ymax [lindex [$canv cget -scrollregion] 3]
8640    if {$ymax == {}} return
8641    set yfrac [lindex [$canv yview] 0]
8642    set x [expr {$hoverx + 2 * $linespc}]
8643    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8644    set x0 [expr {$x - 2 * $lthickness}]
8645    set y0 [expr {$y - 2 * $lthickness}]
8646    set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
8647    set y1 [expr {$y + $linespc + 2 * $lthickness}]
8648    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8649               -fill $linehoverbgcolor -outline $linehoveroutlinecolor \
8650               -width 1 -tags hover]
8651    $canv raise $t
8652    set t [$canv create text $x $y -anchor nw -text $text -tags hover \
8653               -font mainfont -fill $linehoverfgcolor]
8654    $canv raise $t
8655}
8656
8657proc clickisonarrow {id y} {
8658    global lthickness
8659
8660    set ranges [rowranges $id]
8661    set thresh [expr {2 * $lthickness + 6}]
8662    set n [expr {[llength $ranges] - 1}]
8663    for {set i 1} {$i < $n} {incr i} {
8664        set row [lindex $ranges $i]
8665        if {abs([yc $row] - $y) < $thresh} {
8666            return $i
8667        }
8668    }
8669    return {}
8670}
8671
8672proc arrowjump {id n y} {
8673    global canv
8674
8675    # 1 <-> 2, 3 <-> 4, etc...
8676    set n [expr {(($n - 1) ^ 1) + 1}]
8677    set row [lindex [rowranges $id] $n]
8678    set yt [yc $row]
8679    set ymax [lindex [$canv cget -scrollregion] 3]
8680    if {$ymax eq {} || $ymax <= 0} return
8681    set view [$canv yview]
8682    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8683    set yfrac [expr {$yt / $ymax - $yspan / 2}]
8684    if {$yfrac < 0} {
8685        set yfrac 0
8686    }
8687    allcanvs yview moveto $yfrac
8688}
8689
8690proc lineclick {x y id isnew} {
8691    global ctext commitinfo children canv thickerline curview
8692
8693    if {![info exists commitinfo($id)] && ![getcommit $id]} return
8694    unmarkmatches
8695    unselectline
8696    normalline
8697    $canv delete hover
8698    # draw this line thicker than normal
8699    set thickerline $id
8700    drawlines $id
8701    if {$isnew} {
8702        set ymax [lindex [$canv cget -scrollregion] 3]
8703        if {$ymax eq {}} return
8704        set yfrac [lindex [$canv yview] 0]
8705        set y [expr {$y + $yfrac * $ymax}]
8706    }
8707    set dirn [clickisonarrow $id $y]
8708    if {$dirn ne {}} {
8709        arrowjump $id $dirn $y
8710        return
8711    }
8712
8713    if {$isnew} {
8714        addtohistory [list lineclick $x $y $id 0] savectextpos
8715    }
8716    # fill the details pane with info about this line
8717    $ctext conf -state normal
8718    clear_ctext
8719    settabs 0
8720    $ctext insert end "[mc "Parent"]:\t"
8721    $ctext insert end $id link0
8722    setlink $id link0
8723    set info $commitinfo($id)
8724    $ctext insert end "\n\t[lindex $info 0]\n"
8725    $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8726    set date [formatdate [lindex $info 2]]
8727    $ctext insert end "\t[mc "Date"]:\t$date\n"
8728    set kids $children($curview,$id)
8729    if {$kids ne {}} {
8730        $ctext insert end "\n[mc "Children"]:"
8731        set i 0
8732        foreach child $kids {
8733            incr i
8734            if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8735            set info $commitinfo($child)
8736            $ctext insert end "\n\t"
8737            $ctext insert end $child link$i
8738            setlink $child link$i
8739            $ctext insert end "\n\t[lindex $info 0]"
8740            $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8741            set date [formatdate [lindex $info 2]]
8742            $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8743        }
8744    }
8745    maybe_scroll_ctext 1
8746    $ctext conf -state disabled
8747    init_flist {}
8748}
8749
8750proc normalline {} {
8751    global thickerline
8752    if {[info exists thickerline]} {
8753        set id $thickerline
8754        unset thickerline
8755        drawlines $id
8756    }
8757}
8758
8759proc selbyid {id {isnew 1}} {
8760    global curview
8761    if {[commitinview $id $curview]} {
8762        selectline [rowofcommit $id] $isnew
8763    }
8764}
8765
8766proc mstime {} {
8767    global startmstime
8768    if {![info exists startmstime]} {
8769        set startmstime [clock clicks -milliseconds]
8770    }
8771    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8772}
8773
8774proc rowmenu {x y id} {
8775    global rowctxmenu selectedline rowmenuid curview
8776    global nullid nullid2 fakerowmenu mainhead markedid
8777
8778    stopfinding
8779    set rowmenuid $id
8780    if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8781        set state disabled
8782    } else {
8783        set state normal
8784    }
8785    if {[info exists markedid] && $markedid ne $id} {
8786        set mstate normal
8787    } else {
8788        set mstate disabled
8789    }
8790    if {$id ne $nullid && $id ne $nullid2} {
8791        set menu $rowctxmenu
8792        if {$mainhead ne {}} {
8793            $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead] -state normal
8794        } else {
8795            $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8796        }
8797        $menu entryconfigure 9 -state $mstate
8798        $menu entryconfigure 10 -state $mstate
8799        $menu entryconfigure 11 -state $mstate
8800    } else {
8801        set menu $fakerowmenu
8802    }
8803    $menu entryconfigure [mca "Diff this -> selected"] -state $state
8804    $menu entryconfigure [mca "Diff selected -> this"] -state $state
8805    $menu entryconfigure [mca "Make patch"] -state $state
8806    $menu entryconfigure [mca "Diff this -> marked commit"] -state $mstate
8807    $menu entryconfigure [mca "Diff marked commit -> this"] -state $mstate
8808    tk_popup $menu $x $y
8809}
8810
8811proc markhere {} {
8812    global rowmenuid markedid canv
8813
8814    set markedid $rowmenuid
8815    make_idmark $markedid
8816}
8817
8818proc gotomark {} {
8819    global markedid
8820
8821    if {[info exists markedid]} {
8822        selbyid $markedid
8823    }
8824}
8825
8826proc replace_by_kids {l r} {
8827    global curview children
8828
8829    set id [commitonrow $r]
8830    set l [lreplace $l 0 0]
8831    foreach kid $children($curview,$id) {
8832        lappend l [rowofcommit $kid]
8833    }
8834    return [lsort -integer -decreasing -unique $l]
8835}
8836
8837proc find_common_desc {} {
8838    global markedid rowmenuid curview children
8839
8840    if {![info exists markedid]} return
8841    if {![commitinview $markedid $curview] ||
8842        ![commitinview $rowmenuid $curview]} return
8843    #set t1 [clock clicks -milliseconds]
8844    set l1 [list [rowofcommit $markedid]]
8845    set l2 [list [rowofcommit $rowmenuid]]
8846    while 1 {
8847        set r1 [lindex $l1 0]
8848        set r2 [lindex $l2 0]
8849        if {$r1 eq {} || $r2 eq {}} break
8850        if {$r1 == $r2} {
8851            selectline $r1 1
8852            break
8853        }
8854        if {$r1 > $r2} {
8855            set l1 [replace_by_kids $l1 $r1]
8856        } else {
8857            set l2 [replace_by_kids $l2 $r2]
8858        }
8859    }
8860    #set t2 [clock clicks -milliseconds]
8861    #puts "took [expr {$t2-$t1}]ms"
8862}
8863
8864proc compare_commits {} {
8865    global markedid rowmenuid curview children
8866
8867    if {![info exists markedid]} return
8868    if {![commitinview $markedid $curview]} return
8869    addtohistory [list do_cmp_commits $markedid $rowmenuid]
8870    do_cmp_commits $markedid $rowmenuid
8871}
8872
8873proc getpatchid {id} {
8874    global patchids
8875
8876    if {![info exists patchids($id)]} {
8877        set cmd [diffcmd [list $id] {-p --root}]
8878        # trim off the initial "|"
8879        set cmd [lrange $cmd 1 end]
8880        if {[catch {
8881            set x [eval exec $cmd | git patch-id]
8882            set patchids($id) [lindex $x 0]
8883        }]} {
8884            set patchids($id) "error"
8885        }
8886    }
8887    return $patchids($id)
8888}
8889
8890proc do_cmp_commits {a b} {
8891    global ctext curview parents children patchids commitinfo
8892
8893    $ctext conf -state normal
8894    clear_ctext
8895    init_flist {}
8896    for {set i 0} {$i < 100} {incr i} {
8897        set skipa 0
8898        set skipb 0
8899        if {[llength $parents($curview,$a)] > 1} {
8900            appendshortlink $a [mc "Skipping merge commit "] "\n"
8901            set skipa 1
8902        } else {
8903            set patcha [getpatchid $a]
8904        }
8905        if {[llength $parents($curview,$b)] > 1} {
8906            appendshortlink $b [mc "Skipping merge commit "] "\n"
8907            set skipb 1
8908        } else {
8909            set patchb [getpatchid $b]
8910        }
8911        if {!$skipa && !$skipb} {
8912            set heada [lindex $commitinfo($a) 0]
8913            set headb [lindex $commitinfo($b) 0]
8914            if {$patcha eq "error"} {
8915                appendshortlink $a [mc "Error getting patch ID for "] \
8916                    [mc " - stopping\n"]
8917                break
8918            }
8919            if {$patchb eq "error"} {
8920                appendshortlink $b [mc "Error getting patch ID for "] \
8921                    [mc " - stopping\n"]
8922                break
8923            }
8924            if {$patcha eq $patchb} {
8925                if {$heada eq $headb} {
8926                    appendshortlink $a [mc "Commit "]
8927                    appendshortlink $b " == " "  $heada\n"
8928                } else {
8929                    appendshortlink $a [mc "Commit "] "  $heada\n"
8930                    appendshortlink $b [mc " is the same patch as\n       "] \
8931                        "  $headb\n"
8932                }
8933                set skipa 1
8934                set skipb 1
8935            } else {
8936                $ctext insert end "\n"
8937                appendshortlink $a [mc "Commit "] "  $heada\n"
8938                appendshortlink $b [mc " differs from\n       "] \
8939                    "  $headb\n"
8940                $ctext insert end [mc "Diff of commits:\n\n"]
8941                $ctext conf -state disabled
8942                update
8943                diffcommits $a $b
8944                return
8945            }
8946        }
8947        if {$skipa} {
8948            set kids [real_children $curview,$a]
8949            if {[llength $kids] != 1} {
8950                $ctext insert end "\n"
8951                appendshortlink $a [mc "Commit "] \
8952                    [mc " has %s children - stopping\n" [llength $kids]]
8953                break
8954            }
8955            set a [lindex $kids 0]
8956        }
8957        if {$skipb} {
8958            set kids [real_children $curview,$b]
8959            if {[llength $kids] != 1} {
8960                appendshortlink $b [mc "Commit "] \
8961                    [mc " has %s children - stopping\n" [llength $kids]]
8962                break
8963            }
8964            set b [lindex $kids 0]
8965        }
8966    }
8967    $ctext conf -state disabled
8968}
8969
8970proc diffcommits {a b} {
8971    global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
8972
8973    set tmpdir [gitknewtmpdir]
8974    set fna [file join $tmpdir "commit-[string range $a 0 7]"]
8975    set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
8976    if {[catch {
8977        exec git diff-tree -p --pretty $a >$fna
8978        exec git diff-tree -p --pretty $b >$fnb
8979    } err]} {
8980        error_popup [mc "Error writing commit to file: %s" $err]
8981        return
8982    }
8983    if {[catch {
8984        set fd [open "| diff -U$diffcontext $fna $fnb" r]
8985    } err]} {
8986        error_popup [mc "Error diffing commits: %s" $err]
8987        return
8988    }
8989    set diffids [list commits $a $b]
8990    set blobdifffd($diffids) $fd
8991    set diffinhdr 0
8992    set currdiffsubmod ""
8993    filerun $fd [list getblobdiffline $fd $diffids]
8994}
8995
8996proc diffvssel {dirn} {
8997    global rowmenuid selectedline
8998
8999    if {$selectedline eq {}} return
9000    if {$dirn} {
9001        set oldid [commitonrow $selectedline]
9002        set newid $rowmenuid
9003    } else {
9004        set oldid $rowmenuid
9005        set newid [commitonrow $selectedline]
9006    }
9007    addtohistory [list doseldiff $oldid $newid] savectextpos
9008    doseldiff $oldid $newid
9009}
9010
9011proc diffvsmark {dirn} {
9012    global rowmenuid markedid
9013
9014    if {![info exists markedid]} return
9015    if {$dirn} {
9016        set oldid $markedid
9017        set newid $rowmenuid
9018    } else {
9019        set oldid $rowmenuid
9020        set newid $markedid
9021    }
9022    addtohistory [list doseldiff $oldid $newid] savectextpos
9023    doseldiff $oldid $newid
9024}
9025
9026proc doseldiff {oldid newid} {
9027    global ctext
9028    global commitinfo
9029
9030    $ctext conf -state normal
9031    clear_ctext
9032    init_flist [mc "Top"]
9033    $ctext insert end "[mc "From"] "
9034    $ctext insert end $oldid link0
9035    setlink $oldid link0
9036    $ctext insert end "\n     "
9037    $ctext insert end [lindex $commitinfo($oldid) 0]
9038    $ctext insert end "\n\n[mc "To"]   "
9039    $ctext insert end $newid link1
9040    setlink $newid link1
9041    $ctext insert end "\n     "
9042    $ctext insert end [lindex $commitinfo($newid) 0]
9043    $ctext insert end "\n"
9044    $ctext conf -state disabled
9045    $ctext tag remove found 1.0 end
9046    startdiff [list $oldid $newid]
9047}
9048
9049proc mkpatch {} {
9050    global rowmenuid currentid commitinfo patchtop patchnum NS
9051
9052    if {![info exists currentid]} return
9053    set oldid $currentid
9054    set oldhead [lindex $commitinfo($oldid) 0]
9055    set newid $rowmenuid
9056    set newhead [lindex $commitinfo($newid) 0]
9057    set top .patch
9058    set patchtop $top
9059    catch {destroy $top}
9060    ttk_toplevel $top
9061    make_transient $top .
9062    ${NS}::label $top.title -text [mc "Generate patch"]
9063    grid $top.title - -pady 10
9064    ${NS}::label $top.from -text [mc "From:"]
9065    ${NS}::entry $top.fromsha1 -width 40
9066    $top.fromsha1 insert 0 $oldid
9067    $top.fromsha1 conf -state readonly
9068    grid $top.from $top.fromsha1 -sticky w
9069    ${NS}::entry $top.fromhead -width 60
9070    $top.fromhead insert 0 $oldhead
9071    $top.fromhead conf -state readonly
9072    grid x $top.fromhead -sticky w
9073    ${NS}::label $top.to -text [mc "To:"]
9074    ${NS}::entry $top.tosha1 -width 40
9075    $top.tosha1 insert 0 $newid
9076    $top.tosha1 conf -state readonly
9077    grid $top.to $top.tosha1 -sticky w
9078    ${NS}::entry $top.tohead -width 60
9079    $top.tohead insert 0 $newhead
9080    $top.tohead conf -state readonly
9081    grid x $top.tohead -sticky w
9082    ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
9083    grid $top.rev x -pady 10 -padx 5
9084    ${NS}::label $top.flab -text [mc "Output file:"]
9085    ${NS}::entry $top.fname -width 60
9086    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
9087    incr patchnum
9088    grid $top.flab $top.fname -sticky w
9089    ${NS}::frame $top.buts
9090    ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
9091    ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
9092    bind $top <Key-Return> mkpatchgo
9093    bind $top <Key-Escape> mkpatchcan
9094    grid $top.buts.gen $top.buts.can
9095    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9096    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9097    grid $top.buts - -pady 10 -sticky ew
9098    focus $top.fname
9099}
9100
9101proc mkpatchrev {} {
9102    global patchtop
9103
9104    set oldid [$patchtop.fromsha1 get]
9105    set oldhead [$patchtop.fromhead get]
9106    set newid [$patchtop.tosha1 get]
9107    set newhead [$patchtop.tohead get]
9108    foreach e [list fromsha1 fromhead tosha1 tohead] \
9109            v [list $newid $newhead $oldid $oldhead] {
9110        $patchtop.$e conf -state normal
9111        $patchtop.$e delete 0 end
9112        $patchtop.$e insert 0 $v
9113        $patchtop.$e conf -state readonly
9114    }
9115}
9116
9117proc mkpatchgo {} {
9118    global patchtop nullid nullid2
9119
9120    set oldid [$patchtop.fromsha1 get]
9121    set newid [$patchtop.tosha1 get]
9122    set fname [$patchtop.fname get]
9123    set cmd [diffcmd [list $oldid $newid] -p]
9124    # trim off the initial "|"
9125    set cmd [lrange $cmd 1 end]
9126    lappend cmd >$fname &
9127    if {[catch {eval exec $cmd} err]} {
9128        error_popup "[mc "Error creating patch:"] $err" $patchtop
9129    }
9130    catch {destroy $patchtop}
9131    unset patchtop
9132}
9133
9134proc mkpatchcan {} {
9135    global patchtop
9136
9137    catch {destroy $patchtop}
9138    unset patchtop
9139}
9140
9141proc mktag {} {
9142    global rowmenuid mktagtop commitinfo NS
9143
9144    set top .maketag
9145    set mktagtop $top
9146    catch {destroy $top}
9147    ttk_toplevel $top
9148    make_transient $top .
9149    ${NS}::label $top.title -text [mc "Create tag"]
9150    grid $top.title - -pady 10
9151    ${NS}::label $top.id -text [mc "ID:"]
9152    ${NS}::entry $top.sha1 -width 40
9153    $top.sha1 insert 0 $rowmenuid
9154    $top.sha1 conf -state readonly
9155    grid $top.id $top.sha1 -sticky w
9156    ${NS}::entry $top.head -width 60
9157    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9158    $top.head conf -state readonly
9159    grid x $top.head -sticky w
9160    ${NS}::label $top.tlab -text [mc "Tag name:"]
9161    ${NS}::entry $top.tag -width 60
9162    grid $top.tlab $top.tag -sticky w
9163    ${NS}::label $top.op -text [mc "Tag message is optional"]
9164    grid $top.op -columnspan 2 -sticky we
9165    ${NS}::label $top.mlab -text [mc "Tag message:"]
9166    ${NS}::entry $top.msg -width 60
9167    grid $top.mlab $top.msg -sticky w
9168    ${NS}::frame $top.buts
9169    ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
9170    ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
9171    bind $top <Key-Return> mktaggo
9172    bind $top <Key-Escape> mktagcan
9173    grid $top.buts.gen $top.buts.can
9174    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9175    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9176    grid $top.buts - -pady 10 -sticky ew
9177    focus $top.tag
9178}
9179
9180proc domktag {} {
9181    global mktagtop env tagids idtags
9182
9183    set id [$mktagtop.sha1 get]
9184    set tag [$mktagtop.tag get]
9185    set msg [$mktagtop.msg get]
9186    if {$tag == {}} {
9187        error_popup [mc "No tag name specified"] $mktagtop
9188        return 0
9189    }
9190    if {[info exists tagids($tag)]} {
9191        error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
9192        return 0
9193    }
9194    if {[catch {
9195        if {$msg != {}} {
9196            exec git tag -a -m $msg $tag $id
9197        } else {
9198            exec git tag $tag $id
9199        }
9200    } err]} {
9201        error_popup "[mc "Error creating tag:"] $err" $mktagtop
9202        return 0
9203    }
9204
9205    set tagids($tag) $id
9206    lappend idtags($id) $tag
9207    redrawtags $id
9208    addedtag $id
9209    dispneartags 0
9210    run refill_reflist
9211    return 1
9212}
9213
9214proc redrawtags {id} {
9215    global canv linehtag idpos currentid curview cmitlisted markedid
9216    global canvxmax iddrawn circleitem mainheadid circlecolors
9217    global mainheadcirclecolor
9218
9219    if {![commitinview $id $curview]} return
9220    if {![info exists iddrawn($id)]} return
9221    set row [rowofcommit $id]
9222    if {$id eq $mainheadid} {
9223        set ofill $mainheadcirclecolor
9224    } else {
9225        set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
9226    }
9227    $canv itemconf $circleitem($row) -fill $ofill
9228    $canv delete tag.$id
9229    set xt [eval drawtags $id $idpos($id)]
9230    $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
9231    set text [$canv itemcget $linehtag($id) -text]
9232    set font [$canv itemcget $linehtag($id) -font]
9233    set xr [expr {$xt + [font measure $font $text]}]
9234    if {$xr > $canvxmax} {
9235        set canvxmax $xr
9236        setcanvscroll
9237    }
9238    if {[info exists currentid] && $currentid == $id} {
9239        make_secsel $id
9240    }
9241    if {[info exists markedid] && $markedid eq $id} {
9242        make_idmark $id
9243    }
9244}
9245
9246proc mktagcan {} {
9247    global mktagtop
9248
9249    catch {destroy $mktagtop}
9250    unset mktagtop
9251}
9252
9253proc mktaggo {} {
9254    if {![domktag]} return
9255    mktagcan
9256}
9257
9258proc writecommit {} {
9259    global rowmenuid wrcomtop commitinfo wrcomcmd NS
9260
9261    set top .writecommit
9262    set wrcomtop $top
9263    catch {destroy $top}
9264    ttk_toplevel $top
9265    make_transient $top .
9266    ${NS}::label $top.title -text [mc "Write commit to file"]
9267    grid $top.title - -pady 10
9268    ${NS}::label $top.id -text [mc "ID:"]
9269    ${NS}::entry $top.sha1 -width 40
9270    $top.sha1 insert 0 $rowmenuid
9271    $top.sha1 conf -state readonly
9272    grid $top.id $top.sha1 -sticky w
9273    ${NS}::entry $top.head -width 60
9274    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9275    $top.head conf -state readonly
9276    grid x $top.head -sticky w
9277    ${NS}::label $top.clab -text [mc "Command:"]
9278    ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
9279    grid $top.clab $top.cmd -sticky w -pady 10
9280    ${NS}::label $top.flab -text [mc "Output file:"]
9281    ${NS}::entry $top.fname -width 60
9282    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
9283    grid $top.flab $top.fname -sticky w
9284    ${NS}::frame $top.buts
9285    ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
9286    ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
9287    bind $top <Key-Return> wrcomgo
9288    bind $top <Key-Escape> wrcomcan
9289    grid $top.buts.gen $top.buts.can
9290    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9291    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9292    grid $top.buts - -pady 10 -sticky ew
9293    focus $top.fname
9294}
9295
9296proc wrcomgo {} {
9297    global wrcomtop
9298
9299    set id [$wrcomtop.sha1 get]
9300    set cmd "echo $id | [$wrcomtop.cmd get]"
9301    set fname [$wrcomtop.fname get]
9302    if {[catch {exec sh -c $cmd >$fname &} err]} {
9303        error_popup "[mc "Error writing commit:"] $err" $wrcomtop
9304    }
9305    catch {destroy $wrcomtop}
9306    unset wrcomtop
9307}
9308
9309proc wrcomcan {} {
9310    global wrcomtop
9311
9312    catch {destroy $wrcomtop}
9313    unset wrcomtop
9314}
9315
9316proc mkbranch {} {
9317    global rowmenuid mkbrtop NS
9318
9319    set top .makebranch
9320    catch {destroy $top}
9321    ttk_toplevel $top
9322    make_transient $top .
9323    ${NS}::label $top.title -text [mc "Create new branch"]
9324    grid $top.title - -pady 10
9325    ${NS}::label $top.id -text [mc "ID:"]
9326    ${NS}::entry $top.sha1 -width 40
9327    $top.sha1 insert 0 $rowmenuid
9328    $top.sha1 conf -state readonly
9329    grid $top.id $top.sha1 -sticky w
9330    ${NS}::label $top.nlab -text [mc "Name:"]
9331    ${NS}::entry $top.name -width 40
9332    grid $top.nlab $top.name -sticky w
9333    ${NS}::frame $top.buts
9334    ${NS}::button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
9335    ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
9336    bind $top <Key-Return> [list mkbrgo $top]
9337    bind $top <Key-Escape> "catch {destroy $top}"
9338    grid $top.buts.go $top.buts.can
9339    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9340    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9341    grid $top.buts - -pady 10 -sticky ew
9342    focus $top.name
9343}
9344
9345proc mkbrgo {top} {
9346    global headids idheads
9347
9348    set name [$top.name get]
9349    set id [$top.sha1 get]
9350    set cmdargs {}
9351    set old_id {}
9352    if {$name eq {}} {
9353        error_popup [mc "Please specify a name for the new branch"] $top
9354        return
9355    }
9356    if {[info exists headids($name)]} {
9357        if {![confirm_popup [mc \
9358                "Branch '%s' already exists. Overwrite?" $name] $top]} {
9359            return
9360        }
9361        set old_id $headids($name)
9362        lappend cmdargs -f
9363    }
9364    catch {destroy $top}
9365    lappend cmdargs $name $id
9366    nowbusy newbranch
9367    update
9368    if {[catch {
9369        eval exec git branch $cmdargs
9370    } err]} {
9371        notbusy newbranch
9372        error_popup $err
9373    } else {
9374        notbusy newbranch
9375        if {$old_id ne {}} {
9376            movehead $id $name
9377            movedhead $id $name
9378            redrawtags $old_id
9379            redrawtags $id
9380        } else {
9381            set headids($name) $id
9382            lappend idheads($id) $name
9383            addedhead $id $name
9384            redrawtags $id
9385        }
9386        dispneartags 0
9387        run refill_reflist
9388    }
9389}
9390
9391proc exec_citool {tool_args {baseid {}}} {
9392    global commitinfo env
9393
9394    set save_env [array get env GIT_AUTHOR_*]
9395
9396    if {$baseid ne {}} {
9397        if {![info exists commitinfo($baseid)]} {
9398            getcommit $baseid
9399        }
9400        set author [lindex $commitinfo($baseid) 1]
9401        set date [lindex $commitinfo($baseid) 2]
9402        if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9403                    $author author name email]
9404            && $date ne {}} {
9405            set env(GIT_AUTHOR_NAME) $name
9406            set env(GIT_AUTHOR_EMAIL) $email
9407            set env(GIT_AUTHOR_DATE) $date
9408        }
9409    }
9410
9411    eval exec git citool $tool_args &
9412
9413    array unset env GIT_AUTHOR_*
9414    array set env $save_env
9415}
9416
9417proc cherrypick {} {
9418    global rowmenuid curview
9419    global mainhead mainheadid
9420    global gitdir
9421
9422    set oldhead [exec git rev-parse HEAD]
9423    set dheads [descheads $rowmenuid]
9424    if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
9425        set ok [confirm_popup [mc "Commit %s is already\
9426                included in branch %s -- really re-apply it?" \
9427                                   [string range $rowmenuid 0 7] $mainhead]]
9428        if {!$ok} return
9429    }
9430    nowbusy cherrypick [mc "Cherry-picking"]
9431    update
9432    # Unfortunately git-cherry-pick writes stuff to stderr even when
9433    # no error occurs, and exec takes that as an indication of error...
9434    if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9435        notbusy cherrypick
9436        if {[regexp -line \
9437                 {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9438                 $err msg fname]} {
9439            error_popup [mc "Cherry-pick failed because of local changes\
9440                        to file '%s'.\nPlease commit, reset or stash\
9441                        your changes and try again." $fname]
9442        } elseif {[regexp -line \
9443                       {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
9444                       $err]} {
9445            if {[confirm_popup [mc "Cherry-pick failed because of merge\
9446                        conflict.\nDo you wish to run git citool to\
9447                        resolve it?"]]} {
9448                # Force citool to read MERGE_MSG
9449                file delete [file join $gitdir "GITGUI_MSG"]
9450                exec_citool {} $rowmenuid
9451            }
9452        } else {
9453            error_popup $err
9454        }
9455        run updatecommits
9456        return
9457    }
9458    set newhead [exec git rev-parse HEAD]
9459    if {$newhead eq $oldhead} {
9460        notbusy cherrypick
9461        error_popup [mc "No changes committed"]
9462        return
9463    }
9464    addnewchild $newhead $oldhead
9465    if {[commitinview $oldhead $curview]} {
9466        # XXX this isn't right if we have a path limit...
9467        insertrow $newhead $oldhead $curview
9468        if {$mainhead ne {}} {
9469            movehead $newhead $mainhead
9470            movedhead $newhead $mainhead
9471        }
9472        set mainheadid $newhead
9473        redrawtags $oldhead
9474        redrawtags $newhead
9475        selbyid $newhead
9476    }
9477    notbusy cherrypick
9478}
9479
9480proc revert {} {
9481    global rowmenuid curview
9482    global mainhead mainheadid
9483    global gitdir
9484
9485    set oldhead [exec git rev-parse HEAD]
9486    set dheads [descheads $rowmenuid]
9487    if { $dheads eq {} || [lsearch -exact $dheads $oldhead] == -1 } {
9488       set ok [confirm_popup [mc "Commit %s is not\
9489           included in branch %s -- really revert it?" \
9490                      [string range $rowmenuid 0 7] $mainhead]]
9491       if {!$ok} return
9492    }
9493    nowbusy revert [mc "Reverting"]
9494    update
9495
9496    if [catch {exec git revert --no-edit $rowmenuid} err] {
9497        notbusy revert
9498        if [regexp {files would be overwritten by merge:(\n(( |\t)+[^\n]+\n)+)}\
9499                $err match files] {
9500            regsub {\n( |\t)+} $files "\n" files
9501            error_popup [mc "Revert failed because of local changes to\
9502                the following files:%s Please commit, reset or stash \
9503                your changes and try again." $files]
9504        } elseif [regexp {error: could not revert} $err] {
9505            if [confirm_popup [mc "Revert failed because of merge conflict.\n\
9506                Do you wish to run git citool to resolve it?"]] {
9507                # Force citool to read MERGE_MSG
9508                file delete [file join $gitdir "GITGUI_MSG"]
9509                exec_citool {} $rowmenuid
9510            }
9511        } else { error_popup $err }
9512        run updatecommits
9513        return
9514    }
9515
9516    set newhead [exec git rev-parse HEAD]
9517    if { $newhead eq $oldhead } {
9518        notbusy revert
9519        error_popup [mc "No changes committed"]
9520        return
9521    }
9522
9523    addnewchild $newhead $oldhead
9524
9525    if [commitinview $oldhead $curview] {
9526        # XXX this isn't right if we have a path limit...
9527        insertrow $newhead $oldhead $curview
9528        if {$mainhead ne {}} {
9529            movehead $newhead $mainhead
9530            movedhead $newhead $mainhead
9531        }
9532        set mainheadid $newhead
9533        redrawtags $oldhead
9534        redrawtags $newhead
9535        selbyid $newhead
9536    }
9537
9538    notbusy revert
9539}
9540
9541proc resethead {} {
9542    global mainhead rowmenuid confirm_ok resettype NS
9543
9544    set confirm_ok 0
9545    set w ".confirmreset"
9546    ttk_toplevel $w
9547    make_transient $w .
9548    wm title $w [mc "Confirm reset"]
9549    ${NS}::label $w.m -text \
9550        [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
9551    pack $w.m -side top -fill x -padx 20 -pady 20
9552    ${NS}::labelframe $w.f -text [mc "Reset type:"]
9553    set resettype mixed
9554    ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
9555        -text [mc "Soft: Leave working tree and index untouched"]
9556    grid $w.f.soft -sticky w
9557    ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
9558        -text [mc "Mixed: Leave working tree untouched, reset index"]
9559    grid $w.f.mixed -sticky w
9560    ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
9561        -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
9562    grid $w.f.hard -sticky w
9563    pack $w.f -side top -fill x -padx 4
9564    ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
9565    pack $w.ok -side left -fill x -padx 20 -pady 20
9566    ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
9567    bind $w <Key-Escape> [list destroy $w]
9568    pack $w.cancel -side right -fill x -padx 20 -pady 20
9569    bind $w <Visibility> "grab $w; focus $w"
9570    tkwait window $w
9571    if {!$confirm_ok} return
9572    if {[catch {set fd [open \
9573            [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
9574        error_popup $err
9575    } else {
9576        dohidelocalchanges
9577        filerun $fd [list readresetstat $fd]
9578        nowbusy reset [mc "Resetting"]
9579        selbyid $rowmenuid
9580    }
9581}
9582
9583proc readresetstat {fd} {
9584    global mainhead mainheadid showlocalchanges rprogcoord
9585
9586    if {[gets $fd line] >= 0} {
9587        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9588            set rprogcoord [expr {1.0 * $m / $n}]
9589            adjustprogress
9590        }
9591        return 1
9592    }
9593    set rprogcoord 0
9594    adjustprogress
9595    notbusy reset
9596    if {[catch {close $fd} err]} {
9597        error_popup $err
9598    }
9599    set oldhead $mainheadid
9600    set newhead [exec git rev-parse HEAD]
9601    if {$newhead ne $oldhead} {
9602        movehead $newhead $mainhead
9603        movedhead $newhead $mainhead
9604        set mainheadid $newhead
9605        redrawtags $oldhead
9606        redrawtags $newhead
9607    }
9608    if {$showlocalchanges} {
9609        doshowlocalchanges
9610    }
9611    return 0
9612}
9613
9614# context menu for a head
9615proc headmenu {x y id head} {
9616    global headmenuid headmenuhead headctxmenu mainhead
9617
9618    stopfinding
9619    set headmenuid $id
9620    set headmenuhead $head
9621    set state normal
9622    if {[string match "remotes/*" $head]} {
9623        set state disabled
9624    }
9625    if {$head eq $mainhead} {
9626        set state disabled
9627    }
9628    $headctxmenu entryconfigure 0 -state $state
9629    $headctxmenu entryconfigure 1 -state $state
9630    tk_popup $headctxmenu $x $y
9631}
9632
9633proc cobranch {} {
9634    global headmenuid headmenuhead headids
9635    global showlocalchanges
9636
9637    # check the tree is clean first??
9638    nowbusy checkout [mc "Checking out"]
9639    update
9640    dohidelocalchanges
9641    if {[catch {
9642        set fd [open [list | git checkout $headmenuhead 2>@1] r]
9643    } err]} {
9644        notbusy checkout
9645        error_popup $err
9646        if {$showlocalchanges} {
9647            dodiffindex
9648        }
9649    } else {
9650        filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
9651    }
9652}
9653
9654proc readcheckoutstat {fd newhead newheadid} {
9655    global mainhead mainheadid headids showlocalchanges progresscoords
9656    global viewmainheadid curview
9657
9658    if {[gets $fd line] >= 0} {
9659        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9660            set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9661            adjustprogress
9662        }
9663        return 1
9664    }
9665    set progresscoords {0 0}
9666    adjustprogress
9667    notbusy checkout
9668    if {[catch {close $fd} err]} {
9669        error_popup $err
9670    }
9671    set oldmainid $mainheadid
9672    set mainhead $newhead
9673    set mainheadid $newheadid
9674    set viewmainheadid($curview) $newheadid
9675    redrawtags $oldmainid
9676    redrawtags $newheadid
9677    selbyid $newheadid
9678    if {$showlocalchanges} {
9679        dodiffindex
9680    }
9681}
9682
9683proc rmbranch {} {
9684    global headmenuid headmenuhead mainhead
9685    global idheads
9686
9687    set head $headmenuhead
9688    set id $headmenuid
9689    # this check shouldn't be needed any more...
9690    if {$head eq $mainhead} {
9691        error_popup [mc "Cannot delete the currently checked-out branch"]
9692        return
9693    }
9694    set dheads [descheads $id]
9695    if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
9696        # the stuff on this branch isn't on any other branch
9697        if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9698                        branch.\nReally delete branch %s?" $head $head]]} return
9699    }
9700    nowbusy rmbranch
9701    update
9702    if {[catch {exec git branch -D $head} err]} {
9703        notbusy rmbranch
9704        error_popup $err
9705        return
9706    }
9707    removehead $id $head
9708    removedhead $id $head
9709    redrawtags $id
9710    notbusy rmbranch
9711    dispneartags 0
9712    run refill_reflist
9713}
9714
9715# Display a list of tags and heads
9716proc showrefs {} {
9717    global showrefstop bgcolor fgcolor selectbgcolor NS
9718    global bglist fglist reflistfilter reflist maincursor
9719
9720    set top .showrefs
9721    set showrefstop $top
9722    if {[winfo exists $top]} {
9723        raise $top
9724        refill_reflist
9725        return
9726    }
9727    ttk_toplevel $top
9728    wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
9729    make_transient $top .
9730    text $top.list -background $bgcolor -foreground $fgcolor \
9731        -selectbackground $selectbgcolor -font mainfont \
9732        -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
9733        -width 30 -height 20 -cursor $maincursor \
9734        -spacing1 1 -spacing3 1 -state disabled
9735    $top.list tag configure highlight -background $selectbgcolor
9736    lappend bglist $top.list
9737    lappend fglist $top.list
9738    ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
9739    ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
9740    grid $top.list $top.ysb -sticky nsew
9741    grid $top.xsb x -sticky ew
9742    ${NS}::frame $top.f
9743    ${NS}::label $top.f.l -text "[mc "Filter"]: "
9744    ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
9745    set reflistfilter "*"
9746    trace add variable reflistfilter write reflistfilter_change
9747    pack $top.f.e -side right -fill x -expand 1
9748    pack $top.f.l -side left
9749    grid $top.f - -sticky ew -pady 2
9750    ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
9751    bind $top <Key-Escape> [list destroy $top]
9752    grid $top.close -
9753    grid columnconfigure $top 0 -weight 1
9754    grid rowconfigure $top 0 -weight 1
9755    bind $top.list <1> {break}
9756    bind $top.list <B1-Motion> {break}
9757    bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
9758    set reflist {}
9759    refill_reflist
9760}
9761
9762proc sel_reflist {w x y} {
9763    global showrefstop reflist headids tagids otherrefids
9764
9765    if {![winfo exists $showrefstop]} return
9766    set l [lindex [split [$w index "@$x,$y"] "."] 0]
9767    set ref [lindex $reflist [expr {$l-1}]]
9768    set n [lindex $ref 0]
9769    switch -- [lindex $ref 1] {
9770        "H" {selbyid $headids($n)}
9771        "T" {selbyid $tagids($n)}
9772        "o" {selbyid $otherrefids($n)}
9773    }
9774    $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
9775}
9776
9777proc unsel_reflist {} {
9778    global showrefstop
9779
9780    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9781    $showrefstop.list tag remove highlight 0.0 end
9782}
9783
9784proc reflistfilter_change {n1 n2 op} {
9785    global reflistfilter
9786
9787    after cancel refill_reflist
9788    after 200 refill_reflist
9789}
9790
9791proc refill_reflist {} {
9792    global reflist reflistfilter showrefstop headids tagids otherrefids
9793    global curview
9794
9795    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9796    set refs {}
9797    foreach n [array names headids] {
9798        if {[string match $reflistfilter $n]} {
9799            if {[commitinview $headids($n) $curview]} {
9800                lappend refs [list $n H]
9801            } else {
9802                interestedin $headids($n) {run refill_reflist}
9803            }
9804        }
9805    }
9806    foreach n [array names tagids] {
9807        if {[string match $reflistfilter $n]} {
9808            if {[commitinview $tagids($n) $curview]} {
9809                lappend refs [list $n T]
9810            } else {
9811                interestedin $tagids($n) {run refill_reflist}
9812            }
9813        }
9814    }
9815    foreach n [array names otherrefids] {
9816        if {[string match $reflistfilter $n]} {
9817            if {[commitinview $otherrefids($n) $curview]} {
9818                lappend refs [list $n o]
9819            } else {
9820                interestedin $otherrefids($n) {run refill_reflist}
9821            }
9822        }
9823    }
9824    set refs [lsort -index 0 $refs]
9825    if {$refs eq $reflist} return
9826
9827    # Update the contents of $showrefstop.list according to the
9828    # differences between $reflist (old) and $refs (new)
9829    $showrefstop.list conf -state normal
9830    $showrefstop.list insert end "\n"
9831    set i 0
9832    set j 0
9833    while {$i < [llength $reflist] || $j < [llength $refs]} {
9834        if {$i < [llength $reflist]} {
9835            if {$j < [llength $refs]} {
9836                set cmp [string compare [lindex $reflist $i 0] \
9837                             [lindex $refs $j 0]]
9838                if {$cmp == 0} {
9839                    set cmp [string compare [lindex $reflist $i 1] \
9840                                 [lindex $refs $j 1]]
9841                }
9842            } else {
9843                set cmp -1
9844            }
9845        } else {
9846            set cmp 1
9847        }
9848        switch -- $cmp {
9849            -1 {
9850                $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
9851                incr i
9852            }
9853            0 {
9854                incr i
9855                incr j
9856            }
9857            1 {
9858                set l [expr {$j + 1}]
9859                $showrefstop.list image create $l.0 -align baseline \
9860                    -image reficon-[lindex $refs $j 1] -padx 2
9861                $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
9862                incr j
9863            }
9864        }
9865    }
9866    set reflist $refs
9867    # delete last newline
9868    $showrefstop.list delete end-2c end-1c
9869    $showrefstop.list conf -state disabled
9870}
9871
9872# Stuff for finding nearby tags
9873proc getallcommits {} {
9874    global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
9875    global idheads idtags idotherrefs allparents tagobjid
9876    global gitdir
9877
9878    if {![info exists allcommits]} {
9879        set nextarc 0
9880        set allcommits 0
9881        set seeds {}
9882        set allcwait 0
9883        set cachedarcs 0
9884        set allccache [file join $gitdir "gitk.cache"]
9885        if {![catch {
9886            set f [open $allccache r]
9887            set allcwait 1
9888            getcache $f
9889        }]} return
9890    }
9891
9892    if {$allcwait} {
9893        return
9894    }
9895    set cmd [list | git rev-list --parents]
9896    set allcupdate [expr {$seeds ne {}}]
9897    if {!$allcupdate} {
9898        set ids "--all"
9899    } else {
9900        set refs [concat [array names idheads] [array names idtags] \
9901                      [array names idotherrefs]]
9902        set ids {}
9903        set tagobjs {}
9904        foreach name [array names tagobjid] {
9905            lappend tagobjs $tagobjid($name)
9906        }
9907        foreach id [lsort -unique $refs] {
9908            if {![info exists allparents($id)] &&
9909                [lsearch -exact $tagobjs $id] < 0} {
9910                lappend ids $id
9911            }
9912        }
9913        if {$ids ne {}} {
9914            foreach id $seeds {
9915                lappend ids "^$id"
9916            }
9917        }
9918    }
9919    if {$ids ne {}} {
9920        set fd [open [concat $cmd $ids] r]
9921        fconfigure $fd -blocking 0
9922        incr allcommits
9923        nowbusy allcommits
9924        filerun $fd [list getallclines $fd]
9925    } else {
9926        dispneartags 0
9927    }
9928}
9929
9930# Since most commits have 1 parent and 1 child, we group strings of
9931# such commits into "arcs" joining branch/merge points (BMPs), which
9932# are commits that either don't have 1 parent or don't have 1 child.
9933#
9934# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
9935# arcout(id) - outgoing arcs for BMP
9936# arcids(a) - list of IDs on arc including end but not start
9937# arcstart(a) - BMP ID at start of arc
9938# arcend(a) - BMP ID at end of arc
9939# growing(a) - arc a is still growing
9940# arctags(a) - IDs out of arcids (excluding end) that have tags
9941# archeads(a) - IDs out of arcids (excluding end) that have heads
9942# The start of an arc is at the descendent end, so "incoming" means
9943# coming from descendents, and "outgoing" means going towards ancestors.
9944
9945proc getallclines {fd} {
9946    global allparents allchildren idtags idheads nextarc
9947    global arcnos arcids arctags arcout arcend arcstart archeads growing
9948    global seeds allcommits cachedarcs allcupdate
9949
9950    set nid 0
9951    while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
9952        set id [lindex $line 0]
9953        if {[info exists allparents($id)]} {
9954            # seen it already
9955            continue
9956        }
9957        set cachedarcs 0
9958        set olds [lrange $line 1 end]
9959        set allparents($id) $olds
9960        if {![info exists allchildren($id)]} {
9961            set allchildren($id) {}
9962            set arcnos($id) {}
9963            lappend seeds $id
9964        } else {
9965            set a $arcnos($id)
9966            if {[llength $olds] == 1 && [llength $a] == 1} {
9967                lappend arcids($a) $id
9968                if {[info exists idtags($id)]} {
9969                    lappend arctags($a) $id
9970                }
9971                if {[info exists idheads($id)]} {
9972                    lappend archeads($a) $id
9973                }
9974                if {[info exists allparents($olds)]} {
9975                    # seen parent already
9976                    if {![info exists arcout($olds)]} {
9977                        splitarc $olds
9978                    }
9979                    lappend arcids($a) $olds
9980                    set arcend($a) $olds
9981                    unset growing($a)
9982                }
9983                lappend allchildren($olds) $id
9984                lappend arcnos($olds) $a
9985                continue
9986            }
9987        }
9988        foreach a $arcnos($id) {
9989            lappend arcids($a) $id
9990            set arcend($a) $id
9991            unset growing($a)
9992        }
9993
9994        set ao {}
9995        foreach p $olds {
9996            lappend allchildren($p) $id
9997            set a [incr nextarc]
9998            set arcstart($a) $id
9999            set archeads($a) {}
10000            set arctags($a) {}
10001            set archeads($a) {}
10002            set arcids($a) {}
10003            lappend ao $a
10004            set growing($a) 1
10005            if {[info exists allparents($p)]} {
10006                # seen it already, may need to make a new branch
10007                if {![info exists arcout($p)]} {
10008                    splitarc $p
10009                }
10010                lappend arcids($a) $p
10011                set arcend($a) $p
10012                unset growing($a)
10013            }
10014            lappend arcnos($p) $a
10015        }
10016        set arcout($id) $ao
10017    }
10018    if {$nid > 0} {
10019        global cached_dheads cached_dtags cached_atags
10020        catch {unset cached_dheads}
10021        catch {unset cached_dtags}
10022        catch {unset cached_atags}
10023    }
10024    if {![eof $fd]} {
10025        return [expr {$nid >= 1000? 2: 1}]
10026    }
10027    set cacheok 1
10028    if {[catch {
10029        fconfigure $fd -blocking 1
10030        close $fd
10031    } err]} {
10032        # got an error reading the list of commits
10033        # if we were updating, try rereading the whole thing again
10034        if {$allcupdate} {
10035            incr allcommits -1
10036            dropcache $err
10037            return
10038        }
10039        error_popup "[mc "Error reading commit topology information;\
10040                branch and preceding/following tag information\
10041                will be incomplete."]\n($err)"
10042        set cacheok 0
10043    }
10044    if {[incr allcommits -1] == 0} {
10045        notbusy allcommits
10046        if {$cacheok} {
10047            run savecache
10048        }
10049    }
10050    dispneartags 0
10051    return 0
10052}
10053
10054proc recalcarc {a} {
10055    global arctags archeads arcids idtags idheads
10056
10057    set at {}
10058    set ah {}
10059    foreach id [lrange $arcids($a) 0 end-1] {
10060        if {[info exists idtags($id)]} {
10061            lappend at $id
10062        }
10063        if {[info exists idheads($id)]} {
10064            lappend ah $id
10065        }
10066    }
10067    set arctags($a) $at
10068    set archeads($a) $ah
10069}
10070
10071proc splitarc {p} {
10072    global arcnos arcids nextarc arctags archeads idtags idheads
10073    global arcstart arcend arcout allparents growing
10074
10075    set a $arcnos($p)
10076    if {[llength $a] != 1} {
10077        puts "oops splitarc called but [llength $a] arcs already"
10078        return
10079    }
10080    set a [lindex $a 0]
10081    set i [lsearch -exact $arcids($a) $p]
10082    if {$i < 0} {
10083        puts "oops splitarc $p not in arc $a"
10084        return
10085    }
10086    set na [incr nextarc]
10087    if {[info exists arcend($a)]} {
10088        set arcend($na) $arcend($a)
10089    } else {
10090        set l [lindex $allparents([lindex $arcids($a) end]) 0]
10091        set j [lsearch -exact $arcnos($l) $a]
10092        set arcnos($l) [lreplace $arcnos($l) $j $j $na]
10093    }
10094    set tail [lrange $arcids($a) [expr {$i+1}] end]
10095    set arcids($a) [lrange $arcids($a) 0 $i]
10096    set arcend($a) $p
10097    set arcstart($na) $p
10098    set arcout($p) $na
10099    set arcids($na) $tail
10100    if {[info exists growing($a)]} {
10101        set growing($na) 1
10102        unset growing($a)
10103    }
10104
10105    foreach id $tail {
10106        if {[llength $arcnos($id)] == 1} {
10107            set arcnos($id) $na
10108        } else {
10109            set j [lsearch -exact $arcnos($id) $a]
10110            set arcnos($id) [lreplace $arcnos($id) $j $j $na]
10111        }
10112    }
10113
10114    # reconstruct tags and heads lists
10115    if {$arctags($a) ne {} || $archeads($a) ne {}} {
10116        recalcarc $a
10117        recalcarc $na
10118    } else {
10119        set arctags($na) {}
10120        set archeads($na) {}
10121    }
10122}
10123
10124# Update things for a new commit added that is a child of one
10125# existing commit.  Used when cherry-picking.
10126proc addnewchild {id p} {
10127    global allparents allchildren idtags nextarc
10128    global arcnos arcids arctags arcout arcend arcstart archeads growing
10129    global seeds allcommits
10130
10131    if {![info exists allcommits] || ![info exists arcnos($p)]} return
10132    set allparents($id) [list $p]
10133    set allchildren($id) {}
10134    set arcnos($id) {}
10135    lappend seeds $id
10136    lappend allchildren($p) $id
10137    set a [incr nextarc]
10138    set arcstart($a) $id
10139    set archeads($a) {}
10140    set arctags($a) {}
10141    set arcids($a) [list $p]
10142    set arcend($a) $p
10143    if {![info exists arcout($p)]} {
10144        splitarc $p
10145    }
10146    lappend arcnos($p) $a
10147    set arcout($id) [list $a]
10148}
10149
10150# This implements a cache for the topology information.
10151# The cache saves, for each arc, the start and end of the arc,
10152# the ids on the arc, and the outgoing arcs from the end.
10153proc readcache {f} {
10154    global arcnos arcids arcout arcstart arcend arctags archeads nextarc
10155    global idtags idheads allparents cachedarcs possible_seeds seeds growing
10156    global allcwait
10157
10158    set a $nextarc
10159    set lim $cachedarcs
10160    if {$lim - $a > 500} {
10161        set lim [expr {$a + 500}]
10162    }
10163    if {[catch {
10164        if {$a == $lim} {
10165            # finish reading the cache and setting up arctags, etc.
10166            set line [gets $f]
10167            if {$line ne "1"} {error "bad final version"}
10168            close $f
10169            foreach id [array names idtags] {
10170                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10171                    [llength $allparents($id)] == 1} {
10172                    set a [lindex $arcnos($id) 0]
10173                    if {$arctags($a) eq {}} {
10174                        recalcarc $a
10175                    }
10176                }
10177            }
10178            foreach id [array names idheads] {
10179                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10180                    [llength $allparents($id)] == 1} {
10181                    set a [lindex $arcnos($id) 0]
10182                    if {$archeads($a) eq {}} {
10183                        recalcarc $a
10184                    }
10185                }
10186            }
10187            foreach id [lsort -unique $possible_seeds] {
10188                if {$arcnos($id) eq {}} {
10189                    lappend seeds $id
10190                }
10191            }
10192            set allcwait 0
10193        } else {
10194            while {[incr a] <= $lim} {
10195                set line [gets $f]
10196                if {[llength $line] != 3} {error "bad line"}
10197                set s [lindex $line 0]
10198                set arcstart($a) $s
10199                lappend arcout($s) $a
10200                if {![info exists arcnos($s)]} {
10201                    lappend possible_seeds $s
10202                    set arcnos($s) {}
10203                }
10204                set e [lindex $line 1]
10205                if {$e eq {}} {
10206                    set growing($a) 1
10207                } else {
10208                    set arcend($a) $e
10209                    if {![info exists arcout($e)]} {
10210                        set arcout($e) {}
10211                    }
10212                }
10213                set arcids($a) [lindex $line 2]
10214                foreach id $arcids($a) {
10215                    lappend allparents($s) $id
10216                    set s $id
10217                    lappend arcnos($id) $a
10218                }
10219                if {![info exists allparents($s)]} {
10220                    set allparents($s) {}
10221                }
10222                set arctags($a) {}
10223                set archeads($a) {}
10224            }
10225            set nextarc [expr {$a - 1}]
10226        }
10227    } err]} {
10228        dropcache $err
10229        return 0
10230    }
10231    if {!$allcwait} {
10232        getallcommits
10233    }
10234    return $allcwait
10235}
10236
10237proc getcache {f} {
10238    global nextarc cachedarcs possible_seeds
10239
10240    if {[catch {
10241        set line [gets $f]
10242        if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
10243        # make sure it's an integer
10244        set cachedarcs [expr {int([lindex $line 1])}]
10245        if {$cachedarcs < 0} {error "bad number of arcs"}
10246        set nextarc 0
10247        set possible_seeds {}
10248        run readcache $f
10249    } err]} {
10250        dropcache $err
10251    }
10252    return 0
10253}
10254
10255proc dropcache {err} {
10256    global allcwait nextarc cachedarcs seeds
10257
10258    #puts "dropping cache ($err)"
10259    foreach v {arcnos arcout arcids arcstart arcend growing \
10260                   arctags archeads allparents allchildren} {
10261        global $v
10262        catch {unset $v}
10263    }
10264    set allcwait 0
10265    set nextarc 0
10266    set cachedarcs 0
10267    set seeds {}
10268    getallcommits
10269}
10270
10271proc writecache {f} {
10272    global cachearc cachedarcs allccache
10273    global arcstart arcend arcnos arcids arcout
10274
10275    set a $cachearc
10276    set lim $cachedarcs
10277    if {$lim - $a > 1000} {
10278        set lim [expr {$a + 1000}]
10279    }
10280    if {[catch {
10281        while {[incr a] <= $lim} {
10282            if {[info exists arcend($a)]} {
10283                puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
10284            } else {
10285                puts $f [list $arcstart($a) {} $arcids($a)]
10286            }
10287        }
10288    } err]} {
10289        catch {close $f}
10290        catch {file delete $allccache}
10291        #puts "writing cache failed ($err)"
10292        return 0
10293    }
10294    set cachearc [expr {$a - 1}]
10295    if {$a > $cachedarcs} {
10296        puts $f "1"
10297        close $f
10298        return 0
10299    }
10300    return 1
10301}
10302
10303proc savecache {} {
10304    global nextarc cachedarcs cachearc allccache
10305
10306    if {$nextarc == $cachedarcs} return
10307    set cachearc 0
10308    set cachedarcs $nextarc
10309    catch {
10310        set f [open $allccache w]
10311        puts $f [list 1 $cachedarcs]
10312        run writecache $f
10313    }
10314}
10315
10316# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
10317# or 0 if neither is true.
10318proc anc_or_desc {a b} {
10319    global arcout arcstart arcend arcnos cached_isanc
10320
10321    if {$arcnos($a) eq $arcnos($b)} {
10322        # Both are on the same arc(s); either both are the same BMP,
10323        # or if one is not a BMP, the other is also not a BMP or is
10324        # the BMP at end of the arc (and it only has 1 incoming arc).
10325        # Or both can be BMPs with no incoming arcs.
10326        if {$a eq $b || $arcnos($a) eq {}} {
10327            return 0
10328        }
10329        # assert {[llength $arcnos($a)] == 1}
10330        set arc [lindex $arcnos($a) 0]
10331        set i [lsearch -exact $arcids($arc) $a]
10332        set j [lsearch -exact $arcids($arc) $b]
10333        if {$i < 0 || $i > $j} {
10334            return 1
10335        } else {
10336            return -1
10337        }
10338    }
10339
10340    if {![info exists arcout($a)]} {
10341        set arc [lindex $arcnos($a) 0]
10342        if {[info exists arcend($arc)]} {
10343            set aend $arcend($arc)
10344        } else {
10345            set aend {}
10346        }
10347        set a $arcstart($arc)
10348    } else {
10349        set aend $a
10350    }
10351    if {![info exists arcout($b)]} {
10352        set arc [lindex $arcnos($b) 0]
10353        if {[info exists arcend($arc)]} {
10354            set bend $arcend($arc)
10355        } else {
10356            set bend {}
10357        }
10358        set b $arcstart($arc)
10359    } else {
10360        set bend $b
10361    }
10362    if {$a eq $bend} {
10363        return 1
10364    }
10365    if {$b eq $aend} {
10366        return -1
10367    }
10368    if {[info exists cached_isanc($a,$bend)]} {
10369        if {$cached_isanc($a,$bend)} {
10370            return 1
10371        }
10372    }
10373    if {[info exists cached_isanc($b,$aend)]} {
10374        if {$cached_isanc($b,$aend)} {
10375            return -1
10376        }
10377        if {[info exists cached_isanc($a,$bend)]} {
10378            return 0
10379        }
10380    }
10381
10382    set todo [list $a $b]
10383    set anc($a) a
10384    set anc($b) b
10385    for {set i 0} {$i < [llength $todo]} {incr i} {
10386        set x [lindex $todo $i]
10387        if {$anc($x) eq {}} {
10388            continue
10389        }
10390        foreach arc $arcnos($x) {
10391            set xd $arcstart($arc)
10392            if {$xd eq $bend} {
10393                set cached_isanc($a,$bend) 1
10394                set cached_isanc($b,$aend) 0
10395                return 1
10396            } elseif {$xd eq $aend} {
10397                set cached_isanc($b,$aend) 1
10398                set cached_isanc($a,$bend) 0
10399                return -1
10400            }
10401            if {![info exists anc($xd)]} {
10402                set anc($xd) $anc($x)
10403                lappend todo $xd
10404            } elseif {$anc($xd) ne $anc($x)} {
10405                set anc($xd) {}
10406            }
10407        }
10408    }
10409    set cached_isanc($a,$bend) 0
10410    set cached_isanc($b,$aend) 0
10411    return 0
10412}
10413
10414# This identifies whether $desc has an ancestor that is
10415# a growing tip of the graph and which is not an ancestor of $anc
10416# and returns 0 if so and 1 if not.
10417# If we subsequently discover a tag on such a growing tip, and that
10418# turns out to be a descendent of $anc (which it could, since we
10419# don't necessarily see children before parents), then $desc
10420# isn't a good choice to display as a descendent tag of
10421# $anc (since it is the descendent of another tag which is
10422# a descendent of $anc).  Similarly, $anc isn't a good choice to
10423# display as a ancestor tag of $desc.
10424#
10425proc is_certain {desc anc} {
10426    global arcnos arcout arcstart arcend growing problems
10427
10428    set certain {}
10429    if {[llength $arcnos($anc)] == 1} {
10430        # tags on the same arc are certain
10431        if {$arcnos($desc) eq $arcnos($anc)} {
10432            return 1
10433        }
10434        if {![info exists arcout($anc)]} {
10435            # if $anc is partway along an arc, use the start of the arc instead
10436            set a [lindex $arcnos($anc) 0]
10437            set anc $arcstart($a)
10438        }
10439    }
10440    if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
10441        set x $desc
10442    } else {
10443        set a [lindex $arcnos($desc) 0]
10444        set x $arcend($a)
10445    }
10446    if {$x == $anc} {
10447        return 1
10448    }
10449    set anclist [list $x]
10450    set dl($x) 1
10451    set nnh 1
10452    set ngrowanc 0
10453    for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
10454        set x [lindex $anclist $i]
10455        if {$dl($x)} {
10456            incr nnh -1
10457        }
10458        set done($x) 1
10459        foreach a $arcout($x) {
10460            if {[info exists growing($a)]} {
10461                if {![info exists growanc($x)] && $dl($x)} {
10462                    set growanc($x) 1
10463                    incr ngrowanc
10464                }
10465            } else {
10466                set y $arcend($a)
10467                if {[info exists dl($y)]} {
10468                    if {$dl($y)} {
10469                        if {!$dl($x)} {
10470                            set dl($y) 0
10471                            if {![info exists done($y)]} {
10472                                incr nnh -1
10473                            }
10474                            if {[info exists growanc($x)]} {
10475                                incr ngrowanc -1
10476                            }
10477                            set xl [list $y]
10478                            for {set k 0} {$k < [llength $xl]} {incr k} {
10479                                set z [lindex $xl $k]
10480                                foreach c $arcout($z) {
10481                                    if {[info exists arcend($c)]} {
10482                                        set v $arcend($c)
10483                                        if {[info exists dl($v)] && $dl($v)} {
10484                                            set dl($v) 0
10485                                            if {![info exists done($v)]} {
10486                                                incr nnh -1
10487                                            }
10488                                            if {[info exists growanc($v)]} {
10489                                                incr ngrowanc -1
10490                                            }
10491                                            lappend xl $v
10492                                        }
10493                                    }
10494                                }
10495                            }
10496                        }
10497                    }
10498                } elseif {$y eq $anc || !$dl($x)} {
10499                    set dl($y) 0
10500                    lappend anclist $y
10501                } else {
10502                    set dl($y) 1
10503                    lappend anclist $y
10504                    incr nnh
10505                }
10506            }
10507        }
10508    }
10509    foreach x [array names growanc] {
10510        if {$dl($x)} {
10511            return 0
10512        }
10513        return 0
10514    }
10515    return 1
10516}
10517
10518proc validate_arctags {a} {
10519    global arctags idtags
10520
10521    set i -1
10522    set na $arctags($a)
10523    foreach id $arctags($a) {
10524        incr i
10525        if {![info exists idtags($id)]} {
10526            set na [lreplace $na $i $i]
10527            incr i -1
10528        }
10529    }
10530    set arctags($a) $na
10531}
10532
10533proc validate_archeads {a} {
10534    global archeads idheads
10535
10536    set i -1
10537    set na $archeads($a)
10538    foreach id $archeads($a) {
10539        incr i
10540        if {![info exists idheads($id)]} {
10541            set na [lreplace $na $i $i]
10542            incr i -1
10543        }
10544    }
10545    set archeads($a) $na
10546}
10547
10548# Return the list of IDs that have tags that are descendents of id,
10549# ignoring IDs that are descendents of IDs already reported.
10550proc desctags {id} {
10551    global arcnos arcstart arcids arctags idtags allparents
10552    global growing cached_dtags
10553
10554    if {![info exists allparents($id)]} {
10555        return {}
10556    }
10557    set t1 [clock clicks -milliseconds]
10558    set argid $id
10559    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10560        # part-way along an arc; check that arc first
10561        set a [lindex $arcnos($id) 0]
10562        if {$arctags($a) ne {}} {
10563            validate_arctags $a
10564            set i [lsearch -exact $arcids($a) $id]
10565            set tid {}
10566            foreach t $arctags($a) {
10567                set j [lsearch -exact $arcids($a) $t]
10568                if {$j >= $i} break
10569                set tid $t
10570            }
10571            if {$tid ne {}} {
10572                return $tid
10573            }
10574        }
10575        set id $arcstart($a)
10576        if {[info exists idtags($id)]} {
10577            return $id
10578        }
10579    }
10580    if {[info exists cached_dtags($id)]} {
10581        return $cached_dtags($id)
10582    }
10583
10584    set origid $id
10585    set todo [list $id]
10586    set queued($id) 1
10587    set nc 1
10588    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10589        set id [lindex $todo $i]
10590        set done($id) 1
10591        set ta [info exists hastaggedancestor($id)]
10592        if {!$ta} {
10593            incr nc -1
10594        }
10595        # ignore tags on starting node
10596        if {!$ta && $i > 0} {
10597            if {[info exists idtags($id)]} {
10598                set tagloc($id) $id
10599                set ta 1
10600            } elseif {[info exists cached_dtags($id)]} {
10601                set tagloc($id) $cached_dtags($id)
10602                set ta 1
10603            }
10604        }
10605        foreach a $arcnos($id) {
10606            set d $arcstart($a)
10607            if {!$ta && $arctags($a) ne {}} {
10608                validate_arctags $a
10609                if {$arctags($a) ne {}} {
10610                    lappend tagloc($id) [lindex $arctags($a) end]
10611                }
10612            }
10613            if {$ta || $arctags($a) ne {}} {
10614                set tomark [list $d]
10615                for {set j 0} {$j < [llength $tomark]} {incr j} {
10616                    set dd [lindex $tomark $j]
10617                    if {![info exists hastaggedancestor($dd)]} {
10618                        if {[info exists done($dd)]} {
10619                            foreach b $arcnos($dd) {
10620                                lappend tomark $arcstart($b)
10621                            }
10622                            if {[info exists tagloc($dd)]} {
10623                                unset tagloc($dd)
10624                            }
10625                        } elseif {[info exists queued($dd)]} {
10626                            incr nc -1
10627                        }
10628                        set hastaggedancestor($dd) 1
10629                    }
10630                }
10631            }
10632            if {![info exists queued($d)]} {
10633                lappend todo $d
10634                set queued($d) 1
10635                if {![info exists hastaggedancestor($d)]} {
10636                    incr nc
10637                }
10638            }
10639        }
10640    }
10641    set tags {}
10642    foreach id [array names tagloc] {
10643        if {![info exists hastaggedancestor($id)]} {
10644            foreach t $tagloc($id) {
10645                if {[lsearch -exact $tags $t] < 0} {
10646                    lappend tags $t
10647                }
10648            }
10649        }
10650    }
10651    set t2 [clock clicks -milliseconds]
10652    set loopix $i
10653
10654    # remove tags that are descendents of other tags
10655    for {set i 0} {$i < [llength $tags]} {incr i} {
10656        set a [lindex $tags $i]
10657        for {set j 0} {$j < $i} {incr j} {
10658            set b [lindex $tags $j]
10659            set r [anc_or_desc $a $b]
10660            if {$r == 1} {
10661                set tags [lreplace $tags $j $j]
10662                incr j -1
10663                incr i -1
10664            } elseif {$r == -1} {
10665                set tags [lreplace $tags $i $i]
10666                incr i -1
10667                break
10668            }
10669        }
10670    }
10671
10672    if {[array names growing] ne {}} {
10673        # graph isn't finished, need to check if any tag could get
10674        # eclipsed by another tag coming later.  Simply ignore any
10675        # tags that could later get eclipsed.
10676        set ctags {}
10677        foreach t $tags {
10678            if {[is_certain $t $origid]} {
10679                lappend ctags $t
10680            }
10681        }
10682        if {$tags eq $ctags} {
10683            set cached_dtags($origid) $tags
10684        } else {
10685            set tags $ctags
10686        }
10687    } else {
10688        set cached_dtags($origid) $tags
10689    }
10690    set t3 [clock clicks -milliseconds]
10691    if {0 && $t3 - $t1 >= 100} {
10692        puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10693            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10694    }
10695    return $tags
10696}
10697
10698proc anctags {id} {
10699    global arcnos arcids arcout arcend arctags idtags allparents
10700    global growing cached_atags
10701
10702    if {![info exists allparents($id)]} {
10703        return {}
10704    }
10705    set t1 [clock clicks -milliseconds]
10706    set argid $id
10707    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10708        # part-way along an arc; check that arc first
10709        set a [lindex $arcnos($id) 0]
10710        if {$arctags($a) ne {}} {
10711            validate_arctags $a
10712            set i [lsearch -exact $arcids($a) $id]
10713            foreach t $arctags($a) {
10714                set j [lsearch -exact $arcids($a) $t]
10715                if {$j > $i} {
10716                    return $t
10717                }
10718            }
10719        }
10720        if {![info exists arcend($a)]} {
10721            return {}
10722        }
10723        set id $arcend($a)
10724        if {[info exists idtags($id)]} {
10725            return $id
10726        }
10727    }
10728    if {[info exists cached_atags($id)]} {
10729        return $cached_atags($id)
10730    }
10731
10732    set origid $id
10733    set todo [list $id]
10734    set queued($id) 1
10735    set taglist {}
10736    set nc 1
10737    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10738        set id [lindex $todo $i]
10739        set done($id) 1
10740        set td [info exists hastaggeddescendent($id)]
10741        if {!$td} {
10742            incr nc -1
10743        }
10744        # ignore tags on starting node
10745        if {!$td && $i > 0} {
10746            if {[info exists idtags($id)]} {
10747                set tagloc($id) $id
10748                set td 1
10749            } elseif {[info exists cached_atags($id)]} {
10750                set tagloc($id) $cached_atags($id)
10751                set td 1
10752            }
10753        }
10754        foreach a $arcout($id) {
10755            if {!$td && $arctags($a) ne {}} {
10756                validate_arctags $a
10757                if {$arctags($a) ne {}} {
10758                    lappend tagloc($id) [lindex $arctags($a) 0]
10759                }
10760            }
10761            if {![info exists arcend($a)]} continue
10762            set d $arcend($a)
10763            if {$td || $arctags($a) ne {}} {
10764                set tomark [list $d]
10765                for {set j 0} {$j < [llength $tomark]} {incr j} {
10766                    set dd [lindex $tomark $j]
10767                    if {![info exists hastaggeddescendent($dd)]} {
10768                        if {[info exists done($dd)]} {
10769                            foreach b $arcout($dd) {
10770                                if {[info exists arcend($b)]} {
10771                                    lappend tomark $arcend($b)
10772                                }
10773                            }
10774                            if {[info exists tagloc($dd)]} {
10775                                unset tagloc($dd)
10776                            }
10777                        } elseif {[info exists queued($dd)]} {
10778                            incr nc -1
10779                        }
10780                        set hastaggeddescendent($dd) 1
10781                    }
10782                }
10783            }
10784            if {![info exists queued($d)]} {
10785                lappend todo $d
10786                set queued($d) 1
10787                if {![info exists hastaggeddescendent($d)]} {
10788                    incr nc
10789                }
10790            }
10791        }
10792    }
10793    set t2 [clock clicks -milliseconds]
10794    set loopix $i
10795    set tags {}
10796    foreach id [array names tagloc] {
10797        if {![info exists hastaggeddescendent($id)]} {
10798            foreach t $tagloc($id) {
10799                if {[lsearch -exact $tags $t] < 0} {
10800                    lappend tags $t
10801                }
10802            }
10803        }
10804    }
10805
10806    # remove tags that are ancestors of other tags
10807    for {set i 0} {$i < [llength $tags]} {incr i} {
10808        set a [lindex $tags $i]
10809        for {set j 0} {$j < $i} {incr j} {
10810            set b [lindex $tags $j]
10811            set r [anc_or_desc $a $b]
10812            if {$r == -1} {
10813                set tags [lreplace $tags $j $j]
10814                incr j -1
10815                incr i -1
10816            } elseif {$r == 1} {
10817                set tags [lreplace $tags $i $i]
10818                incr i -1
10819                break
10820            }
10821        }
10822    }
10823
10824    if {[array names growing] ne {}} {
10825        # graph isn't finished, need to check if any tag could get
10826        # eclipsed by another tag coming later.  Simply ignore any
10827        # tags that could later get eclipsed.
10828        set ctags {}
10829        foreach t $tags {
10830            if {[is_certain $origid $t]} {
10831                lappend ctags $t
10832            }
10833        }
10834        if {$tags eq $ctags} {
10835            set cached_atags($origid) $tags
10836        } else {
10837            set tags $ctags
10838        }
10839    } else {
10840        set cached_atags($origid) $tags
10841    }
10842    set t3 [clock clicks -milliseconds]
10843    if {0 && $t3 - $t1 >= 100} {
10844        puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
10845            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10846    }
10847    return $tags
10848}
10849
10850# Return the list of IDs that have heads that are descendents of id,
10851# including id itself if it has a head.
10852proc descheads {id} {
10853    global arcnos arcstart arcids archeads idheads cached_dheads
10854    global allparents arcout
10855
10856    if {![info exists allparents($id)]} {
10857        return {}
10858    }
10859    set aret {}
10860    if {![info exists arcout($id)]} {
10861        # part-way along an arc; check it first
10862        set a [lindex $arcnos($id) 0]
10863        if {$archeads($a) ne {}} {
10864            validate_archeads $a
10865            set i [lsearch -exact $arcids($a) $id]
10866            foreach t $archeads($a) {
10867                set j [lsearch -exact $arcids($a) $t]
10868                if {$j > $i} break
10869                lappend aret $t
10870            }
10871        }
10872        set id $arcstart($a)
10873    }
10874    set origid $id
10875    set todo [list $id]
10876    set seen($id) 1
10877    set ret {}
10878    for {set i 0} {$i < [llength $todo]} {incr i} {
10879        set id [lindex $todo $i]
10880        if {[info exists cached_dheads($id)]} {
10881            set ret [concat $ret $cached_dheads($id)]
10882        } else {
10883            if {[info exists idheads($id)]} {
10884                lappend ret $id
10885            }
10886            foreach a $arcnos($id) {
10887                if {$archeads($a) ne {}} {
10888                    validate_archeads $a
10889                    if {$archeads($a) ne {}} {
10890                        set ret [concat $ret $archeads($a)]
10891                    }
10892                }
10893                set d $arcstart($a)
10894                if {![info exists seen($d)]} {
10895                    lappend todo $d
10896                    set seen($d) 1
10897                }
10898            }
10899        }
10900    }
10901    set ret [lsort -unique $ret]
10902    set cached_dheads($origid) $ret
10903    return [concat $ret $aret]
10904}
10905
10906proc addedtag {id} {
10907    global arcnos arcout cached_dtags cached_atags
10908
10909    if {![info exists arcnos($id)]} return
10910    if {![info exists arcout($id)]} {
10911        recalcarc [lindex $arcnos($id) 0]
10912    }
10913    catch {unset cached_dtags}
10914    catch {unset cached_atags}
10915}
10916
10917proc addedhead {hid head} {
10918    global arcnos arcout cached_dheads
10919
10920    if {![info exists arcnos($hid)]} return
10921    if {![info exists arcout($hid)]} {
10922        recalcarc [lindex $arcnos($hid) 0]
10923    }
10924    catch {unset cached_dheads}
10925}
10926
10927proc removedhead {hid head} {
10928    global cached_dheads
10929
10930    catch {unset cached_dheads}
10931}
10932
10933proc movedhead {hid head} {
10934    global arcnos arcout cached_dheads
10935
10936    if {![info exists arcnos($hid)]} return
10937    if {![info exists arcout($hid)]} {
10938        recalcarc [lindex $arcnos($hid) 0]
10939    }
10940    catch {unset cached_dheads}
10941}
10942
10943proc changedrefs {} {
10944    global cached_dheads cached_dtags cached_atags cached_tagcontent
10945    global arctags archeads arcnos arcout idheads idtags
10946
10947    foreach id [concat [array names idheads] [array names idtags]] {
10948        if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
10949            set a [lindex $arcnos($id) 0]
10950            if {![info exists donearc($a)]} {
10951                recalcarc $a
10952                set donearc($a) 1
10953            }
10954        }
10955    }
10956    catch {unset cached_tagcontent}
10957    catch {unset cached_dtags}
10958    catch {unset cached_atags}
10959    catch {unset cached_dheads}
10960}
10961
10962proc rereadrefs {} {
10963    global idtags idheads idotherrefs mainheadid
10964
10965    set refids [concat [array names idtags] \
10966                    [array names idheads] [array names idotherrefs]]
10967    foreach id $refids {
10968        if {![info exists ref($id)]} {
10969            set ref($id) [listrefs $id]
10970        }
10971    }
10972    set oldmainhead $mainheadid
10973    readrefs
10974    changedrefs
10975    set refids [lsort -unique [concat $refids [array names idtags] \
10976                        [array names idheads] [array names idotherrefs]]]
10977    foreach id $refids {
10978        set v [listrefs $id]
10979        if {![info exists ref($id)] || $ref($id) != $v} {
10980            redrawtags $id
10981        }
10982    }
10983    if {$oldmainhead ne $mainheadid} {
10984        redrawtags $oldmainhead
10985        redrawtags $mainheadid
10986    }
10987    run refill_reflist
10988}
10989
10990proc listrefs {id} {
10991    global idtags idheads idotherrefs
10992
10993    set x {}
10994    if {[info exists idtags($id)]} {
10995        set x $idtags($id)
10996    }
10997    set y {}
10998    if {[info exists idheads($id)]} {
10999        set y $idheads($id)
11000    }
11001    set z {}
11002    if {[info exists idotherrefs($id)]} {
11003        set z $idotherrefs($id)
11004    }
11005    return [list $x $y $z]
11006}
11007
11008proc add_tag_ctext {tag} {
11009    global ctext cached_tagcontent tagids
11010
11011    if {![info exists cached_tagcontent($tag)]} {
11012        catch {
11013            set cached_tagcontent($tag) [exec git cat-file -p $tag]
11014        }
11015    }
11016    $ctext insert end "[mc "Tag"]: $tag\n" bold
11017    if {[info exists cached_tagcontent($tag)]} {
11018        set text $cached_tagcontent($tag)
11019    } else {
11020        set text "[mc "Id"]:  $tagids($tag)"
11021    }
11022    appendwithlinks $text {}
11023}
11024
11025proc showtag {tag isnew} {
11026    global ctext cached_tagcontent tagids linknum tagobjid
11027
11028    if {$isnew} {
11029        addtohistory [list showtag $tag 0] savectextpos
11030    }
11031    $ctext conf -state normal
11032    clear_ctext
11033    settabs 0
11034    set linknum 0
11035    add_tag_ctext $tag
11036    maybe_scroll_ctext 1
11037    $ctext conf -state disabled
11038    init_flist {}
11039}
11040
11041proc showtags {id isnew} {
11042    global idtags ctext linknum
11043
11044    if {$isnew} {
11045        addtohistory [list showtags $id 0] savectextpos
11046    }
11047    $ctext conf -state normal
11048    clear_ctext
11049    settabs 0
11050    set linknum 0
11051    set sep {}
11052    foreach tag $idtags($id) {
11053        $ctext insert end $sep
11054        add_tag_ctext $tag
11055        set sep "\n\n"
11056    }
11057    maybe_scroll_ctext 1
11058    $ctext conf -state disabled
11059    init_flist {}
11060}
11061
11062proc doquit {} {
11063    global stopped
11064    global gitktmpdir
11065
11066    set stopped 100
11067    savestuff .
11068    destroy .
11069
11070    if {[info exists gitktmpdir]} {
11071        catch {file delete -force $gitktmpdir}
11072    }
11073}
11074
11075proc mkfontdisp {font top which} {
11076    global fontattr fontpref $font NS use_ttk
11077
11078    set fontpref($font) [set $font]
11079    ${NS}::button $top.${font}but -text $which \
11080        -command [list choosefont $font $which]
11081    ${NS}::label $top.$font -relief flat -font $font \
11082        -text $fontattr($font,family) -justify left
11083    grid x $top.${font}but $top.$font -sticky w
11084}
11085
11086proc choosefont {font which} {
11087    global fontparam fontlist fonttop fontattr
11088    global prefstop NS
11089
11090    set fontparam(which) $which
11091    set fontparam(font) $font
11092    set fontparam(family) [font actual $font -family]
11093    set fontparam(size) $fontattr($font,size)
11094    set fontparam(weight) $fontattr($font,weight)
11095    set fontparam(slant) $fontattr($font,slant)
11096    set top .gitkfont
11097    set fonttop $top
11098    if {![winfo exists $top]} {
11099        font create sample
11100        eval font config sample [font actual $font]
11101        ttk_toplevel $top
11102        make_transient $top $prefstop
11103        wm title $top [mc "Gitk font chooser"]
11104        ${NS}::label $top.l -textvariable fontparam(which)
11105        pack $top.l -side top
11106        set fontlist [lsort [font families]]
11107        ${NS}::frame $top.f
11108        listbox $top.f.fam -listvariable fontlist \
11109            -yscrollcommand [list $top.f.sb set]
11110        bind $top.f.fam <<ListboxSelect>> selfontfam
11111        ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
11112        pack $top.f.sb -side right -fill y
11113        pack $top.f.fam -side left -fill both -expand 1
11114        pack $top.f -side top -fill both -expand 1
11115        ${NS}::frame $top.g
11116        spinbox $top.g.size -from 4 -to 40 -width 4 \
11117            -textvariable fontparam(size) \
11118            -validatecommand {string is integer -strict %s}
11119        checkbutton $top.g.bold -padx 5 \
11120            -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
11121            -variable fontparam(weight) -onvalue bold -offvalue normal
11122        checkbutton $top.g.ital -padx 5 \
11123            -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
11124            -variable fontparam(slant) -onvalue italic -offvalue roman
11125        pack $top.g.size $top.g.bold $top.g.ital -side left
11126        pack $top.g -side top
11127        canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
11128            -background white
11129        $top.c create text 100 25 -anchor center -text $which -font sample \
11130            -fill black -tags text
11131        bind $top.c <Configure> [list centertext $top.c]
11132        pack $top.c -side top -fill x
11133        ${NS}::frame $top.buts
11134        ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
11135        ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
11136        bind $top <Key-Return> fontok
11137        bind $top <Key-Escape> fontcan
11138        grid $top.buts.ok $top.buts.can
11139        grid columnconfigure $top.buts 0 -weight 1 -uniform a
11140        grid columnconfigure $top.buts 1 -weight 1 -uniform a
11141        pack $top.buts -side bottom -fill x
11142        trace add variable fontparam write chg_fontparam
11143    } else {
11144        raise $top
11145        $top.c itemconf text -text $which
11146    }
11147    set i [lsearch -exact $fontlist $fontparam(family)]
11148    if {$i >= 0} {
11149        $top.f.fam selection set $i
11150        $top.f.fam see $i
11151    }
11152}
11153
11154proc centertext {w} {
11155    $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
11156}
11157
11158proc fontok {} {
11159    global fontparam fontpref prefstop
11160
11161    set f $fontparam(font)
11162    set fontpref($f) [list $fontparam(family) $fontparam(size)]
11163    if {$fontparam(weight) eq "bold"} {
11164        lappend fontpref($f) "bold"
11165    }
11166    if {$fontparam(slant) eq "italic"} {
11167        lappend fontpref($f) "italic"
11168    }
11169    set w $prefstop.notebook.fonts.$f
11170    $w conf -text $fontparam(family) -font $fontpref($f)
11171
11172    fontcan
11173}
11174
11175proc fontcan {} {
11176    global fonttop fontparam
11177
11178    if {[info exists fonttop]} {
11179        catch {destroy $fonttop}
11180        catch {font delete sample}
11181        unset fonttop
11182        unset fontparam
11183    }
11184}
11185
11186if {[package vsatisfies [package provide Tk] 8.6]} {
11187    # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
11188    # function to make use of it.
11189    proc choosefont {font which} {
11190        tk fontchooser configure -title $which -font $font \
11191            -command [list on_choosefont $font $which]
11192        tk fontchooser show
11193    }
11194    proc on_choosefont {font which newfont} {
11195        global fontparam
11196        puts stderr "$font $newfont"
11197        array set f [font actual $newfont]
11198        set fontparam(which) $which
11199        set fontparam(font) $font
11200        set fontparam(family) $f(-family)
11201        set fontparam(size) $f(-size)
11202        set fontparam(weight) $f(-weight)
11203        set fontparam(slant) $f(-slant)
11204        fontok
11205    }
11206}
11207
11208proc selfontfam {} {
11209    global fonttop fontparam
11210
11211    set i [$fonttop.f.fam curselection]
11212    if {$i ne {}} {
11213        set fontparam(family) [$fonttop.f.fam get $i]
11214    }
11215}
11216
11217proc chg_fontparam {v sub op} {
11218    global fontparam
11219
11220    font config sample -$sub $fontparam($sub)
11221}
11222
11223# Create a property sheet tab page
11224proc create_prefs_page {w} {
11225    global NS
11226    set parent [join [lrange [split $w .] 0 end-1] .]
11227    if {[winfo class $parent] eq "TNotebook"} {
11228        ${NS}::frame $w
11229    } else {
11230        ${NS}::labelframe $w
11231    }
11232}
11233
11234proc prefspage_general {notebook} {
11235    global NS maxwidth maxgraphpct showneartags showlocalchanges
11236    global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11237    global hideremotes want_ttk have_ttk maxrefs
11238
11239    set page [create_prefs_page $notebook.general]
11240
11241    ${NS}::label $page.ldisp -text [mc "Commit list display options"]
11242    grid $page.ldisp - -sticky w -pady 10
11243    ${NS}::label $page.spacer -text " "
11244    ${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
11245    spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
11246    grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w
11247    ${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
11248    spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
11249    grid x $page.maxpctl $page.maxpct -sticky w
11250    ${NS}::checkbutton $page.showlocal -text [mc "Show local changes"] \
11251        -variable showlocalchanges
11252    grid x $page.showlocal -sticky w
11253    ${NS}::checkbutton $page.autoselect -text [mc "Auto-select SHA1 (length)"] \
11254        -variable autoselect
11255    spinbox $page.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
11256    grid x $page.autoselect $page.autosellen -sticky w
11257    ${NS}::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \
11258        -variable hideremotes
11259    grid x $page.hideremotes -sticky w
11260
11261    ${NS}::label $page.ddisp -text [mc "Diff display options"]
11262    grid $page.ddisp - -sticky w -pady 10
11263    ${NS}::label $page.tabstopl -text [mc "Tab spacing"]
11264    spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
11265    grid x $page.tabstopl $page.tabstop -sticky w
11266    ${NS}::checkbutton $page.ntag -text [mc "Display nearby tags/heads"] \
11267        -variable showneartags
11268    grid x $page.ntag -sticky w
11269    ${NS}::label $page.maxrefsl -text [mc "Maximum # tags/heads to show"]
11270    spinbox $page.maxrefs -from 1 -to 1000 -width 4 -textvariable maxrefs
11271    grid x $page.maxrefsl $page.maxrefs -sticky w
11272    ${NS}::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \
11273        -variable limitdiffs
11274    grid x $page.ldiff -sticky w
11275    ${NS}::checkbutton $page.lattr -text [mc "Support per-file encodings"] \
11276        -variable perfile_attrs
11277    grid x $page.lattr -sticky w
11278
11279    ${NS}::entry $page.extdifft -textvariable extdifftool
11280    ${NS}::frame $page.extdifff
11281    ${NS}::label $page.extdifff.l -text [mc "External diff tool" ]
11282    ${NS}::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff
11283    pack $page.extdifff.l $page.extdifff.b -side left
11284    pack configure $page.extdifff.l -padx 10
11285    grid x $page.extdifff $page.extdifft -sticky ew
11286
11287    ${NS}::label $page.lgen -text [mc "General options"]
11288    grid $page.lgen - -sticky w -pady 10
11289    ${NS}::checkbutton $page.want_ttk -variable want_ttk \
11290        -text [mc "Use themed widgets"]
11291    if {$have_ttk} {
11292        ${NS}::label $page.ttk_note -text [mc "(change requires restart)"]
11293    } else {
11294        ${NS}::label $page.ttk_note -text [mc "(currently unavailable)"]
11295    }
11296    grid x $page.want_ttk $page.ttk_note -sticky w
11297    return $page
11298}
11299
11300proc prefspage_colors {notebook} {
11301    global NS uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11302
11303    set page [create_prefs_page $notebook.colors]
11304
11305    ${NS}::label $page.cdisp -text [mc "Colors: press to choose"]
11306    grid $page.cdisp - -sticky w -pady 10
11307    label $page.ui -padx 40 -relief sunk -background $uicolor
11308    ${NS}::button $page.uibut -text [mc "Interface"] \
11309       -command [list choosecolor uicolor {} $page.ui [mc "interface"] setui]
11310    grid x $page.uibut $page.ui -sticky w
11311    label $page.bg -padx 40 -relief sunk -background $bgcolor
11312    ${NS}::button $page.bgbut -text [mc "Background"] \
11313        -command [list choosecolor bgcolor {} $page.bg [mc "background"] setbg]
11314    grid x $page.bgbut $page.bg -sticky w
11315    label $page.fg -padx 40 -relief sunk -background $fgcolor
11316    ${NS}::button $page.fgbut -text [mc "Foreground"] \
11317        -command [list choosecolor fgcolor {} $page.fg [mc "foreground"] setfg]
11318    grid x $page.fgbut $page.fg -sticky w
11319    label $page.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
11320    ${NS}::button $page.diffoldbut -text [mc "Diff: old lines"] \
11321        -command [list choosecolor diffcolors 0 $page.diffold [mc "diff old lines"] \
11322                      [list $ctext tag conf d0 -foreground]]
11323    grid x $page.diffoldbut $page.diffold -sticky w
11324    label $page.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
11325    ${NS}::button $page.diffnewbut -text [mc "Diff: new lines"] \
11326        -command [list choosecolor diffcolors 1 $page.diffnew [mc "diff new lines"] \
11327                      [list $ctext tag conf dresult -foreground]]
11328    grid x $page.diffnewbut $page.diffnew -sticky w
11329    label $page.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
11330    ${NS}::button $page.hunksepbut -text [mc "Diff: hunk header"] \
11331        -command [list choosecolor diffcolors 2 $page.hunksep \
11332                      [mc "diff hunk header"] \
11333                      [list $ctext tag conf hunksep -foreground]]
11334    grid x $page.hunksepbut $page.hunksep -sticky w
11335    label $page.markbgsep -padx 40 -relief sunk -background $markbgcolor
11336    ${NS}::button $page.markbgbut -text [mc "Marked line bg"] \
11337        -command [list choosecolor markbgcolor {} $page.markbgsep \
11338                      [mc "marked line background"] \
11339                      [list $ctext tag conf omark -background]]
11340    grid x $page.markbgbut $page.markbgsep -sticky w
11341    label $page.selbgsep -padx 40 -relief sunk -background $selectbgcolor
11342    ${NS}::button $page.selbgbut -text [mc "Select bg"] \
11343        -command [list choosecolor selectbgcolor {} $page.selbgsep [mc "background"] setselbg]
11344    grid x $page.selbgbut $page.selbgsep -sticky w
11345    return $page
11346}
11347
11348proc prefspage_fonts {notebook} {
11349    global NS
11350    set page [create_prefs_page $notebook.fonts]
11351    ${NS}::label $page.cfont -text [mc "Fonts: press to choose"]
11352    grid $page.cfont - -sticky w -pady 10
11353    mkfontdisp mainfont $page [mc "Main font"]
11354    mkfontdisp textfont $page [mc "Diff display font"]
11355    mkfontdisp uifont $page [mc "User interface font"]
11356    return $page
11357}
11358
11359proc doprefs {} {
11360    global maxwidth maxgraphpct use_ttk NS
11361    global oldprefs prefstop showneartags showlocalchanges
11362    global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11363    global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11364    global hideremotes want_ttk have_ttk
11365
11366    set top .gitkprefs
11367    set prefstop $top
11368    if {[winfo exists $top]} {
11369        raise $top
11370        return
11371    }
11372    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11373                   limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11374        set oldprefs($v) [set $v]
11375    }
11376    ttk_toplevel $top
11377    wm title $top [mc "Gitk preferences"]
11378    make_transient $top .
11379
11380    if {[set use_notebook [expr {$use_ttk && [info command ::ttk::notebook] ne ""}]]} {
11381        set notebook [ttk::notebook $top.notebook]
11382    } else {
11383        set notebook [${NS}::frame $top.notebook -borderwidth 0 -relief flat]
11384    }
11385
11386    lappend pages [prefspage_general $notebook] [mc "General"]
11387    lappend pages [prefspage_colors $notebook] [mc "Colors"]
11388    lappend pages [prefspage_fonts $notebook] [mc "Fonts"]
11389    set col 0
11390    foreach {page title} $pages {
11391        if {$use_notebook} {
11392            $notebook add $page -text $title
11393        } else {
11394            set btn [${NS}::button $notebook.b_[string map {. X} $page] \
11395                         -text $title -command [list raise $page]]
11396            $page configure -text $title
11397            grid $btn -row 0 -column [incr col] -sticky w
11398            grid $page -row 1 -column 0 -sticky news -columnspan 100
11399        }
11400    }
11401
11402    if {!$use_notebook} {
11403        grid columnconfigure $notebook 0 -weight 1
11404        grid rowconfigure $notebook 1 -weight 1
11405        raise [lindex $pages 0]
11406    }
11407
11408    grid $notebook -sticky news -padx 2 -pady 2
11409    grid rowconfigure $top 0 -weight 1
11410    grid columnconfigure $top 0 -weight 1
11411
11412    ${NS}::frame $top.buts
11413    ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
11414    ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
11415    bind $top <Key-Return> prefsok
11416    bind $top <Key-Escape> prefscan
11417    grid $top.buts.ok $top.buts.can
11418    grid columnconfigure $top.buts 0 -weight 1 -uniform a
11419    grid columnconfigure $top.buts 1 -weight 1 -uniform a
11420    grid $top.buts - - -pady 10 -sticky ew
11421    grid columnconfigure $top 2 -weight 1
11422    bind $top <Visibility> [list focus $top.buts.ok]
11423}
11424
11425proc choose_extdiff {} {
11426    global extdifftool
11427
11428    set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
11429    if {$prog ne {}} {
11430        set extdifftool $prog
11431    }
11432}
11433
11434proc choosecolor {v vi w x cmd} {
11435    global $v
11436
11437    set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
11438               -title [mc "Gitk: choose color for %s" $x]]
11439    if {$c eq {}} return
11440    $w conf -background $c
11441    lset $v $vi $c
11442    eval $cmd $c
11443}
11444
11445proc setselbg {c} {
11446    global bglist cflist
11447    foreach w $bglist {
11448        $w configure -selectbackground $c
11449    }
11450    $cflist tag configure highlight \
11451        -background [$cflist cget -selectbackground]
11452    allcanvs itemconf secsel -fill $c
11453}
11454
11455# This sets the background color and the color scheme for the whole UI.
11456# For some reason, tk_setPalette chooses a nasty dark red for selectColor
11457# if we don't specify one ourselves, which makes the checkbuttons and
11458# radiobuttons look bad.  This chooses white for selectColor if the
11459# background color is light, or black if it is dark.
11460proc setui {c} {
11461    if {[tk windowingsystem] eq "win32"} { return }
11462    set bg [winfo rgb . $c]
11463    set selc black
11464    if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
11465        set selc white
11466    }
11467    tk_setPalette background $c selectColor $selc
11468}
11469
11470proc setbg {c} {
11471    global bglist
11472
11473    foreach w $bglist {
11474        $w conf -background $c
11475    }
11476}
11477
11478proc setfg {c} {
11479    global fglist canv
11480
11481    foreach w $fglist {
11482        $w conf -foreground $c
11483    }
11484    allcanvs itemconf text -fill $c
11485    $canv itemconf circle -outline $c
11486    $canv itemconf markid -outline $c
11487}
11488
11489proc prefscan {} {
11490    global oldprefs prefstop
11491
11492    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11493                   limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11494        global $v
11495        set $v $oldprefs($v)
11496    }
11497    catch {destroy $prefstop}
11498    unset prefstop
11499    fontcan
11500}
11501
11502proc prefsok {} {
11503    global maxwidth maxgraphpct
11504    global oldprefs prefstop showneartags showlocalchanges
11505    global fontpref mainfont textfont uifont
11506    global limitdiffs treediffs perfile_attrs
11507    global hideremotes
11508
11509    catch {destroy $prefstop}
11510    unset prefstop
11511    fontcan
11512    set fontchanged 0
11513    if {$mainfont ne $fontpref(mainfont)} {
11514        set mainfont $fontpref(mainfont)
11515        parsefont mainfont $mainfont
11516        eval font configure mainfont [fontflags mainfont]
11517        eval font configure mainfontbold [fontflags mainfont 1]
11518        setcoords
11519        set fontchanged 1
11520    }
11521    if {$textfont ne $fontpref(textfont)} {
11522        set textfont $fontpref(textfont)
11523        parsefont textfont $textfont
11524        eval font configure textfont [fontflags textfont]
11525        eval font configure textfontbold [fontflags textfont 1]
11526    }
11527    if {$uifont ne $fontpref(uifont)} {
11528        set uifont $fontpref(uifont)
11529        parsefont uifont $uifont
11530        eval font configure uifont [fontflags uifont]
11531    }
11532    settabs
11533    if {$showlocalchanges != $oldprefs(showlocalchanges)} {
11534        if {$showlocalchanges} {
11535            doshowlocalchanges
11536        } else {
11537            dohidelocalchanges
11538        }
11539    }
11540    if {$limitdiffs != $oldprefs(limitdiffs) ||
11541        ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11542        # treediffs elements are limited by path;
11543        # won't have encodings cached if perfile_attrs was just turned on
11544        catch {unset treediffs}
11545    }
11546    if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
11547        || $maxgraphpct != $oldprefs(maxgraphpct)} {
11548        redisplay
11549    } elseif {$showneartags != $oldprefs(showneartags) ||
11550          $limitdiffs != $oldprefs(limitdiffs)} {
11551        reselectline
11552    }
11553    if {$hideremotes != $oldprefs(hideremotes)} {
11554        rereadrefs
11555    }
11556}
11557
11558proc formatdate {d} {
11559    global datetimeformat
11560    if {$d ne {}} {
11561        # If $datetimeformat includes a timezone, display in the
11562        # timezone of the argument.  Otherwise, display in local time.
11563        if {[string match {*%[zZ]*} $datetimeformat]} {
11564            if {[catch {set d [clock format [lindex $d 0] -timezone [lindex $d 1] -format $datetimeformat]}]} {
11565                # Tcl < 8.5 does not support -timezone.  Emulate it by
11566                # setting TZ (e.g. TZ=<-0430>+04:30).
11567                global env
11568                if {[info exists env(TZ)]} {
11569                    set savedTZ $env(TZ)
11570                }
11571                set zone [lindex $d 1]
11572                set sign [string map {+ - - +} [string index $zone 0]]
11573                set env(TZ) <$zone>$sign[string range $zone 1 2]:[string range $zone 3 4]
11574                set d [clock format [lindex $d 0] -format $datetimeformat]
11575                if {[info exists savedTZ]} {
11576                    set env(TZ) $savedTZ
11577                } else {
11578                    unset env(TZ)
11579                }
11580            }
11581        } else {
11582            set d [clock format [lindex $d 0] -format $datetimeformat]
11583        }
11584    }
11585    return $d
11586}
11587
11588# This list of encoding names and aliases is distilled from
11589# http://www.iana.org/assignments/character-sets.
11590# Not all of them are supported by Tcl.
11591set encoding_aliases {
11592    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11593      ISO646-US US-ASCII us IBM367 cp367 csASCII }
11594    { ISO-10646-UTF-1 csISO10646UTF1 }
11595    { ISO_646.basic:1983 ref csISO646basic1983 }
11596    { INVARIANT csINVARIANT }
11597    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11598    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11599    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11600    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11601    { NATS-DANO iso-ir-9-1 csNATSDANO }
11602    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11603    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11604    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11605    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11606    { ISO-2022-KR csISO2022KR }
11607    { EUC-KR csEUCKR }
11608    { ISO-2022-JP csISO2022JP }
11609    { ISO-2022-JP-2 csISO2022JP2 }
11610    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11611      csISO13JISC6220jp }
11612    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11613    { IT iso-ir-15 ISO646-IT csISO15Italian }
11614    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11615    { ES iso-ir-17 ISO646-ES csISO17Spanish }
11616    { greek7-old iso-ir-18 csISO18Greek7Old }
11617    { latin-greek iso-ir-19 csISO19LatinGreek }
11618    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11619    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11620    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11621    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11622    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11623    { BS_viewdata iso-ir-47 csISO47BSViewdata }
11624    { INIS iso-ir-49 csISO49INIS }
11625    { INIS-8 iso-ir-50 csISO50INIS8 }
11626    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11627    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11628    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11629    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11630    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11631    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11632      csISO60Norwegian1 }
11633    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11634    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11635    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11636    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11637    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11638    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11639    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11640    { greek7 iso-ir-88 csISO88Greek7 }
11641    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11642    { iso-ir-90 csISO90 }
11643    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11644    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11645      csISO92JISC62991984b }
11646    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11647    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11648    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11649      csISO95JIS62291984handadd }
11650    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11651    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11652    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11653    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11654      CP819 csISOLatin1 }
11655    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11656    { T.61-7bit iso-ir-102 csISO102T617bit }
11657    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11658    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
11659    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
11660    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
11661    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
11662    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
11663    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
11664    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
11665      arabic csISOLatinArabic }
11666    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
11667    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
11668    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
11669      greek greek8 csISOLatinGreek }
11670    { T.101-G2 iso-ir-128 csISO128T101G2 }
11671    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
11672      csISOLatinHebrew }
11673    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
11674    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
11675    { CSN_369103 iso-ir-139 csISO139CSN369103 }
11676    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
11677    { ISO_6937-2-add iso-ir-142 csISOTextComm }
11678    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
11679    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
11680      csISOLatinCyrillic }
11681    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
11682    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
11683    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
11684    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
11685    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
11686    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
11687    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
11688    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
11689    { ISO_10367-box iso-ir-155 csISO10367Box }
11690    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
11691    { latin-lap lap iso-ir-158 csISO158Lap }
11692    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
11693    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
11694    { us-dk csUSDK }
11695    { dk-us csDKUS }
11696    { JIS_X0201 X0201 csHalfWidthKatakana }
11697    { KSC5636 ISO646-KR csKSC5636 }
11698    { ISO-10646-UCS-2 csUnicode }
11699    { ISO-10646-UCS-4 csUCS4 }
11700    { DEC-MCS dec csDECMCS }
11701    { hp-roman8 roman8 r8 csHPRoman8 }
11702    { macintosh mac csMacintosh }
11703    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
11704      csIBM037 }
11705    { IBM038 EBCDIC-INT cp038 csIBM038 }
11706    { IBM273 CP273 csIBM273 }
11707    { IBM274 EBCDIC-BE CP274 csIBM274 }
11708    { IBM275 EBCDIC-BR cp275 csIBM275 }
11709    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
11710    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
11711    { IBM280 CP280 ebcdic-cp-it csIBM280 }
11712    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
11713    { IBM284 CP284 ebcdic-cp-es csIBM284 }
11714    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
11715    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
11716    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
11717    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
11718    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
11719    { IBM424 cp424 ebcdic-cp-he csIBM424 }
11720    { IBM437 cp437 437 csPC8CodePage437 }
11721    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
11722    { IBM775 cp775 csPC775Baltic }
11723    { IBM850 cp850 850 csPC850Multilingual }
11724    { IBM851 cp851 851 csIBM851 }
11725    { IBM852 cp852 852 csPCp852 }
11726    { IBM855 cp855 855 csIBM855 }
11727    { IBM857 cp857 857 csIBM857 }
11728    { IBM860 cp860 860 csIBM860 }
11729    { IBM861 cp861 861 cp-is csIBM861 }
11730    { IBM862 cp862 862 csPC862LatinHebrew }
11731    { IBM863 cp863 863 csIBM863 }
11732    { IBM864 cp864 csIBM864 }
11733    { IBM865 cp865 865 csIBM865 }
11734    { IBM866 cp866 866 csIBM866 }
11735    { IBM868 CP868 cp-ar csIBM868 }
11736    { IBM869 cp869 869 cp-gr csIBM869 }
11737    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
11738    { IBM871 CP871 ebcdic-cp-is csIBM871 }
11739    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
11740    { IBM891 cp891 csIBM891 }
11741    { IBM903 cp903 csIBM903 }
11742    { IBM904 cp904 904 csIBBM904 }
11743    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
11744    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
11745    { IBM1026 CP1026 csIBM1026 }
11746    { EBCDIC-AT-DE csIBMEBCDICATDE }
11747    { EBCDIC-AT-DE-A csEBCDICATDEA }
11748    { EBCDIC-CA-FR csEBCDICCAFR }
11749    { EBCDIC-DK-NO csEBCDICDKNO }
11750    { EBCDIC-DK-NO-A csEBCDICDKNOA }
11751    { EBCDIC-FI-SE csEBCDICFISE }
11752    { EBCDIC-FI-SE-A csEBCDICFISEA }
11753    { EBCDIC-FR csEBCDICFR }
11754    { EBCDIC-IT csEBCDICIT }
11755    { EBCDIC-PT csEBCDICPT }
11756    { EBCDIC-ES csEBCDICES }
11757    { EBCDIC-ES-A csEBCDICESA }
11758    { EBCDIC-ES-S csEBCDICESS }
11759    { EBCDIC-UK csEBCDICUK }
11760    { EBCDIC-US csEBCDICUS }
11761    { UNKNOWN-8BIT csUnknown8BiT }
11762    { MNEMONIC csMnemonic }
11763    { MNEM csMnem }
11764    { VISCII csVISCII }
11765    { VIQR csVIQR }
11766    { KOI8-R csKOI8R }
11767    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
11768    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
11769    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
11770    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
11771    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
11772    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
11773    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
11774    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
11775    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
11776    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
11777    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
11778    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
11779    { IBM1047 IBM-1047 }
11780    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
11781    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
11782    { UNICODE-1-1 csUnicode11 }
11783    { CESU-8 csCESU-8 }
11784    { BOCU-1 csBOCU-1 }
11785    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
11786    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
11787      l8 }
11788    { ISO-8859-15 ISO_8859-15 Latin-9 }
11789    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
11790    { GBK CP936 MS936 windows-936 }
11791    { JIS_Encoding csJISEncoding }
11792    { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
11793    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
11794      EUC-JP }
11795    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
11796    { ISO-10646-UCS-Basic csUnicodeASCII }
11797    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
11798    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
11799    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
11800    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
11801    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
11802    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
11803    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
11804    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
11805    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
11806    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
11807    { Adobe-Standard-Encoding csAdobeStandardEncoding }
11808    { Ventura-US csVenturaUS }
11809    { Ventura-International csVenturaInternational }
11810    { PC8-Danish-Norwegian csPC8DanishNorwegian }
11811    { PC8-Turkish csPC8Turkish }
11812    { IBM-Symbols csIBMSymbols }
11813    { IBM-Thai csIBMThai }
11814    { HP-Legal csHPLegal }
11815    { HP-Pi-font csHPPiFont }
11816    { HP-Math8 csHPMath8 }
11817    { Adobe-Symbol-Encoding csHPPSMath }
11818    { HP-DeskTop csHPDesktop }
11819    { Ventura-Math csVenturaMath }
11820    { Microsoft-Publishing csMicrosoftPublishing }
11821    { Windows-31J csWindows31J }
11822    { GB2312 csGB2312 }
11823    { Big5 csBig5 }
11824}
11825
11826proc tcl_encoding {enc} {
11827    global encoding_aliases tcl_encoding_cache
11828    if {[info exists tcl_encoding_cache($enc)]} {
11829        return $tcl_encoding_cache($enc)
11830    }
11831    set names [encoding names]
11832    set lcnames [string tolower $names]
11833    set enc [string tolower $enc]
11834    set i [lsearch -exact $lcnames $enc]
11835    if {$i < 0} {
11836        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
11837        if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
11838            set i [lsearch -exact $lcnames $encx]
11839        }
11840    }
11841    if {$i < 0} {
11842        foreach l $encoding_aliases {
11843            set ll [string tolower $l]
11844            if {[lsearch -exact $ll $enc] < 0} continue
11845            # look through the aliases for one that tcl knows about
11846            foreach e $ll {
11847                set i [lsearch -exact $lcnames $e]
11848                if {$i < 0} {
11849                    if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
11850                        set i [lsearch -exact $lcnames $ex]
11851                    }
11852                }
11853                if {$i >= 0} break
11854            }
11855            break
11856        }
11857    }
11858    set tclenc {}
11859    if {$i >= 0} {
11860        set tclenc [lindex $names $i]
11861    }
11862    set tcl_encoding_cache($enc) $tclenc
11863    return $tclenc
11864}
11865
11866proc gitattr {path attr default} {
11867    global path_attr_cache
11868    if {[info exists path_attr_cache($attr,$path)]} {
11869        set r $path_attr_cache($attr,$path)
11870    } else {
11871        set r "unspecified"
11872        if {![catch {set line [exec git check-attr $attr -- $path]}]} {
11873            regexp "(.*): $attr: (.*)" $line m f r
11874        }
11875        set path_attr_cache($attr,$path) $r
11876    }
11877    if {$r eq "unspecified"} {
11878        return $default
11879    }
11880    return $r
11881}
11882
11883proc cache_gitattr {attr pathlist} {
11884    global path_attr_cache
11885    set newlist {}
11886    foreach path $pathlist {
11887        if {![info exists path_attr_cache($attr,$path)]} {
11888            lappend newlist $path
11889        }
11890    }
11891    set lim 1000
11892    if {[tk windowingsystem] == "win32"} {
11893        # windows has a 32k limit on the arguments to a command...
11894        set lim 30
11895    }
11896    while {$newlist ne {}} {
11897        set head [lrange $newlist 0 [expr {$lim - 1}]]
11898        set newlist [lrange $newlist $lim end]
11899        if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
11900            foreach row [split $rlist "\n"] {
11901                if {[regexp "(.*): $attr: (.*)" $row m path value]} {
11902                    if {[string index $path 0] eq "\""} {
11903                        set path [encoding convertfrom [lindex $path 0]]
11904                    }
11905                    set path_attr_cache($attr,$path) $value
11906                }
11907            }
11908        }
11909    }
11910}
11911
11912proc get_path_encoding {path} {
11913    global gui_encoding perfile_attrs
11914    set tcl_enc $gui_encoding
11915    if {$path ne {} && $perfile_attrs} {
11916        set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
11917        if {$enc2 ne {}} {
11918            set tcl_enc $enc2
11919        }
11920    }
11921    return $tcl_enc
11922}
11923
11924# First check that Tcl/Tk is recent enough
11925if {[catch {package require Tk 8.4} err]} {
11926    show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
11927                     Gitk requires at least Tcl/Tk 8.4." list
11928    exit 1
11929}
11930
11931# on OSX bring the current Wish process window to front
11932if {[tk windowingsystem] eq "aqua"} {
11933    exec osascript -e [format {
11934        tell application "System Events"
11935            set frontmost of processes whose unix id is %d to true
11936        end tell
11937    } [pid] ]
11938}
11939
11940# Unset GIT_TRACE var if set
11941if { [info exists ::env(GIT_TRACE)] } {
11942    unset ::env(GIT_TRACE)
11943}
11944
11945# defaults...
11946set wrcomcmd "git diff-tree --stdin -p --pretty=email"
11947
11948set gitencoding {}
11949catch {
11950    set gitencoding [exec git config --get i18n.commitencoding]
11951}
11952catch {
11953    set gitencoding [exec git config --get i18n.logoutputencoding]
11954}
11955if {$gitencoding == ""} {
11956    set gitencoding "utf-8"
11957}
11958set tclencoding [tcl_encoding $gitencoding]
11959if {$tclencoding == {}} {
11960    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
11961}
11962
11963set gui_encoding [encoding system]
11964catch {
11965    set enc [exec git config --get gui.encoding]
11966    if {$enc ne {}} {
11967        set tclenc [tcl_encoding $enc]
11968        if {$tclenc ne {}} {
11969            set gui_encoding $tclenc
11970        } else {
11971            puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
11972        }
11973    }
11974}
11975
11976set log_showroot true
11977catch {
11978    set log_showroot [exec git config --bool --get log.showroot]
11979}
11980
11981if {[tk windowingsystem] eq "aqua"} {
11982    set mainfont {{Lucida Grande} 9}
11983    set textfont {Monaco 9}
11984    set uifont {{Lucida Grande} 9 bold}
11985} elseif {![catch {::tk::pkgconfig get fontsystem} xft] && $xft eq "xft"} {
11986    # fontconfig!
11987    set mainfont {sans 9}
11988    set textfont {monospace 9}
11989    set uifont {sans 9 bold}
11990} else {
11991    set mainfont {Helvetica 9}
11992    set textfont {Courier 9}
11993    set uifont {Helvetica 9 bold}
11994}
11995set tabstop 8
11996set findmergefiles 0
11997set maxgraphpct 50
11998set maxwidth 16
11999set revlistorder 0
12000set fastdate 0
12001set uparrowlen 5
12002set downarrowlen 5
12003set mingaplen 100
12004set cmitmode "patch"
12005set wrapcomment "none"
12006set showneartags 1
12007set hideremotes 0
12008set maxrefs 20
12009set visiblerefs {"master"}
12010set maxlinelen 200
12011set showlocalchanges 1
12012set limitdiffs 1
12013set datetimeformat "%Y-%m-%d %H:%M:%S"
12014set autoselect 1
12015set autosellen 40
12016set perfile_attrs 0
12017set want_ttk 1
12018
12019if {[tk windowingsystem] eq "aqua"} {
12020    set extdifftool "opendiff"
12021} else {
12022    set extdifftool "meld"
12023}
12024
12025set colors {green red blue magenta darkgrey brown orange}
12026if {[tk windowingsystem] eq "win32"} {
12027    set uicolor SystemButtonFace
12028    set uifgcolor SystemButtonText
12029    set uifgdisabledcolor SystemDisabledText
12030    set bgcolor SystemWindow
12031    set fgcolor SystemWindowText
12032    set selectbgcolor SystemHighlight
12033} else {
12034    set uicolor grey85
12035    set uifgcolor black
12036    set uifgdisabledcolor "#999"
12037    set bgcolor white
12038    set fgcolor black
12039    set selectbgcolor gray85
12040}
12041set diffcolors {red "#00a000" blue}
12042set diffcontext 3
12043set mergecolors {red blue green purple brown "#009090" magenta "#808000" "#009000" "#ff0080" cyan "#b07070" "#70b0f0" "#70f0b0" "#f0b070" "#ff70b0"}
12044set ignorespace 0
12045set worddiff ""
12046set markbgcolor "#e0e0ff"
12047
12048set headbgcolor green
12049set headfgcolor black
12050set headoutlinecolor black
12051set remotebgcolor #ffddaa
12052set tagbgcolor yellow
12053set tagfgcolor black
12054set tagoutlinecolor black
12055set reflinecolor black
12056set filesepbgcolor #aaaaaa
12057set filesepfgcolor black
12058set linehoverbgcolor #ffff80
12059set linehoverfgcolor black
12060set linehoveroutlinecolor black
12061set mainheadcirclecolor yellow
12062set workingfilescirclecolor red
12063set indexcirclecolor green
12064set circlecolors {white blue gray blue blue}
12065set linkfgcolor blue
12066set circleoutlinecolor $fgcolor
12067set foundbgcolor yellow
12068set currentsearchhitbgcolor orange
12069
12070# button for popping up context menus
12071if {[tk windowingsystem] eq "aqua"} {
12072    set ctxbut <Button-2>
12073} else {
12074    set ctxbut <Button-3>
12075}
12076
12077## For msgcat loading, first locate the installation location.
12078if { [info exists ::env(GITK_MSGSDIR)] } {
12079    ## Msgsdir was manually set in the environment.
12080    set gitk_msgsdir $::env(GITK_MSGSDIR)
12081} else {
12082    ## Let's guess the prefix from argv0.
12083    set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
12084    set gitk_libdir [file join $gitk_prefix share gitk lib]
12085    set gitk_msgsdir [file join $gitk_libdir msgs]
12086    unset gitk_prefix
12087}
12088
12089## Internationalization (i18n) through msgcat and gettext. See
12090## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
12091package require msgcat
12092namespace import ::msgcat::mc
12093## And eventually load the actual message catalog
12094::msgcat::mcload $gitk_msgsdir
12095
12096catch {
12097    # follow the XDG base directory specification by default. See
12098    # http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html
12099    if {[info exists env(XDG_CONFIG_HOME)] && $env(XDG_CONFIG_HOME) ne ""} {
12100        # XDG_CONFIG_HOME environment variable is set
12101        set config_file [file join $env(XDG_CONFIG_HOME) git gitk]
12102        set config_file_tmp [file join $env(XDG_CONFIG_HOME) git gitk-tmp]
12103    } else {
12104        # default XDG_CONFIG_HOME
12105        set config_file "~/.config/git/gitk"
12106        set config_file_tmp "~/.config/git/gitk-tmp"
12107    }
12108    if {![file exists $config_file]} {
12109        # for backward compatibility use the old config file if it exists
12110        if {[file exists "~/.gitk"]} {
12111            set config_file "~/.gitk"
12112            set config_file_tmp "~/.gitk-tmp"
12113        } elseif {![file exists [file dirname $config_file]]} {
12114            file mkdir [file dirname $config_file]
12115        }
12116    }
12117    source $config_file
12118}
12119
12120set config_variables {
12121    mainfont textfont uifont tabstop findmergefiles maxgraphpct maxwidth
12122    cmitmode wrapcomment autoselect autosellen showneartags maxrefs visiblerefs
12123    hideremotes showlocalchanges datetimeformat limitdiffs uicolor want_ttk
12124    bgcolor fgcolor uifgcolor uifgdisabledcolor colors diffcolors mergecolors
12125    markbgcolor diffcontext selectbgcolor foundbgcolor currentsearchhitbgcolor
12126    extdifftool perfile_attrs headbgcolor headfgcolor headoutlinecolor
12127    remotebgcolor tagbgcolor tagfgcolor tagoutlinecolor reflinecolor
12128    filesepbgcolor filesepfgcolor linehoverbgcolor linehoverfgcolor
12129    linehoveroutlinecolor mainheadcirclecolor workingfilescirclecolor
12130    indexcirclecolor circlecolors linkfgcolor circleoutlinecolor
12131}
12132
12133parsefont mainfont $mainfont
12134eval font create mainfont [fontflags mainfont]
12135eval font create mainfontbold [fontflags mainfont 1]
12136
12137parsefont textfont $textfont
12138eval font create textfont [fontflags textfont]
12139eval font create textfontbold [fontflags textfont 1]
12140
12141parsefont uifont $uifont
12142eval font create uifont [fontflags uifont]
12143
12144setui $uicolor
12145
12146setoptions
12147
12148# check that we can find a .git directory somewhere...
12149if {[catch {set gitdir [exec git rev-parse --git-dir]}]} {
12150    show_error {} . [mc "Cannot find a git repository here."]
12151    exit 1
12152}
12153
12154set selecthead {}
12155set selectheadid {}
12156
12157set revtreeargs {}
12158set cmdline_files {}
12159set i 0
12160set revtreeargscmd {}
12161foreach arg $argv {
12162    switch -glob -- $arg {
12163        "" { }
12164        "--" {
12165            set cmdline_files [lrange $argv [expr {$i + 1}] end]
12166            break
12167        }
12168        "--select-commit=*" {
12169            set selecthead [string range $arg 16 end]
12170        }
12171        "--argscmd=*" {
12172            set revtreeargscmd [string range $arg 10 end]
12173        }
12174        default {
12175            lappend revtreeargs $arg
12176        }
12177    }
12178    incr i
12179}
12180
12181if {$selecthead eq "HEAD"} {
12182    set selecthead {}
12183}
12184
12185if {$i >= [llength $argv] && $revtreeargs ne {}} {
12186    # no -- on command line, but some arguments (other than --argscmd)
12187    if {[catch {
12188        set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
12189        set cmdline_files [split $f "\n"]
12190        set n [llength $cmdline_files]
12191        set revtreeargs [lrange $revtreeargs 0 end-$n]
12192        # Unfortunately git rev-parse doesn't produce an error when
12193        # something is both a revision and a filename.  To be consistent
12194        # with git log and git rev-list, check revtreeargs for filenames.
12195        foreach arg $revtreeargs {
12196            if {[file exists $arg]} {
12197                show_error {} . [mc "Ambiguous argument '%s': both revision\
12198                                 and filename" $arg]
12199                exit 1
12200            }
12201        }
12202    } err]} {
12203        # unfortunately we get both stdout and stderr in $err,
12204        # so look for "fatal:".
12205        set i [string first "fatal:" $err]
12206        if {$i > 0} {
12207            set err [string range $err [expr {$i + 6}] end]
12208        }
12209        show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
12210        exit 1
12211    }
12212}
12213
12214set nullid "0000000000000000000000000000000000000000"
12215set nullid2 "0000000000000000000000000000000000000001"
12216set nullfile "/dev/null"
12217
12218set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
12219if {![info exists have_ttk]} {
12220    set have_ttk [llength [info commands ::ttk::style]]
12221}
12222set use_ttk [expr {$have_ttk && $want_ttk}]
12223set NS [expr {$use_ttk ? "ttk" : ""}]
12224
12225regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
12226
12227set show_notes {}
12228if {[package vcompare $git_version "1.6.6.2"] >= 0} {
12229    set show_notes "--show-notes"
12230}
12231
12232set appname "gitk"
12233
12234set runq {}
12235set history {}
12236set historyindex 0
12237set fh_serial 0
12238set nhl_names {}
12239set highlight_paths {}
12240set findpattern {}
12241set searchdirn -forwards
12242set boldids {}
12243set boldnameids {}
12244set diffelide {0 0}
12245set markingmatches 0
12246set linkentercount 0
12247set need_redisplay 0
12248set nrows_drawn 0
12249set firsttabstop 0
12250
12251set nextviewnum 1
12252set curview 0
12253set selectedview 0
12254set selectedhlview [mc "None"]
12255set highlight_related [mc "None"]
12256set highlight_files {}
12257set viewfiles(0) {}
12258set viewperm(0) 0
12259set viewargs(0) {}
12260set viewargscmd(0) {}
12261
12262set selectedline {}
12263set numcommits 0
12264set loginstance 0
12265set cmdlineok 0
12266set stopped 0
12267set stuffsaved 0
12268set patchnum 0
12269set lserial 0
12270set hasworktree [hasworktree]
12271set cdup {}
12272if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} {
12273    set cdup [exec git rev-parse --show-cdup]
12274}
12275set worktree [exec git rev-parse --show-toplevel]
12276setcoords
12277makewindow
12278catch {
12279    image create photo gitlogo      -width 16 -height 16
12280
12281    image create photo gitlogominus -width  4 -height  2
12282    gitlogominus put #C00000 -to 0 0 4 2
12283    gitlogo copy gitlogominus -to  1 5
12284    gitlogo copy gitlogominus -to  6 5
12285    gitlogo copy gitlogominus -to 11 5
12286    image delete gitlogominus
12287
12288    image create photo gitlogoplus  -width  4 -height  4
12289    gitlogoplus  put #008000 -to 1 0 3 4
12290    gitlogoplus  put #008000 -to 0 1 4 3
12291    gitlogo copy gitlogoplus  -to  1 9
12292    gitlogo copy gitlogoplus  -to  6 9
12293    gitlogo copy gitlogoplus  -to 11 9
12294    image delete gitlogoplus
12295
12296    image create photo gitlogo32    -width 32 -height 32
12297    gitlogo32 copy gitlogo -zoom 2 2
12298
12299    wm iconphoto . -default gitlogo gitlogo32
12300}
12301# wait for the window to become visible
12302tkwait visibility .
12303wm title . "$appname: [reponame]"
12304update
12305readrefs
12306
12307if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
12308    # create a view for the files/dirs specified on the command line
12309    set curview 1
12310    set selectedview 1
12311    set nextviewnum 2
12312    set viewname(1) [mc "Command line"]
12313    set viewfiles(1) $cmdline_files
12314    set viewargs(1) $revtreeargs
12315    set viewargscmd(1) $revtreeargscmd
12316    set viewperm(1) 0
12317    set vdatemode(1) 0
12318    addviewmenu 1
12319    .bar.view entryconf [mca "Edit view..."] -state normal
12320    .bar.view entryconf [mca "Delete view"] -state normal
12321}
12322
12323if {[info exists permviews]} {
12324    foreach v $permviews {
12325        set n $nextviewnum
12326        incr nextviewnum
12327        set viewname($n) [lindex $v 0]
12328        set viewfiles($n) [lindex $v 1]
12329        set viewargs($n) [lindex $v 2]
12330        set viewargscmd($n) [lindex $v 3]
12331        set viewperm($n) 1
12332        addviewmenu $n
12333    }
12334}
12335
12336if {[tk windowingsystem] eq "win32"} {
12337    focus -force .
12338}
12339
12340getcommits {}
12341
12342# Local variables:
12343# mode: tcl
12344# indent-tabs-mode: t
12345# tab-width: 8
12346# End: