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