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