gitk-git / gitkon commit Merge early parts from git://ozlabs.org/~paulus/gitk.git (ea0e524)
   1#!/bin/sh
   2# Tcl ignores the next line -*- tcl -*- \
   3exec wish "$0" -- "$@"
   4
   5# Copyright © 2005-2014 Paul Mackerras.  All rights reserved.
   6# This program is free software; it may be used, copied, modified
   7# and distributed under the terms of the GNU General Public Licence,
   8# either version 2, or (at your option) any later version.
   9
  10package require Tk
  11
  12proc hasworktree {} {
  13    return [expr {[exec git rev-parse --is-bare-repository] == "false" &&
  14                  [exec git rev-parse --is-inside-git-dir] == "false"}]
  15}
  16
  17proc reponame {} {
  18    global gitdir
  19    set n [file normalize $gitdir]
  20    if {[string match "*/.git" $n]} {
  21        set n [string range $n 0 end-5]
  22    }
  23    return [file tail $n]
  24}
  25
  26proc gitworktree {} {
  27    variable _gitworktree
  28    if {[info exists _gitworktree]} {
  29        return $_gitworktree
  30    }
  31    # v1.7.0 introduced --show-toplevel to return the canonical work-tree
  32    if {[catch {set _gitworktree [exec git rev-parse --show-toplevel]}]} {
  33        # try to set work tree from environment, core.worktree or use
  34        # cdup to obtain a relative path to the top of the worktree. If
  35        # run from the top, the ./ prefix ensures normalize expands pwd.
  36        if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
  37            catch {set _gitworktree [exec git config --get core.worktree]}
  38            if {$_gitworktree eq ""} {
  39                set _gitworktree [file normalize ./[exec git rev-parse --show-cdup]]
  40            }
  41        }
  42    }
  43    return $_gitworktree
  44}
  45
  46# A simple scheduler for compute-intensive stuff.
  47# The aim is to make sure that event handlers for GUI actions can
  48# run at least every 50-100 ms.  Unfortunately fileevent handlers are
  49# run before X event handlers, so reading from a fast source can
  50# make the GUI completely unresponsive.
  51proc run args {
  52    global isonrunq runq currunq
  53
  54    set script $args
  55    if {[info exists isonrunq($script)]} return
  56    if {$runq eq {} && ![info exists currunq]} {
  57        after idle dorunq
  58    }
  59    lappend runq [list {} $script]
  60    set isonrunq($script) 1
  61}
  62
  63proc filerun {fd script} {
  64    fileevent $fd readable [list filereadable $fd $script]
  65}
  66
  67proc filereadable {fd script} {
  68    global runq currunq
  69
  70    fileevent $fd readable {}
  71    if {$runq eq {} && ![info exists currunq]} {
  72        after idle dorunq
  73    }
  74    lappend runq [list $fd $script]
  75}
  76
  77proc nukefile {fd} {
  78    global runq
  79
  80    for {set i 0} {$i < [llength $runq]} {} {
  81        if {[lindex $runq $i 0] eq $fd} {
  82            set runq [lreplace $runq $i $i]
  83        } else {
  84            incr i
  85        }
  86    }
  87}
  88
  89proc dorunq {} {
  90    global isonrunq runq currunq
  91
  92    set tstart [clock clicks -milliseconds]
  93    set t0 $tstart
  94    while {[llength $runq] > 0} {
  95        set fd [lindex $runq 0 0]
  96        set script [lindex $runq 0 1]
  97        set currunq [lindex $runq 0]
  98        set runq [lrange $runq 1 end]
  99        set repeat [eval $script]
 100        unset currunq
 101        set t1 [clock clicks -milliseconds]
 102        set t [expr {$t1 - $t0}]
 103        if {$repeat ne {} && $repeat} {
 104            if {$fd eq {} || $repeat == 2} {
 105                # script returns 1 if it wants to be readded
 106                # file readers return 2 if they could do more straight away
 107                lappend runq [list $fd $script]
 108            } else {
 109                fileevent $fd readable [list filereadable $fd $script]
 110            }
 111        } elseif {$fd eq {}} {
 112            unset isonrunq($script)
 113        }
 114        set t0 $t1
 115        if {$t1 - $tstart >= 80} break
 116    }
 117    if {$runq ne {}} {
 118        after idle dorunq
 119    }
 120}
 121
 122proc reg_instance {fd} {
 123    global commfd leftover loginstance
 124
 125    set i [incr loginstance]
 126    set commfd($i) $fd
 127    set leftover($i) {}
 128    return $i
 129}
 130
 131proc unmerged_files {files} {
 132    global nr_unmerged
 133
 134    # find the list of unmerged files
 135    set mlist {}
 136    set nr_unmerged 0
 137    if {[catch {
 138        set fd [open "| git ls-files -u" r]
 139    } err]} {
 140        show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
 141        exit 1
 142    }
 143    while {[gets $fd line] >= 0} {
 144        set i [string first "\t" $line]
 145        if {$i < 0} continue
 146        set fname [string range $line [expr {$i+1}] end]
 147        if {[lsearch -exact $mlist $fname] >= 0} continue
 148        incr nr_unmerged
 149        if {$files eq {} || [path_filter $files $fname]} {
 150            lappend mlist $fname
 151        }
 152    }
 153    catch {close $fd}
 154    return $mlist
 155}
 156
 157proc parseviewargs {n arglist} {
 158    global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs env
 159    global vinlinediff
 160    global worddiff git_version
 161
 162    set vdatemode($n) 0
 163    set vmergeonly($n) 0
 164    set vinlinediff($n) 0
 165    set glflags {}
 166    set diffargs {}
 167    set nextisval 0
 168    set revargs {}
 169    set origargs $arglist
 170    set allknown 1
 171    set filtered 0
 172    set i -1
 173    foreach arg $arglist {
 174        incr i
 175        if {$nextisval} {
 176            lappend glflags $arg
 177            set nextisval 0
 178            continue
 179        }
 180        switch -glob -- $arg {
 181            "-d" -
 182            "--date-order" {
 183                set vdatemode($n) 1
 184                # remove from origargs in case we hit an unknown option
 185                set origargs [lreplace $origargs $i $i]
 186                incr i -1
 187            }
 188            "-[puabwcrRBMC]" -
 189            "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
 190            "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
 191            "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
 192            "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
 193            "--ignore-space-change" - "-U*" - "--unified=*" {
 194                # These request or affect diff output, which we don't want.
 195                # Some could be used to set our defaults for diff display.
 196                lappend diffargs $arg
 197            }
 198            "--raw" - "--patch-with-raw" - "--patch-with-stat" -
 199            "--name-only" - "--name-status" - "--color" -
 200            "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
 201            "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
 202            "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
 203            "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
 204            "--objects" - "--objects-edge" - "--reverse" {
 205                # These cause our parsing of git log's output to fail, or else
 206                # they're options we want to set ourselves, so ignore them.
 207            }
 208            "--color-words*" - "--word-diff=color" {
 209                # These trigger a word diff in the console interface,
 210                # so help the user by enabling our own support
 211                if {[package vcompare $git_version "1.7.2"] >= 0} {
 212                    set worddiff [mc "Color words"]
 213                }
 214            }
 215            "--word-diff*" {
 216                if {[package vcompare $git_version "1.7.2"] >= 0} {
 217                    set worddiff [mc "Markup words"]
 218                }
 219            }
 220            "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
 221            "--check" - "--exit-code" - "--quiet" - "--topo-order" -
 222            "--full-history" - "--dense" - "--sparse" -
 223            "--follow" - "--left-right" - "--encoding=*" {
 224                # These are harmless, and some are even useful
 225                lappend glflags $arg
 226            }
 227            "--diff-filter=*" - "--no-merges" - "--unpacked" -
 228            "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
 229            "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
 230            "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
 231            "--remove-empty" - "--first-parent" - "--cherry-pick" -
 232            "-S*" - "-G*" - "--pickaxe-all" - "--pickaxe-regex" -
 233            "--simplify-by-decoration" {
 234                # These mean that we get a subset of the commits
 235                set filtered 1
 236                lappend glflags $arg
 237            }
 238            "-L*" {
 239                # Line-log with 'stuck' argument (unstuck form is
 240                # not supported)
 241                set filtered 1
 242                set vinlinediff($n) 1
 243                set allknown 0
 244                lappend glflags $arg
 245            }
 246            "-n" {
 247                # This appears to be the only one that has a value as a
 248                # separate word following it
 249                set filtered 1
 250                set nextisval 1
 251                lappend glflags $arg
 252            }
 253            "--not" - "--all" {
 254                lappend revargs $arg
 255            }
 256            "--merge" {
 257                set vmergeonly($n) 1
 258                # git rev-parse doesn't understand --merge
 259                lappend revargs --gitk-symmetric-diff-marker MERGE_HEAD...HEAD
 260            }
 261            "--no-replace-objects" {
 262                set env(GIT_NO_REPLACE_OBJECTS) "1"
 263            }
 264            "-*" {
 265                # Other flag arguments including -<n>
 266                if {[string is digit -strict [string range $arg 1 end]]} {
 267                    set filtered 1
 268                } else {
 269                    # a flag argument that we don't recognize;
 270                    # that means we can't optimize
 271                    set allknown 0
 272                }
 273                lappend glflags $arg
 274            }
 275            default {
 276                # Non-flag arguments specify commits or ranges of commits
 277                if {[string match "*...*" $arg]} {
 278                    lappend revargs --gitk-symmetric-diff-marker
 279                }
 280                lappend revargs $arg
 281            }
 282        }
 283    }
 284    set vdflags($n) $diffargs
 285    set vflags($n) $glflags
 286    set vrevs($n) $revargs
 287    set vfiltered($n) $filtered
 288    set vorigargs($n) $origargs
 289    return $allknown
 290}
 291
 292proc parseviewrevs {view revs} {
 293    global vposids vnegids
 294
 295    if {$revs eq {}} {
 296        set revs HEAD
 297    }
 298    if {[catch {set ids [eval exec git rev-parse $revs]} err]} {
 299        # we get stdout followed by stderr in $err
 300        # for an unknown rev, git rev-parse echoes it and then errors out
 301        set errlines [split $err "\n"]
 302        set badrev {}
 303        for {set l 0} {$l < [llength $errlines]} {incr l} {
 304            set line [lindex $errlines $l]
 305            if {!([string length $line] == 40 && [string is xdigit $line])} {
 306                if {[string match "fatal:*" $line]} {
 307                    if {[string match "fatal: ambiguous argument*" $line]
 308                        && $badrev ne {}} {
 309                        if {[llength $badrev] == 1} {
 310                            set err "unknown revision $badrev"
 311                        } else {
 312                            set err "unknown revisions: [join $badrev ", "]"
 313                        }
 314                    } else {
 315                        set err [join [lrange $errlines $l end] "\n"]
 316                    }
 317                    break
 318                }
 319                lappend badrev $line
 320            }
 321        }
 322        error_popup "[mc "Error parsing revisions:"] $err"
 323        return {}
 324    }
 325    set ret {}
 326    set pos {}
 327    set neg {}
 328    set sdm 0
 329    foreach id [split $ids "\n"] {
 330        if {$id eq "--gitk-symmetric-diff-marker"} {
 331            set sdm 4
 332        } elseif {[string match "^*" $id]} {
 333            if {$sdm != 1} {
 334                lappend ret $id
 335                if {$sdm == 3} {
 336                    set sdm 0
 337                }
 338            }
 339            lappend neg [string range $id 1 end]
 340        } else {
 341            if {$sdm != 2} {
 342                lappend ret $id
 343            } else {
 344                lset ret end $id...[lindex $ret end]
 345            }
 346            lappend pos $id
 347        }
 348        incr sdm -1
 349    }
 350    set vposids($view) $pos
 351    set vnegids($view) $neg
 352    return $ret
 353}
 354
 355# Start off a git log process and arrange to read its output
 356proc start_rev_list {view} {
 357    global startmsecs commitidx viewcomplete curview
 358    global tclencoding
 359    global viewargs viewargscmd viewfiles vfilelimit
 360    global showlocalchanges
 361    global viewactive viewinstances vmergeonly
 362    global mainheadid viewmainheadid viewmainheadid_orig
 363    global vcanopt vflags vrevs vorigargs
 364    global show_notes
 365
 366    set startmsecs [clock clicks -milliseconds]
 367    set commitidx($view) 0
 368    # these are set this way for the error exits
 369    set viewcomplete($view) 1
 370    set viewactive($view) 0
 371    varcinit $view
 372
 373    set args $viewargs($view)
 374    if {$viewargscmd($view) ne {}} {
 375        if {[catch {
 376            set str [exec sh -c $viewargscmd($view)]
 377        } err]} {
 378            error_popup "[mc "Error executing --argscmd command:"] $err"
 379            return 0
 380        }
 381        set args [concat $args [split $str "\n"]]
 382    }
 383    set vcanopt($view) [parseviewargs $view $args]
 384
 385    set files $viewfiles($view)
 386    if {$vmergeonly($view)} {
 387        set files [unmerged_files $files]
 388        if {$files eq {}} {
 389            global nr_unmerged
 390            if {$nr_unmerged == 0} {
 391                error_popup [mc "No files selected: --merge specified but\
 392                             no files are unmerged."]
 393            } else {
 394                error_popup [mc "No files selected: --merge specified but\
 395                             no unmerged files are within file limit."]
 396            }
 397            return 0
 398        }
 399    }
 400    set vfilelimit($view) $files
 401
 402    if {$vcanopt($view)} {
 403        set revs [parseviewrevs $view $vrevs($view)]
 404        if {$revs eq {}} {
 405            return 0
 406        }
 407        set args [concat $vflags($view) $revs]
 408    } else {
 409        set args $vorigargs($view)
 410    }
 411
 412    if {[catch {
 413        set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
 414                        --parents --boundary $args "--" $files] r]
 415    } err]} {
 416        error_popup "[mc "Error executing git log:"] $err"
 417        return 0
 418    }
 419    set i [reg_instance $fd]
 420    set viewinstances($view) [list $i]
 421    set viewmainheadid($view) $mainheadid
 422    set viewmainheadid_orig($view) $mainheadid
 423    if {$files ne {} && $mainheadid ne {}} {
 424        get_viewmainhead $view
 425    }
 426    if {$showlocalchanges && $viewmainheadid($view) ne {}} {
 427        interestedin $viewmainheadid($view) dodiffindex
 428    }
 429    fconfigure $fd -blocking 0 -translation lf -eofchar {}
 430    if {$tclencoding != {}} {
 431        fconfigure $fd -encoding $tclencoding
 432    }
 433    filerun $fd [list getcommitlines $fd $i $view 0]
 434    nowbusy $view [mc "Reading"]
 435    set viewcomplete($view) 0
 436    set viewactive($view) 1
 437    return 1
 438}
 439
 440proc stop_instance {inst} {
 441    global commfd leftover
 442
 443    set fd $commfd($inst)
 444    catch {
 445        set pid [pid $fd]
 446
 447        if {$::tcl_platform(platform) eq {windows}} {
 448            exec kill -f $pid
 449        } else {
 450            exec kill $pid
 451        }
 452    }
 453    catch {close $fd}
 454    nukefile $fd
 455    unset commfd($inst)
 456    unset leftover($inst)
 457}
 458
 459proc stop_backends {} {
 460    global commfd
 461
 462    foreach inst [array names commfd] {
 463        stop_instance $inst
 464    }
 465}
 466
 467proc stop_rev_list {view} {
 468    global viewinstances
 469
 470    foreach inst $viewinstances($view) {
 471        stop_instance $inst
 472    }
 473    set viewinstances($view) {}
 474}
 475
 476proc reset_pending_select {selid} {
 477    global pending_select mainheadid selectheadid
 478
 479    if {$selid ne {}} {
 480        set pending_select $selid
 481    } elseif {$selectheadid ne {}} {
 482        set pending_select $selectheadid
 483    } else {
 484        set pending_select $mainheadid
 485    }
 486}
 487
 488proc getcommits {selid} {
 489    global canv curview need_redisplay viewactive
 490
 491    initlayout
 492    if {[start_rev_list $curview]} {
 493        reset_pending_select $selid
 494        show_status [mc "Reading commits..."]
 495        set need_redisplay 1
 496    } else {
 497        show_status [mc "No commits selected"]
 498    }
 499}
 500
 501proc updatecommits {} {
 502    global curview vcanopt vorigargs vfilelimit viewinstances
 503    global viewactive viewcomplete tclencoding
 504    global startmsecs showneartags showlocalchanges
 505    global mainheadid viewmainheadid viewmainheadid_orig pending_select
 506    global hasworktree
 507    global varcid vposids vnegids vflags vrevs
 508    global show_notes
 509
 510    set hasworktree [hasworktree]
 511    rereadrefs
 512    set view $curview
 513    if {$mainheadid ne $viewmainheadid_orig($view)} {
 514        if {$showlocalchanges} {
 515            dohidelocalchanges
 516        }
 517        set viewmainheadid($view) $mainheadid
 518        set viewmainheadid_orig($view) $mainheadid
 519        if {$vfilelimit($view) ne {}} {
 520            get_viewmainhead $view
 521        }
 522    }
 523    if {$showlocalchanges} {
 524        doshowlocalchanges
 525    }
 526    if {$vcanopt($view)} {
 527        set oldpos $vposids($view)
 528        set oldneg $vnegids($view)
 529        set revs [parseviewrevs $view $vrevs($view)]
 530        if {$revs eq {}} {
 531            return
 532        }
 533        # note: getting the delta when negative refs change is hard,
 534        # and could require multiple git log invocations, so in that
 535        # case we ask git log for all the commits (not just the delta)
 536        if {$oldneg eq $vnegids($view)} {
 537            set newrevs {}
 538            set npos 0
 539            # take out positive refs that we asked for before or
 540            # that we have already seen
 541            foreach rev $revs {
 542                if {[string length $rev] == 40} {
 543                    if {[lsearch -exact $oldpos $rev] < 0
 544                        && ![info exists varcid($view,$rev)]} {
 545                        lappend newrevs $rev
 546                        incr npos
 547                    }
 548                } else {
 549                    lappend $newrevs $rev
 550                }
 551            }
 552            if {$npos == 0} return
 553            set revs $newrevs
 554            set vposids($view) [lsort -unique [concat $oldpos $vposids($view)]]
 555        }
 556        set args [concat $vflags($view) $revs --not $oldpos]
 557    } else {
 558        set args $vorigargs($view)
 559    }
 560    if {[catch {
 561        set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
 562                        --parents --boundary $args "--" $vfilelimit($view)] r]
 563    } err]} {
 564        error_popup "[mc "Error executing git log:"] $err"
 565        return
 566    }
 567    if {$viewactive($view) == 0} {
 568        set startmsecs [clock clicks -milliseconds]
 569    }
 570    set i [reg_instance $fd]
 571    lappend viewinstances($view) $i
 572    fconfigure $fd -blocking 0 -translation lf -eofchar {}
 573    if {$tclencoding != {}} {
 574        fconfigure $fd -encoding $tclencoding
 575    }
 576    filerun $fd [list getcommitlines $fd $i $view 1]
 577    incr viewactive($view)
 578    set viewcomplete($view) 0
 579    reset_pending_select {}
 580    nowbusy $view [mc "Reading"]
 581    if {$showneartags} {
 582        getallcommits
 583    }
 584}
 585
 586proc reloadcommits {} {
 587    global curview viewcomplete selectedline currentid thickerline
 588    global showneartags treediffs commitinterest cached_commitrow
 589    global targetid
 590
 591    set selid {}
 592    if {$selectedline ne {}} {
 593        set selid $currentid
 594    }
 595
 596    if {!$viewcomplete($curview)} {
 597        stop_rev_list $curview
 598    }
 599    resetvarcs $curview
 600    set selectedline {}
 601    catch {unset currentid}
 602    catch {unset thickerline}
 603    catch {unset treediffs}
 604    readrefs
 605    changedrefs
 606    if {$showneartags} {
 607        getallcommits
 608    }
 609    clear_display
 610    catch {unset commitinterest}
 611    catch {unset cached_commitrow}
 612    catch {unset targetid}
 613    setcanvscroll
 614    getcommits $selid
 615    return 0
 616}
 617
 618# This makes a string representation of a positive integer which
 619# sorts as a string in numerical order
 620proc strrep {n} {
 621    if {$n < 16} {
 622        return [format "%x" $n]
 623    } elseif {$n < 256} {
 624        return [format "x%.2x" $n]
 625    } elseif {$n < 65536} {
 626        return [format "y%.4x" $n]
 627    }
 628    return [format "z%.8x" $n]
 629}
 630
 631# Procedures used in reordering commits from git log (without
 632# --topo-order) into the order for display.
 633
 634proc varcinit {view} {
 635    global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
 636    global vtokmod varcmod vrowmod varcix vlastins
 637
 638    set varcstart($view) {{}}
 639    set vupptr($view) {0}
 640    set vdownptr($view) {0}
 641    set vleftptr($view) {0}
 642    set vbackptr($view) {0}
 643    set varctok($view) {{}}
 644    set varcrow($view) {{}}
 645    set vtokmod($view) {}
 646    set varcmod($view) 0
 647    set vrowmod($view) 0
 648    set varcix($view) {{}}
 649    set vlastins($view) {0}
 650}
 651
 652proc resetvarcs {view} {
 653    global varcid varccommits parents children vseedcount ordertok
 654    global vshortids
 655
 656    foreach vid [array names varcid $view,*] {
 657        unset varcid($vid)
 658        unset children($vid)
 659        unset parents($vid)
 660    }
 661    foreach vid [array names vshortids $view,*] {
 662        unset vshortids($vid)
 663    }
 664    # some commits might have children but haven't been seen yet
 665    foreach vid [array names children $view,*] {
 666        unset children($vid)
 667    }
 668    foreach va [array names varccommits $view,*] {
 669        unset varccommits($va)
 670    }
 671    foreach vd [array names vseedcount $view,*] {
 672        unset vseedcount($vd)
 673    }
 674    catch {unset ordertok}
 675}
 676
 677# returns a list of the commits with no children
 678proc seeds {v} {
 679    global vdownptr vleftptr varcstart
 680
 681    set ret {}
 682    set a [lindex $vdownptr($v) 0]
 683    while {$a != 0} {
 684        lappend ret [lindex $varcstart($v) $a]
 685        set a [lindex $vleftptr($v) $a]
 686    }
 687    return $ret
 688}
 689
 690proc newvarc {view id} {
 691    global varcid varctok parents children vdatemode
 692    global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
 693    global commitdata commitinfo vseedcount varccommits vlastins
 694
 695    set a [llength $varctok($view)]
 696    set vid $view,$id
 697    if {[llength $children($vid)] == 0 || $vdatemode($view)} {
 698        if {![info exists commitinfo($id)]} {
 699            parsecommit $id $commitdata($id) 1
 700        }
 701        set cdate [lindex [lindex $commitinfo($id) 4] 0]
 702        if {![string is integer -strict $cdate]} {
 703            set cdate 0
 704        }
 705        if {![info exists vseedcount($view,$cdate)]} {
 706            set vseedcount($view,$cdate) -1
 707        }
 708        set c [incr vseedcount($view,$cdate)]
 709        set cdate [expr {$cdate ^ 0xffffffff}]
 710        set tok "s[strrep $cdate][strrep $c]"
 711    } else {
 712        set tok {}
 713    }
 714    set ka 0
 715    if {[llength $children($vid)] > 0} {
 716        set kid [lindex $children($vid) end]
 717        set k $varcid($view,$kid)
 718        if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
 719            set ki $kid
 720            set ka $k
 721            set tok [lindex $varctok($view) $k]
 722        }
 723    }
 724    if {$ka != 0} {
 725        set i [lsearch -exact $parents($view,$ki) $id]
 726        set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
 727        append tok [strrep $j]
 728    }
 729    set c [lindex $vlastins($view) $ka]
 730    if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
 731        set c $ka
 732        set b [lindex $vdownptr($view) $ka]
 733    } else {
 734        set b [lindex $vleftptr($view) $c]
 735    }
 736    while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
 737        set c $b
 738        set b [lindex $vleftptr($view) $c]
 739    }
 740    if {$c == $ka} {
 741        lset vdownptr($view) $ka $a
 742        lappend vbackptr($view) 0
 743    } else {
 744        lset vleftptr($view) $c $a
 745        lappend vbackptr($view) $c
 746    }
 747    lset vlastins($view) $ka $a
 748    lappend vupptr($view) $ka
 749    lappend vleftptr($view) $b
 750    if {$b != 0} {
 751        lset vbackptr($view) $b $a
 752    }
 753    lappend varctok($view) $tok
 754    lappend varcstart($view) $id
 755    lappend vdownptr($view) 0
 756    lappend varcrow($view) {}
 757    lappend varcix($view) {}
 758    set varccommits($view,$a) {}
 759    lappend vlastins($view) 0
 760    return $a
 761}
 762
 763proc splitvarc {p v} {
 764    global varcid varcstart varccommits varctok vtokmod
 765    global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
 766
 767    set oa $varcid($v,$p)
 768    set otok [lindex $varctok($v) $oa]
 769    set ac $varccommits($v,$oa)
 770    set i [lsearch -exact $varccommits($v,$oa) $p]
 771    if {$i <= 0} return
 772    set na [llength $varctok($v)]
 773    # "%" sorts before "0"...
 774    set tok "$otok%[strrep $i]"
 775    lappend varctok($v) $tok
 776    lappend varcrow($v) {}
 777    lappend varcix($v) {}
 778    set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
 779    set varccommits($v,$na) [lrange $ac $i end]
 780    lappend varcstart($v) $p
 781    foreach id $varccommits($v,$na) {
 782        set varcid($v,$id) $na
 783    }
 784    lappend vdownptr($v) [lindex $vdownptr($v) $oa]
 785    lappend vlastins($v) [lindex $vlastins($v) $oa]
 786    lset vdownptr($v) $oa $na
 787    lset vlastins($v) $oa 0
 788    lappend vupptr($v) $oa
 789    lappend vleftptr($v) 0
 790    lappend vbackptr($v) 0
 791    for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
 792        lset vupptr($v) $b $na
 793    }
 794    if {[string compare $otok $vtokmod($v)] <= 0} {
 795        modify_arc $v $oa
 796    }
 797}
 798
 799proc renumbervarc {a v} {
 800    global parents children varctok varcstart varccommits
 801    global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
 802
 803    set t1 [clock clicks -milliseconds]
 804    set todo {}
 805    set isrelated($a) 1
 806    set kidchanged($a) 1
 807    set ntot 0
 808    while {$a != 0} {
 809        if {[info exists isrelated($a)]} {
 810            lappend todo $a
 811            set id [lindex $varccommits($v,$a) end]
 812            foreach p $parents($v,$id) {
 813                if {[info exists varcid($v,$p)]} {
 814                    set isrelated($varcid($v,$p)) 1
 815                }
 816            }
 817        }
 818        incr ntot
 819        set b [lindex $vdownptr($v) $a]
 820        if {$b == 0} {
 821            while {$a != 0} {
 822                set b [lindex $vleftptr($v) $a]
 823                if {$b != 0} break
 824                set a [lindex $vupptr($v) $a]
 825            }
 826        }
 827        set a $b
 828    }
 829    foreach a $todo {
 830        if {![info exists kidchanged($a)]} continue
 831        set id [lindex $varcstart($v) $a]
 832        if {[llength $children($v,$id)] > 1} {
 833            set children($v,$id) [lsort -command [list vtokcmp $v] \
 834                                      $children($v,$id)]
 835        }
 836        set oldtok [lindex $varctok($v) $a]
 837        if {!$vdatemode($v)} {
 838            set tok {}
 839        } else {
 840            set tok $oldtok
 841        }
 842        set ka 0
 843        set kid [last_real_child $v,$id]
 844        if {$kid ne {}} {
 845            set k $varcid($v,$kid)
 846            if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
 847                set ki $kid
 848                set ka $k
 849                set tok [lindex $varctok($v) $k]
 850            }
 851        }
 852        if {$ka != 0} {
 853            set i [lsearch -exact $parents($v,$ki) $id]
 854            set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
 855            append tok [strrep $j]
 856        }
 857        if {$tok eq $oldtok} {
 858            continue
 859        }
 860        set id [lindex $varccommits($v,$a) end]
 861        foreach p $parents($v,$id) {
 862            if {[info exists varcid($v,$p)]} {
 863                set kidchanged($varcid($v,$p)) 1
 864            } else {
 865                set sortkids($p) 1
 866            }
 867        }
 868        lset varctok($v) $a $tok
 869        set b [lindex $vupptr($v) $a]
 870        if {$b != $ka} {
 871            if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
 872                modify_arc $v $ka
 873            }
 874            if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
 875                modify_arc $v $b
 876            }
 877            set c [lindex $vbackptr($v) $a]
 878            set d [lindex $vleftptr($v) $a]
 879            if {$c == 0} {
 880                lset vdownptr($v) $b $d
 881            } else {
 882                lset vleftptr($v) $c $d
 883            }
 884            if {$d != 0} {
 885                lset vbackptr($v) $d $c
 886            }
 887            if {[lindex $vlastins($v) $b] == $a} {
 888                lset vlastins($v) $b $c
 889            }
 890            lset vupptr($v) $a $ka
 891            set c [lindex $vlastins($v) $ka]
 892            if {$c == 0 || \
 893                    [string compare $tok [lindex $varctok($v) $c]] < 0} {
 894                set c $ka
 895                set b [lindex $vdownptr($v) $ka]
 896            } else {
 897                set b [lindex $vleftptr($v) $c]
 898            }
 899            while {$b != 0 && \
 900                      [string compare $tok [lindex $varctok($v) $b]] >= 0} {
 901                set c $b
 902                set b [lindex $vleftptr($v) $c]
 903            }
 904            if {$c == $ka} {
 905                lset vdownptr($v) $ka $a
 906                lset vbackptr($v) $a 0
 907            } else {
 908                lset vleftptr($v) $c $a
 909                lset vbackptr($v) $a $c
 910            }
 911            lset vleftptr($v) $a $b
 912            if {$b != 0} {
 913                lset vbackptr($v) $b $a
 914            }
 915            lset vlastins($v) $ka $a
 916        }
 917    }
 918    foreach id [array names sortkids] {
 919        if {[llength $children($v,$id)] > 1} {
 920            set children($v,$id) [lsort -command [list vtokcmp $v] \
 921                                      $children($v,$id)]
 922        }
 923    }
 924    set t2 [clock clicks -milliseconds]
 925    #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
 926}
 927
 928# Fix up the graph after we have found out that in view $v,
 929# $p (a commit that we have already seen) is actually the parent
 930# of the last commit in arc $a.
 931proc fix_reversal {p a v} {
 932    global varcid varcstart varctok vupptr
 933
 934    set pa $varcid($v,$p)
 935    if {$p ne [lindex $varcstart($v) $pa]} {
 936        splitvarc $p $v
 937        set pa $varcid($v,$p)
 938    }
 939    # seeds always need to be renumbered
 940    if {[lindex $vupptr($v) $pa] == 0 ||
 941        [string compare [lindex $varctok($v) $a] \
 942             [lindex $varctok($v) $pa]] > 0} {
 943        renumbervarc $pa $v
 944    }
 945}
 946
 947proc insertrow {id p v} {
 948    global cmitlisted children parents varcid varctok vtokmod
 949    global varccommits ordertok commitidx numcommits curview
 950    global targetid targetrow vshortids
 951
 952    readcommit $id
 953    set vid $v,$id
 954    set cmitlisted($vid) 1
 955    set children($vid) {}
 956    set parents($vid) [list $p]
 957    set a [newvarc $v $id]
 958    set varcid($vid) $a
 959    lappend vshortids($v,[string range $id 0 3]) $id
 960    if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
 961        modify_arc $v $a
 962    }
 963    lappend varccommits($v,$a) $id
 964    set vp $v,$p
 965    if {[llength [lappend children($vp) $id]] > 1} {
 966        set children($vp) [lsort -command [list vtokcmp $v] $children($vp)]
 967        catch {unset ordertok}
 968    }
 969    fix_reversal $p $a $v
 970    incr commitidx($v)
 971    if {$v == $curview} {
 972        set numcommits $commitidx($v)
 973        setcanvscroll
 974        if {[info exists targetid]} {
 975            if {![comes_before $targetid $p]} {
 976                incr targetrow
 977            }
 978        }
 979    }
 980}
 981
 982proc insertfakerow {id p} {
 983    global varcid varccommits parents children cmitlisted
 984    global commitidx varctok vtokmod targetid targetrow curview numcommits
 985
 986    set v $curview
 987    set a $varcid($v,$p)
 988    set i [lsearch -exact $varccommits($v,$a) $p]
 989    if {$i < 0} {
 990        puts "oops: insertfakerow can't find [shortids $p] on arc $a"
 991        return
 992    }
 993    set children($v,$id) {}
 994    set parents($v,$id) [list $p]
 995    set varcid($v,$id) $a
 996    lappend children($v,$p) $id
 997    set cmitlisted($v,$id) 1
 998    set numcommits [incr commitidx($v)]
 999    # note we deliberately don't update varcstart($v) even if $i == 0
1000    set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
1001    modify_arc $v $a $i
1002    if {[info exists targetid]} {
1003        if {![comes_before $targetid $p]} {
1004            incr targetrow
1005        }
1006    }
1007    setcanvscroll
1008    drawvisible
1009}
1010
1011proc removefakerow {id} {
1012    global varcid varccommits parents children commitidx
1013    global varctok vtokmod cmitlisted currentid selectedline
1014    global targetid curview numcommits
1015
1016    set v $curview
1017    if {[llength $parents($v,$id)] != 1} {
1018        puts "oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
1019        return
1020    }
1021    set p [lindex $parents($v,$id) 0]
1022    set a $varcid($v,$id)
1023    set i [lsearch -exact $varccommits($v,$a) $id]
1024    if {$i < 0} {
1025        puts "oops: removefakerow can't find [shortids $id] on arc $a"
1026        return
1027    }
1028    unset varcid($v,$id)
1029    set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
1030    unset parents($v,$id)
1031    unset children($v,$id)
1032    unset cmitlisted($v,$id)
1033    set numcommits [incr commitidx($v) -1]
1034    set j [lsearch -exact $children($v,$p) $id]
1035    if {$j >= 0} {
1036        set children($v,$p) [lreplace $children($v,$p) $j $j]
1037    }
1038    modify_arc $v $a $i
1039    if {[info exist currentid] && $id eq $currentid} {
1040        unset currentid
1041        set selectedline {}
1042    }
1043    if {[info exists targetid] && $targetid eq $id} {
1044        set targetid $p
1045    }
1046    setcanvscroll
1047    drawvisible
1048}
1049
1050proc real_children {vp} {
1051    global children nullid nullid2
1052
1053    set kids {}
1054    foreach id $children($vp) {
1055        if {$id ne $nullid && $id ne $nullid2} {
1056            lappend kids $id
1057        }
1058    }
1059    return $kids
1060}
1061
1062proc first_real_child {vp} {
1063    global children nullid nullid2
1064
1065    foreach id $children($vp) {
1066        if {$id ne $nullid && $id ne $nullid2} {
1067            return $id
1068        }
1069    }
1070    return {}
1071}
1072
1073proc last_real_child {vp} {
1074    global children nullid nullid2
1075
1076    set kids $children($vp)
1077    for {set i [llength $kids]} {[incr i -1] >= 0} {} {
1078        set id [lindex $kids $i]
1079        if {$id ne $nullid && $id ne $nullid2} {
1080            return $id
1081        }
1082    }
1083    return {}
1084}
1085
1086proc vtokcmp {v a b} {
1087    global varctok varcid
1088
1089    return [string compare [lindex $varctok($v) $varcid($v,$a)] \
1090                [lindex $varctok($v) $varcid($v,$b)]]
1091}
1092
1093# This assumes that if lim is not given, the caller has checked that
1094# arc a's token is less than $vtokmod($v)
1095proc modify_arc {v a {lim {}}} {
1096    global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
1097
1098    if {$lim ne {}} {
1099        set c [string compare [lindex $varctok($v) $a] $vtokmod($v)]
1100        if {$c > 0} return
1101        if {$c == 0} {
1102            set r [lindex $varcrow($v) $a]
1103            if {$r ne {} && $vrowmod($v) <= $r + $lim} return
1104        }
1105    }
1106    set vtokmod($v) [lindex $varctok($v) $a]
1107    set varcmod($v) $a
1108    if {$v == $curview} {
1109        while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
1110            set a [lindex $vupptr($v) $a]
1111            set lim {}
1112        }
1113        set r 0
1114        if {$a != 0} {
1115            if {$lim eq {}} {
1116                set lim [llength $varccommits($v,$a)]
1117            }
1118            set r [expr {[lindex $varcrow($v) $a] + $lim}]
1119        }
1120        set vrowmod($v) $r
1121        undolayout $r
1122    }
1123}
1124
1125proc update_arcrows {v} {
1126    global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
1127    global varcid vrownum varcorder varcix varccommits
1128    global vupptr vdownptr vleftptr varctok
1129    global displayorder parentlist curview cached_commitrow
1130
1131    if {$vrowmod($v) == $commitidx($v)} return
1132    if {$v == $curview} {
1133        if {[llength $displayorder] > $vrowmod($v)} {
1134            set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
1135            set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
1136        }
1137        catch {unset cached_commitrow}
1138    }
1139    set narctot [expr {[llength $varctok($v)] - 1}]
1140    set a $varcmod($v)
1141    while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
1142        # go up the tree until we find something that has a row number,
1143        # or we get to a seed
1144        set a [lindex $vupptr($v) $a]
1145    }
1146    if {$a == 0} {
1147        set a [lindex $vdownptr($v) 0]
1148        if {$a == 0} return
1149        set vrownum($v) {0}
1150        set varcorder($v) [list $a]
1151        lset varcix($v) $a 0
1152        lset varcrow($v) $a 0
1153        set arcn 0
1154        set row 0
1155    } else {
1156        set arcn [lindex $varcix($v) $a]
1157        if {[llength $vrownum($v)] > $arcn + 1} {
1158            set vrownum($v) [lrange $vrownum($v) 0 $arcn]
1159            set varcorder($v) [lrange $varcorder($v) 0 $arcn]
1160        }
1161        set row [lindex $varcrow($v) $a]
1162    }
1163    while {1} {
1164        set p $a
1165        incr row [llength $varccommits($v,$a)]
1166        # go down if possible
1167        set b [lindex $vdownptr($v) $a]
1168        if {$b == 0} {
1169            # if not, go left, or go up until we can go left
1170            while {$a != 0} {
1171                set b [lindex $vleftptr($v) $a]
1172                if {$b != 0} break
1173                set a [lindex $vupptr($v) $a]
1174            }
1175            if {$a == 0} break
1176        }
1177        set a $b
1178        incr arcn
1179        lappend vrownum($v) $row
1180        lappend varcorder($v) $a
1181        lset varcix($v) $a $arcn
1182        lset varcrow($v) $a $row
1183    }
1184    set vtokmod($v) [lindex $varctok($v) $p]
1185    set varcmod($v) $p
1186    set vrowmod($v) $row
1187    if {[info exists currentid]} {
1188        set selectedline [rowofcommit $currentid]
1189    }
1190}
1191
1192# Test whether view $v contains commit $id
1193proc commitinview {id v} {
1194    global varcid
1195
1196    return [info exists varcid($v,$id)]
1197}
1198
1199# Return the row number for commit $id in the current view
1200proc rowofcommit {id} {
1201    global varcid varccommits varcrow curview cached_commitrow
1202    global varctok vtokmod
1203
1204    set v $curview
1205    if {![info exists varcid($v,$id)]} {
1206        puts "oops rowofcommit no arc for [shortids $id]"
1207        return {}
1208    }
1209    set a $varcid($v,$id)
1210    if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
1211        update_arcrows $v
1212    }
1213    if {[info exists cached_commitrow($id)]} {
1214        return $cached_commitrow($id)
1215    }
1216    set i [lsearch -exact $varccommits($v,$a) $id]
1217    if {$i < 0} {
1218        puts "oops didn't find commit [shortids $id] in arc $a"
1219        return {}
1220    }
1221    incr i [lindex $varcrow($v) $a]
1222    set cached_commitrow($id) $i
1223    return $i
1224}
1225
1226# Returns 1 if a is on an earlier row than b, otherwise 0
1227proc comes_before {a b} {
1228    global varcid varctok curview
1229
1230    set v $curview
1231    if {$a eq $b || ![info exists varcid($v,$a)] || \
1232            ![info exists varcid($v,$b)]} {
1233        return 0
1234    }
1235    if {$varcid($v,$a) != $varcid($v,$b)} {
1236        return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
1237                           [lindex $varctok($v) $varcid($v,$b)]] < 0}]
1238    }
1239    return [expr {[rowofcommit $a] < [rowofcommit $b]}]
1240}
1241
1242proc bsearch {l elt} {
1243    if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
1244        return 0
1245    }
1246    set lo 0
1247    set hi [llength $l]
1248    while {$hi - $lo > 1} {
1249        set mid [expr {int(($lo + $hi) / 2)}]
1250        set t [lindex $l $mid]
1251        if {$elt < $t} {
1252            set hi $mid
1253        } elseif {$elt > $t} {
1254            set lo $mid
1255        } else {
1256            return $mid
1257        }
1258    }
1259    return $lo
1260}
1261
1262# Make sure rows $start..$end-1 are valid in displayorder and parentlist
1263proc make_disporder {start end} {
1264    global vrownum curview commitidx displayorder parentlist
1265    global varccommits varcorder parents vrowmod varcrow
1266    global d_valid_start d_valid_end
1267
1268    if {$end > $vrowmod($curview)} {
1269        update_arcrows $curview
1270    }
1271    set ai [bsearch $vrownum($curview) $start]
1272    set start [lindex $vrownum($curview) $ai]
1273    set narc [llength $vrownum($curview)]
1274    for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
1275        set a [lindex $varcorder($curview) $ai]
1276        set l [llength $displayorder]
1277        set al [llength $varccommits($curview,$a)]
1278        if {$l < $r + $al} {
1279            if {$l < $r} {
1280                set pad [ntimes [expr {$r - $l}] {}]
1281                set displayorder [concat $displayorder $pad]
1282                set parentlist [concat $parentlist $pad]
1283            } elseif {$l > $r} {
1284                set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
1285                set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
1286            }
1287            foreach id $varccommits($curview,$a) {
1288                lappend displayorder $id
1289                lappend parentlist $parents($curview,$id)
1290            }
1291        } elseif {[lindex $displayorder [expr {$r + $al - 1}]] eq {}} {
1292            set i $r
1293            foreach id $varccommits($curview,$a) {
1294                lset displayorder $i $id
1295                lset parentlist $i $parents($curview,$id)
1296                incr i
1297            }
1298        }
1299        incr r $al
1300    }
1301}
1302
1303proc commitonrow {row} {
1304    global displayorder
1305
1306    set id [lindex $displayorder $row]
1307    if {$id eq {}} {
1308        make_disporder $row [expr {$row + 1}]
1309        set id [lindex $displayorder $row]
1310    }
1311    return $id
1312}
1313
1314proc closevarcs {v} {
1315    global varctok varccommits varcid parents children
1316    global cmitlisted commitidx vtokmod
1317
1318    set missing_parents 0
1319    set scripts {}
1320    set narcs [llength $varctok($v)]
1321    for {set a 1} {$a < $narcs} {incr a} {
1322        set id [lindex $varccommits($v,$a) end]
1323        foreach p $parents($v,$id) {
1324            if {[info exists varcid($v,$p)]} continue
1325            # add p as a new commit
1326            incr missing_parents
1327            set cmitlisted($v,$p) 0
1328            set parents($v,$p) {}
1329            if {[llength $children($v,$p)] == 1 &&
1330                [llength $parents($v,$id)] == 1} {
1331                set b $a
1332            } else {
1333                set b [newvarc $v $p]
1334            }
1335            set varcid($v,$p) $b
1336            if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
1337                modify_arc $v $b
1338            }
1339            lappend varccommits($v,$b) $p
1340            incr commitidx($v)
1341            set scripts [check_interest $p $scripts]
1342        }
1343    }
1344    if {$missing_parents > 0} {
1345        foreach s $scripts {
1346            eval $s
1347        }
1348    }
1349}
1350
1351# Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1352# Assumes we already have an arc for $rwid.
1353proc rewrite_commit {v id rwid} {
1354    global children parents varcid varctok vtokmod varccommits
1355
1356    foreach ch $children($v,$id) {
1357        # make $rwid be $ch's parent in place of $id
1358        set i [lsearch -exact $parents($v,$ch) $id]
1359        if {$i < 0} {
1360            puts "oops rewrite_commit didn't find $id in parent list for $ch"
1361        }
1362        set parents($v,$ch) [lreplace $parents($v,$ch) $i $i $rwid]
1363        # add $ch to $rwid's children and sort the list if necessary
1364        if {[llength [lappend children($v,$rwid) $ch]] > 1} {
1365            set children($v,$rwid) [lsort -command [list vtokcmp $v] \
1366                                        $children($v,$rwid)]
1367        }
1368        # fix the graph after joining $id to $rwid
1369        set a $varcid($v,$ch)
1370        fix_reversal $rwid $a $v
1371        # parentlist is wrong for the last element of arc $a
1372        # even if displayorder is right, hence the 3rd arg here
1373        modify_arc $v $a [expr {[llength $varccommits($v,$a)] - 1}]
1374    }
1375}
1376
1377# Mechanism for registering a command to be executed when we come
1378# across a particular commit.  To handle the case when only the
1379# prefix of the commit is known, the commitinterest array is now
1380# indexed by the first 4 characters of the ID.  Each element is a
1381# list of id, cmd pairs.
1382proc interestedin {id cmd} {
1383    global commitinterest
1384
1385    lappend commitinterest([string range $id 0 3]) $id $cmd
1386}
1387
1388proc check_interest {id scripts} {
1389    global commitinterest
1390
1391    set prefix [string range $id 0 3]
1392    if {[info exists commitinterest($prefix)]} {
1393        set newlist {}
1394        foreach {i script} $commitinterest($prefix) {
1395            if {[string match "$i*" $id]} {
1396                lappend scripts [string map [list "%I" $id "%P" $i] $script]
1397            } else {
1398                lappend newlist $i $script
1399            }
1400        }
1401        if {$newlist ne {}} {
1402            set commitinterest($prefix) $newlist
1403        } else {
1404            unset commitinterest($prefix)
1405        }
1406    }
1407    return $scripts
1408}
1409
1410proc getcommitlines {fd inst view updating}  {
1411    global cmitlisted leftover
1412    global commitidx commitdata vdatemode
1413    global parents children curview hlview
1414    global idpending ordertok
1415    global varccommits varcid varctok vtokmod vfilelimit vshortids
1416
1417    set stuff [read $fd 500000]
1418    # git log doesn't terminate the last commit with a null...
1419    if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
1420        set stuff "\0"
1421    }
1422    if {$stuff == {}} {
1423        if {![eof $fd]} {
1424            return 1
1425        }
1426        global commfd viewcomplete viewactive viewname
1427        global viewinstances
1428        unset commfd($inst)
1429        set i [lsearch -exact $viewinstances($view) $inst]
1430        if {$i >= 0} {
1431            set viewinstances($view) [lreplace $viewinstances($view) $i $i]
1432        }
1433        # set it blocking so we wait for the process to terminate
1434        fconfigure $fd -blocking 1
1435        if {[catch {close $fd} err]} {
1436            set fv {}
1437            if {$view != $curview} {
1438                set fv " for the \"$viewname($view)\" view"
1439            }
1440            if {[string range $err 0 4] == "usage"} {
1441                set err "Gitk: error reading commits$fv:\
1442                        bad arguments to git log."
1443                if {$viewname($view) eq "Command line"} {
1444                    append err \
1445                        "  (Note: arguments to gitk are passed to git log\
1446                         to allow selection of commits to be displayed.)"
1447                }
1448            } else {
1449                set err "Error reading commits$fv: $err"
1450            }
1451            error_popup $err
1452        }
1453        if {[incr viewactive($view) -1] <= 0} {
1454            set viewcomplete($view) 1
1455            # Check if we have seen any ids listed as parents that haven't
1456            # appeared in the list
1457            closevarcs $view
1458            notbusy $view
1459        }
1460        if {$view == $curview} {
1461            run chewcommits
1462        }
1463        return 0
1464    }
1465    set start 0
1466    set gotsome 0
1467    set scripts {}
1468    while 1 {
1469        set i [string first "\0" $stuff $start]
1470        if {$i < 0} {
1471            append leftover($inst) [string range $stuff $start end]
1472            break
1473        }
1474        if {$start == 0} {
1475            set cmit $leftover($inst)
1476            append cmit [string range $stuff 0 [expr {$i - 1}]]
1477            set leftover($inst) {}
1478        } else {
1479            set cmit [string range $stuff $start [expr {$i - 1}]]
1480        }
1481        set start [expr {$i + 1}]
1482        set j [string first "\n" $cmit]
1483        set ok 0
1484        set listed 1
1485        if {$j >= 0 && [string match "commit *" $cmit]} {
1486            set ids [string range $cmit 7 [expr {$j - 1}]]
1487            if {[string match {[-^<>]*} $ids]} {
1488                switch -- [string index $ids 0] {
1489                    "-" {set listed 0}
1490                    "^" {set listed 2}
1491                    "<" {set listed 3}
1492                    ">" {set listed 4}
1493                }
1494                set ids [string range $ids 1 end]
1495            }
1496            set ok 1
1497            foreach id $ids {
1498                if {[string length $id] != 40} {
1499                    set ok 0
1500                    break
1501                }
1502            }
1503        }
1504        if {!$ok} {
1505            set shortcmit $cmit
1506            if {[string length $shortcmit] > 80} {
1507                set shortcmit "[string range $shortcmit 0 80]..."
1508            }
1509            error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
1510            exit 1
1511        }
1512        set id [lindex $ids 0]
1513        set vid $view,$id
1514
1515        lappend vshortids($view,[string range $id 0 3]) $id
1516
1517        if {!$listed && $updating && ![info exists varcid($vid)] &&
1518            $vfilelimit($view) ne {}} {
1519            # git log doesn't rewrite parents for unlisted commits
1520            # when doing path limiting, so work around that here
1521            # by working out the rewritten parent with git rev-list
1522            # and if we already know about it, using the rewritten
1523            # parent as a substitute parent for $id's children.
1524            if {![catch {
1525                set rwid [exec git rev-list --first-parent --max-count=1 \
1526                              $id -- $vfilelimit($view)]
1527            }]} {
1528                if {$rwid ne {} && [info exists varcid($view,$rwid)]} {
1529                    # use $rwid in place of $id
1530                    rewrite_commit $view $id $rwid
1531                    continue
1532                }
1533            }
1534        }
1535
1536        set a 0
1537        if {[info exists varcid($vid)]} {
1538            if {$cmitlisted($vid) || !$listed} continue
1539            set a $varcid($vid)
1540        }
1541        if {$listed} {
1542            set olds [lrange $ids 1 end]
1543        } else {
1544            set olds {}
1545        }
1546        set commitdata($id) [string range $cmit [expr {$j + 1}] end]
1547        set cmitlisted($vid) $listed
1548        set parents($vid) $olds
1549        if {![info exists children($vid)]} {
1550            set children($vid) {}
1551        } elseif {$a == 0 && [llength $children($vid)] == 1} {
1552            set k [lindex $children($vid) 0]
1553            if {[llength $parents($view,$k)] == 1 &&
1554                (!$vdatemode($view) ||
1555                 $varcid($view,$k) == [llength $varctok($view)] - 1)} {
1556                set a $varcid($view,$k)
1557            }
1558        }
1559        if {$a == 0} {
1560            # new arc
1561            set a [newvarc $view $id]
1562        }
1563        if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
1564            modify_arc $view $a
1565        }
1566        if {![info exists varcid($vid)]} {
1567            set varcid($vid) $a
1568            lappend varccommits($view,$a) $id
1569            incr commitidx($view)
1570        }
1571
1572        set i 0
1573        foreach p $olds {
1574            if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
1575                set vp $view,$p
1576                if {[llength [lappend children($vp) $id]] > 1 &&
1577                    [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
1578                    set children($vp) [lsort -command [list vtokcmp $view] \
1579                                           $children($vp)]
1580                    catch {unset ordertok}
1581                }
1582                if {[info exists varcid($view,$p)]} {
1583                    fix_reversal $p $a $view
1584                }
1585            }
1586            incr i
1587        }
1588
1589        set scripts [check_interest $id $scripts]
1590        set gotsome 1
1591    }
1592    if {$gotsome} {
1593        global numcommits hlview
1594
1595        if {$view == $curview} {
1596            set numcommits $commitidx($view)
1597            run chewcommits
1598        }
1599        if {[info exists hlview] && $view == $hlview} {
1600            # we never actually get here...
1601            run vhighlightmore
1602        }
1603        foreach s $scripts {
1604            eval $s
1605        }
1606    }
1607    return 2
1608}
1609
1610proc chewcommits {} {
1611    global curview hlview viewcomplete
1612    global pending_select
1613
1614    layoutmore
1615    if {$viewcomplete($curview)} {
1616        global commitidx varctok
1617        global numcommits startmsecs
1618
1619        if {[info exists pending_select]} {
1620            update
1621            reset_pending_select {}
1622
1623            if {[commitinview $pending_select $curview]} {
1624                selectline [rowofcommit $pending_select] 1
1625            } else {
1626                set row [first_real_row]
1627                selectline $row 1
1628            }
1629        }
1630        if {$commitidx($curview) > 0} {
1631            #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1632            #puts "overall $ms ms for $numcommits commits"
1633            #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1634        } else {
1635            show_status [mc "No commits selected"]
1636        }
1637        notbusy layout
1638    }
1639    return 0
1640}
1641
1642proc do_readcommit {id} {
1643    global tclencoding
1644
1645    # Invoke git-log to handle automatic encoding conversion
1646    set fd [open [concat | git log --no-color --pretty=raw -1 $id] r]
1647    # Read the results using i18n.logoutputencoding
1648    fconfigure $fd -translation lf -eofchar {}
1649    if {$tclencoding != {}} {
1650        fconfigure $fd -encoding $tclencoding
1651    }
1652    set contents [read $fd]
1653    close $fd
1654    # Remove the heading line
1655    regsub {^commit [0-9a-f]+\n} $contents {} contents
1656
1657    return $contents
1658}
1659
1660proc readcommit {id} {
1661    if {[catch {set contents [do_readcommit $id]}]} return
1662    parsecommit $id $contents 1
1663}
1664
1665proc parsecommit {id contents listed} {
1666    global commitinfo
1667
1668    set inhdr 1
1669    set comment {}
1670    set headline {}
1671    set auname {}
1672    set audate {}
1673    set comname {}
1674    set comdate {}
1675    set hdrend [string first "\n\n" $contents]
1676    if {$hdrend < 0} {
1677        # should never happen...
1678        set hdrend [string length $contents]
1679    }
1680    set header [string range $contents 0 [expr {$hdrend - 1}]]
1681    set comment [string range $contents [expr {$hdrend + 2}] end]
1682    foreach line [split $header "\n"] {
1683        set line [split $line " "]
1684        set tag [lindex $line 0]
1685        if {$tag == "author"} {
1686            set audate [lrange $line end-1 end]
1687            set auname [join [lrange $line 1 end-2] " "]
1688        } elseif {$tag == "committer"} {
1689            set comdate [lrange $line end-1 end]
1690            set comname [join [lrange $line 1 end-2] " "]
1691        }
1692    }
1693    set headline {}
1694    # take the first non-blank line of the comment as the headline
1695    set headline [string trimleft $comment]
1696    set i [string first "\n" $headline]
1697    if {$i >= 0} {
1698        set headline [string range $headline 0 $i]
1699    }
1700    set headline [string trimright $headline]
1701    set i [string first "\r" $headline]
1702    if {$i >= 0} {
1703        set headline [string trimright [string range $headline 0 $i]]
1704    }
1705    if {!$listed} {
1706        # git log indents the comment by 4 spaces;
1707        # if we got this via git cat-file, add the indentation
1708        set newcomment {}
1709        foreach line [split $comment "\n"] {
1710            append newcomment "    "
1711            append newcomment $line
1712            append newcomment "\n"
1713        }
1714        set comment $newcomment
1715    }
1716    set hasnote [string first "\nNotes:\n" $contents]
1717    set diff ""
1718    # If there is diff output shown in the git-log stream, split it
1719    # out.  But get rid of the empty line that always precedes the
1720    # diff.
1721    set i [string first "\n\ndiff" $comment]
1722    if {$i >= 0} {
1723        set diff [string range $comment $i+1 end]
1724        set comment [string range $comment 0 $i-1]
1725    }
1726    set commitinfo($id) [list $headline $auname $audate \
1727                             $comname $comdate $comment $hasnote $diff]
1728}
1729
1730proc getcommit {id} {
1731    global commitdata commitinfo
1732
1733    if {[info exists commitdata($id)]} {
1734        parsecommit $id $commitdata($id) 1
1735    } else {
1736        readcommit $id
1737        if {![info exists commitinfo($id)]} {
1738            set commitinfo($id) [list [mc "No commit information available"]]
1739        }
1740    }
1741    return 1
1742}
1743
1744# Expand an abbreviated commit ID to a list of full 40-char IDs that match
1745# and are present in the current view.
1746# This is fairly slow...
1747proc longid {prefix} {
1748    global varcid curview vshortids
1749
1750    set ids {}
1751    if {[string length $prefix] >= 4} {
1752        set vshortid $curview,[string range $prefix 0 3]
1753        if {[info exists vshortids($vshortid)]} {
1754            foreach id $vshortids($vshortid) {
1755                if {[string match "$prefix*" $id]} {
1756                    if {[lsearch -exact $ids $id] < 0} {
1757                        lappend ids $id
1758                        if {[llength $ids] >= 2} break
1759                    }
1760                }
1761            }
1762        }
1763    } else {
1764        foreach match [array names varcid "$curview,$prefix*"] {
1765            lappend ids [lindex [split $match ","] 1]
1766            if {[llength $ids] >= 2} break
1767        }
1768    }
1769    return $ids
1770}
1771
1772proc readrefs {} {
1773    global tagids idtags headids idheads tagobjid
1774    global otherrefids idotherrefs mainhead mainheadid
1775    global selecthead selectheadid
1776    global hideremotes
1777
1778    foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
1779        catch {unset $v}
1780    }
1781    set refd [open [list | git show-ref -d] r]
1782    while {[gets $refd line] >= 0} {
1783        if {[string index $line 40] ne " "} continue
1784        set id [string range $line 0 39]
1785        set ref [string range $line 41 end]
1786        if {![string match "refs/*" $ref]} continue
1787        set name [string range $ref 5 end]
1788        if {[string match "remotes/*" $name]} {
1789            if {![string match "*/HEAD" $name] && !$hideremotes} {
1790                set headids($name) $id
1791                lappend idheads($id) $name
1792            }
1793        } elseif {[string match "heads/*" $name]} {
1794            set name [string range $name 6 end]
1795            set headids($name) $id
1796            lappend idheads($id) $name
1797        } elseif {[string match "tags/*" $name]} {
1798            # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1799            # which is what we want since the former is the commit ID
1800            set name [string range $name 5 end]
1801            if {[string match "*^{}" $name]} {
1802                set name [string range $name 0 end-3]
1803            } else {
1804                set tagobjid($name) $id
1805            }
1806            set tagids($name) $id
1807            lappend idtags($id) $name
1808        } else {
1809            set otherrefids($name) $id
1810            lappend idotherrefs($id) $name
1811        }
1812    }
1813    catch {close $refd}
1814    set mainhead {}
1815    set mainheadid {}
1816    catch {
1817        set mainheadid [exec git rev-parse HEAD]
1818        set thehead [exec git symbolic-ref HEAD]
1819        if {[string match "refs/heads/*" $thehead]} {
1820            set mainhead [string range $thehead 11 end]
1821        }
1822    }
1823    set selectheadid {}
1824    if {$selecthead ne {}} {
1825        catch {
1826            set selectheadid [exec git rev-parse --verify $selecthead]
1827        }
1828    }
1829}
1830
1831# skip over fake commits
1832proc first_real_row {} {
1833    global nullid nullid2 numcommits
1834
1835    for {set row 0} {$row < $numcommits} {incr row} {
1836        set id [commitonrow $row]
1837        if {$id ne $nullid && $id ne $nullid2} {
1838            break
1839        }
1840    }
1841    return $row
1842}
1843
1844# update things for a head moved to a child of its previous location
1845proc movehead {id name} {
1846    global headids idheads
1847
1848    removehead $headids($name) $name
1849    set headids($name) $id
1850    lappend idheads($id) $name
1851}
1852
1853# update things when a head has been removed
1854proc removehead {id name} {
1855    global headids idheads
1856
1857    if {$idheads($id) eq $name} {
1858        unset idheads($id)
1859    } else {
1860        set i [lsearch -exact $idheads($id) $name]
1861        if {$i >= 0} {
1862            set idheads($id) [lreplace $idheads($id) $i $i]
1863        }
1864    }
1865    unset headids($name)
1866}
1867
1868proc ttk_toplevel {w args} {
1869    global use_ttk
1870    eval [linsert $args 0 ::toplevel $w]
1871    if {$use_ttk} {
1872        place [ttk::frame $w._toplevel_background] -x 0 -y 0 -relwidth 1 -relheight 1
1873    }
1874    return $w
1875}
1876
1877proc make_transient {window origin} {
1878    global have_tk85
1879
1880    # In MacOS Tk 8.4 transient appears to work by setting
1881    # overrideredirect, which is utterly useless, since the
1882    # windows get no border, and are not even kept above
1883    # the parent.
1884    if {!$have_tk85 && [tk windowingsystem] eq {aqua}} return
1885
1886    wm transient $window $origin
1887
1888    # Windows fails to place transient windows normally, so
1889    # schedule a callback to center them on the parent.
1890    if {[tk windowingsystem] eq {win32}} {
1891        after idle [list tk::PlaceWindow $window widget $origin]
1892    }
1893}
1894
1895proc show_error {w top msg {mc mc}} {
1896    global NS
1897    if {![info exists NS]} {set NS ""}
1898    if {[wm state $top] eq "withdrawn"} { wm deiconify $top }
1899    message $w.m -text $msg -justify center -aspect 400
1900    pack $w.m -side top -fill x -padx 20 -pady 20
1901    ${NS}::button $w.ok -default active -text [$mc OK] -command "destroy $top"
1902    pack $w.ok -side bottom -fill x
1903    bind $top <Visibility> "grab $top; focus $top"
1904    bind $top <Key-Return> "destroy $top"
1905    bind $top <Key-space>  "destroy $top"
1906    bind $top <Key-Escape> "destroy $top"
1907    tkwait window $top
1908}
1909
1910proc error_popup {msg {owner .}} {
1911    if {[tk windowingsystem] eq "win32"} {
1912        tk_messageBox -icon error -type ok -title [wm title .] \
1913            -parent $owner -message $msg
1914    } else {
1915        set w .error
1916        ttk_toplevel $w
1917        make_transient $w $owner
1918        show_error $w $w $msg
1919    }
1920}
1921
1922proc confirm_popup {msg {owner .}} {
1923    global confirm_ok NS
1924    set confirm_ok 0
1925    set w .confirm
1926    ttk_toplevel $w
1927    make_transient $w $owner
1928    message $w.m -text $msg -justify center -aspect 400
1929    pack $w.m -side top -fill x -padx 20 -pady 20
1930    ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
1931    pack $w.ok -side left -fill x
1932    ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
1933    pack $w.cancel -side right -fill x
1934    bind $w <Visibility> "grab $w; focus $w"
1935    bind $w <Key-Return> "set confirm_ok 1; destroy $w"
1936    bind $w <Key-space>  "set confirm_ok 1; destroy $w"
1937    bind $w <Key-Escape> "destroy $w"
1938    tk::PlaceWindow $w widget $owner
1939    tkwait window $w
1940    return $confirm_ok
1941}
1942
1943proc setoptions {} {
1944    if {[tk windowingsystem] ne "win32"} {
1945        option add *Panedwindow.showHandle 1 startupFile
1946        option add *Panedwindow.sashRelief raised startupFile
1947        if {[tk windowingsystem] ne "aqua"} {
1948            option add *Menu.font uifont startupFile
1949        }
1950    } else {
1951        option add *Menu.TearOff 0 startupFile
1952    }
1953    option add *Button.font uifont startupFile
1954    option add *Checkbutton.font uifont startupFile
1955    option add *Radiobutton.font uifont startupFile
1956    option add *Menubutton.font uifont startupFile
1957    option add *Label.font uifont startupFile
1958    option add *Message.font uifont startupFile
1959    option add *Entry.font textfont startupFile
1960    option add *Text.font textfont startupFile
1961    option add *Labelframe.font uifont startupFile
1962    option add *Spinbox.font textfont startupFile
1963    option add *Listbox.font mainfont startupFile
1964}
1965
1966# Make a menu and submenus.
1967# m is the window name for the menu, items is the list of menu items to add.
1968# Each item is a list {mc label type description options...}
1969# mc is ignored; it's so we can put mc there to alert xgettext
1970# label is the string that appears in the menu
1971# type is cascade, command or radiobutton (should add checkbutton)
1972# description depends on type; it's the sublist for cascade, the
1973# command to invoke for command, or {variable value} for radiobutton
1974proc makemenu {m items} {
1975    menu $m
1976    if {[tk windowingsystem] eq {aqua}} {
1977        set Meta1 Cmd
1978    } else {
1979        set Meta1 Ctrl
1980    }
1981    foreach i $items {
1982        set name [mc [lindex $i 1]]
1983        set type [lindex $i 2]
1984        set thing [lindex $i 3]
1985        set params [list $type]
1986        if {$name ne {}} {
1987            set u [string first "&" [string map {&& x} $name]]
1988            lappend params -label [string map {&& & & {}} $name]
1989            if {$u >= 0} {
1990                lappend params -underline $u
1991            }
1992        }
1993        switch -- $type {
1994            "cascade" {
1995                set submenu [string tolower [string map {& ""} [lindex $i 1]]]
1996                lappend params -menu $m.$submenu
1997            }
1998            "command" {
1999                lappend params -command $thing
2000            }
2001            "radiobutton" {
2002                lappend params -variable [lindex $thing 0] \
2003                    -value [lindex $thing 1]
2004            }
2005        }
2006        set tail [lrange $i 4 end]
2007        regsub -all {\yMeta1\y} $tail $Meta1 tail
2008        eval $m add $params $tail
2009        if {$type eq "cascade"} {
2010            makemenu $m.$submenu $thing
2011        }
2012    }
2013}
2014
2015# translate string and remove ampersands
2016proc mca {str} {
2017    return [string map {&& & & {}} [mc $str]]
2018}
2019
2020proc cleardropsel {w} {
2021    $w selection clear
2022}
2023proc makedroplist {w varname args} {
2024    global use_ttk
2025    if {$use_ttk} {
2026        set width 0
2027        foreach label $args {
2028            set cx [string length $label]
2029            if {$cx > $width} {set width $cx}
2030        }
2031        set gm [ttk::combobox $w -width $width -state readonly\
2032                    -textvariable $varname -values $args \
2033                    -exportselection false]
2034        bind $gm <<ComboboxSelected>> [list $gm selection clear]
2035    } else {
2036        set gm [eval [linsert $args 0 tk_optionMenu $w $varname]]
2037    }
2038    return $gm
2039}
2040
2041proc makewindow {} {
2042    global canv canv2 canv3 linespc charspc ctext cflist cscroll
2043    global tabstop
2044    global findtype findtypemenu findloc findstring fstring geometry
2045    global entries sha1entry sha1string sha1but
2046    global diffcontextstring diffcontext
2047    global ignorespace
2048    global maincursor textcursor curtextcursor
2049    global rowctxmenu fakerowmenu mergemax wrapcomment
2050    global highlight_files gdttype
2051    global searchstring sstring
2052    global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
2053    global uifgcolor uifgdisabledcolor
2054    global filesepbgcolor filesepfgcolor
2055    global mergecolors foundbgcolor currentsearchhitbgcolor
2056    global headctxmenu progresscanv progressitem progresscoords statusw
2057    global fprogitem fprogcoord lastprogupdate progupdatepending
2058    global rprogitem rprogcoord rownumsel numcommits
2059    global have_tk85 use_ttk NS
2060    global git_version
2061    global worddiff
2062
2063    # The "mc" arguments here are purely so that xgettext
2064    # sees the following string as needing to be translated
2065    set file {
2066        mc "File" cascade {
2067            {mc "Update" command updatecommits -accelerator F5}
2068            {mc "Reload" command reloadcommits -accelerator Shift-F5}
2069            {mc "Reread references" command rereadrefs}
2070            {mc "List references" command showrefs -accelerator F2}
2071            {xx "" separator}
2072            {mc "Start git gui" command {exec git gui &}}
2073            {xx "" separator}
2074            {mc "Quit" command doquit -accelerator Meta1-Q}
2075        }}
2076    set edit {
2077        mc "Edit" cascade {
2078            {mc "Preferences" command doprefs}
2079        }}
2080    set view {
2081        mc "View" cascade {
2082            {mc "New view..." command {newview 0} -accelerator Shift-F4}
2083            {mc "Edit view..." command editview -state disabled -accelerator F4}
2084            {mc "Delete view" command delview -state disabled}
2085            {xx "" separator}
2086            {mc "All files" radiobutton {selectedview 0} -command {showview 0}}
2087        }}
2088    if {[tk windowingsystem] ne "aqua"} {
2089        set help {
2090        mc "Help" cascade {
2091            {mc "About gitk" command about}
2092            {mc "Key bindings" command keys}
2093        }}
2094        set bar [list $file $edit $view $help]
2095    } else {
2096        proc ::tk::mac::ShowPreferences {} {doprefs}
2097        proc ::tk::mac::Quit {} {doquit}
2098        lset file end [lreplace [lindex $file end] end-1 end]
2099        set apple {
2100        xx "Apple" cascade {
2101            {mc "About gitk" command about}
2102            {xx "" separator}
2103        }}
2104        set help {
2105        mc "Help" cascade {
2106            {mc "Key bindings" command keys}
2107        }}
2108        set bar [list $apple $file $view $help]
2109    }
2110    makemenu .bar $bar
2111    . configure -menu .bar
2112
2113    if {$use_ttk} {
2114        # cover the non-themed toplevel with a themed frame.
2115        place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1
2116    }
2117
2118    # the gui has upper and lower half, parts of a paned window.
2119    ${NS}::panedwindow .ctop -orient vertical
2120
2121    # possibly use assumed geometry
2122    if {![info exists geometry(pwsash0)]} {
2123        set geometry(topheight) [expr {15 * $linespc}]
2124        set geometry(topwidth) [expr {80 * $charspc}]
2125        set geometry(botheight) [expr {15 * $linespc}]
2126        set geometry(botwidth) [expr {50 * $charspc}]
2127        set geometry(pwsash0) [list [expr {40 * $charspc}] 2]
2128        set geometry(pwsash1) [list [expr {60 * $charspc}] 2]
2129    }
2130
2131    # the upper half will have a paned window, a scroll bar to the right, and some stuff below
2132    ${NS}::frame .tf -height $geometry(topheight) -width $geometry(topwidth)
2133    ${NS}::frame .tf.histframe
2134    ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal
2135    if {!$use_ttk} {
2136        .tf.histframe.pwclist configure -sashpad 0 -handlesize 4
2137    }
2138
2139    # create three canvases
2140    set cscroll .tf.histframe.csb
2141    set canv .tf.histframe.pwclist.canv
2142    canvas $canv \
2143        -selectbackground $selectbgcolor \
2144        -background $bgcolor -bd 0 \
2145        -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
2146    .tf.histframe.pwclist add $canv
2147    set canv2 .tf.histframe.pwclist.canv2
2148    canvas $canv2 \
2149        -selectbackground $selectbgcolor \
2150        -background $bgcolor -bd 0 -yscrollincr $linespc
2151    .tf.histframe.pwclist add $canv2
2152    set canv3 .tf.histframe.pwclist.canv3
2153    canvas $canv3 \
2154        -selectbackground $selectbgcolor \
2155        -background $bgcolor -bd 0 -yscrollincr $linespc
2156    .tf.histframe.pwclist add $canv3
2157    if {$use_ttk} {
2158        bind .tf.histframe.pwclist <Map> {
2159            bind %W <Map> {}
2160            .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0]
2161            .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0]
2162        }
2163    } else {
2164        eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
2165        eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
2166    }
2167
2168    # a scroll bar to rule them
2169    ${NS}::scrollbar $cscroll -command {allcanvs yview}
2170    if {!$use_ttk} {$cscroll configure -highlightthickness 0}
2171    pack $cscroll -side right -fill y
2172    bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
2173    lappend bglist $canv $canv2 $canv3
2174    pack .tf.histframe.pwclist -fill both -expand 1 -side left
2175
2176    # we have two button bars at bottom of top frame. Bar 1
2177    ${NS}::frame .tf.bar
2178    ${NS}::frame .tf.lbar -height 15
2179
2180    set sha1entry .tf.bar.sha1
2181    set entries $sha1entry
2182    set sha1but .tf.bar.sha1label
2183    button $sha1but -text "[mc "SHA1 ID:"] " -state disabled -relief flat \
2184        -command gotocommit -width 8
2185    $sha1but conf -disabledforeground [$sha1but cget -foreground]
2186    pack .tf.bar.sha1label -side left
2187    ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string
2188    trace add variable sha1string write sha1change
2189    pack $sha1entry -side left -pady 2
2190
2191    set bm_left_data {
2192        #define left_width 16
2193        #define left_height 16
2194        static unsigned char left_bits[] = {
2195        0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
2196        0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
2197        0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
2198    }
2199    set bm_right_data {
2200        #define right_width 16
2201        #define right_height 16
2202        static unsigned char right_bits[] = {
2203        0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
2204        0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
2205        0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
2206    }
2207    image create bitmap bm-left -data $bm_left_data -foreground $uifgcolor
2208    image create bitmap bm-left-gray -data $bm_left_data -foreground $uifgdisabledcolor
2209    image create bitmap bm-right -data $bm_right_data -foreground $uifgcolor
2210    image create bitmap bm-right-gray -data $bm_right_data -foreground $uifgdisabledcolor
2211
2212    ${NS}::button .tf.bar.leftbut -command goback -state disabled -width 26
2213    if {$use_ttk} {
2214        .tf.bar.leftbut configure -image [list bm-left disabled bm-left-gray]
2215    } else {
2216        .tf.bar.leftbut configure -image bm-left
2217    }
2218    pack .tf.bar.leftbut -side left -fill y
2219    ${NS}::button .tf.bar.rightbut -command goforw -state disabled -width 26
2220    if {$use_ttk} {
2221        .tf.bar.rightbut configure -image [list bm-right disabled bm-right-gray]
2222    } else {
2223        .tf.bar.rightbut configure -image bm-right
2224    }
2225    pack .tf.bar.rightbut -side left -fill y
2226
2227    ${NS}::label .tf.bar.rowlabel -text [mc "Row"]
2228    set rownumsel {}
2229    ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \
2230        -relief sunken -anchor e
2231    ${NS}::label .tf.bar.rowlabel2 -text "/"
2232    ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \
2233        -relief sunken -anchor e
2234    pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
2235        -side left
2236    if {!$use_ttk} {
2237        foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont}
2238    }
2239    global selectedline
2240    trace add variable selectedline write selectedline_change
2241
2242    # Status label and progress bar
2243    set statusw .tf.bar.status
2244    ${NS}::label $statusw -width 15 -relief sunken
2245    pack $statusw -side left -padx 5
2246    if {$use_ttk} {
2247        set progresscanv [ttk::progressbar .tf.bar.progress]
2248    } else {
2249        set h [expr {[font metrics uifont -linespace] + 2}]
2250        set progresscanv .tf.bar.progress
2251        canvas $progresscanv -relief sunken -height $h -borderwidth 2
2252        set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
2253        set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
2254        set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
2255    }
2256    pack $progresscanv -side right -expand 1 -fill x -padx {0 2}
2257    set progresscoords {0 0}
2258    set fprogcoord 0
2259    set rprogcoord 0
2260    bind $progresscanv <Configure> adjustprogress
2261    set lastprogupdate [clock clicks -milliseconds]
2262    set progupdatepending 0
2263
2264    # build up the bottom bar of upper window
2265    ${NS}::label .tf.lbar.flabel -text "[mc "Find"] "
2266
2267    set bm_down_data {
2268        #define down_width 16
2269        #define down_height 16
2270        static unsigned char down_bits[] = {
2271        0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2272        0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2273        0x87, 0xe1, 0x8e, 0x71, 0x9c, 0x39, 0xb8, 0x1d,
2274        0xf0, 0x0f, 0xe0, 0x07, 0xc0, 0x03, 0x80, 0x01};
2275    }
2276    image create bitmap bm-down -data $bm_down_data -foreground $uifgcolor
2277    ${NS}::button .tf.lbar.fnext -width 26 -command {dofind 1 1}
2278    .tf.lbar.fnext configure -image bm-down
2279
2280    set bm_up_data {
2281        #define up_width 16
2282        #define up_height 16
2283        static unsigned char up_bits[] = {
2284        0x80, 0x01, 0xc0, 0x03, 0xe0, 0x07, 0xf0, 0x0f,
2285        0xb8, 0x1d, 0x9c, 0x39, 0x8e, 0x71, 0x87, 0xe1,
2286        0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2287        0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01};
2288    }
2289    image create bitmap bm-up -data $bm_up_data -foreground $uifgcolor
2290    ${NS}::button .tf.lbar.fprev -width 26 -command {dofind -1 1}
2291    .tf.lbar.fprev configure -image bm-up
2292
2293    ${NS}::label .tf.lbar.flab2 -text " [mc "commit"] "
2294
2295    pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
2296        -side left -fill y
2297    set gdttype [mc "containing:"]
2298    set gm [makedroplist .tf.lbar.gdttype gdttype \
2299                [mc "containing:"] \
2300                [mc "touching paths:"] \
2301                [mc "adding/removing string:"] \
2302                [mc "changing lines matching:"]]
2303    trace add variable gdttype write gdttype_change
2304    pack .tf.lbar.gdttype -side left -fill y
2305
2306    set findstring {}
2307    set fstring .tf.lbar.findstring
2308    lappend entries $fstring
2309    ${NS}::entry $fstring -width 30 -textvariable findstring
2310    trace add variable findstring write find_change
2311    set findtype [mc "Exact"]
2312    set findtypemenu [makedroplist .tf.lbar.findtype \
2313                          findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
2314    trace add variable findtype write findcom_change
2315    set findloc [mc "All fields"]
2316    makedroplist .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
2317        [mc "Comments"] [mc "Author"] [mc "Committer"]
2318    trace add variable findloc write find_change
2319    pack .tf.lbar.findloc -side right
2320    pack .tf.lbar.findtype -side right
2321    pack $fstring -side left -expand 1 -fill x
2322
2323    # Finish putting the upper half of the viewer together
2324    pack .tf.lbar -in .tf -side bottom -fill x
2325    pack .tf.bar -in .tf -side bottom -fill x
2326    pack .tf.histframe -fill both -side top -expand 1
2327    .ctop add .tf
2328    if {!$use_ttk} {
2329        .ctop paneconfigure .tf -height $geometry(topheight)
2330        .ctop paneconfigure .tf -width $geometry(topwidth)
2331    }
2332
2333    # now build up the bottom
2334    ${NS}::panedwindow .pwbottom -orient horizontal
2335
2336    # lower left, a text box over search bar, scroll bar to the right
2337    # if we know window height, then that will set the lower text height, otherwise
2338    # we set lower text height which will drive window height
2339    if {[info exists geometry(main)]} {
2340        ${NS}::frame .bleft -width $geometry(botwidth)
2341    } else {
2342        ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
2343    }
2344    ${NS}::frame .bleft.top
2345    ${NS}::frame .bleft.mid
2346    ${NS}::frame .bleft.bottom
2347
2348    ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch
2349    pack .bleft.top.search -side left -padx 5
2350    set sstring .bleft.top.sstring
2351    set searchstring ""
2352    ${NS}::entry $sstring -width 20 -textvariable searchstring
2353    lappend entries $sstring
2354    trace add variable searchstring write incrsearch
2355    pack $sstring -side left -expand 1 -fill x
2356    ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \
2357        -command changediffdisp -variable diffelide -value {0 0}
2358    ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \
2359        -command changediffdisp -variable diffelide -value {0 1}
2360    ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \
2361        -command changediffdisp -variable diffelide -value {1 0}
2362    ${NS}::label .bleft.mid.labeldiffcontext -text "      [mc "Lines of context"]: "
2363    pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
2364    spinbox .bleft.mid.diffcontext -width 5 \
2365        -from 0 -increment 1 -to 10000000 \
2366        -validate all -validatecommand "diffcontextvalidate %P" \
2367        -textvariable diffcontextstring
2368    .bleft.mid.diffcontext set $diffcontext
2369    trace add variable diffcontextstring write diffcontextchange
2370    lappend entries .bleft.mid.diffcontext
2371    pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
2372    ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
2373        -command changeignorespace -variable ignorespace
2374    pack .bleft.mid.ignspace -side left -padx 5
2375
2376    set worddiff [mc "Line diff"]
2377    if {[package vcompare $git_version "1.7.2"] >= 0} {
2378        makedroplist .bleft.mid.worddiff worddiff [mc "Line diff"] \
2379            [mc "Markup words"] [mc "Color words"]
2380        trace add variable worddiff write changeworddiff
2381        pack .bleft.mid.worddiff -side left -padx 5
2382    }
2383
2384    set ctext .bleft.bottom.ctext
2385    text $ctext -background $bgcolor -foreground $fgcolor \
2386        -state disabled -font textfont \
2387        -yscrollcommand scrolltext -wrap none \
2388        -xscrollcommand ".bleft.bottom.sbhorizontal set"
2389    if {$have_tk85} {
2390        $ctext conf -tabstyle wordprocessor
2391    }
2392    ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview"
2393    ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h
2394    pack .bleft.top -side top -fill x
2395    pack .bleft.mid -side top -fill x
2396    grid $ctext .bleft.bottom.sb -sticky nsew
2397    grid .bleft.bottom.sbhorizontal -sticky ew
2398    grid columnconfigure .bleft.bottom 0 -weight 1
2399    grid rowconfigure .bleft.bottom 0 -weight 1
2400    grid rowconfigure .bleft.bottom 1 -weight 0
2401    pack .bleft.bottom -side top -fill both -expand 1
2402    lappend bglist $ctext
2403    lappend fglist $ctext
2404
2405    $ctext tag conf comment -wrap $wrapcomment
2406    $ctext tag conf filesep -font textfontbold -fore $filesepfgcolor -back $filesepbgcolor
2407    $ctext tag conf hunksep -fore [lindex $diffcolors 2]
2408    $ctext tag conf d0 -fore [lindex $diffcolors 0]
2409    $ctext tag conf dresult -fore [lindex $diffcolors 1]
2410    $ctext tag conf m0 -fore [lindex $mergecolors 0]
2411    $ctext tag conf m1 -fore [lindex $mergecolors 1]
2412    $ctext tag conf m2 -fore [lindex $mergecolors 2]
2413    $ctext tag conf m3 -fore [lindex $mergecolors 3]
2414    $ctext tag conf m4 -fore [lindex $mergecolors 4]
2415    $ctext tag conf m5 -fore [lindex $mergecolors 5]
2416    $ctext tag conf m6 -fore [lindex $mergecolors 6]
2417    $ctext tag conf m7 -fore [lindex $mergecolors 7]
2418    $ctext tag conf m8 -fore [lindex $mergecolors 8]
2419    $ctext tag conf m9 -fore [lindex $mergecolors 9]
2420    $ctext tag conf m10 -fore [lindex $mergecolors 10]
2421    $ctext tag conf m11 -fore [lindex $mergecolors 11]
2422    $ctext tag conf m12 -fore [lindex $mergecolors 12]
2423    $ctext tag conf m13 -fore [lindex $mergecolors 13]
2424    $ctext tag conf m14 -fore [lindex $mergecolors 14]
2425    $ctext tag conf m15 -fore [lindex $mergecolors 15]
2426    $ctext tag conf mmax -fore darkgrey
2427    set mergemax 16
2428    $ctext tag conf mresult -font textfontbold
2429    $ctext tag conf msep -font textfontbold
2430    $ctext tag conf found -back $foundbgcolor
2431    $ctext tag conf currentsearchhit -back $currentsearchhitbgcolor
2432    $ctext tag conf wwrap -wrap word -lmargin2 1c
2433    $ctext tag conf bold -font textfontbold
2434
2435    .pwbottom add .bleft
2436    if {!$use_ttk} {
2437        .pwbottom paneconfigure .bleft -width $geometry(botwidth)
2438    }
2439
2440    # lower right
2441    ${NS}::frame .bright
2442    ${NS}::frame .bright.mode
2443    ${NS}::radiobutton .bright.mode.patch -text [mc "Patch"] \
2444        -command reselectline -variable cmitmode -value "patch"
2445    ${NS}::radiobutton .bright.mode.tree -text [mc "Tree"] \
2446        -command reselectline -variable cmitmode -value "tree"
2447    grid .bright.mode.patch .bright.mode.tree -sticky ew
2448    pack .bright.mode -side top -fill x
2449    set cflist .bright.cfiles
2450    set indent [font measure mainfont "nn"]
2451    text $cflist \
2452        -selectbackground $selectbgcolor \
2453        -background $bgcolor -foreground $fgcolor \
2454        -font mainfont \
2455        -tabs [list $indent [expr {2 * $indent}]] \
2456        -yscrollcommand ".bright.sb set" \
2457        -cursor [. cget -cursor] \
2458        -spacing1 1 -spacing3 1
2459    lappend bglist $cflist
2460    lappend fglist $cflist
2461    ${NS}::scrollbar .bright.sb -command "$cflist yview"
2462    pack .bright.sb -side right -fill y
2463    pack $cflist -side left -fill both -expand 1
2464    $cflist tag configure highlight \
2465        -background [$cflist cget -selectbackground]
2466    $cflist tag configure bold -font mainfontbold
2467
2468    .pwbottom add .bright
2469    .ctop add .pwbottom
2470
2471    # restore window width & height if known
2472    if {[info exists geometry(main)]} {
2473        if {[scan $geometry(main) "%dx%d" w h] >= 2} {
2474            if {$w > [winfo screenwidth .]} {
2475                set w [winfo screenwidth .]
2476            }
2477            if {$h > [winfo screenheight .]} {
2478                set h [winfo screenheight .]
2479            }
2480            wm geometry . "${w}x$h"
2481        }
2482    }
2483
2484    if {[info exists geometry(state)] && $geometry(state) eq "zoomed"} {
2485        wm state . $geometry(state)
2486    }
2487
2488    if {[tk windowingsystem] eq {aqua}} {
2489        set M1B M1
2490        set ::BM "3"
2491    } else {
2492        set M1B Control
2493        set ::BM "2"
2494    }
2495
2496    if {$use_ttk} {
2497        bind .ctop <Map> {
2498            bind %W <Map> {}
2499            %W sashpos 0 $::geometry(topheight)
2500        }
2501        bind .pwbottom <Map> {
2502            bind %W <Map> {}
2503            %W sashpos 0 $::geometry(botwidth)
2504        }
2505    }
2506
2507    bind .pwbottom <Configure> {resizecdetpanes %W %w}
2508    pack .ctop -fill both -expand 1
2509    bindall <1> {selcanvline %W %x %y}
2510    #bindall <B1-Motion> {selcanvline %W %x %y}
2511    if {[tk windowingsystem] == "win32"} {
2512        bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
2513        bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
2514    } else {
2515        bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
2516        bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
2517        if {[tk windowingsystem] eq "aqua"} {
2518            bindall <MouseWheel> {
2519                set delta [expr {- (%D)}]
2520                allcanvs yview scroll $delta units
2521            }
2522            bindall <Shift-MouseWheel> {
2523                set delta [expr {- (%D)}]
2524                $canv xview scroll $delta units
2525            }
2526        }
2527    }
2528    bindall <$::BM> "canvscan mark %W %x %y"
2529    bindall <B$::BM-Motion> "canvscan dragto %W %x %y"
2530    bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2531    bind . <$M1B-Key-w> doquit
2532    bindkey <Home> selfirstline
2533    bindkey <End> sellastline
2534    bind . <Key-Up> "selnextline -1"
2535    bind . <Key-Down> "selnextline 1"
2536    bind . <Shift-Key-Up> "dofind -1 0"
2537    bind . <Shift-Key-Down> "dofind 1 0"
2538    bindkey <Key-Right> "goforw"
2539    bindkey <Key-Left> "goback"
2540    bind . <Key-Prior> "selnextpage -1"
2541    bind . <Key-Next> "selnextpage 1"
2542    bind . <$M1B-Home> "allcanvs yview moveto 0.0"
2543    bind . <$M1B-End> "allcanvs yview moveto 1.0"
2544    bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
2545    bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
2546    bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2547    bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
2548    bindkey <Key-Delete> "$ctext yview scroll -1 pages"
2549    bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
2550    bindkey <Key-space> "$ctext yview scroll 1 pages"
2551    bindkey p "selnextline -1"
2552    bindkey n "selnextline 1"
2553    bindkey z "goback"
2554    bindkey x "goforw"
2555    bindkey k "selnextline -1"
2556    bindkey j "selnextline 1"
2557    bindkey h "goback"
2558    bindkey l "goforw"
2559    bindkey b prevfile
2560    bindkey d "$ctext yview scroll 18 units"
2561    bindkey u "$ctext yview scroll -18 units"
2562    bindkey / {focus $fstring}
2563    bindkey <Key-KP_Divide> {focus $fstring}
2564    bindkey <Key-Return> {dofind 1 1}
2565    bindkey ? {dofind -1 1}
2566    bindkey f nextfile
2567    bind . <F5> updatecommits
2568    bindmodfunctionkey Shift 5 reloadcommits
2569    bind . <F2> showrefs
2570    bindmodfunctionkey Shift 4 {newview 0}
2571    bind . <F4> edit_or_newview
2572    bind . <$M1B-q> doquit
2573    bind . <$M1B-f> {dofind 1 1}
2574    bind . <$M1B-g> {dofind 1 0}
2575    bind . <$M1B-r> dosearchback
2576    bind . <$M1B-s> dosearch
2577    bind . <$M1B-equal> {incrfont 1}
2578    bind . <$M1B-plus> {incrfont 1}
2579    bind . <$M1B-KP_Add> {incrfont 1}
2580    bind . <$M1B-minus> {incrfont -1}
2581    bind . <$M1B-KP_Subtract> {incrfont -1}
2582    wm protocol . WM_DELETE_WINDOW doquit
2583    bind . <Destroy> {stop_backends}
2584    bind . <Button-1> "click %W"
2585    bind $fstring <Key-Return> {dofind 1 1}
2586    bind $sha1entry <Key-Return> {gotocommit; break}
2587    bind $sha1entry <<PasteSelection>> clearsha1
2588    bind $sha1entry <<Paste>> clearsha1
2589    bind $cflist <1> {sel_flist %W %x %y; break}
2590    bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
2591    bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
2592    global ctxbut
2593    bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
2594    bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
2595    bind $ctext <Button-1> {focus %W}
2596    bind $ctext <<Selection>> rehighlight_search_results
2597
2598    set maincursor [. cget -cursor]
2599    set textcursor [$ctext cget -cursor]
2600    set curtextcursor $textcursor
2601
2602    set rowctxmenu .rowctxmenu
2603    makemenu $rowctxmenu {
2604        {mc "Diff this -> selected" command {diffvssel 0}}
2605        {mc "Diff selected -> this" command {diffvssel 1}}
2606        {mc "Make patch" command mkpatch}
2607        {mc "Create tag" command mktag}
2608        {mc "Write commit to file" command writecommit}
2609        {mc "Create new branch" command mkbranch}
2610        {mc "Cherry-pick this commit" command cherrypick}
2611        {mc "Reset HEAD branch to here" command resethead}
2612        {mc "Mark this commit" command markhere}
2613        {mc "Return to mark" command gotomark}
2614        {mc "Find descendant of this and mark" command find_common_desc}
2615        {mc "Compare with marked commit" command compare_commits}
2616        {mc "Diff this -> marked commit" command {diffvsmark 0}}
2617        {mc "Diff marked commit -> this" command {diffvsmark 1}}
2618        {mc "Revert this commit" command revert}
2619    }
2620    $rowctxmenu configure -tearoff 0
2621
2622    set fakerowmenu .fakerowmenu
2623    makemenu $fakerowmenu {
2624        {mc "Diff this -> selected" command {diffvssel 0}}
2625        {mc "Diff selected -> this" command {diffvssel 1}}
2626        {mc "Make patch" command mkpatch}
2627        {mc "Diff this -> marked commit" command {diffvsmark 0}}
2628        {mc "Diff marked commit -> this" command {diffvsmark 1}}
2629    }
2630    $fakerowmenu configure -tearoff 0
2631
2632    set headctxmenu .headctxmenu
2633    makemenu $headctxmenu {
2634        {mc "Check out this branch" command cobranch}
2635        {mc "Remove this branch" command rmbranch}
2636    }
2637    $headctxmenu configure -tearoff 0
2638
2639    global flist_menu
2640    set flist_menu .flistctxmenu
2641    makemenu $flist_menu {
2642        {mc "Highlight this too" command {flist_hl 0}}
2643        {mc "Highlight this only" command {flist_hl 1}}
2644        {mc "External diff" command {external_diff}}
2645        {mc "Blame parent commit" command {external_blame 1}}
2646    }
2647    $flist_menu configure -tearoff 0
2648
2649    global diff_menu
2650    set diff_menu .diffctxmenu
2651    makemenu $diff_menu {
2652        {mc "Show origin of this line" command show_line_source}
2653        {mc "Run git gui blame on this line" command {external_blame_diff}}
2654    }
2655    $diff_menu configure -tearoff 0
2656}
2657
2658# Windows sends all mouse wheel events to the current focused window, not
2659# the one where the mouse hovers, so bind those events here and redirect
2660# to the correct window
2661proc windows_mousewheel_redirector {W X Y D} {
2662    global canv canv2 canv3
2663    set w [winfo containing -displayof $W $X $Y]
2664    if {$w ne ""} {
2665        set u [expr {$D < 0 ? 5 : -5}]
2666        if {$w == $canv || $w == $canv2 || $w == $canv3} {
2667            allcanvs yview scroll $u units
2668        } else {
2669            catch {
2670                $w yview scroll $u units
2671            }
2672        }
2673    }
2674}
2675
2676# Update row number label when selectedline changes
2677proc selectedline_change {n1 n2 op} {
2678    global selectedline rownumsel
2679
2680    if {$selectedline eq {}} {
2681        set rownumsel {}
2682    } else {
2683        set rownumsel [expr {$selectedline + 1}]
2684    }
2685}
2686
2687# mouse-2 makes all windows scan vertically, but only the one
2688# the cursor is in scans horizontally
2689proc canvscan {op w x y} {
2690    global canv canv2 canv3
2691    foreach c [list $canv $canv2 $canv3] {
2692        if {$c == $w} {
2693            $c scan $op $x $y
2694        } else {
2695            $c scan $op 0 $y
2696        }
2697    }
2698}
2699
2700proc scrollcanv {cscroll f0 f1} {
2701    $cscroll set $f0 $f1
2702    drawvisible
2703    flushhighlights
2704}
2705
2706# when we make a key binding for the toplevel, make sure
2707# it doesn't get triggered when that key is pressed in the
2708# find string entry widget.
2709proc bindkey {ev script} {
2710    global entries
2711    bind . $ev $script
2712    set escript [bind Entry $ev]
2713    if {$escript == {}} {
2714        set escript [bind Entry <Key>]
2715    }
2716    foreach e $entries {
2717        bind $e $ev "$escript; break"
2718    }
2719}
2720
2721proc bindmodfunctionkey {mod n script} {
2722    bind . <$mod-F$n> $script
2723    catch { bind . <$mod-XF86_Switch_VT_$n> $script }
2724}
2725
2726# set the focus back to the toplevel for any click outside
2727# the entry widgets
2728proc click {w} {
2729    global ctext entries
2730    foreach e [concat $entries $ctext] {
2731        if {$w == $e} return
2732    }
2733    focus .
2734}
2735
2736# Adjust the progress bar for a change in requested extent or canvas size
2737proc adjustprogress {} {
2738    global progresscanv progressitem progresscoords
2739    global fprogitem fprogcoord lastprogupdate progupdatepending
2740    global rprogitem rprogcoord use_ttk
2741
2742    if {$use_ttk} {
2743        $progresscanv configure -value [expr {int($fprogcoord * 100)}]
2744        return
2745    }
2746
2747    set w [expr {[winfo width $progresscanv] - 4}]
2748    set x0 [expr {$w * [lindex $progresscoords 0]}]
2749    set x1 [expr {$w * [lindex $progresscoords 1]}]
2750    set h [winfo height $progresscanv]
2751    $progresscanv coords $progressitem $x0 0 $x1 $h
2752    $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2753    $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2754    set now [clock clicks -milliseconds]
2755    if {$now >= $lastprogupdate + 100} {
2756        set progupdatepending 0
2757        update
2758    } elseif {!$progupdatepending} {
2759        set progupdatepending 1
2760        after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2761    }
2762}
2763
2764proc doprogupdate {} {
2765    global lastprogupdate progupdatepending
2766
2767    if {$progupdatepending} {
2768        set progupdatepending 0
2769        set lastprogupdate [clock clicks -milliseconds]
2770        update
2771    }
2772}
2773
2774proc savestuff {w} {
2775    global canv canv2 canv3 mainfont textfont uifont tabstop
2776    global stuffsaved findmergefiles maxgraphpct
2777    global maxwidth showneartags showlocalchanges
2778    global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
2779    global cmitmode wrapcomment datetimeformat limitdiffs
2780    global colors uicolor bgcolor fgcolor diffcolors diffcontext selectbgcolor
2781    global uifgcolor uifgdisabledcolor
2782    global headbgcolor headfgcolor headoutlinecolor remotebgcolor
2783    global tagbgcolor tagfgcolor tagoutlinecolor
2784    global reflinecolor filesepbgcolor filesepfgcolor
2785    global mergecolors foundbgcolor currentsearchhitbgcolor
2786    global linehoverbgcolor linehoverfgcolor linehoveroutlinecolor circlecolors
2787    global mainheadcirclecolor workingfilescirclecolor indexcirclecolor
2788    global linkfgcolor circleoutlinecolor
2789    global autoselect autosellen extdifftool perfile_attrs markbgcolor use_ttk
2790    global hideremotes want_ttk maxrefs
2791    global config_file config_file_tmp
2792
2793    if {$stuffsaved} return
2794    if {![winfo viewable .]} return
2795    catch {
2796        if {[file exists $config_file_tmp]} {
2797            file delete -force $config_file_tmp
2798        }
2799        set f [open $config_file_tmp w]
2800        if {$::tcl_platform(platform) eq {windows}} {
2801            file attributes $config_file_tmp -hidden true
2802        }
2803        puts $f [list set mainfont $mainfont]
2804        puts $f [list set textfont $textfont]
2805        puts $f [list set uifont $uifont]
2806        puts $f [list set tabstop $tabstop]
2807        puts $f [list set findmergefiles $findmergefiles]
2808        puts $f [list set maxgraphpct $maxgraphpct]
2809        puts $f [list set maxwidth $maxwidth]
2810        puts $f [list set cmitmode $cmitmode]
2811        puts $f [list set wrapcomment $wrapcomment]
2812        puts $f [list set autoselect $autoselect]
2813        puts $f [list set autosellen $autosellen]
2814        puts $f [list set showneartags $showneartags]
2815        puts $f [list set maxrefs $maxrefs]
2816        puts $f [list set hideremotes $hideremotes]
2817        puts $f [list set showlocalchanges $showlocalchanges]
2818        puts $f [list set datetimeformat $datetimeformat]
2819        puts $f [list set limitdiffs $limitdiffs]
2820        puts $f [list set uicolor $uicolor]
2821        puts $f [list set want_ttk $want_ttk]
2822        puts $f [list set bgcolor $bgcolor]
2823        puts $f [list set fgcolor $fgcolor]
2824        puts $f [list set uifgcolor $uifgcolor]
2825        puts $f [list set uifgdisabledcolor $uifgdisabledcolor]
2826        puts $f [list set colors $colors]
2827        puts $f [list set diffcolors $diffcolors]
2828        puts $f [list set mergecolors $mergecolors]
2829        puts $f [list set markbgcolor $markbgcolor]
2830        puts $f [list set diffcontext $diffcontext]
2831        puts $f [list set selectbgcolor $selectbgcolor]
2832        puts $f [list set foundbgcolor $foundbgcolor]
2833        puts $f [list set currentsearchhitbgcolor $currentsearchhitbgcolor]
2834        puts $f [list set extdifftool $extdifftool]
2835        puts $f [list set perfile_attrs $perfile_attrs]
2836        puts $f [list set headbgcolor $headbgcolor]
2837        puts $f [list set headfgcolor $headfgcolor]
2838        puts $f [list set headoutlinecolor $headoutlinecolor]
2839        puts $f [list set remotebgcolor $remotebgcolor]
2840        puts $f [list set tagbgcolor $tagbgcolor]
2841        puts $f [list set tagfgcolor $tagfgcolor]
2842        puts $f [list set tagoutlinecolor $tagoutlinecolor]
2843        puts $f [list set reflinecolor $reflinecolor]
2844        puts $f [list set filesepbgcolor $filesepbgcolor]
2845        puts $f [list set filesepfgcolor $filesepfgcolor]
2846        puts $f [list set linehoverbgcolor $linehoverbgcolor]
2847        puts $f [list set linehoverfgcolor $linehoverfgcolor]
2848        puts $f [list set linehoveroutlinecolor $linehoveroutlinecolor]
2849        puts $f [list set mainheadcirclecolor $mainheadcirclecolor]
2850        puts $f [list set workingfilescirclecolor $workingfilescirclecolor]
2851        puts $f [list set indexcirclecolor $indexcirclecolor]
2852        puts $f [list set circlecolors $circlecolors]
2853        puts $f [list set linkfgcolor $linkfgcolor]
2854        puts $f [list set circleoutlinecolor $circleoutlinecolor]
2855
2856        puts $f "set geometry(main) [wm geometry .]"
2857        puts $f "set geometry(state) [wm state .]"
2858        puts $f "set geometry(topwidth) [winfo width .tf]"
2859        puts $f "set geometry(topheight) [winfo height .tf]"
2860        if {$use_ttk} {
2861            puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
2862            puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
2863        } else {
2864            puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2865            puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2866        }
2867        puts $f "set geometry(botwidth) [winfo width .bleft]"
2868        puts $f "set geometry(botheight) [winfo height .bleft]"
2869
2870        puts -nonewline $f "set permviews {"
2871        for {set v 0} {$v < $nextviewnum} {incr v} {
2872            if {$viewperm($v)} {
2873                puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
2874            }
2875        }
2876        puts $f "}"
2877        close $f
2878        file rename -force $config_file_tmp $config_file
2879    }
2880    set stuffsaved 1
2881}
2882
2883proc resizeclistpanes {win w} {
2884    global oldwidth use_ttk
2885    if {[info exists oldwidth($win)]} {
2886        if {$use_ttk} {
2887            set s0 [$win sashpos 0]
2888            set s1 [$win sashpos 1]
2889        } else {
2890            set s0 [$win sash coord 0]
2891            set s1 [$win sash coord 1]
2892        }
2893        if {$w < 60} {
2894            set sash0 [expr {int($w/2 - 2)}]
2895            set sash1 [expr {int($w*5/6 - 2)}]
2896        } else {
2897            set factor [expr {1.0 * $w / $oldwidth($win)}]
2898            set sash0 [expr {int($factor * [lindex $s0 0])}]
2899            set sash1 [expr {int($factor * [lindex $s1 0])}]
2900            if {$sash0 < 30} {
2901                set sash0 30
2902            }
2903            if {$sash1 < $sash0 + 20} {
2904                set sash1 [expr {$sash0 + 20}]
2905            }
2906            if {$sash1 > $w - 10} {
2907                set sash1 [expr {$w - 10}]
2908                if {$sash0 > $sash1 - 20} {
2909                    set sash0 [expr {$sash1 - 20}]
2910                }
2911            }
2912        }
2913        if {$use_ttk} {
2914            $win sashpos 0 $sash0
2915            $win sashpos 1 $sash1
2916        } else {
2917            $win sash place 0 $sash0 [lindex $s0 1]
2918            $win sash place 1 $sash1 [lindex $s1 1]
2919        }
2920    }
2921    set oldwidth($win) $w
2922}
2923
2924proc resizecdetpanes {win w} {
2925    global oldwidth use_ttk
2926    if {[info exists oldwidth($win)]} {
2927        if {$use_ttk} {
2928            set s0 [$win sashpos 0]
2929        } else {
2930            set s0 [$win sash coord 0]
2931        }
2932        if {$w < 60} {
2933            set sash0 [expr {int($w*3/4 - 2)}]
2934        } else {
2935            set factor [expr {1.0 * $w / $oldwidth($win)}]
2936            set sash0 [expr {int($factor * [lindex $s0 0])}]
2937            if {$sash0 < 45} {
2938                set sash0 45
2939            }
2940            if {$sash0 > $w - 15} {
2941                set sash0 [expr {$w - 15}]
2942            }
2943        }
2944        if {$use_ttk} {
2945            $win sashpos 0 $sash0
2946        } else {
2947            $win sash place 0 $sash0 [lindex $s0 1]
2948        }
2949    }
2950    set oldwidth($win) $w
2951}
2952
2953proc allcanvs args {
2954    global canv canv2 canv3
2955    eval $canv $args
2956    eval $canv2 $args
2957    eval $canv3 $args
2958}
2959
2960proc bindall {event action} {
2961    global canv canv2 canv3
2962    bind $canv $event $action
2963    bind $canv2 $event $action
2964    bind $canv3 $event $action
2965}
2966
2967proc about {} {
2968    global uifont NS
2969    set w .about
2970    if {[winfo exists $w]} {
2971        raise $w
2972        return
2973    }
2974    ttk_toplevel $w
2975    wm title $w [mc "About gitk"]
2976    make_transient $w .
2977    message $w.m -text [mc "
2978Gitk - a commit viewer for git
2979
2980Copyright \u00a9 2005-2014 Paul Mackerras
2981
2982Use and redistribute under the terms of the GNU General Public License"] \
2983            -justify center -aspect 400 -border 2 -bg white -relief groove
2984    pack $w.m -side top -fill x -padx 2 -pady 2
2985    ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2986    pack $w.ok -side bottom
2987    bind $w <Visibility> "focus $w.ok"
2988    bind $w <Key-Escape> "destroy $w"
2989    bind $w <Key-Return> "destroy $w"
2990    tk::PlaceWindow $w widget .
2991}
2992
2993proc keys {} {
2994    global NS
2995    set w .keys
2996    if {[winfo exists $w]} {
2997        raise $w
2998        return
2999    }
3000    if {[tk windowingsystem] eq {aqua}} {
3001        set M1T Cmd
3002    } else {
3003        set M1T Ctrl
3004    }
3005    ttk_toplevel $w
3006    wm title $w [mc "Gitk key bindings"]
3007    make_transient $w .
3008    message $w.m -text "
3009[mc "Gitk key bindings:"]
3010
3011[mc "<%s-Q>             Quit" $M1T]
3012[mc "<%s-W>             Close window" $M1T]
3013[mc "<Home>             Move to first commit"]
3014[mc "<End>              Move to last commit"]
3015[mc "<Up>, p, k Move up one commit"]
3016[mc "<Down>, n, j       Move down one commit"]
3017[mc "<Left>, z, h       Go back in history list"]
3018[mc "<Right>, x, l      Go forward in history list"]
3019[mc "<PageUp>   Move up one page in commit list"]
3020[mc "<PageDown> Move down one page in commit list"]
3021[mc "<%s-Home>  Scroll to top of commit list" $M1T]
3022[mc "<%s-End>   Scroll to bottom of commit list" $M1T]
3023[mc "<%s-Up>    Scroll commit list up one line" $M1T]
3024[mc "<%s-Down>  Scroll commit list down one line" $M1T]
3025[mc "<%s-PageUp>        Scroll commit list up one page" $M1T]
3026[mc "<%s-PageDown>      Scroll commit list down one page" $M1T]
3027[mc "<Shift-Up> Find backwards (upwards, later commits)"]
3028[mc "<Shift-Down>       Find forwards (downwards, earlier commits)"]
3029[mc "<Delete>, b        Scroll diff view up one page"]
3030[mc "<Backspace>        Scroll diff view up one page"]
3031[mc "<Space>            Scroll diff view down one page"]
3032[mc "u          Scroll diff view up 18 lines"]
3033[mc "d          Scroll diff view down 18 lines"]
3034[mc "<%s-F>             Find" $M1T]
3035[mc "<%s-G>             Move to next find hit" $M1T]
3036[mc "<Return>   Move to next find hit"]
3037[mc "/          Focus the search box"]
3038[mc "?          Move to previous find hit"]
3039[mc "f          Scroll diff view to next file"]
3040[mc "<%s-S>             Search for next hit in diff view" $M1T]
3041[mc "<%s-R>             Search for previous hit in diff view" $M1T]
3042[mc "<%s-KP+>   Increase font size" $M1T]
3043[mc "<%s-plus>  Increase font size" $M1T]
3044[mc "<%s-KP->   Decrease font size" $M1T]
3045[mc "<%s-minus> Decrease font size" $M1T]
3046[mc "<F5>               Update"]
3047" \
3048            -justify left -bg white -border 2 -relief groove
3049    pack $w.m -side top -fill both -padx 2 -pady 2
3050    ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
3051    bind $w <Key-Escape> [list destroy $w]
3052    pack $w.ok -side bottom
3053    bind $w <Visibility> "focus $w.ok"
3054    bind $w <Key-Escape> "destroy $w"
3055    bind $w <Key-Return> "destroy $w"
3056}
3057
3058# Procedures for manipulating the file list window at the
3059# bottom right of the overall window.
3060
3061proc treeview {w l openlevs} {
3062    global treecontents treediropen treeheight treeparent treeindex
3063
3064    set ix 0
3065    set treeindex() 0
3066    set lev 0
3067    set prefix {}
3068    set prefixend -1
3069    set prefendstack {}
3070    set htstack {}
3071    set ht 0
3072    set treecontents() {}
3073    $w conf -state normal
3074    foreach f $l {
3075        while {[string range $f 0 $prefixend] ne $prefix} {
3076            if {$lev <= $openlevs} {
3077                $w mark set e:$treeindex($prefix) "end -1c"
3078                $w mark gravity e:$treeindex($prefix) left
3079            }
3080            set treeheight($prefix) $ht
3081            incr ht [lindex $htstack end]
3082            set htstack [lreplace $htstack end end]
3083            set prefixend [lindex $prefendstack end]
3084            set prefendstack [lreplace $prefendstack end end]
3085            set prefix [string range $prefix 0 $prefixend]
3086            incr lev -1
3087        }
3088        set tail [string range $f [expr {$prefixend+1}] end]
3089        while {[set slash [string first "/" $tail]] >= 0} {
3090            lappend htstack $ht
3091            set ht 0
3092            lappend prefendstack $prefixend
3093            incr prefixend [expr {$slash + 1}]
3094            set d [string range $tail 0 $slash]
3095            lappend treecontents($prefix) $d
3096            set oldprefix $prefix
3097            append prefix $d
3098            set treecontents($prefix) {}
3099            set treeindex($prefix) [incr ix]
3100            set treeparent($prefix) $oldprefix
3101            set tail [string range $tail [expr {$slash+1}] end]
3102            if {$lev <= $openlevs} {
3103                set ht 1
3104                set treediropen($prefix) [expr {$lev < $openlevs}]
3105                set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
3106                $w mark set d:$ix "end -1c"
3107                $w mark gravity d:$ix left
3108                set str "\n"
3109                for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3110                $w insert end $str
3111                $w image create end -align center -image $bm -padx 1 \
3112                    -name a:$ix
3113                $w insert end $d [highlight_tag $prefix]
3114                $w mark set s:$ix "end -1c"
3115                $w mark gravity s:$ix left
3116            }
3117            incr lev
3118        }
3119        if {$tail ne {}} {
3120            if {$lev <= $openlevs} {
3121                incr ht
3122                set str "\n"
3123                for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3124                $w insert end $str
3125                $w insert end $tail [highlight_tag $f]
3126            }
3127            lappend treecontents($prefix) $tail
3128        }
3129    }
3130    while {$htstack ne {}} {
3131        set treeheight($prefix) $ht
3132        incr ht [lindex $htstack end]
3133        set htstack [lreplace $htstack end end]
3134        set prefixend [lindex $prefendstack end]
3135        set prefendstack [lreplace $prefendstack end end]
3136        set prefix [string range $prefix 0 $prefixend]
3137    }
3138    $w conf -state disabled
3139}
3140
3141proc linetoelt {l} {
3142    global treeheight treecontents
3143
3144    set y 2
3145    set prefix {}
3146    while {1} {
3147        foreach e $treecontents($prefix) {
3148            if {$y == $l} {
3149                return "$prefix$e"
3150            }
3151            set n 1
3152            if {[string index $e end] eq "/"} {
3153                set n $treeheight($prefix$e)
3154                if {$y + $n > $l} {
3155                    append prefix $e
3156                    incr y
3157                    break
3158                }
3159            }
3160            incr y $n
3161        }
3162    }
3163}
3164
3165proc highlight_tree {y prefix} {
3166    global treeheight treecontents cflist
3167
3168    foreach e $treecontents($prefix) {
3169        set path $prefix$e
3170        if {[highlight_tag $path] ne {}} {
3171            $cflist tag add bold $y.0 "$y.0 lineend"
3172        }
3173        incr y
3174        if {[string index $e end] eq "/" && $treeheight($path) > 1} {
3175            set y [highlight_tree $y $path]
3176        }
3177    }
3178    return $y
3179}
3180
3181proc treeclosedir {w dir} {
3182    global treediropen treeheight treeparent treeindex
3183
3184    set ix $treeindex($dir)
3185    $w conf -state normal
3186    $w delete s:$ix e:$ix
3187    set treediropen($dir) 0
3188    $w image configure a:$ix -image tri-rt
3189    $w conf -state disabled
3190    set n [expr {1 - $treeheight($dir)}]
3191    while {$dir ne {}} {
3192        incr treeheight($dir) $n
3193        set dir $treeparent($dir)
3194    }
3195}
3196
3197proc treeopendir {w dir} {
3198    global treediropen treeheight treeparent treecontents treeindex
3199
3200    set ix $treeindex($dir)
3201    $w conf -state normal
3202    $w image configure a:$ix -image tri-dn
3203    $w mark set e:$ix s:$ix
3204    $w mark gravity e:$ix right
3205    set lev 0
3206    set str "\n"
3207    set n [llength $treecontents($dir)]
3208    for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
3209        incr lev
3210        append str "\t"
3211        incr treeheight($x) $n
3212    }
3213    foreach e $treecontents($dir) {
3214        set de $dir$e
3215        if {[string index $e end] eq "/"} {
3216            set iy $treeindex($de)
3217            $w mark set d:$iy e:$ix
3218            $w mark gravity d:$iy left
3219            $w insert e:$ix $str
3220            set treediropen($de) 0
3221            $w image create e:$ix -align center -image tri-rt -padx 1 \
3222                -name a:$iy
3223            $w insert e:$ix $e [highlight_tag $de]
3224            $w mark set s:$iy e:$ix
3225            $w mark gravity s:$iy left
3226            set treeheight($de) 1
3227        } else {
3228            $w insert e:$ix $str
3229            $w insert e:$ix $e [highlight_tag $de]
3230        }
3231    }
3232    $w mark gravity e:$ix right
3233    $w conf -state disabled
3234    set treediropen($dir) 1
3235    set top [lindex [split [$w index @0,0] .] 0]
3236    set ht [$w cget -height]
3237    set l [lindex [split [$w index s:$ix] .] 0]
3238    if {$l < $top} {
3239        $w yview $l.0
3240    } elseif {$l + $n + 1 > $top + $ht} {
3241        set top [expr {$l + $n + 2 - $ht}]
3242        if {$l < $top} {
3243            set top $l
3244        }
3245        $w yview $top.0
3246    }
3247}
3248
3249proc treeclick {w x y} {
3250    global treediropen cmitmode ctext cflist cflist_top
3251
3252    if {$cmitmode ne "tree"} return
3253    if {![info exists cflist_top]} return
3254    set l [lindex [split [$w index "@$x,$y"] "."] 0]
3255    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3256    $cflist tag add highlight $l.0 "$l.0 lineend"
3257    set cflist_top $l
3258    if {$l == 1} {
3259        $ctext yview 1.0
3260        return
3261    }
3262    set e [linetoelt $l]
3263    if {[string index $e end] ne "/"} {
3264        showfile $e
3265    } elseif {$treediropen($e)} {
3266        treeclosedir $w $e
3267    } else {
3268        treeopendir $w $e
3269    }
3270}
3271
3272proc setfilelist {id} {
3273    global treefilelist cflist jump_to_here
3274
3275    treeview $cflist $treefilelist($id) 0
3276    if {$jump_to_here ne {}} {
3277        set f [lindex $jump_to_here 0]
3278        if {[lsearch -exact $treefilelist($id) $f] >= 0} {
3279            showfile $f
3280        }
3281    }
3282}
3283
3284image create bitmap tri-rt -background black -foreground blue -data {
3285    #define tri-rt_width 13
3286    #define tri-rt_height 13
3287    static unsigned char tri-rt_bits[] = {
3288       0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
3289       0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
3290       0x00, 0x00};
3291} -maskdata {
3292    #define tri-rt-mask_width 13
3293    #define tri-rt-mask_height 13
3294    static unsigned char tri-rt-mask_bits[] = {
3295       0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
3296       0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
3297       0x08, 0x00};
3298}
3299image create bitmap tri-dn -background black -foreground blue -data {
3300    #define tri-dn_width 13
3301    #define tri-dn_height 13
3302    static unsigned char tri-dn_bits[] = {
3303       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
3304       0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3305       0x00, 0x00};
3306} -maskdata {
3307    #define tri-dn-mask_width 13
3308    #define tri-dn-mask_height 13
3309    static unsigned char tri-dn-mask_bits[] = {
3310       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
3311       0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
3312       0x00, 0x00};
3313}
3314
3315image create bitmap reficon-T -background black -foreground yellow -data {
3316    #define tagicon_width 13
3317    #define tagicon_height 9
3318    static unsigned char tagicon_bits[] = {
3319       0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
3320       0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
3321} -maskdata {
3322    #define tagicon-mask_width 13
3323    #define tagicon-mask_height 9
3324    static unsigned char tagicon-mask_bits[] = {
3325       0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
3326       0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
3327}
3328set rectdata {
3329    #define headicon_width 13
3330    #define headicon_height 9
3331    static unsigned char headicon_bits[] = {
3332       0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3333       0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3334}
3335set rectmask {
3336    #define headicon-mask_width 13
3337    #define headicon-mask_height 9
3338    static unsigned char headicon-mask_bits[] = {
3339       0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3340       0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3341}
3342image create bitmap reficon-H -background black -foreground green \
3343    -data $rectdata -maskdata $rectmask
3344image create bitmap reficon-o -background black -foreground "#ddddff" \
3345    -data $rectdata -maskdata $rectmask
3346
3347proc init_flist {first} {
3348    global cflist cflist_top difffilestart
3349
3350    $cflist conf -state normal
3351    $cflist delete 0.0 end
3352    if {$first ne {}} {
3353        $cflist insert end $first
3354        set cflist_top 1
3355        $cflist tag add highlight 1.0 "1.0 lineend"
3356    } else {
3357        catch {unset cflist_top}
3358    }
3359    $cflist conf -state disabled
3360    set difffilestart {}
3361}
3362
3363proc highlight_tag {f} {
3364    global highlight_paths
3365
3366    foreach p $highlight_paths {
3367        if {[string match $p $f]} {
3368            return "bold"
3369        }
3370    }
3371    return {}
3372}
3373
3374proc highlight_filelist {} {
3375    global cmitmode cflist
3376
3377    $cflist conf -state normal
3378    if {$cmitmode ne "tree"} {
3379        set end [lindex [split [$cflist index end] .] 0]
3380        for {set l 2} {$l < $end} {incr l} {
3381            set line [$cflist get $l.0 "$l.0 lineend"]
3382            if {[highlight_tag $line] ne {}} {
3383                $cflist tag add bold $l.0 "$l.0 lineend"
3384            }
3385        }
3386    } else {
3387        highlight_tree 2 {}
3388    }
3389    $cflist conf -state disabled
3390}
3391
3392proc unhighlight_filelist {} {
3393    global cflist
3394
3395    $cflist conf -state normal
3396    $cflist tag remove bold 1.0 end
3397    $cflist conf -state disabled
3398}
3399
3400proc add_flist {fl} {
3401    global cflist
3402
3403    $cflist conf -state normal
3404    foreach f $fl {
3405        $cflist insert end "\n"
3406        $cflist insert end $f [highlight_tag $f]
3407    }
3408    $cflist conf -state disabled
3409}
3410
3411proc sel_flist {w x y} {
3412    global ctext difffilestart cflist cflist_top cmitmode
3413
3414    if {$cmitmode eq "tree"} return
3415    if {![info exists cflist_top]} return
3416    set l [lindex [split [$w index "@$x,$y"] "."] 0]
3417    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3418    $cflist tag add highlight $l.0 "$l.0 lineend"
3419    set cflist_top $l
3420    if {$l == 1} {
3421        $ctext yview 1.0
3422    } else {
3423        catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
3424    }
3425    suppress_highlighting_file_for_current_scrollpos
3426}
3427
3428proc pop_flist_menu {w X Y x y} {
3429    global ctext cflist cmitmode flist_menu flist_menu_file
3430    global treediffs diffids
3431
3432    stopfinding
3433    set l [lindex [split [$w index "@$x,$y"] "."] 0]
3434    if {$l <= 1} return
3435    if {$cmitmode eq "tree"} {
3436        set e [linetoelt $l]
3437        if {[string index $e end] eq "/"} return
3438    } else {
3439        set e [lindex $treediffs($diffids) [expr {$l-2}]]
3440    }
3441    set flist_menu_file $e
3442    set xdiffstate "normal"
3443    if {$cmitmode eq "tree"} {
3444        set xdiffstate "disabled"
3445    }
3446    # Disable "External diff" item in tree mode
3447    $flist_menu entryconf 2 -state $xdiffstate
3448    tk_popup $flist_menu $X $Y
3449}
3450
3451proc find_ctext_fileinfo {line} {
3452    global ctext_file_names ctext_file_lines
3453
3454    set ok [bsearch $ctext_file_lines $line]
3455    set tline [lindex $ctext_file_lines $ok]
3456
3457    if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3458        return {}
3459    } else {
3460        return [list [lindex $ctext_file_names $ok] $tline]
3461    }
3462}
3463
3464proc pop_diff_menu {w X Y x y} {
3465    global ctext diff_menu flist_menu_file
3466    global diff_menu_txtpos diff_menu_line
3467    global diff_menu_filebase
3468
3469    set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3470    set diff_menu_line [lindex $diff_menu_txtpos 0]
3471    # don't pop up the menu on hunk-separator or file-separator lines
3472    if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3473        return
3474    }
3475    stopfinding
3476    set f [find_ctext_fileinfo $diff_menu_line]
3477    if {$f eq {}} return
3478    set flist_menu_file [lindex $f 0]
3479    set diff_menu_filebase [lindex $f 1]
3480    tk_popup $diff_menu $X $Y
3481}
3482
3483proc flist_hl {only} {
3484    global flist_menu_file findstring gdttype
3485
3486    set x [shellquote $flist_menu_file]
3487    if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
3488        set findstring $x
3489    } else {
3490        append findstring " " $x
3491    }
3492    set gdttype [mc "touching paths:"]
3493}
3494
3495proc gitknewtmpdir {} {
3496    global diffnum gitktmpdir gitdir
3497
3498    if {![info exists gitktmpdir]} {
3499        set gitktmpdir [file join $gitdir [format ".gitk-tmp.%s" [pid]]]
3500        if {[catch {file mkdir $gitktmpdir} err]} {
3501            error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3502            unset gitktmpdir
3503            return {}
3504        }
3505        set diffnum 0
3506    }
3507    incr diffnum
3508    set diffdir [file join $gitktmpdir $diffnum]
3509    if {[catch {file mkdir $diffdir} err]} {
3510        error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3511        return {}
3512    }
3513    return $diffdir
3514}
3515
3516proc save_file_from_commit {filename output what} {
3517    global nullfile
3518
3519    if {[catch {exec git show $filename -- > $output} err]} {
3520        if {[string match "fatal: bad revision *" $err]} {
3521            return $nullfile
3522        }
3523        error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
3524        return {}
3525    }
3526    return $output
3527}
3528
3529proc external_diff_get_one_file {diffid filename diffdir} {
3530    global nullid nullid2 nullfile
3531    global worktree
3532
3533    if {$diffid == $nullid} {
3534        set difffile [file join $worktree $filename]
3535        if {[file exists $difffile]} {
3536            return $difffile
3537        }
3538        return $nullfile
3539    }
3540    if {$diffid == $nullid2} {
3541        set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3542        return [save_file_from_commit :$filename $difffile index]
3543    }
3544    set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3545    return [save_file_from_commit $diffid:$filename $difffile \
3546               "revision $diffid"]
3547}
3548
3549proc external_diff {} {
3550    global nullid nullid2
3551    global flist_menu_file
3552    global diffids
3553    global extdifftool
3554
3555    if {[llength $diffids] == 1} {
3556        # no reference commit given
3557        set diffidto [lindex $diffids 0]
3558        if {$diffidto eq $nullid} {
3559            # diffing working copy with index
3560            set diffidfrom $nullid2
3561        } elseif {$diffidto eq $nullid2} {
3562            # diffing index with HEAD
3563            set diffidfrom "HEAD"
3564        } else {
3565            # use first parent commit
3566            global parentlist selectedline
3567            set diffidfrom [lindex $parentlist $selectedline 0]
3568        }
3569    } else {
3570        set diffidfrom [lindex $diffids 0]
3571        set diffidto [lindex $diffids 1]
3572    }
3573
3574    # make sure that several diffs wont collide
3575    set diffdir [gitknewtmpdir]
3576    if {$diffdir eq {}} return
3577
3578    # gather files to diff
3579    set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3580    set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3581
3582    if {$difffromfile ne {} && $difftofile ne {}} {
3583        set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
3584        if {[catch {set fl [open |$cmd r]} err]} {
3585            file delete -force $diffdir
3586            error_popup "$extdifftool: [mc "command failed:"] $err"
3587        } else {
3588            fconfigure $fl -blocking 0
3589            filerun $fl [list delete_at_eof $fl $diffdir]
3590        }
3591    }
3592}
3593
3594proc find_hunk_blamespec {base line} {
3595    global ctext
3596
3597    # Find and parse the hunk header
3598    set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3599    if {$s_lix eq {}} return
3600
3601    set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3602    if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3603            s_line old_specs osz osz1 new_line nsz]} {
3604        return
3605    }
3606
3607    # base lines for the parents
3608    set base_lines [list $new_line]
3609    foreach old_spec [lrange [split $old_specs " "] 1 end] {
3610        if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3611                old_spec old_line osz]} {
3612            return
3613        }
3614        lappend base_lines $old_line
3615    }
3616
3617    # Now scan the lines to determine offset within the hunk
3618    set max_parent [expr {[llength $base_lines]-2}]
3619    set dline 0
3620    set s_lno [lindex [split $s_lix "."] 0]
3621
3622    # Determine if the line is removed
3623    set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3624    if {[string match {[-+ ]*} $chunk]} {
3625        set removed_idx [string first "-" $chunk]
3626        # Choose a parent index
3627        if {$removed_idx >= 0} {
3628            set parent $removed_idx
3629        } else {
3630            set unchanged_idx [string first " " $chunk]
3631            if {$unchanged_idx >= 0} {
3632                set parent $unchanged_idx
3633            } else {
3634                # blame the current commit
3635                set parent -1
3636            }
3637        }
3638        # then count other lines that belong to it
3639        for {set i $line} {[incr i -1] > $s_lno} {} {
3640            set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3641            # Determine if the line is removed
3642            set removed_idx [string first "-" $chunk]
3643            if {$parent >= 0} {
3644                set code [string index $chunk $parent]
3645                if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3646                    incr dline
3647                }
3648            } else {
3649                if {$removed_idx < 0} {
3650                    incr dline
3651                }
3652            }
3653        }
3654        incr parent
3655    } else {
3656        set parent 0
3657    }
3658
3659    incr dline [lindex $base_lines $parent]
3660    return [list $parent $dline]
3661}
3662
3663proc external_blame_diff {} {
3664    global currentid cmitmode
3665    global diff_menu_txtpos diff_menu_line
3666    global diff_menu_filebase flist_menu_file
3667
3668    if {$cmitmode eq "tree"} {
3669        set parent_idx 0
3670        set line [expr {$diff_menu_line - $diff_menu_filebase}]
3671    } else {
3672        set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3673        if {$hinfo ne {}} {
3674            set parent_idx [lindex $hinfo 0]
3675            set line [lindex $hinfo 1]
3676        } else {
3677            set parent_idx 0
3678            set line 0
3679        }
3680    }
3681
3682    external_blame $parent_idx $line
3683}
3684
3685# Find the SHA1 ID of the blob for file $fname in the index
3686# at stage 0 or 2
3687proc index_sha1 {fname} {
3688    set f [open [list | git ls-files -s $fname] r]
3689    while {[gets $f line] >= 0} {
3690        set info [lindex [split $line "\t"] 0]
3691        set stage [lindex $info 2]
3692        if {$stage eq "0" || $stage eq "2"} {
3693            close $f
3694            return [lindex $info 1]
3695        }
3696    }
3697    close $f
3698    return {}
3699}
3700
3701# Turn an absolute path into one relative to the current directory
3702proc make_relative {f} {
3703    if {[file pathtype $f] eq "relative"} {
3704        return $f
3705    }
3706    set elts [file split $f]
3707    set here [file split [pwd]]
3708    set ei 0
3709    set hi 0
3710    set res {}
3711    foreach d $here {
3712        if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3713            lappend res ".."
3714        } else {
3715            incr ei
3716        }
3717        incr hi
3718    }
3719    set elts [concat $res [lrange $elts $ei end]]
3720    return [eval file join $elts]
3721}
3722
3723proc external_blame {parent_idx {line {}}} {
3724    global flist_menu_file cdup
3725    global nullid nullid2
3726    global parentlist selectedline currentid
3727
3728    if {$parent_idx > 0} {
3729        set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3730    } else {
3731        set base_commit $currentid
3732    }
3733
3734    if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3735        error_popup [mc "No such commit"]
3736        return
3737    }
3738
3739    set cmdline [list git gui blame]
3740    if {$line ne {} && $line > 1} {
3741        lappend cmdline "--line=$line"
3742    }
3743    set f [file join $cdup $flist_menu_file]
3744    # Unfortunately it seems git gui blame doesn't like
3745    # being given an absolute path...
3746    set f [make_relative $f]
3747    lappend cmdline $base_commit $f
3748    if {[catch {eval exec $cmdline &} err]} {
3749        error_popup "[mc "git gui blame: command failed:"] $err"
3750    }
3751}
3752
3753proc show_line_source {} {
3754    global cmitmode currentid parents curview blamestuff blameinst
3755    global diff_menu_line diff_menu_filebase flist_menu_file
3756    global nullid nullid2 gitdir cdup
3757
3758    set from_index {}
3759    if {$cmitmode eq "tree"} {
3760        set id $currentid
3761        set line [expr {$diff_menu_line - $diff_menu_filebase}]
3762    } else {
3763        set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3764        if {$h eq {}} return
3765        set pi [lindex $h 0]
3766        if {$pi == 0} {
3767            mark_ctext_line $diff_menu_line
3768            return
3769        }
3770        incr pi -1
3771        if {$currentid eq $nullid} {
3772            if {$pi > 0} {
3773                # must be a merge in progress...
3774                if {[catch {
3775                    # get the last line from .git/MERGE_HEAD
3776                    set f [open [file join $gitdir MERGE_HEAD] r]
3777                    set id [lindex [split [read $f] "\n"] end-1]
3778                    close $f
3779                } err]} {
3780                    error_popup [mc "Couldn't read merge head: %s" $err]
3781                    return
3782                }
3783            } elseif {$parents($curview,$currentid) eq $nullid2} {
3784                # need to do the blame from the index
3785                if {[catch {
3786                    set from_index [index_sha1 $flist_menu_file]
3787                } err]} {
3788                    error_popup [mc "Error reading index: %s" $err]
3789                    return
3790                }
3791            } else {
3792                set id $parents($curview,$currentid)
3793            }
3794        } else {
3795            set id [lindex $parents($curview,$currentid) $pi]
3796        }
3797        set line [lindex $h 1]
3798    }
3799    set blameargs {}
3800    if {$from_index ne {}} {
3801        lappend blameargs | git cat-file blob $from_index
3802    }
3803    lappend blameargs | git blame -p -L$line,+1
3804    if {$from_index ne {}} {
3805        lappend blameargs --contents -
3806    } else {
3807        lappend blameargs $id
3808    }
3809    lappend blameargs -- [file join $cdup $flist_menu_file]
3810    if {[catch {
3811        set f [open $blameargs r]
3812    } err]} {
3813        error_popup [mc "Couldn't start git blame: %s" $err]
3814        return
3815    }
3816    nowbusy blaming [mc "Searching"]
3817    fconfigure $f -blocking 0
3818    set i [reg_instance $f]
3819    set blamestuff($i) {}
3820    set blameinst $i
3821    filerun $f [list read_line_source $f $i]
3822}
3823
3824proc stopblaming {} {
3825    global blameinst
3826
3827    if {[info exists blameinst]} {
3828        stop_instance $blameinst
3829        unset blameinst
3830        notbusy blaming
3831    }
3832}
3833
3834proc read_line_source {fd inst} {
3835    global blamestuff curview commfd blameinst nullid nullid2
3836
3837    while {[gets $fd line] >= 0} {
3838        lappend blamestuff($inst) $line
3839    }
3840    if {![eof $fd]} {
3841        return 1
3842    }
3843    unset commfd($inst)
3844    unset blameinst
3845    notbusy blaming
3846    fconfigure $fd -blocking 1
3847    if {[catch {close $fd} err]} {
3848        error_popup [mc "Error running git blame: %s" $err]
3849        return 0
3850    }
3851
3852    set fname {}
3853    set line [split [lindex $blamestuff($inst) 0] " "]
3854    set id [lindex $line 0]
3855    set lnum [lindex $line 1]
3856    if {[string length $id] == 40 && [string is xdigit $id] &&
3857        [string is digit -strict $lnum]} {
3858        # look for "filename" line
3859        foreach l $blamestuff($inst) {
3860            if {[string match "filename *" $l]} {
3861                set fname [string range $l 9 end]
3862                break
3863            }
3864        }
3865    }
3866    if {$fname ne {}} {
3867        # all looks good, select it
3868        if {$id eq $nullid} {
3869            # blame uses all-zeroes to mean not committed,
3870            # which would mean a change in the index
3871            set id $nullid2
3872        }
3873        if {[commitinview $id $curview]} {
3874            selectline [rowofcommit $id] 1 [list $fname $lnum] 1
3875        } else {
3876            error_popup [mc "That line comes from commit %s, \
3877                             which is not in this view" [shortids $id]]
3878        }
3879    } else {
3880        puts "oops couldn't parse git blame output"
3881    }
3882    return 0
3883}
3884
3885# delete $dir when we see eof on $f (presumably because the child has exited)
3886proc delete_at_eof {f dir} {
3887    while {[gets $f line] >= 0} {}
3888    if {[eof $f]} {
3889        if {[catch {close $f} err]} {
3890            error_popup "[mc "External diff viewer failed:"] $err"
3891        }
3892        file delete -force $dir
3893        return 0
3894    }
3895    return 1
3896}
3897
3898# Functions for adding and removing shell-type quoting
3899
3900proc shellquote {str} {
3901    if {![string match "*\['\"\\ \t]*" $str]} {
3902        return $str
3903    }
3904    if {![string match "*\['\"\\]*" $str]} {
3905        return "\"$str\""
3906    }
3907    if {![string match "*'*" $str]} {
3908        return "'$str'"
3909    }
3910    return "\"[string map {\" \\\" \\ \\\\} $str]\""
3911}
3912
3913proc shellarglist {l} {
3914    set str {}
3915    foreach a $l {
3916        if {$str ne {}} {
3917            append str " "
3918        }
3919        append str [shellquote $a]
3920    }
3921    return $str
3922}
3923
3924proc shelldequote {str} {
3925    set ret {}
3926    set used -1
3927    while {1} {
3928        incr used
3929        if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
3930            append ret [string range $str $used end]
3931            set used [string length $str]
3932            break
3933        }
3934        set first [lindex $first 0]
3935        set ch [string index $str $first]
3936        if {$first > $used} {
3937            append ret [string range $str $used [expr {$first - 1}]]
3938            set used $first
3939        }
3940        if {$ch eq " " || $ch eq "\t"} break
3941        incr used
3942        if {$ch eq "'"} {
3943            set first [string first "'" $str $used]
3944            if {$first < 0} {
3945                error "unmatched single-quote"
3946            }
3947            append ret [string range $str $used [expr {$first - 1}]]
3948            set used $first
3949            continue
3950        }
3951        if {$ch eq "\\"} {
3952            if {$used >= [string length $str]} {
3953                error "trailing backslash"
3954            }
3955            append ret [string index $str $used]
3956            continue
3957        }
3958        # here ch == "\""
3959        while {1} {
3960            if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
3961                error "unmatched double-quote"
3962            }
3963            set first [lindex $first 0]
3964            set ch [string index $str $first]
3965            if {$first > $used} {
3966                append ret [string range $str $used [expr {$first - 1}]]
3967                set used $first
3968            }
3969            if {$ch eq "\""} break
3970            incr used
3971            append ret [string index $str $used]
3972            incr used
3973        }
3974    }
3975    return [list $used $ret]
3976}
3977
3978proc shellsplit {str} {
3979    set l {}
3980    while {1} {
3981        set str [string trimleft $str]
3982        if {$str eq {}} break
3983        set dq [shelldequote $str]
3984        set n [lindex $dq 0]
3985        set word [lindex $dq 1]
3986        set str [string range $str $n end]
3987        lappend l $word
3988    }
3989    return $l
3990}
3991
3992# Code to implement multiple views
3993
3994proc newview {ishighlight} {
3995    global nextviewnum newviewname newishighlight
3996    global revtreeargs viewargscmd newviewopts curview
3997
3998    set newishighlight $ishighlight
3999    set top .gitkview
4000    if {[winfo exists $top]} {
4001        raise $top
4002        return
4003    }
4004    decode_view_opts $nextviewnum $revtreeargs
4005    set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
4006    set newviewopts($nextviewnum,perm) 0
4007    set newviewopts($nextviewnum,cmd)  $viewargscmd($curview)
4008    vieweditor $top $nextviewnum [mc "Gitk view definition"]
4009}
4010
4011set known_view_options {
4012    {perm      b    .  {}               {mc "Remember this view"}}
4013    {reflabel  l    +  {}               {mc "References (space separated list):"}}
4014    {refs      t15  .. {}               {mc "Branches & tags:"}}
4015    {allrefs   b    *. "--all"          {mc "All refs"}}
4016    {branches  b    .  "--branches"     {mc "All (local) branches"}}
4017    {tags      b    .  "--tags"         {mc "All tags"}}
4018    {remotes   b    .  "--remotes"      {mc "All remote-tracking branches"}}
4019    {commitlbl l    +  {}               {mc "Commit Info (regular expressions):"}}
4020    {author    t15  .. "--author=*"     {mc "Author:"}}
4021    {committer t15  .  "--committer=*"  {mc "Committer:"}}
4022    {loginfo   t15  .. "--grep=*"       {mc "Commit Message:"}}
4023    {allmatch  b    .. "--all-match"    {mc "Matches all Commit Info criteria"}}
4024    {changes_l l    +  {}               {mc "Changes to Files:"}}
4025    {pickaxe_s r0   .  {}               {mc "Fixed String"}}
4026    {pickaxe_t r1   .  "--pickaxe-regex"  {mc "Regular Expression"}}
4027    {pickaxe   t15  .. "-S*"            {mc "Search string:"}}
4028    {datelabel l    +  {}               {mc "Commit Dates (\"2 weeks ago\", \"2009-03-17 15:27:38\", \"March 17, 2009 15:27:38\"):"}}
4029    {since     t15  ..  {"--since=*" "--after=*"}  {mc "Since:"}}
4030    {until     t15  .   {"--until=*" "--before=*"} {mc "Until:"}}
4031    {limit_lbl l    +  {}               {mc "Limit and/or skip a number of revisions (positive integer):"}}
4032    {limit     t10  *. "--max-count=*"  {mc "Number to show:"}}
4033    {skip      t10  .  "--skip=*"       {mc "Number to skip:"}}
4034    {misc_lbl  l    +  {}               {mc "Miscellaneous options:"}}
4035    {dorder    b    *. {"--date-order" "-d"}      {mc "Strictly sort by date"}}
4036    {lright    b    .  "--left-right"   {mc "Mark branch sides"}}
4037    {first     b    .  "--first-parent" {mc "Limit to first parent"}}
4038    {smplhst   b    .  "--simplify-by-decoration"   {mc "Simple history"}}
4039    {args      t50  *. {}               {mc "Additional arguments to git log:"}}
4040    {allpaths  path +  {}               {mc "Enter files and directories to include, one per line:"}}
4041    {cmd       t50= +  {}               {mc "Command to generate more commits to include:"}}
4042    }
4043
4044# Convert $newviewopts($n, ...) into args for git log.
4045proc encode_view_opts {n} {
4046    global known_view_options newviewopts
4047
4048    set rargs [list]
4049    foreach opt $known_view_options {
4050        set patterns [lindex $opt 3]
4051        if {$patterns eq {}} continue
4052        set pattern [lindex $patterns 0]
4053
4054        if {[lindex $opt 1] eq "b"} {
4055            set val $newviewopts($n,[lindex $opt 0])
4056            if {$val} {
4057                lappend rargs $pattern
4058            }
4059        } elseif {[regexp {^r(\d+)$} [lindex $opt 1] type value]} {
4060            regexp {^(.*_)} [lindex $opt 0] uselessvar button_id
4061            set val $newviewopts($n,$button_id)
4062            if {$val eq $value} {
4063                lappend rargs $pattern
4064            }
4065        } else {
4066            set val $newviewopts($n,[lindex $opt 0])
4067            set val [string trim $val]
4068            if {$val ne {}} {
4069                set pfix [string range $pattern 0 end-1]
4070                lappend rargs $pfix$val
4071            }
4072        }
4073    }
4074    set rargs [concat $rargs [shellsplit $newviewopts($n,refs)]]
4075    return [concat $rargs [shellsplit $newviewopts($n,args)]]
4076}
4077
4078# Fill $newviewopts($n, ...) based on args for git log.
4079proc decode_view_opts {n view_args} {
4080    global known_view_options newviewopts
4081
4082    foreach opt $known_view_options {
4083        set id [lindex $opt 0]
4084        if {[lindex $opt 1] eq "b"} {
4085            # Checkboxes
4086            set val 0
4087        } elseif {[regexp {^r(\d+)$} [lindex $opt 1]]} {
4088            # Radiobuttons
4089            regexp {^(.*_)} $id uselessvar id
4090            set val 0
4091        } else {
4092            # Text fields
4093            set val {}
4094        }
4095        set newviewopts($n,$id) $val
4096    }
4097    set oargs [list]
4098    set refargs [list]
4099    foreach arg $view_args {
4100        if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
4101            && ![info exists found(limit)]} {
4102            set newviewopts($n,limit) $cnt
4103            set found(limit) 1
4104            continue
4105        }
4106        catch { unset val }
4107        foreach opt $known_view_options {
4108            set id [lindex $opt 0]
4109            if {[info exists found($id)]} continue
4110            foreach pattern [lindex $opt 3] {
4111                if {![string match $pattern $arg]} continue
4112                if {[lindex $opt 1] eq "b"} {
4113                    # Check buttons
4114                    set val 1
4115                } elseif {[regexp {^r(\d+)$} [lindex $opt 1] match num]} {
4116                    # Radio buttons
4117                    regexp {^(.*_)} $id uselessvar id
4118                    set val $num
4119                } else {
4120                    # Text input fields
4121                    set size [string length $pattern]
4122                    set val [string range $arg [expr {$size-1}] end]
4123                }
4124                set newviewopts($n,$id) $val
4125                set found($id) 1
4126                break
4127            }
4128            if {[info exists val]} break
4129        }
4130        if {[info exists val]} continue
4131        if {[regexp {^-} $arg]} {
4132            lappend oargs $arg
4133        } else {
4134            lappend refargs $arg
4135        }
4136    }
4137    set newviewopts($n,refs) [shellarglist $refargs]
4138    set newviewopts($n,args) [shellarglist $oargs]
4139}
4140
4141proc edit_or_newview {} {
4142    global curview
4143
4144    if {$curview > 0} {
4145        editview
4146    } else {
4147        newview 0
4148    }
4149}
4150
4151proc editview {} {
4152    global curview
4153    global viewname viewperm newviewname newviewopts
4154    global viewargs viewargscmd
4155
4156    set top .gitkvedit-$curview
4157    if {[winfo exists $top]} {
4158        raise $top
4159        return
4160    }
4161    decode_view_opts $curview $viewargs($curview)
4162    set newviewname($curview)      $viewname($curview)
4163    set newviewopts($curview,perm) $viewperm($curview)
4164    set newviewopts($curview,cmd)  $viewargscmd($curview)
4165    vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
4166}
4167
4168proc vieweditor {top n title} {
4169    global newviewname newviewopts viewfiles bgcolor
4170    global known_view_options NS
4171
4172    ttk_toplevel $top
4173    wm title $top [concat $title [mc "-- criteria for selecting revisions"]]
4174    make_transient $top .
4175
4176    # View name
4177    ${NS}::frame $top.nfr
4178    ${NS}::label $top.nl -text [mc "View Name"]
4179    ${NS}::entry $top.name -width 20 -textvariable newviewname($n)
4180    pack $top.nfr -in $top -fill x -pady 5 -padx 3
4181    pack $top.nl -in $top.nfr -side left -padx {0 5}
4182    pack $top.name -in $top.nfr -side left -padx {0 25}
4183
4184    # View options
4185    set cframe $top.nfr
4186    set cexpand 0
4187    set cnt 0
4188    foreach opt $known_view_options {
4189        set id [lindex $opt 0]
4190        set type [lindex $opt 1]
4191        set flags [lindex $opt 2]
4192        set title [eval [lindex $opt 4]]
4193        set lxpad 0
4194
4195        if {$flags eq "+" || $flags eq "*"} {
4196            set cframe $top.fr$cnt
4197            incr cnt
4198            ${NS}::frame $cframe
4199            pack $cframe -in $top -fill x -pady 3 -padx 3
4200            set cexpand [expr {$flags eq "*"}]
4201        } elseif {$flags eq ".." || $flags eq "*."} {
4202            set cframe $top.fr$cnt
4203            incr cnt
4204            ${NS}::frame $cframe
4205            pack $cframe -in $top -fill x -pady 3 -padx [list 15 3]
4206            set cexpand [expr {$flags eq "*."}]
4207        } else {
4208            set lxpad 5
4209        }
4210
4211        if {$type eq "l"} {
4212            ${NS}::label $cframe.l_$id -text $title
4213            pack $cframe.l_$id -in $cframe -side left -pady [list 3 0] -anchor w
4214        } elseif {$type eq "b"} {
4215            ${NS}::checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
4216            pack $cframe.c_$id -in $cframe -side left \
4217                -padx [list $lxpad 0] -expand $cexpand -anchor w
4218        } elseif {[regexp {^r(\d+)$} $type type sz]} {
4219            regexp {^(.*_)} $id uselessvar button_id
4220            ${NS}::radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz
4221            pack $cframe.c_$id -in $cframe -side left \
4222                -padx [list $lxpad 0] -expand $cexpand -anchor w
4223        } elseif {[regexp {^t(\d+)$} $type type sz]} {
4224            ${NS}::label $cframe.l_$id -text $title
4225            ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4226                -textvariable newviewopts($n,$id)
4227            pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
4228            pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
4229        } elseif {[regexp {^t(\d+)=$} $type type sz]} {
4230            ${NS}::label $cframe.l_$id -text $title
4231            ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4232                -textvariable newviewopts($n,$id)
4233            pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
4234            pack $cframe.e_$id -in $cframe -side top -fill x
4235        } elseif {$type eq "path"} {
4236            ${NS}::label $top.l -text $title
4237            pack $top.l -in $top -side top -pady [list 3 0] -anchor w -padx 3
4238            text $top.t -width 40 -height 5 -background $bgcolor
4239            if {[info exists viewfiles($n)]} {
4240                foreach f $viewfiles($n) {
4241                    $top.t insert end $f
4242                    $top.t insert end "\n"
4243                }
4244                $top.t delete {end - 1c} end
4245                $top.t mark set insert 0.0
4246            }
4247            pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
4248        }
4249    }
4250
4251    ${NS}::frame $top.buts
4252    ${NS}::button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
4253    ${NS}::button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
4254    ${NS}::button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
4255    bind $top <Control-Return> [list newviewok $top $n]
4256    bind $top <F5> [list newviewok $top $n 1]
4257    bind $top <Escape> [list destroy $top]
4258    grid $top.buts.ok $top.buts.apply $top.buts.can
4259    grid columnconfigure $top.buts 0 -weight 1 -uniform a
4260    grid columnconfigure $top.buts 1 -weight 1 -uniform a
4261    grid columnconfigure $top.buts 2 -weight 1 -uniform a
4262    pack $top.buts -in $top -side top -fill x
4263    focus $top.t
4264}
4265
4266proc doviewmenu {m first cmd op argv} {
4267    set nmenu [$m index end]
4268    for {set i $first} {$i <= $nmenu} {incr i} {
4269        if {[$m entrycget $i -command] eq $cmd} {
4270            eval $m $op $i $argv
4271            break
4272        }
4273    }
4274}
4275
4276proc allviewmenus {n op args} {
4277    # global viewhlmenu
4278
4279    doviewmenu .bar.view 5 [list showview $n] $op $args
4280    # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
4281}
4282
4283proc newviewok {top n {apply 0}} {
4284    global nextviewnum newviewperm newviewname newishighlight
4285    global viewname viewfiles viewperm selectedview curview
4286    global viewargs viewargscmd newviewopts viewhlmenu
4287
4288    if {[catch {
4289        set newargs [encode_view_opts $n]
4290    } err]} {
4291        error_popup "[mc "Error in commit selection arguments:"] $err" $top
4292        return
4293    }
4294    set files {}
4295    foreach f [split [$top.t get 0.0 end] "\n"] {
4296        set ft [string trim $f]
4297        if {$ft ne {}} {
4298            lappend files $ft
4299        }
4300    }
4301    if {![info exists viewfiles($n)]} {
4302        # creating a new view
4303        incr nextviewnum
4304        set viewname($n) $newviewname($n)
4305        set viewperm($n) $newviewopts($n,perm)
4306        set viewfiles($n) $files
4307        set viewargs($n) $newargs
4308        set viewargscmd($n) $newviewopts($n,cmd)
4309        addviewmenu $n
4310        if {!$newishighlight} {
4311            run showview $n
4312        } else {
4313            run addvhighlight $n
4314        }
4315    } else {
4316        # editing an existing view
4317        set viewperm($n) $newviewopts($n,perm)
4318        if {$newviewname($n) ne $viewname($n)} {
4319            set viewname($n) $newviewname($n)
4320            doviewmenu .bar.view 5 [list showview $n] \
4321                entryconf [list -label $viewname($n)]
4322            # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
4323                # entryconf [list -label $viewname($n) -value $viewname($n)]
4324        }
4325        if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
4326                $newviewopts($n,cmd) ne $viewargscmd($n)} {
4327            set viewfiles($n) $files
4328            set viewargs($n) $newargs
4329            set viewargscmd($n) $newviewopts($n,cmd)
4330            if {$curview == $n} {
4331                run reloadcommits
4332            }
4333        }
4334    }
4335    if {$apply} return
4336    catch {destroy $top}
4337}
4338
4339proc delview {} {
4340    global curview viewperm hlview selectedhlview
4341
4342    if {$curview == 0} return
4343    if {[info exists hlview] && $hlview == $curview} {
4344        set selectedhlview [mc "None"]
4345        unset hlview
4346    }
4347    allviewmenus $curview delete
4348    set viewperm($curview) 0
4349    showview 0
4350}
4351
4352proc addviewmenu {n} {
4353    global viewname viewhlmenu
4354
4355    .bar.view add radiobutton -label $viewname($n) \
4356        -command [list showview $n] -variable selectedview -value $n
4357    #$viewhlmenu add radiobutton -label $viewname($n) \
4358    #   -command [list addvhighlight $n] -variable selectedhlview
4359}
4360
4361proc showview {n} {
4362    global curview cached_commitrow ordertok
4363    global displayorder parentlist rowidlist rowisopt rowfinal
4364    global colormap rowtextx nextcolor canvxmax
4365    global numcommits viewcomplete
4366    global selectedline currentid canv canvy0
4367    global treediffs
4368    global pending_select mainheadid
4369    global commitidx
4370    global selectedview
4371    global hlview selectedhlview commitinterest
4372
4373    if {$n == $curview} return
4374    set selid {}
4375    set ymax [lindex [$canv cget -scrollregion] 3]
4376    set span [$canv yview]
4377    set ytop [expr {[lindex $span 0] * $ymax}]
4378    set ybot [expr {[lindex $span 1] * $ymax}]
4379    set yscreen [expr {($ybot - $ytop) / 2}]
4380    if {$selectedline ne {}} {
4381        set selid $currentid
4382        set y [yc $selectedline]
4383        if {$ytop < $y && $y < $ybot} {
4384            set yscreen [expr {$y - $ytop}]
4385        }
4386    } elseif {[info exists pending_select]} {
4387        set selid $pending_select
4388        unset pending_select
4389    }
4390    unselectline
4391    normalline
4392    catch {unset treediffs}
4393    clear_display
4394    if {[info exists hlview] && $hlview == $n} {
4395        unset hlview
4396        set selectedhlview [mc "None"]
4397    }
4398    catch {unset commitinterest}
4399    catch {unset cached_commitrow}
4400    catch {unset ordertok}
4401
4402    set curview $n
4403    set selectedview $n
4404    .bar.view entryconf [mca "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
4405    .bar.view entryconf [mca "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
4406
4407    run refill_reflist
4408    if {![info exists viewcomplete($n)]} {
4409        getcommits $selid
4410        return
4411    }
4412
4413    set displayorder {}
4414    set parentlist {}
4415    set rowidlist {}
4416    set rowisopt {}
4417    set rowfinal {}
4418    set numcommits $commitidx($n)
4419
4420    catch {unset colormap}
4421    catch {unset rowtextx}
4422    set nextcolor 0
4423    set canvxmax [$canv cget -width]
4424    set curview $n
4425    set row 0
4426    setcanvscroll
4427    set yf 0
4428    set row {}
4429    if {$selid ne {} && [commitinview $selid $n]} {
4430        set row [rowofcommit $selid]
4431        # try to get the selected row in the same position on the screen
4432        set ymax [lindex [$canv cget -scrollregion] 3]
4433        set ytop [expr {[yc $row] - $yscreen}]
4434        if {$ytop < 0} {
4435            set ytop 0
4436        }
4437        set yf [expr {$ytop * 1.0 / $ymax}]
4438    }
4439    allcanvs yview moveto $yf
4440    drawvisible
4441    if {$row ne {}} {
4442        selectline $row 0
4443    } elseif {!$viewcomplete($n)} {
4444        reset_pending_select $selid
4445    } else {
4446        reset_pending_select {}
4447
4448        if {[commitinview $pending_select $curview]} {
4449            selectline [rowofcommit $pending_select] 1
4450        } else {
4451            set row [first_real_row]
4452            if {$row < $numcommits} {
4453                selectline $row 0
4454            }
4455        }
4456    }
4457    if {!$viewcomplete($n)} {
4458        if {$numcommits == 0} {
4459            show_status [mc "Reading commits..."]
4460        }
4461    } elseif {$numcommits == 0} {
4462        show_status [mc "No commits selected"]
4463    }
4464}
4465
4466# Stuff relating to the highlighting facility
4467
4468proc ishighlighted {id} {
4469    global vhighlights fhighlights nhighlights rhighlights
4470
4471    if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
4472        return $nhighlights($id)
4473    }
4474    if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
4475        return $vhighlights($id)
4476    }
4477    if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
4478        return $fhighlights($id)
4479    }
4480    if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4481        return $rhighlights($id)
4482    }
4483    return 0
4484}
4485
4486proc bolden {id font} {
4487    global canv linehtag currentid boldids need_redisplay markedid
4488
4489    # need_redisplay = 1 means the display is stale and about to be redrawn
4490    if {$need_redisplay} return
4491    lappend boldids $id
4492    $canv itemconf $linehtag($id) -font $font
4493    if {[info exists currentid] && $id eq $currentid} {
4494        $canv delete secsel
4495        set t [eval $canv create rect [$canv bbox $linehtag($id)] \
4496                   -outline {{}} -tags secsel \
4497                   -fill [$canv cget -selectbackground]]
4498        $canv lower $t
4499    }
4500    if {[info exists markedid] && $id eq $markedid} {
4501        make_idmark $id
4502    }
4503}
4504
4505proc bolden_name {id font} {
4506    global canv2 linentag currentid boldnameids need_redisplay
4507
4508    if {$need_redisplay} return
4509    lappend boldnameids $id
4510    $canv2 itemconf $linentag($id) -font $font
4511    if {[info exists currentid] && $id eq $currentid} {
4512        $canv2 delete secsel
4513        set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
4514                   -outline {{}} -tags secsel \
4515                   -fill [$canv2 cget -selectbackground]]
4516        $canv2 lower $t
4517    }
4518}
4519
4520proc unbolden {} {
4521    global boldids
4522
4523    set stillbold {}
4524    foreach id $boldids {
4525        if {![ishighlighted $id]} {
4526            bolden $id mainfont
4527        } else {
4528            lappend stillbold $id
4529        }
4530    }
4531    set boldids $stillbold
4532}
4533
4534proc addvhighlight {n} {
4535    global hlview viewcomplete curview vhl_done commitidx
4536
4537    if {[info exists hlview]} {
4538        delvhighlight
4539    }
4540    set hlview $n
4541    if {$n != $curview && ![info exists viewcomplete($n)]} {
4542        start_rev_list $n
4543    }
4544    set vhl_done $commitidx($hlview)
4545    if {$vhl_done > 0} {
4546        drawvisible
4547    }
4548}
4549
4550proc delvhighlight {} {
4551    global hlview vhighlights
4552
4553    if {![info exists hlview]} return
4554    unset hlview
4555    catch {unset vhighlights}
4556    unbolden
4557}
4558
4559proc vhighlightmore {} {
4560    global hlview vhl_done commitidx vhighlights curview
4561
4562    set max $commitidx($hlview)
4563    set vr [visiblerows]
4564    set r0 [lindex $vr 0]
4565    set r1 [lindex $vr 1]
4566    for {set i $vhl_done} {$i < $max} {incr i} {
4567        set id [commitonrow $i $hlview]
4568        if {[commitinview $id $curview]} {
4569            set row [rowofcommit $id]
4570            if {$r0 <= $row && $row <= $r1} {
4571                if {![highlighted $row]} {
4572                    bolden $id mainfontbold
4573                }
4574                set vhighlights($id) 1
4575            }
4576        }
4577    }
4578    set vhl_done $max
4579    return 0
4580}
4581
4582proc askvhighlight {row id} {
4583    global hlview vhighlights iddrawn
4584
4585    if {[commitinview $id $hlview]} {
4586        if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
4587            bolden $id mainfontbold
4588        }
4589        set vhighlights($id) 1
4590    } else {
4591        set vhighlights($id) 0
4592    }
4593}
4594
4595proc hfiles_change {} {
4596    global highlight_files filehighlight fhighlights fh_serial
4597    global highlight_paths
4598
4599    if {[info exists filehighlight]} {
4600        # delete previous highlights
4601        catch {close $filehighlight}
4602        unset filehighlight
4603        catch {unset fhighlights}
4604        unbolden
4605        unhighlight_filelist
4606    }
4607    set highlight_paths {}
4608    after cancel do_file_hl $fh_serial
4609    incr fh_serial
4610    if {$highlight_files ne {}} {
4611        after 300 do_file_hl $fh_serial
4612    }
4613}
4614
4615proc gdttype_change {name ix op} {
4616    global gdttype highlight_files findstring findpattern
4617
4618    stopfinding
4619    if {$findstring ne {}} {
4620        if {$gdttype eq [mc "containing:"]} {
4621            if {$highlight_files ne {}} {
4622                set highlight_files {}
4623                hfiles_change
4624            }
4625            findcom_change
4626        } else {
4627            if {$findpattern ne {}} {
4628                set findpattern {}
4629                findcom_change
4630            }
4631            set highlight_files $findstring
4632            hfiles_change
4633        }
4634        drawvisible
4635    }
4636    # enable/disable findtype/findloc menus too
4637}
4638
4639proc find_change {name ix op} {
4640    global gdttype findstring highlight_files
4641
4642    stopfinding
4643    if {$gdttype eq [mc "containing:"]} {
4644        findcom_change
4645    } else {
4646        if {$highlight_files ne $findstring} {
4647            set highlight_files $findstring
4648            hfiles_change
4649        }
4650    }
4651    drawvisible
4652}
4653
4654proc findcom_change args {
4655    global nhighlights boldnameids
4656    global findpattern findtype findstring gdttype
4657
4658    stopfinding
4659    # delete previous highlights, if any
4660    foreach id $boldnameids {
4661        bolden_name $id mainfont
4662    }
4663    set boldnameids {}
4664    catch {unset nhighlights}
4665    unbolden
4666    unmarkmatches
4667    if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
4668        set findpattern {}
4669    } elseif {$findtype eq [mc "Regexp"]} {
4670        set findpattern $findstring
4671    } else {
4672        set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4673                   $findstring]
4674        set findpattern "*$e*"
4675    }
4676}
4677
4678proc makepatterns {l} {
4679    set ret {}
4680    foreach e $l {
4681        set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4682        if {[string index $ee end] eq "/"} {
4683            lappend ret "$ee*"
4684        } else {
4685            lappend ret $ee
4686            lappend ret "$ee/*"
4687        }
4688    }
4689    return $ret
4690}
4691
4692proc do_file_hl {serial} {
4693    global highlight_files filehighlight highlight_paths gdttype fhl_list
4694    global cdup findtype
4695
4696    if {$gdttype eq [mc "touching paths:"]} {
4697        # If "exact" match then convert backslashes to forward slashes.
4698        # Most useful to support Windows-flavoured file paths.
4699        if {$findtype eq [mc "Exact"]} {
4700            set highlight_files [string map {"\\" "/"} $highlight_files]
4701        }
4702        if {[catch {set paths [shellsplit $highlight_files]}]} return
4703        set highlight_paths [makepatterns $paths]
4704        highlight_filelist
4705        set relative_paths {}
4706        foreach path $paths {
4707            lappend relative_paths [file join $cdup $path]
4708        }
4709        set gdtargs [concat -- $relative_paths]
4710    } elseif {$gdttype eq [mc "adding/removing string:"]} {
4711        set gdtargs [list "-S$highlight_files"]
4712    } elseif {$gdttype eq [mc "changing lines matching:"]} {
4713        set gdtargs [list "-G$highlight_files"]
4714    } else {
4715        # must be "containing:", i.e. we're searching commit info
4716        return
4717    }
4718    set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
4719    set filehighlight [open $cmd r+]
4720    fconfigure $filehighlight -blocking 0
4721    filerun $filehighlight readfhighlight
4722    set fhl_list {}
4723    drawvisible
4724    flushhighlights
4725}
4726
4727proc flushhighlights {} {
4728    global filehighlight fhl_list
4729
4730    if {[info exists filehighlight]} {
4731        lappend fhl_list {}
4732        puts $filehighlight ""
4733        flush $filehighlight
4734    }
4735}
4736
4737proc askfilehighlight {row id} {
4738    global filehighlight fhighlights fhl_list
4739
4740    lappend fhl_list $id
4741    set fhighlights($id) -1
4742    puts $filehighlight $id
4743}
4744
4745proc readfhighlight {} {
4746    global filehighlight fhighlights curview iddrawn
4747    global fhl_list find_dirn
4748
4749    if {![info exists filehighlight]} {
4750        return 0
4751    }
4752    set nr 0
4753    while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4754        set line [string trim $line]
4755        set i [lsearch -exact $fhl_list $line]
4756        if {$i < 0} continue
4757        for {set j 0} {$j < $i} {incr j} {
4758            set id [lindex $fhl_list $j]
4759            set fhighlights($id) 0
4760        }
4761        set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4762        if {$line eq {}} continue
4763        if {![commitinview $line $curview]} continue
4764        if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4765            bolden $line mainfontbold
4766        }
4767        set fhighlights($line) 1
4768    }
4769    if {[eof $filehighlight]} {
4770        # strange...
4771        puts "oops, git diff-tree died"
4772        catch {close $filehighlight}
4773        unset filehighlight
4774        return 0
4775    }
4776    if {[info exists find_dirn]} {
4777        run findmore
4778    }
4779    return 1
4780}
4781
4782proc doesmatch {f} {
4783    global findtype findpattern
4784
4785    if {$findtype eq [mc "Regexp"]} {
4786        return [regexp $findpattern $f]
4787    } elseif {$findtype eq [mc "IgnCase"]} {
4788        return [string match -nocase $findpattern $f]
4789    } else {
4790        return [string match $findpattern $f]
4791    }
4792}
4793
4794proc askfindhighlight {row id} {
4795    global nhighlights commitinfo iddrawn
4796    global findloc
4797    global markingmatches
4798
4799    if {![info exists commitinfo($id)]} {
4800        getcommit $id
4801    }
4802    set info $commitinfo($id)
4803    set isbold 0
4804    set fldtypes [list [mc Headline] [mc Author] "" [mc Committer] "" [mc Comments]]
4805    foreach f $info ty $fldtypes {
4806        if {$ty eq ""} continue
4807        if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4808            [doesmatch $f]} {
4809            if {$ty eq [mc "Author"]} {
4810                set isbold 2
4811                break
4812            }
4813            set isbold 1
4814        }
4815    }
4816    if {$isbold && [info exists iddrawn($id)]} {
4817        if {![ishighlighted $id]} {
4818            bolden $id mainfontbold
4819            if {$isbold > 1} {
4820                bolden_name $id mainfontbold
4821            }
4822        }
4823        if {$markingmatches} {
4824            markrowmatches $row $id
4825        }
4826    }
4827    set nhighlights($id) $isbold
4828}
4829
4830proc markrowmatches {row id} {
4831    global canv canv2 linehtag linentag commitinfo findloc
4832
4833    set headline [lindex $commitinfo($id) 0]
4834    set author [lindex $commitinfo($id) 1]
4835    $canv delete match$row
4836    $canv2 delete match$row
4837    if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4838        set m [findmatches $headline]
4839        if {$m ne {}} {
4840            markmatches $canv $row $headline $linehtag($id) $m \
4841                [$canv itemcget $linehtag($id) -font] $row
4842        }
4843    }
4844    if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4845        set m [findmatches $author]
4846        if {$m ne {}} {
4847            markmatches $canv2 $row $author $linentag($id) $m \
4848                [$canv2 itemcget $linentag($id) -font] $row
4849        }
4850    }
4851}
4852
4853proc vrel_change {name ix op} {
4854    global highlight_related
4855
4856    rhighlight_none
4857    if {$highlight_related ne [mc "None"]} {
4858        run drawvisible
4859    }
4860}
4861
4862# prepare for testing whether commits are descendents or ancestors of a
4863proc rhighlight_sel {a} {
4864    global descendent desc_todo ancestor anc_todo
4865    global highlight_related
4866
4867    catch {unset descendent}
4868    set desc_todo [list $a]
4869    catch {unset ancestor}
4870    set anc_todo [list $a]
4871    if {$highlight_related ne [mc "None"]} {
4872        rhighlight_none
4873        run drawvisible
4874    }
4875}
4876
4877proc rhighlight_none {} {
4878    global rhighlights
4879
4880    catch {unset rhighlights}
4881    unbolden
4882}
4883
4884proc is_descendent {a} {
4885    global curview children descendent desc_todo
4886
4887    set v $curview
4888    set la [rowofcommit $a]
4889    set todo $desc_todo
4890    set leftover {}
4891    set done 0
4892    for {set i 0} {$i < [llength $todo]} {incr i} {
4893        set do [lindex $todo $i]
4894        if {[rowofcommit $do] < $la} {
4895            lappend leftover $do
4896            continue
4897        }
4898        foreach nk $children($v,$do) {
4899            if {![info exists descendent($nk)]} {
4900                set descendent($nk) 1
4901                lappend todo $nk
4902                if {$nk eq $a} {
4903                    set done 1
4904                }
4905            }
4906        }
4907        if {$done} {
4908            set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4909            return
4910        }
4911    }
4912    set descendent($a) 0
4913    set desc_todo $leftover
4914}
4915
4916proc is_ancestor {a} {
4917    global curview parents ancestor anc_todo
4918
4919    set v $curview
4920    set la [rowofcommit $a]
4921    set todo $anc_todo
4922    set leftover {}
4923    set done 0
4924    for {set i 0} {$i < [llength $todo]} {incr i} {
4925        set do [lindex $todo $i]
4926        if {![commitinview $do $v] || [rowofcommit $do] > $la} {
4927            lappend leftover $do
4928            continue
4929        }
4930        foreach np $parents($v,$do) {
4931            if {![info exists ancestor($np)]} {
4932                set ancestor($np) 1
4933                lappend todo $np
4934                if {$np eq $a} {
4935                    set done 1
4936                }
4937            }
4938        }
4939        if {$done} {
4940            set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4941            return
4942        }
4943    }
4944    set ancestor($a) 0
4945    set anc_todo $leftover
4946}
4947
4948proc askrelhighlight {row id} {
4949    global descendent highlight_related iddrawn rhighlights
4950    global selectedline ancestor
4951
4952    if {$selectedline eq {}} return
4953    set isbold 0
4954    if {$highlight_related eq [mc "Descendant"] ||
4955        $highlight_related eq [mc "Not descendant"]} {
4956        if {![info exists descendent($id)]} {
4957            is_descendent $id
4958        }
4959        if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
4960            set isbold 1
4961        }
4962    } elseif {$highlight_related eq [mc "Ancestor"] ||
4963              $highlight_related eq [mc "Not ancestor"]} {
4964        if {![info exists ancestor($id)]} {
4965            is_ancestor $id
4966        }
4967        if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
4968            set isbold 1
4969        }
4970    }
4971    if {[info exists iddrawn($id)]} {
4972        if {$isbold && ![ishighlighted $id]} {
4973            bolden $id mainfontbold
4974        }
4975    }
4976    set rhighlights($id) $isbold
4977}
4978
4979# Graph layout functions
4980
4981proc shortids {ids} {
4982    set res {}
4983    foreach id $ids {
4984        if {[llength $id] > 1} {
4985            lappend res [shortids $id]
4986        } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
4987            lappend res [string range $id 0 7]
4988        } else {
4989            lappend res $id
4990        }
4991    }
4992    return $res
4993}
4994
4995proc ntimes {n o} {
4996    set ret {}
4997    set o [list $o]
4998    for {set mask 1} {$mask <= $n} {incr mask $mask} {
4999        if {($n & $mask) != 0} {
5000            set ret [concat $ret $o]
5001        }
5002        set o [concat $o $o]
5003    }
5004    return $ret
5005}
5006
5007proc ordertoken {id} {
5008    global ordertok curview varcid varcstart varctok curview parents children
5009    global nullid nullid2
5010
5011    if {[info exists ordertok($id)]} {
5012        return $ordertok($id)
5013    }
5014    set origid $id
5015    set todo {}
5016    while {1} {
5017        if {[info exists varcid($curview,$id)]} {
5018            set a $varcid($curview,$id)
5019            set p [lindex $varcstart($curview) $a]
5020        } else {
5021            set p [lindex $children($curview,$id) 0]
5022        }
5023        if {[info exists ordertok($p)]} {
5024            set tok $ordertok($p)
5025            break
5026        }
5027        set id [first_real_child $curview,$p]
5028        if {$id eq {}} {
5029            # it's a root
5030            set tok [lindex $varctok($curview) $varcid($curview,$p)]
5031            break
5032        }
5033        if {[llength $parents($curview,$id)] == 1} {
5034            lappend todo [list $p {}]
5035        } else {
5036            set j [lsearch -exact $parents($curview,$id) $p]
5037            if {$j < 0} {
5038                puts "oops didn't find [shortids $p] in parents of [shortids $id]"
5039            }
5040            lappend todo [list $p [strrep $j]]
5041        }
5042    }
5043    for {set i [llength $todo]} {[incr i -1] >= 0} {} {
5044        set p [lindex $todo $i 0]
5045        append tok [lindex $todo $i 1]
5046        set ordertok($p) $tok
5047    }
5048    set ordertok($origid) $tok
5049    return $tok
5050}
5051
5052# Work out where id should go in idlist so that order-token
5053# values increase from left to right
5054proc idcol {idlist id {i 0}} {
5055    set t [ordertoken $id]
5056    if {$i < 0} {
5057        set i 0
5058    }
5059    if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
5060        if {$i > [llength $idlist]} {
5061            set i [llength $idlist]
5062        }
5063        while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
5064        incr i
5065    } else {
5066        if {$t > [ordertoken [lindex $idlist $i]]} {
5067            while {[incr i] < [llength $idlist] &&
5068                   $t >= [ordertoken [lindex $idlist $i]]} {}
5069        }
5070    }
5071    return $i
5072}
5073
5074proc initlayout {} {
5075    global rowidlist rowisopt rowfinal displayorder parentlist
5076    global numcommits canvxmax canv
5077    global nextcolor
5078    global colormap rowtextx
5079
5080    set numcommits 0
5081    set displayorder {}
5082    set parentlist {}
5083    set nextcolor 0
5084    set rowidlist {}
5085    set rowisopt {}
5086    set rowfinal {}
5087    set canvxmax [$canv cget -width]
5088    catch {unset colormap}
5089    catch {unset rowtextx}
5090    setcanvscroll
5091}
5092
5093proc setcanvscroll {} {
5094    global canv canv2 canv3 numcommits linespc canvxmax canvy0
5095    global lastscrollset lastscrollrows
5096
5097    set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
5098    $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
5099    $canv2 conf -scrollregion [list 0 0 0 $ymax]
5100    $canv3 conf -scrollregion [list 0 0 0 $ymax]
5101    set lastscrollset [clock clicks -milliseconds]
5102    set lastscrollrows $numcommits
5103}
5104
5105proc visiblerows {} {
5106    global canv numcommits linespc
5107
5108    set ymax [lindex [$canv cget -scrollregion] 3]
5109    if {$ymax eq {} || $ymax == 0} return
5110    set f [$canv yview]
5111    set y0 [expr {int([lindex $f 0] * $ymax)}]
5112    set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
5113    if {$r0 < 0} {
5114        set r0 0
5115    }
5116    set y1 [expr {int([lindex $f 1] * $ymax)}]
5117    set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
5118    if {$r1 >= $numcommits} {
5119        set r1 [expr {$numcommits - 1}]
5120    }
5121    return [list $r0 $r1]
5122}
5123
5124proc layoutmore {} {
5125    global commitidx viewcomplete curview
5126    global numcommits pending_select curview
5127    global lastscrollset lastscrollrows
5128
5129    if {$lastscrollrows < 100 || $viewcomplete($curview) ||
5130        [clock clicks -milliseconds] - $lastscrollset > 500} {
5131        setcanvscroll
5132    }
5133    if {[info exists pending_select] &&
5134        [commitinview $pending_select $curview]} {
5135        update
5136        selectline [rowofcommit $pending_select] 1
5137    }
5138    drawvisible
5139}
5140
5141# With path limiting, we mightn't get the actual HEAD commit,
5142# so ask git rev-list what is the first ancestor of HEAD that
5143# touches a file in the path limit.
5144proc get_viewmainhead {view} {
5145    global viewmainheadid vfilelimit viewinstances mainheadid
5146
5147    catch {
5148        set rfd [open [concat | git rev-list -1 $mainheadid \
5149                           -- $vfilelimit($view)] r]
5150        set j [reg_instance $rfd]
5151        lappend viewinstances($view) $j
5152        fconfigure $rfd -blocking 0
5153        filerun $rfd [list getviewhead $rfd $j $view]
5154        set viewmainheadid($curview) {}
5155    }
5156}
5157
5158# git rev-list should give us just 1 line to use as viewmainheadid($view)
5159proc getviewhead {fd inst view} {
5160    global viewmainheadid commfd curview viewinstances showlocalchanges
5161
5162    set id {}
5163    if {[gets $fd line] < 0} {
5164        if {![eof $fd]} {
5165            return 1
5166        }
5167    } elseif {[string length $line] == 40 && [string is xdigit $line]} {
5168        set id $line
5169    }
5170    set viewmainheadid($view) $id
5171    close $fd
5172    unset commfd($inst)
5173    set i [lsearch -exact $viewinstances($view) $inst]
5174    if {$i >= 0} {
5175        set viewinstances($view) [lreplace $viewinstances($view) $i $i]
5176    }
5177    if {$showlocalchanges && $id ne {} && $view == $curview} {
5178        doshowlocalchanges
5179    }
5180    return 0
5181}
5182
5183proc doshowlocalchanges {} {
5184    global curview viewmainheadid
5185
5186    if {$viewmainheadid($curview) eq {}} return
5187    if {[commitinview $viewmainheadid($curview) $curview]} {
5188        dodiffindex
5189    } else {
5190        interestedin $viewmainheadid($curview) dodiffindex
5191    }
5192}
5193
5194proc dohidelocalchanges {} {
5195    global nullid nullid2 lserial curview
5196
5197    if {[commitinview $nullid $curview]} {
5198        removefakerow $nullid
5199    }
5200    if {[commitinview $nullid2 $curview]} {
5201        removefakerow $nullid2
5202    }
5203    incr lserial
5204}
5205
5206# spawn off a process to do git diff-index --cached HEAD
5207proc dodiffindex {} {
5208    global lserial showlocalchanges vfilelimit curview
5209    global hasworktree git_version
5210
5211    if {!$showlocalchanges || !$hasworktree} return
5212    incr lserial
5213    if {[package vcompare $git_version "1.7.2"] >= 0} {
5214        set cmd "|git diff-index --cached --ignore-submodules=dirty HEAD"
5215    } else {
5216        set cmd "|git diff-index --cached HEAD"
5217    }
5218    if {$vfilelimit($curview) ne {}} {
5219        set cmd [concat $cmd -- $vfilelimit($curview)]
5220    }
5221    set fd [open $cmd r]
5222    fconfigure $fd -blocking 0
5223    set i [reg_instance $fd]
5224    filerun $fd [list readdiffindex $fd $lserial $i]
5225}
5226
5227proc readdiffindex {fd serial inst} {
5228    global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
5229    global vfilelimit
5230
5231    set isdiff 1
5232    if {[gets $fd line] < 0} {
5233        if {![eof $fd]} {
5234            return 1
5235        }
5236        set isdiff 0
5237    }
5238    # we only need to see one line and we don't really care what it says...
5239    stop_instance $inst
5240
5241    if {$serial != $lserial} {
5242        return 0
5243    }
5244
5245    # now see if there are any local changes not checked in to the index
5246    set cmd "|git diff-files"
5247    if {$vfilelimit($curview) ne {}} {
5248        set cmd [concat $cmd -- $vfilelimit($curview)]
5249    }
5250    set fd [open $cmd r]
5251    fconfigure $fd -blocking 0
5252    set i [reg_instance $fd]
5253    filerun $fd [list readdifffiles $fd $serial $i]
5254
5255    if {$isdiff && ![commitinview $nullid2 $curview]} {
5256        # add the line for the changes in the index to the graph
5257        set hl [mc "Local changes checked in to index but not committed"]
5258        set commitinfo($nullid2) [list  $hl {} {} {} {} "    $hl\n"]
5259        set commitdata($nullid2) "\n    $hl\n"
5260        if {[commitinview $nullid $curview]} {
5261            removefakerow $nullid
5262        }
5263        insertfakerow $nullid2 $viewmainheadid($curview)
5264    } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
5265        if {[commitinview $nullid $curview]} {
5266            removefakerow $nullid
5267        }
5268        removefakerow $nullid2
5269    }
5270    return 0
5271}
5272
5273proc readdifffiles {fd serial inst} {
5274    global viewmainheadid nullid nullid2 curview
5275    global commitinfo commitdata lserial
5276
5277    set isdiff 1
5278    if {[gets $fd line] < 0} {
5279        if {![eof $fd]} {
5280            return 1
5281        }
5282        set isdiff 0
5283    }
5284    # we only need to see one line and we don't really care what it says...
5285    stop_instance $inst
5286
5287    if {$serial != $lserial} {
5288        return 0
5289    }
5290
5291    if {$isdiff && ![commitinview $nullid $curview]} {
5292        # add the line for the local diff to the graph
5293        set hl [mc "Local uncommitted changes, not checked in to index"]
5294        set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
5295        set commitdata($nullid) "\n    $hl\n"
5296        if {[commitinview $nullid2 $curview]} {
5297            set p $nullid2
5298        } else {
5299            set p $viewmainheadid($curview)
5300        }
5301        insertfakerow $nullid $p
5302    } elseif {!$isdiff && [commitinview $nullid $curview]} {
5303        removefakerow $nullid
5304    }
5305    return 0
5306}
5307
5308proc nextuse {id row} {
5309    global curview children
5310
5311    if {[info exists children($curview,$id)]} {
5312        foreach kid $children($curview,$id) {
5313            if {![commitinview $kid $curview]} {
5314                return -1
5315            }
5316            if {[rowofcommit $kid] > $row} {
5317                return [rowofcommit $kid]
5318            }
5319        }
5320    }
5321    if {[commitinview $id $curview]} {
5322        return [rowofcommit $id]
5323    }
5324    return -1
5325}
5326
5327proc prevuse {id row} {
5328    global curview children
5329
5330    set ret -1
5331    if {[info exists children($curview,$id)]} {
5332        foreach kid $children($curview,$id) {
5333            if {![commitinview $kid $curview]} break
5334            if {[rowofcommit $kid] < $row} {
5335                set ret [rowofcommit $kid]
5336            }
5337        }
5338    }
5339    return $ret
5340}
5341
5342proc make_idlist {row} {
5343    global displayorder parentlist uparrowlen downarrowlen mingaplen
5344    global commitidx curview children
5345
5346    set r [expr {$row - $mingaplen - $downarrowlen - 1}]
5347    if {$r < 0} {
5348        set r 0
5349    }
5350    set ra [expr {$row - $downarrowlen}]
5351    if {$ra < 0} {
5352        set ra 0
5353    }
5354    set rb [expr {$row + $uparrowlen}]
5355    if {$rb > $commitidx($curview)} {
5356        set rb $commitidx($curview)
5357    }
5358    make_disporder $r [expr {$rb + 1}]
5359    set ids {}
5360    for {} {$r < $ra} {incr r} {
5361        set nextid [lindex $displayorder [expr {$r + 1}]]
5362        foreach p [lindex $parentlist $r] {
5363            if {$p eq $nextid} continue
5364            set rn [nextuse $p $r]
5365            if {$rn >= $row &&
5366                $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
5367                lappend ids [list [ordertoken $p] $p]
5368            }
5369        }
5370    }
5371    for {} {$r < $row} {incr r} {
5372        set nextid [lindex $displayorder [expr {$r + 1}]]
5373        foreach p [lindex $parentlist $r] {
5374            if {$p eq $nextid} continue
5375            set rn [nextuse $p $r]
5376            if {$rn < 0 || $rn >= $row} {
5377                lappend ids [list [ordertoken $p] $p]
5378            }
5379        }
5380    }
5381    set id [lindex $displayorder $row]
5382    lappend ids [list [ordertoken $id] $id]
5383    while {$r < $rb} {
5384        foreach p [lindex $parentlist $r] {
5385            set firstkid [lindex $children($curview,$p) 0]
5386            if {[rowofcommit $firstkid] < $row} {
5387                lappend ids [list [ordertoken $p] $p]
5388            }
5389        }
5390        incr r
5391        set id [lindex $displayorder $r]
5392        if {$id ne {}} {
5393            set firstkid [lindex $children($curview,$id) 0]
5394            if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
5395                lappend ids [list [ordertoken $id] $id]
5396            }
5397        }
5398    }
5399    set idlist {}
5400    foreach idx [lsort -unique $ids] {
5401        lappend idlist [lindex $idx 1]
5402    }
5403    return $idlist
5404}
5405
5406proc rowsequal {a b} {
5407    while {[set i [lsearch -exact $a {}]] >= 0} {
5408        set a [lreplace $a $i $i]
5409    }
5410    while {[set i [lsearch -exact $b {}]] >= 0} {
5411        set b [lreplace $b $i $i]
5412    }
5413    return [expr {$a eq $b}]
5414}
5415
5416proc makeupline {id row rend col} {
5417    global rowidlist uparrowlen downarrowlen mingaplen
5418
5419    for {set r $rend} {1} {set r $rstart} {
5420        set rstart [prevuse $id $r]
5421        if {$rstart < 0} return
5422        if {$rstart < $row} break
5423    }
5424    if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5425        set rstart [expr {$rend - $uparrowlen - 1}]
5426    }
5427    for {set r $rstart} {[incr r] <= $row} {} {
5428        set idlist [lindex $rowidlist $r]
5429        if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5430            set col [idcol $idlist $id $col]
5431            lset rowidlist $r [linsert $idlist $col $id]
5432            changedrow $r
5433        }
5434    }
5435}
5436
5437proc layoutrows {row endrow} {
5438    global rowidlist rowisopt rowfinal displayorder
5439    global uparrowlen downarrowlen maxwidth mingaplen
5440    global children parentlist
5441    global commitidx viewcomplete curview
5442
5443    make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
5444    set idlist {}
5445    if {$row > 0} {
5446        set rm1 [expr {$row - 1}]
5447        foreach id [lindex $rowidlist $rm1] {
5448            if {$id ne {}} {
5449                lappend idlist $id
5450            }
5451        }
5452        set final [lindex $rowfinal $rm1]
5453    }
5454    for {} {$row < $endrow} {incr row} {
5455        set rm1 [expr {$row - 1}]
5456        if {$rm1 < 0 || $idlist eq {}} {
5457            set idlist [make_idlist $row]
5458            set final 1
5459        } else {
5460            set id [lindex $displayorder $rm1]
5461            set col [lsearch -exact $idlist $id]
5462            set idlist [lreplace $idlist $col $col]
5463            foreach p [lindex $parentlist $rm1] {
5464                if {[lsearch -exact $idlist $p] < 0} {
5465                    set col [idcol $idlist $p $col]
5466                    set idlist [linsert $idlist $col $p]
5467                    # if not the first child, we have to insert a line going up
5468                    if {$id ne [lindex $children($curview,$p) 0]} {
5469                        makeupline $p $rm1 $row $col
5470                    }
5471                }
5472            }
5473            set id [lindex $displayorder $row]
5474            if {$row > $downarrowlen} {
5475                set termrow [expr {$row - $downarrowlen - 1}]
5476                foreach p [lindex $parentlist $termrow] {
5477                    set i [lsearch -exact $idlist $p]
5478                    if {$i < 0} continue
5479                    set nr [nextuse $p $termrow]
5480                    if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5481                        set idlist [lreplace $idlist $i $i]
5482                    }
5483                }
5484            }
5485            set col [lsearch -exact $idlist $id]
5486            if {$col < 0} {
5487                set col [idcol $idlist $id]
5488                set idlist [linsert $idlist $col $id]
5489                if {$children($curview,$id) ne {}} {
5490                    makeupline $id $rm1 $row $col
5491                }
5492            }
5493            set r [expr {$row + $uparrowlen - 1}]
5494            if {$r < $commitidx($curview)} {
5495                set x $col
5496                foreach p [lindex $parentlist $r] {
5497                    if {[lsearch -exact $idlist $p] >= 0} continue
5498                    set fk [lindex $children($curview,$p) 0]
5499                    if {[rowofcommit $fk] < $row} {
5500                        set x [idcol $idlist $p $x]
5501                        set idlist [linsert $idlist $x $p]
5502                    }
5503                }
5504                if {[incr r] < $commitidx($curview)} {
5505                    set p [lindex $displayorder $r]
5506                    if {[lsearch -exact $idlist $p] < 0} {
5507                        set fk [lindex $children($curview,$p) 0]
5508                        if {$fk ne {} && [rowofcommit $fk] < $row} {
5509                            set x [idcol $idlist $p $x]
5510                            set idlist [linsert $idlist $x $p]
5511                        }
5512                    }
5513                }
5514            }
5515        }
5516        if {$final && !$viewcomplete($curview) &&
5517            $row + $uparrowlen + $mingaplen + $downarrowlen
5518                >= $commitidx($curview)} {
5519            set final 0
5520        }
5521        set l [llength $rowidlist]
5522        if {$row == $l} {
5523            lappend rowidlist $idlist
5524            lappend rowisopt 0
5525            lappend rowfinal $final
5526        } elseif {$row < $l} {
5527            if {![rowsequal $idlist [lindex $rowidlist $row]]} {
5528                lset rowidlist $row $idlist
5529                changedrow $row
5530            }
5531            lset rowfinal $row $final
5532        } else {
5533            set pad [ntimes [expr {$row - $l}] {}]
5534            set rowidlist [concat $rowidlist $pad]
5535            lappend rowidlist $idlist
5536            set rowfinal [concat $rowfinal $pad]
5537            lappend rowfinal $final
5538            set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5539        }
5540    }
5541    return $row
5542}
5543
5544proc changedrow {row} {
5545    global displayorder iddrawn rowisopt need_redisplay
5546
5547    set l [llength $rowisopt]
5548    if {$row < $l} {
5549        lset rowisopt $row 0
5550        if {$row + 1 < $l} {
5551            lset rowisopt [expr {$row + 1}] 0
5552            if {$row + 2 < $l} {
5553                lset rowisopt [expr {$row + 2}] 0
5554            }
5555        }
5556    }
5557    set id [lindex $displayorder $row]
5558    if {[info exists iddrawn($id)]} {
5559        set need_redisplay 1
5560    }
5561}
5562
5563proc insert_pad {row col npad} {
5564    global rowidlist
5565
5566    set pad [ntimes $npad {}]
5567    set idlist [lindex $rowidlist $row]
5568    set bef [lrange $idlist 0 [expr {$col - 1}]]
5569    set aft [lrange $idlist $col end]
5570    set i [lsearch -exact $aft {}]
5571    if {$i > 0} {
5572        set aft [lreplace $aft $i $i]
5573    }
5574    lset rowidlist $row [concat $bef $pad $aft]
5575    changedrow $row
5576}
5577
5578proc optimize_rows {row col endrow} {
5579    global rowidlist rowisopt displayorder curview children
5580
5581    if {$row < 1} {
5582        set row 1
5583    }
5584    for {} {$row < $endrow} {incr row; set col 0} {
5585        if {[lindex $rowisopt $row]} continue
5586        set haspad 0
5587        set y0 [expr {$row - 1}]
5588        set ym [expr {$row - 2}]
5589        set idlist [lindex $rowidlist $row]
5590        set previdlist [lindex $rowidlist $y0]
5591        if {$idlist eq {} || $previdlist eq {}} continue
5592        if {$ym >= 0} {
5593            set pprevidlist [lindex $rowidlist $ym]
5594            if {$pprevidlist eq {}} continue
5595        } else {
5596            set pprevidlist {}
5597        }
5598        set x0 -1
5599        set xm -1
5600        for {} {$col < [llength $idlist]} {incr col} {
5601            set id [lindex $idlist $col]
5602            if {[lindex $previdlist $col] eq $id} continue
5603            if {$id eq {}} {
5604                set haspad 1
5605                continue
5606            }
5607            set x0 [lsearch -exact $previdlist $id]
5608            if {$x0 < 0} continue
5609            set z [expr {$x0 - $col}]
5610            set isarrow 0
5611            set z0 {}
5612            if {$ym >= 0} {
5613                set xm [lsearch -exact $pprevidlist $id]
5614                if {$xm >= 0} {
5615                    set z0 [expr {$xm - $x0}]
5616                }
5617            }
5618            if {$z0 eq {}} {
5619                # if row y0 is the first child of $id then it's not an arrow
5620                if {[lindex $children($curview,$id) 0] ne
5621                    [lindex $displayorder $y0]} {
5622                    set isarrow 1
5623                }
5624            }
5625            if {!$isarrow && $id ne [lindex $displayorder $row] &&
5626                [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5627                set isarrow 1
5628            }
5629            # Looking at lines from this row to the previous row,
5630            # make them go straight up if they end in an arrow on
5631            # the previous row; otherwise make them go straight up
5632            # or at 45 degrees.
5633            if {$z < -1 || ($z < 0 && $isarrow)} {
5634                # Line currently goes left too much;
5635                # insert pads in the previous row, then optimize it
5636                set npad [expr {-1 - $z + $isarrow}]
5637                insert_pad $y0 $x0 $npad
5638                if {$y0 > 0} {
5639                    optimize_rows $y0 $x0 $row
5640                }
5641                set previdlist [lindex $rowidlist $y0]
5642                set x0 [lsearch -exact $previdlist $id]
5643                set z [expr {$x0 - $col}]
5644                if {$z0 ne {}} {
5645                    set pprevidlist [lindex $rowidlist $ym]
5646                    set xm [lsearch -exact $pprevidlist $id]
5647                    set z0 [expr {$xm - $x0}]
5648                }
5649            } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5650                # Line currently goes right too much;
5651                # insert pads in this line
5652                set npad [expr {$z - 1 + $isarrow}]
5653                insert_pad $row $col $npad
5654                set idlist [lindex $rowidlist $row]
5655                incr col $npad
5656                set z [expr {$x0 - $col}]
5657                set haspad 1
5658            }
5659            if {$z0 eq {} && !$isarrow && $ym >= 0} {
5660                # this line links to its first child on row $row-2
5661                set id [lindex $displayorder $ym]
5662                set xc [lsearch -exact $pprevidlist $id]
5663                if {$xc >= 0} {
5664                    set z0 [expr {$xc - $x0}]
5665                }
5666            }
5667            # avoid lines jigging left then immediately right
5668            if {$z0 ne {} && $z < 0 && $z0 > 0} {
5669                insert_pad $y0 $x0 1
5670                incr x0
5671                optimize_rows $y0 $x0 $row
5672                set previdlist [lindex $rowidlist $y0]
5673            }
5674        }
5675        if {!$haspad} {
5676            # Find the first column that doesn't have a line going right
5677            for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5678                set id [lindex $idlist $col]
5679                if {$id eq {}} break
5680                set x0 [lsearch -exact $previdlist $id]
5681                if {$x0 < 0} {
5682                    # check if this is the link to the first child
5683                    set kid [lindex $displayorder $y0]
5684                    if {[lindex $children($curview,$id) 0] eq $kid} {
5685                        # it is, work out offset to child
5686                        set x0 [lsearch -exact $previdlist $kid]
5687                    }
5688                }
5689                if {$x0 <= $col} break
5690            }
5691            # Insert a pad at that column as long as it has a line and
5692            # isn't the last column
5693            if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5694                set idlist [linsert $idlist $col {}]
5695                lset rowidlist $row $idlist
5696                changedrow $row
5697            }
5698        }
5699    }
5700}
5701
5702proc xc {row col} {
5703    global canvx0 linespc
5704    return [expr {$canvx0 + $col * $linespc}]
5705}
5706
5707proc yc {row} {
5708    global canvy0 linespc
5709    return [expr {$canvy0 + $row * $linespc}]
5710}
5711
5712proc linewidth {id} {
5713    global thickerline lthickness
5714
5715    set wid $lthickness
5716    if {[info exists thickerline] && $id eq $thickerline} {
5717        set wid [expr {2 * $lthickness}]
5718    }
5719    return $wid
5720}
5721
5722proc rowranges {id} {
5723    global curview children uparrowlen downarrowlen
5724    global rowidlist
5725
5726    set kids $children($curview,$id)
5727    if {$kids eq {}} {
5728        return {}
5729    }
5730    set ret {}
5731    lappend kids $id
5732    foreach child $kids {
5733        if {![commitinview $child $curview]} break
5734        set row [rowofcommit $child]
5735        if {![info exists prev]} {
5736            lappend ret [expr {$row + 1}]
5737        } else {
5738            if {$row <= $prevrow} {
5739                puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5740            }
5741            # see if the line extends the whole way from prevrow to row
5742            if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5743                [lsearch -exact [lindex $rowidlist \
5744                            [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5745                # it doesn't, see where it ends
5746                set r [expr {$prevrow + $downarrowlen}]
5747                if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5748                    while {[incr r -1] > $prevrow &&
5749                           [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5750                } else {
5751                    while {[incr r] <= $row &&
5752                           [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5753                    incr r -1
5754                }
5755                lappend ret $r
5756                # see where it starts up again
5757                set r [expr {$row - $uparrowlen}]
5758                if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5759                    while {[incr r] < $row &&
5760                           [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5761                } else {
5762                    while {[incr r -1] >= $prevrow &&
5763                           [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5764                    incr r
5765                }
5766                lappend ret $r
5767            }
5768        }
5769        if {$child eq $id} {
5770            lappend ret $row
5771        }
5772        set prev $child
5773        set prevrow $row
5774    }
5775    return $ret
5776}
5777
5778proc drawlineseg {id row endrow arrowlow} {
5779    global rowidlist displayorder iddrawn linesegs
5780    global canv colormap linespc curview maxlinelen parentlist
5781
5782    set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5783    set le [expr {$row + 1}]
5784    set arrowhigh 1
5785    while {1} {
5786        set c [lsearch -exact [lindex $rowidlist $le] $id]
5787        if {$c < 0} {
5788            incr le -1
5789            break
5790        }
5791        lappend cols $c
5792        set x [lindex $displayorder $le]
5793        if {$x eq $id} {
5794            set arrowhigh 0
5795            break
5796        }
5797        if {[info exists iddrawn($x)] || $le == $endrow} {
5798            set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5799            if {$c >= 0} {
5800                lappend cols $c
5801                set arrowhigh 0
5802            }
5803            break
5804        }
5805        incr le
5806    }
5807    if {$le <= $row} {
5808        return $row
5809    }
5810
5811    set lines {}
5812    set i 0
5813    set joinhigh 0
5814    if {[info exists linesegs($id)]} {
5815        set lines $linesegs($id)
5816        foreach li $lines {
5817            set r0 [lindex $li 0]
5818            if {$r0 > $row} {
5819                if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5820                    set joinhigh 1
5821                }
5822                break
5823            }
5824            incr i
5825        }
5826    }
5827    set joinlow 0
5828    if {$i > 0} {
5829        set li [lindex $lines [expr {$i-1}]]
5830        set r1 [lindex $li 1]
5831        if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5832            set joinlow 1
5833        }
5834    }
5835
5836    set x [lindex $cols [expr {$le - $row}]]
5837    set xp [lindex $cols [expr {$le - 1 - $row}]]
5838    set dir [expr {$xp - $x}]
5839    if {$joinhigh} {
5840        set ith [lindex $lines $i 2]
5841        set coords [$canv coords $ith]
5842        set ah [$canv itemcget $ith -arrow]
5843        set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5844        set x2 [lindex $cols [expr {$le + 1 - $row}]]
5845        if {$x2 ne {} && $x - $x2 == $dir} {
5846            set coords [lrange $coords 0 end-2]
5847        }
5848    } else {
5849        set coords [list [xc $le $x] [yc $le]]
5850    }
5851    if {$joinlow} {
5852        set itl [lindex $lines [expr {$i-1}] 2]
5853        set al [$canv itemcget $itl -arrow]
5854        set arrowlow [expr {$al eq "last" || $al eq "both"}]
5855    } elseif {$arrowlow} {
5856        if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5857            [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5858            set arrowlow 0
5859        }
5860    }
5861    set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5862    for {set y $le} {[incr y -1] > $row} {} {
5863        set x $xp
5864        set xp [lindex $cols [expr {$y - 1 - $row}]]
5865        set ndir [expr {$xp - $x}]
5866        if {$dir != $ndir || $xp < 0} {
5867            lappend coords [xc $y $x] [yc $y]
5868        }
5869        set dir $ndir
5870    }
5871    if {!$joinlow} {
5872        if {$xp < 0} {
5873            # join parent line to first child
5874            set ch [lindex $displayorder $row]
5875            set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5876            if {$xc < 0} {
5877                puts "oops: drawlineseg: child $ch not on row $row"
5878            } elseif {$xc != $x} {
5879                if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5880                    set d [expr {int(0.5 * $linespc)}]
5881                    set x1 [xc $row $x]
5882                    if {$xc < $x} {
5883                        set x2 [expr {$x1 - $d}]
5884                    } else {
5885                        set x2 [expr {$x1 + $d}]
5886                    }
5887                    set y2 [yc $row]
5888                    set y1 [expr {$y2 + $d}]
5889                    lappend coords $x1 $y1 $x2 $y2
5890                } elseif {$xc < $x - 1} {
5891                    lappend coords [xc $row [expr {$x-1}]] [yc $row]
5892                } elseif {$xc > $x + 1} {
5893                    lappend coords [xc $row [expr {$x+1}]] [yc $row]
5894                }
5895                set x $xc
5896            }
5897            lappend coords [xc $row $x] [yc $row]
5898        } else {
5899            set xn [xc $row $xp]
5900            set yn [yc $row]
5901            lappend coords $xn $yn
5902        }
5903        if {!$joinhigh} {
5904            assigncolor $id
5905            set t [$canv create line $coords -width [linewidth $id] \
5906                       -fill $colormap($id) -tags lines.$id -arrow $arrow]
5907            $canv lower $t
5908            bindline $t $id
5909            set lines [linsert $lines $i [list $row $le $t]]
5910        } else {
5911            $canv coords $ith $coords
5912            if {$arrow ne $ah} {
5913                $canv itemconf $ith -arrow $arrow
5914            }
5915            lset lines $i 0 $row
5916        }
5917    } else {
5918        set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
5919        set ndir [expr {$xo - $xp}]
5920        set clow [$canv coords $itl]
5921        if {$dir == $ndir} {
5922            set clow [lrange $clow 2 end]
5923        }
5924        set coords [concat $coords $clow]
5925        if {!$joinhigh} {
5926            lset lines [expr {$i-1}] 1 $le
5927        } else {
5928            # coalesce two pieces
5929            $canv delete $ith
5930            set b [lindex $lines [expr {$i-1}] 0]
5931            set e [lindex $lines $i 1]
5932            set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
5933        }
5934        $canv coords $itl $coords
5935        if {$arrow ne $al} {
5936            $canv itemconf $itl -arrow $arrow
5937        }
5938    }
5939
5940    set linesegs($id) $lines
5941    return $le
5942}
5943
5944proc drawparentlinks {id row} {
5945    global rowidlist canv colormap curview parentlist
5946    global idpos linespc
5947
5948    set rowids [lindex $rowidlist $row]
5949    set col [lsearch -exact $rowids $id]
5950    if {$col < 0} return
5951    set olds [lindex $parentlist $row]
5952    set row2 [expr {$row + 1}]
5953    set x [xc $row $col]
5954    set y [yc $row]
5955    set y2 [yc $row2]
5956    set d [expr {int(0.5 * $linespc)}]
5957    set ymid [expr {$y + $d}]
5958    set ids [lindex $rowidlist $row2]
5959    # rmx = right-most X coord used
5960    set rmx 0
5961    foreach p $olds {
5962        set i [lsearch -exact $ids $p]
5963        if {$i < 0} {
5964            puts "oops, parent $p of $id not in list"
5965            continue
5966        }
5967        set x2 [xc $row2 $i]
5968        if {$x2 > $rmx} {
5969            set rmx $x2
5970        }
5971        set j [lsearch -exact $rowids $p]
5972        if {$j < 0} {
5973            # drawlineseg will do this one for us
5974            continue
5975        }
5976        assigncolor $p
5977        # should handle duplicated parents here...
5978        set coords [list $x $y]
5979        if {$i != $col} {
5980            # if attaching to a vertical segment, draw a smaller
5981            # slant for visual distinctness
5982            if {$i == $j} {
5983                if {$i < $col} {
5984                    lappend coords [expr {$x2 + $d}] $y $x2 $ymid
5985                } else {
5986                    lappend coords [expr {$x2 - $d}] $y $x2 $ymid
5987                }
5988            } elseif {$i < $col && $i < $j} {
5989                # segment slants towards us already
5990                lappend coords [xc $row $j] $y
5991            } else {
5992                if {$i < $col - 1} {
5993                    lappend coords [expr {$x2 + $linespc}] $y
5994                } elseif {$i > $col + 1} {
5995                    lappend coords [expr {$x2 - $linespc}] $y
5996                }
5997                lappend coords $x2 $y2
5998            }
5999        } else {
6000            lappend coords $x2 $y2
6001        }
6002        set t [$canv create line $coords -width [linewidth $p] \
6003                   -fill $colormap($p) -tags lines.$p]
6004        $canv lower $t
6005        bindline $t $p
6006    }
6007    if {$rmx > [lindex $idpos($id) 1]} {
6008        lset idpos($id) 1 $rmx
6009        redrawtags $id
6010    }
6011}
6012
6013proc drawlines {id} {
6014    global canv
6015
6016    $canv itemconf lines.$id -width [linewidth $id]
6017}
6018
6019proc drawcmittext {id row col} {
6020    global linespc canv canv2 canv3 fgcolor curview
6021    global cmitlisted commitinfo rowidlist parentlist
6022    global rowtextx idpos idtags idheads idotherrefs
6023    global linehtag linentag linedtag selectedline
6024    global canvxmax boldids boldnameids fgcolor markedid
6025    global mainheadid nullid nullid2 circleitem circlecolors ctxbut
6026    global mainheadcirclecolor workingfilescirclecolor indexcirclecolor
6027    global circleoutlinecolor
6028
6029    # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
6030    set listed $cmitlisted($curview,$id)
6031    if {$id eq $nullid} {
6032        set ofill $workingfilescirclecolor
6033    } elseif {$id eq $nullid2} {
6034        set ofill $indexcirclecolor
6035    } elseif {$id eq $mainheadid} {
6036        set ofill $mainheadcirclecolor
6037    } else {
6038        set ofill [lindex $circlecolors $listed]
6039    }
6040    set x [xc $row $col]
6041    set y [yc $row]
6042    set orad [expr {$linespc / 3}]
6043    if {$listed <= 2} {
6044        set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
6045                   [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6046                   -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6047    } elseif {$listed == 3} {
6048        # triangle pointing left for left-side commits
6049        set t [$canv create polygon \
6050                   [expr {$x - $orad}] $y \
6051                   [expr {$x + $orad - 1}] [expr {$y - $orad}] \
6052                   [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6053                   -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6054    } else {
6055        # triangle pointing right for right-side commits
6056        set t [$canv create polygon \
6057                   [expr {$x + $orad - 1}] $y \
6058                   [expr {$x - $orad}] [expr {$y - $orad}] \
6059                   [expr {$x - $orad}] [expr {$y + $orad - 1}] \
6060                   -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6061    }
6062    set circleitem($row) $t
6063    $canv raise $t
6064    $canv bind $t <1> {selcanvline {} %x %y}
6065    set rmx [llength [lindex $rowidlist $row]]
6066    set olds [lindex $parentlist $row]
6067    if {$olds ne {}} {
6068        set nextids [lindex $rowidlist [expr {$row + 1}]]
6069        foreach p $olds {
6070            set i [lsearch -exact $nextids $p]
6071            if {$i > $rmx} {
6072                set rmx $i
6073            }
6074        }
6075    }
6076    set xt [xc $row $rmx]
6077    set rowtextx($row) $xt
6078    set idpos($id) [list $x $xt $y]
6079    if {[info exists idtags($id)] || [info exists idheads($id)]
6080        || [info exists idotherrefs($id)]} {
6081        set xt [drawtags $id $x $xt $y]
6082    }
6083    if {[lindex $commitinfo($id) 6] > 0} {
6084        set xt [drawnotesign $xt $y]
6085    }
6086    set headline [lindex $commitinfo($id) 0]
6087    set name [lindex $commitinfo($id) 1]
6088    set date [lindex $commitinfo($id) 2]
6089    set date [formatdate $date]
6090    set font mainfont
6091    set nfont mainfont
6092    set isbold [ishighlighted $id]
6093    if {$isbold > 0} {
6094        lappend boldids $id
6095        set font mainfontbold
6096        if {$isbold > 1} {
6097            lappend boldnameids $id
6098            set nfont mainfontbold
6099        }
6100    }
6101    set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
6102                           -text $headline -font $font -tags text]
6103    $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
6104    set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
6105                           -text $name -font $nfont -tags text]
6106    set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
6107                           -text $date -font mainfont -tags text]
6108    if {$selectedline == $row} {
6109        make_secsel $id
6110    }
6111    if {[info exists markedid] && $markedid eq $id} {
6112        make_idmark $id
6113    }
6114    set xr [expr {$xt + [font measure $font $headline]}]
6115    if {$xr > $canvxmax} {
6116        set canvxmax $xr
6117        setcanvscroll
6118    }
6119}
6120
6121proc drawcmitrow {row} {
6122    global displayorder rowidlist nrows_drawn
6123    global iddrawn markingmatches
6124    global commitinfo numcommits
6125    global filehighlight fhighlights findpattern nhighlights
6126    global hlview vhighlights
6127    global highlight_related rhighlights
6128
6129    if {$row >= $numcommits} return
6130
6131    set id [lindex $displayorder $row]
6132    if {[info exists hlview] && ![info exists vhighlights($id)]} {
6133        askvhighlight $row $id
6134    }
6135    if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
6136        askfilehighlight $row $id
6137    }
6138    if {$findpattern ne {} && ![info exists nhighlights($id)]} {
6139        askfindhighlight $row $id
6140    }
6141    if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
6142        askrelhighlight $row $id
6143    }
6144    if {![info exists iddrawn($id)]} {
6145        set col [lsearch -exact [lindex $rowidlist $row] $id]
6146        if {$col < 0} {
6147            puts "oops, row $row id $id not in list"
6148            return
6149        }
6150        if {![info exists commitinfo($id)]} {
6151            getcommit $id
6152        }
6153        assigncolor $id
6154        drawcmittext $id $row $col
6155        set iddrawn($id) 1
6156        incr nrows_drawn
6157    }
6158    if {$markingmatches} {
6159        markrowmatches $row $id
6160    }
6161}
6162
6163proc drawcommits {row {endrow {}}} {
6164    global numcommits iddrawn displayorder curview need_redisplay
6165    global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
6166
6167    if {$row < 0} {
6168        set row 0
6169    }
6170    if {$endrow eq {}} {
6171        set endrow $row
6172    }
6173    if {$endrow >= $numcommits} {
6174        set endrow [expr {$numcommits - 1}]
6175    }
6176
6177    set rl1 [expr {$row - $downarrowlen - 3}]
6178    if {$rl1 < 0} {
6179        set rl1 0
6180    }
6181    set ro1 [expr {$row - 3}]
6182    if {$ro1 < 0} {
6183        set ro1 0
6184    }
6185    set r2 [expr {$endrow + $uparrowlen + 3}]
6186    if {$r2 > $numcommits} {
6187        set r2 $numcommits
6188    }
6189    for {set r $rl1} {$r < $r2} {incr r} {
6190        if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
6191            if {$rl1 < $r} {
6192                layoutrows $rl1 $r
6193            }
6194            set rl1 [expr {$r + 1}]
6195        }
6196    }
6197    if {$rl1 < $r} {
6198        layoutrows $rl1 $r
6199    }
6200    optimize_rows $ro1 0 $r2
6201    if {$need_redisplay || $nrows_drawn > 2000} {
6202        clear_display
6203    }
6204
6205    # make the lines join to already-drawn rows either side
6206    set r [expr {$row - 1}]
6207    if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
6208        set r $row
6209    }
6210    set er [expr {$endrow + 1}]
6211    if {$er >= $numcommits ||
6212        ![info exists iddrawn([lindex $displayorder $er])]} {
6213        set er $endrow
6214    }
6215    for {} {$r <= $er} {incr r} {
6216        set id [lindex $displayorder $r]
6217        set wasdrawn [info exists iddrawn($id)]
6218        drawcmitrow $r
6219        if {$r == $er} break
6220        set nextid [lindex $displayorder [expr {$r + 1}]]
6221        if {$wasdrawn && [info exists iddrawn($nextid)]} continue
6222        drawparentlinks $id $r
6223
6224        set rowids [lindex $rowidlist $r]
6225        foreach lid $rowids {
6226            if {$lid eq {}} continue
6227            if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
6228            if {$lid eq $id} {
6229                # see if this is the first child of any of its parents
6230                foreach p [lindex $parentlist $r] {
6231                    if {[lsearch -exact $rowids $p] < 0} {
6232                        # make this line extend up to the child
6233                        set lineend($p) [drawlineseg $p $r $er 0]
6234                    }
6235                }
6236            } else {
6237                set lineend($lid) [drawlineseg $lid $r $er 1]
6238            }
6239        }
6240    }
6241}
6242
6243proc undolayout {row} {
6244    global uparrowlen mingaplen downarrowlen
6245    global rowidlist rowisopt rowfinal need_redisplay
6246
6247    set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
6248    if {$r < 0} {
6249        set r 0
6250    }
6251    if {[llength $rowidlist] > $r} {
6252        incr r -1
6253        set rowidlist [lrange $rowidlist 0 $r]
6254        set rowfinal [lrange $rowfinal 0 $r]
6255        set rowisopt [lrange $rowisopt 0 $r]
6256        set need_redisplay 1
6257        run drawvisible
6258    }
6259}
6260
6261proc drawvisible {} {
6262    global canv linespc curview vrowmod selectedline targetrow targetid
6263    global need_redisplay cscroll numcommits
6264
6265    set fs [$canv yview]
6266    set ymax [lindex [$canv cget -scrollregion] 3]
6267    if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
6268    set f0 [lindex $fs 0]
6269    set f1 [lindex $fs 1]
6270    set y0 [expr {int($f0 * $ymax)}]
6271    set y1 [expr {int($f1 * $ymax)}]
6272
6273    if {[info exists targetid]} {
6274        if {[commitinview $targetid $curview]} {
6275            set r [rowofcommit $targetid]
6276            if {$r != $targetrow} {
6277                # Fix up the scrollregion and change the scrolling position
6278                # now that our target row has moved.
6279                set diff [expr {($r - $targetrow) * $linespc}]
6280                set targetrow $r
6281                setcanvscroll
6282                set ymax [lindex [$canv cget -scrollregion] 3]
6283                incr y0 $diff
6284                incr y1 $diff
6285                set f0 [expr {$y0 / $ymax}]
6286                set f1 [expr {$y1 / $ymax}]
6287                allcanvs yview moveto $f0
6288                $cscroll set $f0 $f1
6289                set need_redisplay 1
6290            }
6291        } else {
6292            unset targetid
6293        }
6294    }
6295
6296    set row [expr {int(($y0 - 3) / $linespc) - 1}]
6297    set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
6298    if {$endrow >= $vrowmod($curview)} {
6299        update_arcrows $curview
6300    }
6301    if {$selectedline ne {} &&
6302        $row <= $selectedline && $selectedline <= $endrow} {
6303        set targetrow $selectedline
6304    } elseif {[info exists targetid]} {
6305        set targetrow [expr {int(($row + $endrow) / 2)}]
6306    }
6307    if {[info exists targetrow]} {
6308        if {$targetrow >= $numcommits} {
6309            set targetrow [expr {$numcommits - 1}]
6310        }
6311        set targetid [commitonrow $targetrow]
6312    }
6313    drawcommits $row $endrow
6314}
6315
6316proc clear_display {} {
6317    global iddrawn linesegs need_redisplay nrows_drawn
6318    global vhighlights fhighlights nhighlights rhighlights
6319    global linehtag linentag linedtag boldids boldnameids
6320
6321    allcanvs delete all
6322    catch {unset iddrawn}
6323    catch {unset linesegs}
6324    catch {unset linehtag}
6325    catch {unset linentag}
6326    catch {unset linedtag}
6327    set boldids {}
6328    set boldnameids {}
6329    catch {unset vhighlights}
6330    catch {unset fhighlights}
6331    catch {unset nhighlights}
6332    catch {unset rhighlights}
6333    set need_redisplay 0
6334    set nrows_drawn 0
6335}
6336
6337proc findcrossings {id} {
6338    global rowidlist parentlist numcommits displayorder
6339
6340    set cross {}
6341    set ccross {}
6342    foreach {s e} [rowranges $id] {
6343        if {$e >= $numcommits} {
6344            set e [expr {$numcommits - 1}]
6345        }
6346        if {$e <= $s} continue
6347        for {set row $e} {[incr row -1] >= $s} {} {
6348            set x [lsearch -exact [lindex $rowidlist $row] $id]
6349            if {$x < 0} break
6350            set olds [lindex $parentlist $row]
6351            set kid [lindex $displayorder $row]
6352            set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
6353            if {$kidx < 0} continue
6354            set nextrow [lindex $rowidlist [expr {$row + 1}]]
6355            foreach p $olds {
6356                set px [lsearch -exact $nextrow $p]
6357                if {$px < 0} continue
6358                if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
6359                    if {[lsearch -exact $ccross $p] >= 0} continue
6360                    if {$x == $px + ($kidx < $px? -1: 1)} {
6361                        lappend ccross $p
6362                    } elseif {[lsearch -exact $cross $p] < 0} {
6363                        lappend cross $p
6364                    }
6365                }
6366            }
6367        }
6368    }
6369    return [concat $ccross {{}} $cross]
6370}
6371
6372proc assigncolor {id} {
6373    global colormap colors nextcolor
6374    global parents children children curview
6375
6376    if {[info exists colormap($id)]} return
6377    set ncolors [llength $colors]
6378    if {[info exists children($curview,$id)]} {
6379        set kids $children($curview,$id)
6380    } else {
6381        set kids {}
6382    }
6383    if {[llength $kids] == 1} {
6384        set child [lindex $kids 0]
6385        if {[info exists colormap($child)]
6386            && [llength $parents($curview,$child)] == 1} {
6387            set colormap($id) $colormap($child)
6388            return
6389        }
6390    }
6391    set badcolors {}
6392    set origbad {}
6393    foreach x [findcrossings $id] {
6394        if {$x eq {}} {
6395            # delimiter between corner crossings and other crossings
6396            if {[llength $badcolors] >= $ncolors - 1} break
6397            set origbad $badcolors
6398        }
6399        if {[info exists colormap($x)]
6400            && [lsearch -exact $badcolors $colormap($x)] < 0} {
6401            lappend badcolors $colormap($x)
6402        }
6403    }
6404    if {[llength $badcolors] >= $ncolors} {
6405        set badcolors $origbad
6406    }
6407    set origbad $badcolors
6408    if {[llength $badcolors] < $ncolors - 1} {
6409        foreach child $kids {
6410            if {[info exists colormap($child)]
6411                && [lsearch -exact $badcolors $colormap($child)] < 0} {
6412                lappend badcolors $colormap($child)
6413            }
6414            foreach p $parents($curview,$child) {
6415                if {[info exists colormap($p)]
6416                    && [lsearch -exact $badcolors $colormap($p)] < 0} {
6417                    lappend badcolors $colormap($p)
6418                }
6419            }
6420        }
6421        if {[llength $badcolors] >= $ncolors} {
6422            set badcolors $origbad
6423        }
6424    }
6425    for {set i 0} {$i <= $ncolors} {incr i} {
6426        set c [lindex $colors $nextcolor]
6427        if {[incr nextcolor] >= $ncolors} {
6428            set nextcolor 0
6429        }
6430        if {[lsearch -exact $badcolors $c]} break
6431    }
6432    set colormap($id) $c
6433}
6434
6435proc bindline {t id} {
6436    global canv
6437
6438    $canv bind $t <Enter> "lineenter %x %y $id"
6439    $canv bind $t <Motion> "linemotion %x %y $id"
6440    $canv bind $t <Leave> "lineleave $id"
6441    $canv bind $t <Button-1> "lineclick %x %y $id 1"
6442}
6443
6444proc graph_pane_width {} {
6445    global use_ttk
6446
6447    if {$use_ttk} {
6448        set g [.tf.histframe.pwclist sashpos 0]
6449    } else {
6450        set g [.tf.histframe.pwclist sash coord 0]
6451    }
6452    return [lindex $g 0]
6453}
6454
6455proc totalwidth {l font extra} {
6456    set tot 0
6457    foreach str $l {
6458        set tot [expr {$tot + [font measure $font $str] + $extra}]
6459    }
6460    return $tot
6461}
6462
6463proc drawtags {id x xt y1} {
6464    global idtags idheads idotherrefs mainhead
6465    global linespc lthickness
6466    global canv rowtextx curview fgcolor bgcolor ctxbut
6467    global headbgcolor headfgcolor headoutlinecolor remotebgcolor
6468    global tagbgcolor tagfgcolor tagoutlinecolor
6469    global reflinecolor
6470
6471    set marks {}
6472    set ntags 0
6473    set nheads 0
6474    set singletag 0
6475    set maxtags 3
6476    set maxtagpct 25
6477    set maxwidth [expr {[graph_pane_width] * $maxtagpct / 100}]
6478    set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6479    set extra [expr {$delta + $lthickness + $linespc}]
6480
6481    if {[info exists idtags($id)]} {
6482        set marks $idtags($id)
6483        set ntags [llength $marks]
6484        if {$ntags > $maxtags ||
6485            [totalwidth $marks mainfont $extra] > $maxwidth} {
6486            # show just a single "n tags..." tag
6487            set singletag 1
6488            if {$ntags == 1} {
6489                set marks [list "tag..."]
6490            } else {
6491                set marks [list [format "%d tags..." $ntags]]
6492            }
6493            set ntags 1
6494        }
6495    }
6496    if {[info exists idheads($id)]} {
6497        set marks [concat $marks $idheads($id)]
6498        set nheads [llength $idheads($id)]
6499    }
6500    if {[info exists idotherrefs($id)]} {
6501        set marks [concat $marks $idotherrefs($id)]
6502    }
6503    if {$marks eq {}} {
6504        return $xt
6505    }
6506
6507    set yt [expr {$y1 - 0.5 * $linespc}]
6508    set yb [expr {$yt + $linespc - 1}]
6509    set xvals {}
6510    set wvals {}
6511    set i -1
6512    foreach tag $marks {
6513        incr i
6514        if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
6515            set wid [font measure mainfontbold $tag]
6516        } else {
6517            set wid [font measure mainfont $tag]
6518        }
6519        lappend xvals $xt
6520        lappend wvals $wid
6521        set xt [expr {$xt + $wid + $extra}]
6522    }
6523    set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
6524               -width $lthickness -fill $reflinecolor -tags tag.$id]
6525    $canv lower $t
6526    foreach tag $marks x $xvals wid $wvals {
6527        set tag_quoted [string map {% %%} $tag]
6528        set xl [expr {$x + $delta}]
6529        set xr [expr {$x + $delta + $wid + $lthickness}]
6530        set font mainfont
6531        if {[incr ntags -1] >= 0} {
6532            # draw a tag
6533            set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6534                       $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
6535                       -width 1 -outline $tagoutlinecolor -fill $tagbgcolor \
6536                       -tags tag.$id]
6537            if {$singletag} {
6538                set tagclick [list showtags $id 1]
6539            } else {
6540                set tagclick [list showtag $tag_quoted 1]
6541            }
6542            $canv bind $t <1> $tagclick
6543            set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
6544        } else {
6545            # draw a head or other ref
6546            if {[incr nheads -1] >= 0} {
6547                set col $headbgcolor
6548                if {$tag eq $mainhead} {
6549                    set font mainfontbold
6550                }
6551            } else {
6552                set col "#ddddff"
6553            }
6554            set xl [expr {$xl - $delta/2}]
6555            $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
6556                -width 1 -outline black -fill $col -tags tag.$id
6557            if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
6558                set rwid [font measure mainfont $remoteprefix]
6559                set xi [expr {$x + 1}]
6560                set yti [expr {$yt + 1}]
6561                set xri [expr {$x + $rwid}]
6562                $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6563                        -width 0 -fill $remotebgcolor -tags tag.$id
6564            }
6565        }
6566        set t [$canv create text $xl $y1 -anchor w -text $tag -fill $headfgcolor \
6567                   -font $font -tags [list tag.$id text]]
6568        if {$ntags >= 0} {
6569            $canv bind $t <1> $tagclick
6570        } elseif {$nheads >= 0} {
6571            $canv bind $t $ctxbut [list headmenu %X %Y $id $tag_quoted]
6572        }
6573    }
6574    return $xt
6575}
6576
6577proc drawnotesign {xt y} {
6578    global linespc canv fgcolor
6579
6580    set orad [expr {$linespc / 3}]
6581    set t [$canv create rectangle [expr {$xt - $orad}] [expr {$y - $orad}] \
6582               [expr {$xt + $orad - 1}] [expr {$y + $orad - 1}] \
6583               -fill yellow -outline $fgcolor -width 1 -tags circle]
6584    set xt [expr {$xt + $orad * 3}]
6585    return $xt
6586}
6587
6588proc xcoord {i level ln} {
6589    global canvx0 xspc1 xspc2
6590
6591    set x [expr {$canvx0 + $i * $xspc1($ln)}]
6592    if {$i > 0 && $i == $level} {
6593        set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6594    } elseif {$i > $level} {
6595        set x [expr {$x + $xspc2 - $xspc1($ln)}]
6596    }
6597    return $x
6598}
6599
6600proc show_status {msg} {
6601    global canv fgcolor
6602
6603    clear_display
6604    $canv create text 3 3 -anchor nw -text $msg -font mainfont \
6605        -tags text -fill $fgcolor
6606}
6607
6608# Don't change the text pane cursor if it is currently the hand cursor,
6609# showing that we are over a sha1 ID link.
6610proc settextcursor {c} {
6611    global ctext curtextcursor
6612
6613    if {[$ctext cget -cursor] == $curtextcursor} {
6614        $ctext config -cursor $c
6615    }
6616    set curtextcursor $c
6617}
6618
6619proc nowbusy {what {name {}}} {
6620    global isbusy busyname statusw
6621
6622    if {[array names isbusy] eq {}} {
6623        . config -cursor watch
6624        settextcursor watch
6625    }
6626    set isbusy($what) 1
6627    set busyname($what) $name
6628    if {$name ne {}} {
6629        $statusw conf -text $name
6630    }
6631}
6632
6633proc notbusy {what} {
6634    global isbusy maincursor textcursor busyname statusw
6635
6636    catch {
6637        unset isbusy($what)
6638        if {$busyname($what) ne {} &&
6639            [$statusw cget -text] eq $busyname($what)} {
6640            $statusw conf -text {}
6641        }
6642    }
6643    if {[array names isbusy] eq {}} {
6644        . config -cursor $maincursor
6645        settextcursor $textcursor
6646    }
6647}
6648
6649proc findmatches {f} {
6650    global findtype findstring
6651    if {$findtype == [mc "Regexp"]} {
6652        set matches [regexp -indices -all -inline $findstring $f]
6653    } else {
6654        set fs $findstring
6655        if {$findtype == [mc "IgnCase"]} {
6656            set f [string tolower $f]
6657            set fs [string tolower $fs]
6658        }
6659        set matches {}
6660        set i 0
6661        set l [string length $fs]
6662        while {[set j [string first $fs $f $i]] >= 0} {
6663            lappend matches [list $j [expr {$j+$l-1}]]
6664            set i [expr {$j + $l}]
6665        }
6666    }
6667    return $matches
6668}
6669
6670proc dofind {{dirn 1} {wrap 1}} {
6671    global findstring findstartline findcurline selectedline numcommits
6672    global gdttype filehighlight fh_serial find_dirn findallowwrap
6673
6674    if {[info exists find_dirn]} {
6675        if {$find_dirn == $dirn} return
6676        stopfinding
6677    }
6678    focus .
6679    if {$findstring eq {} || $numcommits == 0} return
6680    if {$selectedline eq {}} {
6681        set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6682    } else {
6683        set findstartline $selectedline
6684    }
6685    set findcurline $findstartline
6686    nowbusy finding [mc "Searching"]
6687    if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6688        after cancel do_file_hl $fh_serial
6689        do_file_hl $fh_serial
6690    }
6691    set find_dirn $dirn
6692    set findallowwrap $wrap
6693    run findmore
6694}
6695
6696proc stopfinding {} {
6697    global find_dirn findcurline fprogcoord
6698
6699    if {[info exists find_dirn]} {
6700        unset find_dirn
6701        unset findcurline
6702        notbusy finding
6703        set fprogcoord 0
6704        adjustprogress
6705    }
6706    stopblaming
6707}
6708
6709proc findmore {} {
6710    global commitdata commitinfo numcommits findpattern findloc
6711    global findstartline findcurline findallowwrap
6712    global find_dirn gdttype fhighlights fprogcoord
6713    global curview varcorder vrownum varccommits vrowmod
6714
6715    if {![info exists find_dirn]} {
6716        return 0
6717    }
6718    set fldtypes [list [mc "Headline"] [mc "Author"] "" [mc "Committer"] "" [mc "Comments"]]
6719    set l $findcurline
6720    set moretodo 0
6721    if {$find_dirn > 0} {
6722        incr l
6723        if {$l >= $numcommits} {
6724            set l 0
6725        }
6726        if {$l <= $findstartline} {
6727            set lim [expr {$findstartline + 1}]
6728        } else {
6729            set lim $numcommits
6730            set moretodo $findallowwrap
6731        }
6732    } else {
6733        if {$l == 0} {
6734            set l $numcommits
6735        }
6736        incr l -1
6737        if {$l >= $findstartline} {
6738            set lim [expr {$findstartline - 1}]
6739        } else {
6740            set lim -1
6741            set moretodo $findallowwrap
6742        }
6743    }
6744    set n [expr {($lim - $l) * $find_dirn}]
6745    if {$n > 500} {
6746        set n 500
6747        set moretodo 1
6748    }
6749    if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6750        update_arcrows $curview
6751    }
6752    set found 0
6753    set domore 1
6754    set ai [bsearch $vrownum($curview) $l]
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    if {$gdttype eq [mc "containing:"]} {
6760        for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6761            if {$l < $arow || $l >= $arowend} {
6762                incr ai $find_dirn
6763                set a [lindex $varcorder($curview) $ai]
6764                set arow [lindex $vrownum($curview) $ai]
6765                set ids [lindex $varccommits($curview,$a)]
6766                set arowend [expr {$arow + [llength $ids]}]
6767            }
6768            set id [lindex $ids [expr {$l - $arow}]]
6769            # shouldn't happen unless git log doesn't give all the commits...
6770            if {![info exists commitdata($id)] ||
6771                ![doesmatch $commitdata($id)]} {
6772                continue
6773            }
6774            if {![info exists commitinfo($id)]} {
6775                getcommit $id
6776            }
6777            set info $commitinfo($id)
6778            foreach f $info ty $fldtypes {
6779                if {$ty eq ""} continue
6780                if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6781                    [doesmatch $f]} {
6782                    set found 1
6783                    break
6784                }
6785            }
6786            if {$found} break
6787        }
6788    } else {
6789        for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6790            if {$l < $arow || $l >= $arowend} {
6791                incr ai $find_dirn
6792                set a [lindex $varcorder($curview) $ai]
6793                set arow [lindex $vrownum($curview) $ai]
6794                set ids [lindex $varccommits($curview,$a)]
6795                set arowend [expr {$arow + [llength $ids]}]
6796            }
6797            set id [lindex $ids [expr {$l - $arow}]]
6798            if {![info exists fhighlights($id)]} {
6799                # this sets fhighlights($id) to -1
6800                askfilehighlight $l $id
6801            }
6802            if {$fhighlights($id) > 0} {
6803                set found $domore
6804                break
6805            }
6806            if {$fhighlights($id) < 0} {
6807                if {$domore} {
6808                    set domore 0
6809                    set findcurline [expr {$l - $find_dirn}]
6810                }
6811            }
6812        }
6813    }
6814    if {$found || ($domore && !$moretodo)} {
6815        unset findcurline
6816        unset find_dirn
6817        notbusy finding
6818        set fprogcoord 0
6819        adjustprogress
6820        if {$found} {
6821            findselectline $l
6822        } else {
6823            bell
6824        }
6825        return 0
6826    }
6827    if {!$domore} {
6828        flushhighlights
6829    } else {
6830        set findcurline [expr {$l - $find_dirn}]
6831    }
6832    set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6833    if {$n < 0} {
6834        incr n $numcommits
6835    }
6836    set fprogcoord [expr {$n * 1.0 / $numcommits}]
6837    adjustprogress
6838    return $domore
6839}
6840
6841proc findselectline {l} {
6842    global findloc commentend ctext findcurline markingmatches gdttype
6843
6844    set markingmatches [expr {$gdttype eq [mc "containing:"]}]
6845    set findcurline $l
6846    selectline $l 1
6847    if {$markingmatches &&
6848        ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
6849        # highlight the matches in the comments
6850        set f [$ctext get 1.0 $commentend]
6851        set matches [findmatches $f]
6852        foreach match $matches {
6853            set start [lindex $match 0]
6854            set end [expr {[lindex $match 1] + 1}]
6855            $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6856        }
6857    }
6858    drawvisible
6859}
6860
6861# mark the bits of a headline or author that match a find string
6862proc markmatches {canv l str tag matches font row} {
6863    global selectedline
6864
6865    set bbox [$canv bbox $tag]
6866    set x0 [lindex $bbox 0]
6867    set y0 [lindex $bbox 1]
6868    set y1 [lindex $bbox 3]
6869    foreach match $matches {
6870        set start [lindex $match 0]
6871        set end [lindex $match 1]
6872        if {$start > $end} continue
6873        set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6874        set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6875        set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6876                   [expr {$x0+$xlen+2}] $y1 \
6877                   -outline {} -tags [list match$l matches] -fill yellow]
6878        $canv lower $t
6879        if {$row == $selectedline} {
6880            $canv raise $t secsel
6881        }
6882    }
6883}
6884
6885proc unmarkmatches {} {
6886    global markingmatches
6887
6888    allcanvs delete matches
6889    set markingmatches 0
6890    stopfinding
6891}
6892
6893proc selcanvline {w x y} {
6894    global canv canvy0 ctext linespc
6895    global rowtextx
6896    set ymax [lindex [$canv cget -scrollregion] 3]
6897    if {$ymax == {}} return
6898    set yfrac [lindex [$canv yview] 0]
6899    set y [expr {$y + $yfrac * $ymax}]
6900    set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6901    if {$l < 0} {
6902        set l 0
6903    }
6904    if {$w eq $canv} {
6905        set xmax [lindex [$canv cget -scrollregion] 2]
6906        set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6907        if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
6908    }
6909    unmarkmatches
6910    selectline $l 1
6911}
6912
6913proc commit_descriptor {p} {
6914    global commitinfo
6915    if {![info exists commitinfo($p)]} {
6916        getcommit $p
6917    }
6918    set l "..."
6919    if {[llength $commitinfo($p)] > 1} {
6920        set l [lindex $commitinfo($p) 0]
6921    }
6922    return "$p ($l)\n"
6923}
6924
6925# append some text to the ctext widget, and make any SHA1 ID
6926# that we know about be a clickable link.
6927proc appendwithlinks {text tags} {
6928    global ctext linknum curview
6929
6930    set start [$ctext index "end - 1c"]
6931    $ctext insert end $text $tags
6932    set links [regexp -indices -all -inline {(?:\m|-g)[0-9a-f]{6,40}\M} $text]
6933    foreach l $links {
6934        set s [lindex $l 0]
6935        set e [lindex $l 1]
6936        set linkid [string range $text $s $e]
6937        incr e
6938        $ctext tag delete link$linknum
6939        $ctext tag add link$linknum "$start + $s c" "$start + $e c"
6940        setlink $linkid link$linknum
6941        incr linknum
6942    }
6943}
6944
6945proc setlink {id lk} {
6946    global curview ctext pendinglinks
6947    global linkfgcolor
6948
6949    if {[string range $id 0 1] eq "-g"} {
6950      set id [string range $id 2 end]
6951    }
6952
6953    set known 0
6954    if {[string length $id] < 40} {
6955        set matches [longid $id]
6956        if {[llength $matches] > 0} {
6957            if {[llength $matches] > 1} return
6958            set known 1
6959            set id [lindex $matches 0]
6960        }
6961    } else {
6962        set known [commitinview $id $curview]
6963    }
6964    if {$known} {
6965        $ctext tag conf $lk -foreground $linkfgcolor -underline 1
6966        $ctext tag bind $lk <1> [list selbyid $id]
6967        $ctext tag bind $lk <Enter> {linkcursor %W 1}
6968        $ctext tag bind $lk <Leave> {linkcursor %W -1}
6969    } else {
6970        lappend pendinglinks($id) $lk
6971        interestedin $id {makelink %P}
6972    }
6973}
6974
6975proc appendshortlink {id {pre {}} {post {}}} {
6976    global ctext linknum
6977
6978    $ctext insert end $pre
6979    $ctext tag delete link$linknum
6980    $ctext insert end [string range $id 0 7] link$linknum
6981    $ctext insert end $post
6982    setlink $id link$linknum
6983    incr linknum
6984}
6985
6986proc makelink {id} {
6987    global pendinglinks
6988
6989    if {![info exists pendinglinks($id)]} return
6990    foreach lk $pendinglinks($id) {
6991        setlink $id $lk
6992    }
6993    unset pendinglinks($id)
6994}
6995
6996proc linkcursor {w inc} {
6997    global linkentercount curtextcursor
6998
6999    if {[incr linkentercount $inc] > 0} {
7000        $w configure -cursor hand2
7001    } else {
7002        $w configure -cursor $curtextcursor
7003        if {$linkentercount < 0} {
7004            set linkentercount 0
7005        }
7006    }
7007}
7008
7009proc viewnextline {dir} {
7010    global canv linespc
7011
7012    $canv delete hover
7013    set ymax [lindex [$canv cget -scrollregion] 3]
7014    set wnow [$canv yview]
7015    set wtop [expr {[lindex $wnow 0] * $ymax}]
7016    set newtop [expr {$wtop + $dir * $linespc}]
7017    if {$newtop < 0} {
7018        set newtop 0
7019    } elseif {$newtop > $ymax} {
7020        set newtop $ymax
7021    }
7022    allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7023}
7024
7025# add a list of tag or branch names at position pos
7026# returns the number of names inserted
7027proc appendrefs {pos ids var} {
7028    global ctext linknum curview $var maxrefs mainheadid
7029
7030    if {[catch {$ctext index $pos}]} {
7031        return 0
7032    }
7033    $ctext conf -state normal
7034    $ctext delete $pos "$pos lineend"
7035    set tags {}
7036    foreach id $ids {
7037        foreach tag [set $var\($id\)] {
7038            lappend tags [list $tag $id]
7039        }
7040    }
7041
7042    set sep {}
7043    set tags [lsort -index 0 -decreasing $tags]
7044    set nutags 0
7045
7046    if {[llength $tags] > $maxrefs} {
7047        # If we are displaying heads, and there are too many,
7048        # see if there are some important heads to display.
7049        # Currently this means "master" and the current head.
7050        set itags {}
7051        if {$var eq "idheads"} {
7052            set utags {}
7053            foreach ti $tags {
7054                set hname [lindex $ti 0]
7055                set id [lindex $ti 1]
7056                if {($hname eq "master" || $id eq $mainheadid) &&
7057                    [llength $itags] < $maxrefs} {
7058                    lappend itags $ti
7059                } else {
7060                    lappend utags $ti
7061                }
7062            }
7063            set tags $utags
7064        }
7065        if {$itags ne {}} {
7066            set str [mc "and many more"]
7067            set sep " "
7068        } else {
7069            set str [mc "many"]
7070        }
7071        $ctext insert $pos "$str ([llength $tags])"
7072        set nutags [llength $tags]
7073        set tags $itags
7074    }
7075
7076    foreach ti $tags {
7077        set id [lindex $ti 1]
7078        set lk link$linknum
7079        incr linknum
7080        $ctext tag delete $lk
7081        $ctext insert $pos $sep
7082        $ctext insert $pos [lindex $ti 0] $lk
7083        setlink $id $lk
7084        set sep ", "
7085    }
7086    $ctext tag add wwrap "$pos linestart" "$pos lineend"
7087    $ctext conf -state disabled
7088    return [expr {[llength $tags] + $nutags}]
7089}
7090
7091# called when we have finished computing the nearby tags
7092proc dispneartags {delay} {
7093    global selectedline currentid showneartags tagphase
7094
7095    if {$selectedline eq {} || !$showneartags} return
7096    after cancel dispnexttag
7097    if {$delay} {
7098        after 200 dispnexttag
7099        set tagphase -1
7100    } else {
7101        after idle dispnexttag
7102        set tagphase 0
7103    }
7104}
7105
7106proc dispnexttag {} {
7107    global selectedline currentid showneartags tagphase ctext
7108
7109    if {$selectedline eq {} || !$showneartags} return
7110    switch -- $tagphase {
7111        0 {
7112            set dtags [desctags $currentid]
7113            if {$dtags ne {}} {
7114                appendrefs precedes $dtags idtags
7115            }
7116        }
7117        1 {
7118            set atags [anctags $currentid]
7119            if {$atags ne {}} {
7120                appendrefs follows $atags idtags
7121            }
7122        }
7123        2 {
7124            set dheads [descheads $currentid]
7125            if {$dheads ne {}} {
7126                if {[appendrefs branch $dheads idheads] > 1
7127                    && [$ctext get "branch -3c"] eq "h"} {
7128                    # turn "Branch" into "Branches"
7129                    $ctext conf -state normal
7130                    $ctext insert "branch -2c" "es"
7131                    $ctext conf -state disabled
7132                }
7133            }
7134        }
7135    }
7136    if {[incr tagphase] <= 2} {
7137        after idle dispnexttag
7138    }
7139}
7140
7141proc make_secsel {id} {
7142    global linehtag linentag linedtag canv canv2 canv3
7143
7144    if {![info exists linehtag($id)]} return
7145    $canv delete secsel
7146    set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
7147               -tags secsel -fill [$canv cget -selectbackground]]
7148    $canv lower $t
7149    $canv2 delete secsel
7150    set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
7151               -tags secsel -fill [$canv2 cget -selectbackground]]
7152    $canv2 lower $t
7153    $canv3 delete secsel
7154    set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
7155               -tags secsel -fill [$canv3 cget -selectbackground]]
7156    $canv3 lower $t
7157}
7158
7159proc make_idmark {id} {
7160    global linehtag canv fgcolor
7161
7162    if {![info exists linehtag($id)]} return
7163    $canv delete markid
7164    set t [eval $canv create rect [$canv bbox $linehtag($id)] \
7165               -tags markid -outline $fgcolor]
7166    $canv raise $t
7167}
7168
7169proc selectline {l isnew {desired_loc {}} {switch_to_patch 0}} {
7170    global canv ctext commitinfo selectedline
7171    global canvy0 linespc parents children curview
7172    global currentid sha1entry
7173    global commentend idtags linknum
7174    global mergemax numcommits pending_select
7175    global cmitmode showneartags allcommits
7176    global targetrow targetid lastscrollrows
7177    global autoselect autosellen jump_to_here
7178    global vinlinediff
7179
7180    catch {unset pending_select}
7181    $canv delete hover
7182    normalline
7183    unsel_reflist
7184    stopfinding
7185    if {$l < 0 || $l >= $numcommits} return
7186    set id [commitonrow $l]
7187    set targetid $id
7188    set targetrow $l
7189    set selectedline $l
7190    set currentid $id
7191    if {$lastscrollrows < $numcommits} {
7192        setcanvscroll
7193    }
7194
7195    if {$cmitmode ne "patch" && $switch_to_patch} {
7196        set cmitmode "patch"
7197    }
7198
7199    set y [expr {$canvy0 + $l * $linespc}]
7200    set ymax [lindex [$canv cget -scrollregion] 3]
7201    set ytop [expr {$y - $linespc - 1}]
7202    set ybot [expr {$y + $linespc + 1}]
7203    set wnow [$canv yview]
7204    set wtop [expr {[lindex $wnow 0] * $ymax}]
7205    set wbot [expr {[lindex $wnow 1] * $ymax}]
7206    set wh [expr {$wbot - $wtop}]
7207    set newtop $wtop
7208    if {$ytop < $wtop} {
7209        if {$ybot < $wtop} {
7210            set newtop [expr {$y - $wh / 2.0}]
7211        } else {
7212            set newtop $ytop
7213            if {$newtop > $wtop - $linespc} {
7214                set newtop [expr {$wtop - $linespc}]
7215            }
7216        }
7217    } elseif {$ybot > $wbot} {
7218        if {$ytop > $wbot} {
7219            set newtop [expr {$y - $wh / 2.0}]
7220        } else {
7221            set newtop [expr {$ybot - $wh}]
7222            if {$newtop < $wtop + $linespc} {
7223                set newtop [expr {$wtop + $linespc}]
7224            }
7225        }
7226    }
7227    if {$newtop != $wtop} {
7228        if {$newtop < 0} {
7229            set newtop 0
7230        }
7231        allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7232        drawvisible
7233    }
7234
7235    make_secsel $id
7236
7237    if {$isnew} {
7238        addtohistory [list selbyid $id 0] savecmitpos
7239    }
7240
7241    $sha1entry delete 0 end
7242    $sha1entry insert 0 $id
7243    if {$autoselect} {
7244        $sha1entry selection range 0 $autosellen
7245    }
7246    rhighlight_sel $id
7247
7248    $ctext conf -state normal
7249    clear_ctext
7250    set linknum 0
7251    if {![info exists commitinfo($id)]} {
7252        getcommit $id
7253    }
7254    set info $commitinfo($id)
7255    set date [formatdate [lindex $info 2]]
7256    $ctext insert end "[mc "Author"]: [lindex $info 1]  $date\n"
7257    set date [formatdate [lindex $info 4]]
7258    $ctext insert end "[mc "Committer"]: [lindex $info 3]  $date\n"
7259    if {[info exists idtags($id)]} {
7260        $ctext insert end [mc "Tags:"]
7261        foreach tag $idtags($id) {
7262            $ctext insert end " $tag"
7263        }
7264        $ctext insert end "\n"
7265    }
7266
7267    set headers {}
7268    set olds $parents($curview,$id)
7269    if {[llength $olds] > 1} {
7270        set np 0
7271        foreach p $olds {
7272            if {$np >= $mergemax} {
7273                set tag mmax
7274            } else {
7275                set tag m$np
7276            }
7277            $ctext insert end "[mc "Parent"]: " $tag
7278            appendwithlinks [commit_descriptor $p] {}
7279            incr np
7280        }
7281    } else {
7282        foreach p $olds {
7283            append headers "[mc "Parent"]: [commit_descriptor $p]"
7284        }
7285    }
7286
7287    foreach c $children($curview,$id) {
7288        append headers "[mc "Child"]:  [commit_descriptor $c]"
7289    }
7290
7291    # make anything that looks like a SHA1 ID be a clickable link
7292    appendwithlinks $headers {}
7293    if {$showneartags} {
7294        if {![info exists allcommits]} {
7295            getallcommits
7296        }
7297        $ctext insert end "[mc "Branch"]: "
7298        $ctext mark set branch "end -1c"
7299        $ctext mark gravity branch left
7300        $ctext insert end "\n[mc "Follows"]: "
7301        $ctext mark set follows "end -1c"
7302        $ctext mark gravity follows left
7303        $ctext insert end "\n[mc "Precedes"]: "
7304        $ctext mark set precedes "end -1c"
7305        $ctext mark gravity precedes left
7306        $ctext insert end "\n"
7307        dispneartags 1
7308    }
7309    $ctext insert end "\n"
7310    set comment [lindex $info 5]
7311    if {[string first "\r" $comment] >= 0} {
7312        set comment [string map {"\r" "\n    "} $comment]
7313    }
7314    appendwithlinks $comment {comment}
7315
7316    $ctext tag remove found 1.0 end
7317    $ctext conf -state disabled
7318    set commentend [$ctext index "end - 1c"]
7319
7320    set jump_to_here $desired_loc
7321    init_flist [mc "Comments"]
7322    if {$cmitmode eq "tree"} {
7323        gettree $id
7324    } elseif {$vinlinediff($curview) == 1} {
7325        showinlinediff $id
7326    } elseif {[llength $olds] <= 1} {
7327        startdiff $id
7328    } else {
7329        mergediff $id
7330    }
7331}
7332
7333proc selfirstline {} {
7334    unmarkmatches
7335    selectline 0 1
7336}
7337
7338proc sellastline {} {
7339    global numcommits
7340    unmarkmatches
7341    set l [expr {$numcommits - 1}]
7342    selectline $l 1
7343}
7344
7345proc selnextline {dir} {
7346    global selectedline
7347    focus .
7348    if {$selectedline eq {}} return
7349    set l [expr {$selectedline + $dir}]
7350    unmarkmatches
7351    selectline $l 1
7352}
7353
7354proc selnextpage {dir} {
7355    global canv linespc selectedline numcommits
7356
7357    set lpp [expr {([winfo height $canv] - 2) / $linespc}]
7358    if {$lpp < 1} {
7359        set lpp 1
7360    }
7361    allcanvs yview scroll [expr {$dir * $lpp}] units
7362    drawvisible
7363    if {$selectedline eq {}} return
7364    set l [expr {$selectedline + $dir * $lpp}]
7365    if {$l < 0} {
7366        set l 0
7367    } elseif {$l >= $numcommits} {
7368        set l [expr $numcommits - 1]
7369    }
7370    unmarkmatches
7371    selectline $l 1
7372}
7373
7374proc unselectline {} {
7375    global selectedline currentid
7376
7377    set selectedline {}
7378    catch {unset currentid}
7379    allcanvs delete secsel
7380    rhighlight_none
7381}
7382
7383proc reselectline {} {
7384    global selectedline
7385
7386    if {$selectedline ne {}} {
7387        selectline $selectedline 0
7388    }
7389}
7390
7391proc addtohistory {cmd {saveproc {}}} {
7392    global history historyindex curview
7393
7394    unset_posvars
7395    save_position
7396    set elt [list $curview $cmd $saveproc {}]
7397    if {$historyindex > 0
7398        && [lindex $history [expr {$historyindex - 1}]] == $elt} {
7399        return
7400    }
7401
7402    if {$historyindex < [llength $history]} {
7403        set history [lreplace $history $historyindex end $elt]
7404    } else {
7405        lappend history $elt
7406    }
7407    incr historyindex
7408    if {$historyindex > 1} {
7409        .tf.bar.leftbut conf -state normal
7410    } else {
7411        .tf.bar.leftbut conf -state disabled
7412    }
7413    .tf.bar.rightbut conf -state disabled
7414}
7415
7416# save the scrolling position of the diff display pane
7417proc save_position {} {
7418    global historyindex history
7419
7420    if {$historyindex < 1} return
7421    set hi [expr {$historyindex - 1}]
7422    set fn [lindex $history $hi 2]
7423    if {$fn ne {}} {
7424        lset history $hi 3 [eval $fn]
7425    }
7426}
7427
7428proc unset_posvars {} {
7429    global last_posvars
7430
7431    if {[info exists last_posvars]} {
7432        foreach {var val} $last_posvars {
7433            global $var
7434            catch {unset $var}
7435        }
7436        unset last_posvars
7437    }
7438}
7439
7440proc godo {elt} {
7441    global curview last_posvars
7442
7443    set view [lindex $elt 0]
7444    set cmd [lindex $elt 1]
7445    set pv [lindex $elt 3]
7446    if {$curview != $view} {
7447        showview $view
7448    }
7449    unset_posvars
7450    foreach {var val} $pv {
7451        global $var
7452        set $var $val
7453    }
7454    set last_posvars $pv
7455    eval $cmd
7456}
7457
7458proc goback {} {
7459    global history historyindex
7460    focus .
7461
7462    if {$historyindex > 1} {
7463        save_position
7464        incr historyindex -1
7465        godo [lindex $history [expr {$historyindex - 1}]]
7466        .tf.bar.rightbut conf -state normal
7467    }
7468    if {$historyindex <= 1} {
7469        .tf.bar.leftbut conf -state disabled
7470    }
7471}
7472
7473proc goforw {} {
7474    global history historyindex
7475    focus .
7476
7477    if {$historyindex < [llength $history]} {
7478        save_position
7479        set cmd [lindex $history $historyindex]
7480        incr historyindex
7481        godo $cmd
7482        .tf.bar.leftbut conf -state normal
7483    }
7484    if {$historyindex >= [llength $history]} {
7485        .tf.bar.rightbut conf -state disabled
7486    }
7487}
7488
7489proc gettree {id} {
7490    global treefilelist treeidlist diffids diffmergeid treepending
7491    global nullid nullid2
7492
7493    set diffids $id
7494    catch {unset diffmergeid}
7495    if {![info exists treefilelist($id)]} {
7496        if {![info exists treepending]} {
7497            if {$id eq $nullid} {
7498                set cmd [list | git ls-files]
7499            } elseif {$id eq $nullid2} {
7500                set cmd [list | git ls-files --stage -t]
7501            } else {
7502                set cmd [list | git ls-tree -r $id]
7503            }
7504            if {[catch {set gtf [open $cmd r]}]} {
7505                return
7506            }
7507            set treepending $id
7508            set treefilelist($id) {}
7509            set treeidlist($id) {}
7510            fconfigure $gtf -blocking 0 -encoding binary
7511            filerun $gtf [list gettreeline $gtf $id]
7512        }
7513    } else {
7514        setfilelist $id
7515    }
7516}
7517
7518proc gettreeline {gtf id} {
7519    global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
7520
7521    set nl 0
7522    while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
7523        if {$diffids eq $nullid} {
7524            set fname $line
7525        } else {
7526            set i [string first "\t" $line]
7527            if {$i < 0} continue
7528            set fname [string range $line [expr {$i+1}] end]
7529            set line [string range $line 0 [expr {$i-1}]]
7530            if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7531            set sha1 [lindex $line 2]
7532            lappend treeidlist($id) $sha1
7533        }
7534        if {[string index $fname 0] eq "\""} {
7535            set fname [lindex $fname 0]
7536        }
7537        set fname [encoding convertfrom $fname]
7538        lappend treefilelist($id) $fname
7539    }
7540    if {![eof $gtf]} {
7541        return [expr {$nl >= 1000? 2: 1}]
7542    }
7543    close $gtf
7544    unset treepending
7545    if {$cmitmode ne "tree"} {
7546        if {![info exists diffmergeid]} {
7547            gettreediffs $diffids
7548        }
7549    } elseif {$id ne $diffids} {
7550        gettree $diffids
7551    } else {
7552        setfilelist $id
7553    }
7554    return 0
7555}
7556
7557proc showfile {f} {
7558    global treefilelist treeidlist diffids nullid nullid2
7559    global ctext_file_names ctext_file_lines
7560    global ctext commentend
7561
7562    set i [lsearch -exact $treefilelist($diffids) $f]
7563    if {$i < 0} {
7564        puts "oops, $f not in list for id $diffids"
7565        return
7566    }
7567    if {$diffids eq $nullid} {
7568        if {[catch {set bf [open $f r]} err]} {
7569            puts "oops, can't read $f: $err"
7570            return
7571        }
7572    } else {
7573        set blob [lindex $treeidlist($diffids) $i]
7574        if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7575            puts "oops, error reading blob $blob: $err"
7576            return
7577        }
7578    }
7579    fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7580    filerun $bf [list getblobline $bf $diffids]
7581    $ctext config -state normal
7582    clear_ctext $commentend
7583    lappend ctext_file_names $f
7584    lappend ctext_file_lines [lindex [split $commentend "."] 0]
7585    $ctext insert end "\n"
7586    $ctext insert end "$f\n" filesep
7587    $ctext config -state disabled
7588    $ctext yview $commentend
7589    settabs 0
7590}
7591
7592proc getblobline {bf id} {
7593    global diffids cmitmode ctext
7594
7595    if {$id ne $diffids || $cmitmode ne "tree"} {
7596        catch {close $bf}
7597        return 0
7598    }
7599    $ctext config -state normal
7600    set nl 0
7601    while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7602        $ctext insert end "$line\n"
7603    }
7604    if {[eof $bf]} {
7605        global jump_to_here ctext_file_names commentend
7606
7607        # delete last newline
7608        $ctext delete "end - 2c" "end - 1c"
7609        close $bf
7610        if {$jump_to_here ne {} &&
7611            [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7612            set lnum [expr {[lindex $jump_to_here 1] +
7613                            [lindex [split $commentend .] 0]}]
7614            mark_ctext_line $lnum
7615        }
7616        $ctext config -state disabled
7617        return 0
7618    }
7619    $ctext config -state disabled
7620    return [expr {$nl >= 1000? 2: 1}]
7621}
7622
7623proc mark_ctext_line {lnum} {
7624    global ctext markbgcolor
7625
7626    $ctext tag delete omark
7627    $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7628    $ctext tag conf omark -background $markbgcolor
7629    $ctext see $lnum.0
7630}
7631
7632proc mergediff {id} {
7633    global diffmergeid
7634    global diffids treediffs
7635    global parents curview
7636
7637    set diffmergeid $id
7638    set diffids $id
7639    set treediffs($id) {}
7640    set np [llength $parents($curview,$id)]
7641    settabs $np
7642    getblobdiffs $id
7643}
7644
7645proc startdiff {ids} {
7646    global treediffs diffids treepending diffmergeid nullid nullid2
7647
7648    settabs 1
7649    set diffids $ids
7650    catch {unset diffmergeid}
7651    if {![info exists treediffs($ids)] ||
7652        [lsearch -exact $ids $nullid] >= 0 ||
7653        [lsearch -exact $ids $nullid2] >= 0} {
7654        if {![info exists treepending]} {
7655            gettreediffs $ids
7656        }
7657    } else {
7658        addtocflist $ids
7659    }
7660}
7661
7662proc showinlinediff {ids} {
7663    global commitinfo commitdata ctext
7664    global treediffs
7665
7666    set info $commitinfo($ids)
7667    set diff [lindex $info 7]
7668    set difflines [split $diff "\n"]
7669
7670    initblobdiffvars
7671    set treediff {}
7672
7673    set inhdr 0
7674    foreach line $difflines {
7675        if {![string compare -length 5 "diff " $line]} {
7676            set inhdr 1
7677        } elseif {$inhdr && ![string compare -length 4 "+++ " $line]} {
7678            # offset also accounts for the b/ prefix
7679            lappend treediff [string range $line 6 end]
7680            set inhdr 0
7681        }
7682    }
7683
7684    set treediffs($ids) $treediff
7685    add_flist $treediff
7686
7687    $ctext conf -state normal
7688    foreach line $difflines {
7689        parseblobdiffline $ids $line
7690    }
7691    maybe_scroll_ctext 1
7692    $ctext conf -state disabled
7693}
7694
7695# If the filename (name) is under any of the passed filter paths
7696# then return true to include the file in the listing.
7697proc path_filter {filter name} {
7698    set worktree [gitworktree]
7699    foreach p $filter {
7700        set fq_p [file normalize $p]
7701        set fq_n [file normalize [file join $worktree $name]]
7702        if {[string match [file normalize $fq_p]* $fq_n]} {
7703            return 1
7704        }
7705    }
7706    return 0
7707}
7708
7709proc addtocflist {ids} {
7710    global treediffs
7711
7712    add_flist $treediffs($ids)
7713    getblobdiffs $ids
7714}
7715
7716proc diffcmd {ids flags} {
7717    global log_showroot nullid nullid2 git_version
7718
7719    set i [lsearch -exact $ids $nullid]
7720    set j [lsearch -exact $ids $nullid2]
7721    if {$i >= 0} {
7722        if {[llength $ids] > 1 && $j < 0} {
7723            # comparing working directory with some specific revision
7724            set cmd [concat | git diff-index $flags]
7725            if {$i == 0} {
7726                lappend cmd -R [lindex $ids 1]
7727            } else {
7728                lappend cmd [lindex $ids 0]
7729            }
7730        } else {
7731            # comparing working directory with index
7732            set cmd [concat | git diff-files $flags]
7733            if {$j == 1} {
7734                lappend cmd -R
7735            }
7736        }
7737    } elseif {$j >= 0} {
7738        if {[package vcompare $git_version "1.7.2"] >= 0} {
7739            set flags "$flags --ignore-submodules=dirty"
7740        }
7741        set cmd [concat | git diff-index --cached $flags]
7742        if {[llength $ids] > 1} {
7743            # comparing index with specific revision
7744            if {$j == 0} {
7745                lappend cmd -R [lindex $ids 1]
7746            } else {
7747                lappend cmd [lindex $ids 0]
7748            }
7749        } else {
7750            # comparing index with HEAD
7751            lappend cmd HEAD
7752        }
7753    } else {
7754        if {$log_showroot} {
7755            lappend flags --root
7756        }
7757        set cmd [concat | git diff-tree -r $flags $ids]
7758    }
7759    return $cmd
7760}
7761
7762proc gettreediffs {ids} {
7763    global treediff treepending limitdiffs vfilelimit curview
7764
7765    set cmd [diffcmd $ids {--no-commit-id}]
7766    if {$limitdiffs && $vfilelimit($curview) ne {}} {
7767            set cmd [concat $cmd -- $vfilelimit($curview)]
7768    }
7769    if {[catch {set gdtf [open $cmd r]}]} return
7770
7771    set treepending $ids
7772    set treediff {}
7773    fconfigure $gdtf -blocking 0 -encoding binary
7774    filerun $gdtf [list gettreediffline $gdtf $ids]
7775}
7776
7777proc gettreediffline {gdtf ids} {
7778    global treediff treediffs treepending diffids diffmergeid
7779    global cmitmode vfilelimit curview limitdiffs perfile_attrs
7780
7781    set nr 0
7782    set sublist {}
7783    set max 1000
7784    if {$perfile_attrs} {
7785        # cache_gitattr is slow, and even slower on win32 where we
7786        # have to invoke it for only about 30 paths at a time
7787        set max 500
7788        if {[tk windowingsystem] == "win32"} {
7789            set max 120
7790        }
7791    }
7792    while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7793        set i [string first "\t" $line]
7794        if {$i >= 0} {
7795            set file [string range $line [expr {$i+1}] end]
7796            if {[string index $file 0] eq "\""} {
7797                set file [lindex $file 0]
7798            }
7799            set file [encoding convertfrom $file]
7800            if {$file ne [lindex $treediff end]} {
7801                lappend treediff $file
7802                lappend sublist $file
7803            }
7804        }
7805    }
7806    if {$perfile_attrs} {
7807        cache_gitattr encoding $sublist
7808    }
7809    if {![eof $gdtf]} {
7810        return [expr {$nr >= $max? 2: 1}]
7811    }
7812    close $gdtf
7813    set treediffs($ids) $treediff
7814    unset treepending
7815    if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7816        gettree $diffids
7817    } elseif {$ids != $diffids} {
7818        if {![info exists diffmergeid]} {
7819            gettreediffs $diffids
7820        }
7821    } else {
7822        addtocflist $ids
7823    }
7824    return 0
7825}
7826
7827# empty string or positive integer
7828proc diffcontextvalidate {v} {
7829    return [regexp {^(|[1-9][0-9]*)$} $v]
7830}
7831
7832proc diffcontextchange {n1 n2 op} {
7833    global diffcontextstring diffcontext
7834
7835    if {[string is integer -strict $diffcontextstring]} {
7836        if {$diffcontextstring >= 0} {
7837            set diffcontext $diffcontextstring
7838            reselectline
7839        }
7840    }
7841}
7842
7843proc changeignorespace {} {
7844    reselectline
7845}
7846
7847proc changeworddiff {name ix op} {
7848    reselectline
7849}
7850
7851proc initblobdiffvars {} {
7852    global diffencoding targetline diffnparents
7853    global diffinhdr currdiffsubmod diffseehere
7854    set targetline {}
7855    set diffnparents 0
7856    set diffinhdr 0
7857    set diffencoding [get_path_encoding {}]
7858    set currdiffsubmod ""
7859    set diffseehere -1
7860}
7861
7862proc getblobdiffs {ids} {
7863    global blobdifffd diffids env
7864    global treediffs
7865    global diffcontext
7866    global ignorespace
7867    global worddiff
7868    global limitdiffs vfilelimit curview
7869    global git_version
7870
7871    set textconv {}
7872    if {[package vcompare $git_version "1.6.1"] >= 0} {
7873        set textconv "--textconv"
7874    }
7875    set submodule {}
7876    if {[package vcompare $git_version "1.6.6"] >= 0} {
7877        set submodule "--submodule"
7878    }
7879    set cmd [diffcmd $ids "-p $textconv $submodule  -C --cc --no-commit-id -U$diffcontext"]
7880    if {$ignorespace} {
7881        append cmd " -w"
7882    }
7883    if {$worddiff ne [mc "Line diff"]} {
7884        append cmd " --word-diff=porcelain"
7885    }
7886    if {$limitdiffs && $vfilelimit($curview) ne {}} {
7887        set cmd [concat $cmd -- $vfilelimit($curview)]
7888    }
7889    if {[catch {set bdf [open $cmd r]} err]} {
7890        error_popup [mc "Error getting diffs: %s" $err]
7891        return
7892    }
7893    fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
7894    set blobdifffd($ids) $bdf
7895    initblobdiffvars
7896    filerun $bdf [list getblobdiffline $bdf $diffids]
7897}
7898
7899proc savecmitpos {} {
7900    global ctext cmitmode
7901
7902    if {$cmitmode eq "tree"} {
7903        return {}
7904    }
7905    return [list target_scrollpos [$ctext index @0,0]]
7906}
7907
7908proc savectextpos {} {
7909    global ctext
7910
7911    return [list target_scrollpos [$ctext index @0,0]]
7912}
7913
7914proc maybe_scroll_ctext {ateof} {
7915    global ctext target_scrollpos
7916
7917    if {![info exists target_scrollpos]} return
7918    if {!$ateof} {
7919        set nlines [expr {[winfo height $ctext]
7920                          / [font metrics textfont -linespace]}]
7921        if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
7922    }
7923    $ctext yview $target_scrollpos
7924    unset target_scrollpos
7925}
7926
7927proc setinlist {var i val} {
7928    global $var
7929
7930    while {[llength [set $var]] < $i} {
7931        lappend $var {}
7932    }
7933    if {[llength [set $var]] == $i} {
7934        lappend $var $val
7935    } else {
7936        lset $var $i $val
7937    }
7938}
7939
7940proc makediffhdr {fname ids} {
7941    global ctext curdiffstart treediffs diffencoding
7942    global ctext_file_names jump_to_here targetline diffline
7943
7944    set fname [encoding convertfrom $fname]
7945    set diffencoding [get_path_encoding $fname]
7946    set i [lsearch -exact $treediffs($ids) $fname]
7947    if {$i >= 0} {
7948        setinlist difffilestart $i $curdiffstart
7949    }
7950    lset ctext_file_names end $fname
7951    set l [expr {(78 - [string length $fname]) / 2}]
7952    set pad [string range "----------------------------------------" 1 $l]
7953    $ctext insert $curdiffstart "$pad $fname $pad" filesep
7954    set targetline {}
7955    if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
7956        set targetline [lindex $jump_to_here 1]
7957    }
7958    set diffline 0
7959}
7960
7961proc blobdiffmaybeseehere {ateof} {
7962    global diffseehere
7963    if {$diffseehere >= 0} {
7964        mark_ctext_line [lindex [split $diffseehere .] 0]
7965    }
7966    maybe_scroll_ctext $ateof
7967}
7968
7969proc getblobdiffline {bdf ids} {
7970    global diffids blobdifffd
7971    global ctext
7972
7973    set nr 0
7974    $ctext conf -state normal
7975    while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
7976        if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
7977            catch {close $bdf}
7978            return 0
7979        }
7980        parseblobdiffline $ids $line
7981    }
7982    $ctext conf -state disabled
7983    blobdiffmaybeseehere [eof $bdf]
7984    if {[eof $bdf]} {
7985        catch {close $bdf}
7986        return 0
7987    }
7988    return [expr {$nr >= 1000? 2: 1}]
7989}
7990
7991proc parseblobdiffline {ids line} {
7992    global ctext curdiffstart
7993    global diffnexthead diffnextnote difffilestart
7994    global ctext_file_names ctext_file_lines
7995    global diffinhdr treediffs mergemax diffnparents
7996    global diffencoding jump_to_here targetline diffline currdiffsubmod
7997    global worddiff diffseehere
7998
7999    if {![string compare -length 5 "diff " $line]} {
8000        if {![regexp {^diff (--cc|--git) } $line m type]} {
8001            set line [encoding convertfrom $line]
8002            $ctext insert end "$line\n" hunksep
8003            continue
8004        }
8005        # start of a new file
8006        set diffinhdr 1
8007        $ctext insert end "\n"
8008        set curdiffstart [$ctext index "end - 1c"]
8009        lappend ctext_file_names ""
8010        lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8011        $ctext insert end "\n" filesep
8012
8013        if {$type eq "--cc"} {
8014            # start of a new file in a merge diff
8015            set fname [string range $line 10 end]
8016            if {[lsearch -exact $treediffs($ids) $fname] < 0} {
8017                lappend treediffs($ids) $fname
8018                add_flist [list $fname]
8019            }
8020
8021        } else {
8022            set line [string range $line 11 end]
8023            # If the name hasn't changed the length will be odd,
8024            # the middle char will be a space, and the two bits either
8025            # side will be a/name and b/name, or "a/name" and "b/name".
8026            # If the name has changed we'll get "rename from" and
8027            # "rename to" or "copy from" and "copy to" lines following
8028            # this, and we'll use them to get the filenames.
8029            # This complexity is necessary because spaces in the
8030            # filename(s) don't get escaped.
8031            set l [string length $line]
8032            set i [expr {$l / 2}]
8033            if {!(($l & 1) && [string index $line $i] eq " " &&
8034                  [string range $line 2 [expr {$i - 1}]] eq \
8035                      [string range $line [expr {$i + 3}] end])} {
8036                return
8037            }
8038            # unescape if quoted and chop off the a/ from the front
8039            if {[string index $line 0] eq "\""} {
8040                set fname [string range [lindex $line 0] 2 end]
8041            } else {
8042                set fname [string range $line 2 [expr {$i - 1}]]
8043            }
8044        }
8045        makediffhdr $fname $ids
8046
8047    } elseif {![string compare -length 16 "* Unmerged path " $line]} {
8048        set fname [encoding convertfrom [string range $line 16 end]]
8049        $ctext insert end "\n"
8050        set curdiffstart [$ctext index "end - 1c"]
8051        lappend ctext_file_names $fname
8052        lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8053        $ctext insert end "$line\n" filesep
8054        set i [lsearch -exact $treediffs($ids) $fname]
8055        if {$i >= 0} {
8056            setinlist difffilestart $i $curdiffstart
8057        }
8058
8059    } elseif {![string compare -length 2 "@@" $line]} {
8060        regexp {^@@+} $line ats
8061        set line [encoding convertfrom $diffencoding $line]
8062        $ctext insert end "$line\n" hunksep
8063        if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
8064            set diffline $nl
8065        }
8066        set diffnparents [expr {[string length $ats] - 1}]
8067        set diffinhdr 0
8068
8069    } elseif {![string compare -length 10 "Submodule " $line]} {
8070        # start of a new submodule
8071        if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
8072            set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
8073        } else {
8074            set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
8075        }
8076        if {$currdiffsubmod != $fname} {
8077            $ctext insert end "\n";     # Add newline after commit message
8078        }
8079        set curdiffstart [$ctext index "end - 1c"]
8080        lappend ctext_file_names ""
8081        if {$currdiffsubmod != $fname} {
8082            lappend ctext_file_lines $fname
8083            makediffhdr $fname $ids
8084            set currdiffsubmod $fname
8085            $ctext insert end "\n$line\n" filesep
8086        } else {
8087            $ctext insert end "$line\n" filesep
8088        }
8089    } elseif {![string compare -length 3 "  >" $line]} {
8090        set $currdiffsubmod ""
8091        set line [encoding convertfrom $diffencoding $line]
8092        $ctext insert end "$line\n" dresult
8093    } elseif {![string compare -length 3 "  <" $line]} {
8094        set $currdiffsubmod ""
8095        set line [encoding convertfrom $diffencoding $line]
8096        $ctext insert end "$line\n" d0
8097    } elseif {$diffinhdr} {
8098        if {![string compare -length 12 "rename from " $line]} {
8099            set fname [string range $line [expr 6 + [string first " from " $line] ] end]
8100            if {[string index $fname 0] eq "\""} {
8101                set fname [lindex $fname 0]
8102            }
8103            set fname [encoding convertfrom $fname]
8104            set i [lsearch -exact $treediffs($ids) $fname]
8105            if {$i >= 0} {
8106                setinlist difffilestart $i $curdiffstart
8107            }
8108        } elseif {![string compare -length 10 $line "rename to "] ||
8109                  ![string compare -length 8 $line "copy to "]} {
8110            set fname [string range $line [expr 4 + [string first " to " $line] ] end]
8111            if {[string index $fname 0] eq "\""} {
8112                set fname [lindex $fname 0]
8113            }
8114            makediffhdr $fname $ids
8115        } elseif {[string compare -length 3 $line "---"] == 0} {
8116            # do nothing
8117            return
8118        } elseif {[string compare -length 3 $line "+++"] == 0} {
8119            set diffinhdr 0
8120            return
8121        }
8122        $ctext insert end "$line\n" filesep
8123
8124    } else {
8125        set line [string map {\x1A ^Z} \
8126                      [encoding convertfrom $diffencoding $line]]
8127        # parse the prefix - one ' ', '-' or '+' for each parent
8128        set prefix [string range $line 0 [expr {$diffnparents - 1}]]
8129        set tag [expr {$diffnparents > 1? "m": "d"}]
8130        set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
8131        set words_pre_markup ""
8132        set words_post_markup ""
8133        if {[string trim $prefix " -+"] eq {}} {
8134            # prefix only has " ", "-" and "+" in it: normal diff line
8135            set num [string first "-" $prefix]
8136            if {$dowords} {
8137                set line [string range $line 1 end]
8138            }
8139            if {$num >= 0} {
8140                # removed line, first parent with line is $num
8141                if {$num >= $mergemax} {
8142                    set num "max"
8143                }
8144                if {$dowords && $worddiff eq [mc "Markup words"]} {
8145                    $ctext insert end "\[-$line-\]" $tag$num
8146                } else {
8147                    $ctext insert end "$line" $tag$num
8148                }
8149                if {!$dowords} {
8150                    $ctext insert end "\n" $tag$num
8151                }
8152            } else {
8153                set tags {}
8154                if {[string first "+" $prefix] >= 0} {
8155                    # added line
8156                    lappend tags ${tag}result
8157                    if {$diffnparents > 1} {
8158                        set num [string first " " $prefix]
8159                        if {$num >= 0} {
8160                            if {$num >= $mergemax} {
8161                                set num "max"
8162                            }
8163                            lappend tags m$num
8164                        }
8165                    }
8166                    set words_pre_markup "{+"
8167                    set words_post_markup "+}"
8168                }
8169                if {$targetline ne {}} {
8170                    if {$diffline == $targetline} {
8171                        set diffseehere [$ctext index "end - 1 chars"]
8172                        set targetline {}
8173                    } else {
8174                        incr diffline
8175                    }
8176                }
8177                if {$dowords && $worddiff eq [mc "Markup words"]} {
8178                    $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
8179                } else {
8180                    $ctext insert end "$line" $tags
8181                }
8182                if {!$dowords} {
8183                    $ctext insert end "\n" $tags
8184                }
8185            }
8186        } elseif {$dowords && $prefix eq "~"} {
8187            $ctext insert end "\n" {}
8188        } else {
8189            # "\ No newline at end of file",
8190            # or something else we don't recognize
8191            $ctext insert end "$line\n" hunksep
8192        }
8193    }
8194}
8195
8196proc changediffdisp {} {
8197    global ctext diffelide
8198
8199    $ctext tag conf d0 -elide [lindex $diffelide 0]
8200    $ctext tag conf dresult -elide [lindex $diffelide 1]
8201}
8202
8203proc highlightfile {cline} {
8204    global cflist cflist_top
8205
8206    if {![info exists cflist_top]} return
8207
8208    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
8209    $cflist tag add highlight $cline.0 "$cline.0 lineend"
8210    $cflist see $cline.0
8211    set cflist_top $cline
8212}
8213
8214proc highlightfile_for_scrollpos {topidx} {
8215    global cmitmode difffilestart
8216
8217    if {$cmitmode eq "tree"} return
8218    if {![info exists difffilestart]} return
8219
8220    set top [lindex [split $topidx .] 0]
8221    if {$difffilestart eq {} || $top < [lindex $difffilestart 0]} {
8222        highlightfile 0
8223    } else {
8224        highlightfile [expr {[bsearch $difffilestart $top] + 2}]
8225    }
8226}
8227
8228proc prevfile {} {
8229    global difffilestart ctext cmitmode
8230
8231    if {$cmitmode eq "tree"} return
8232    set prev 0.0
8233    set here [$ctext index @0,0]
8234    foreach loc $difffilestart {
8235        if {[$ctext compare $loc >= $here]} {
8236            $ctext yview $prev
8237            return
8238        }
8239        set prev $loc
8240    }
8241    $ctext yview $prev
8242}
8243
8244proc nextfile {} {
8245    global difffilestart ctext cmitmode
8246
8247    if {$cmitmode eq "tree"} return
8248    set here [$ctext index @0,0]
8249    foreach loc $difffilestart {
8250        if {[$ctext compare $loc > $here]} {
8251            $ctext yview $loc
8252            return
8253        }
8254    }
8255}
8256
8257proc clear_ctext {{first 1.0}} {
8258    global ctext smarktop smarkbot
8259    global ctext_file_names ctext_file_lines
8260    global pendinglinks
8261
8262    set l [lindex [split $first .] 0]
8263    if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
8264        set smarktop $l
8265    }
8266    if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
8267        set smarkbot $l
8268    }
8269    $ctext delete $first end
8270    if {$first eq "1.0"} {
8271        catch {unset pendinglinks}
8272    }
8273    set ctext_file_names {}
8274    set ctext_file_lines {}
8275}
8276
8277proc settabs {{firstab {}}} {
8278    global firsttabstop tabstop ctext have_tk85
8279
8280    if {$firstab ne {} && $have_tk85} {
8281        set firsttabstop $firstab
8282    }
8283    set w [font measure textfont "0"]
8284    if {$firsttabstop != 0} {
8285        $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
8286                               [expr {($firsttabstop + 2 * $tabstop) * $w}]]
8287    } elseif {$have_tk85 || $tabstop != 8} {
8288        $ctext conf -tabs [expr {$tabstop * $w}]
8289    } else {
8290        $ctext conf -tabs {}
8291    }
8292}
8293
8294proc incrsearch {name ix op} {
8295    global ctext searchstring searchdirn
8296
8297    if {[catch {$ctext index anchor}]} {
8298        # no anchor set, use start of selection, or of visible area
8299        set sel [$ctext tag ranges sel]
8300        if {$sel ne {}} {
8301            $ctext mark set anchor [lindex $sel 0]
8302        } elseif {$searchdirn eq "-forwards"} {
8303            $ctext mark set anchor @0,0
8304        } else {
8305            $ctext mark set anchor @0,[winfo height $ctext]
8306        }
8307    }
8308    if {$searchstring ne {}} {
8309        set here [$ctext search -count mlen $searchdirn -- $searchstring anchor]
8310        if {$here ne {}} {
8311            $ctext see $here
8312            set mend "$here + $mlen c"
8313            $ctext tag remove sel 1.0 end
8314            $ctext tag add sel $here $mend
8315            suppress_highlighting_file_for_current_scrollpos
8316            highlightfile_for_scrollpos $here
8317        }
8318    }
8319    rehighlight_search_results
8320}
8321
8322proc dosearch {} {
8323    global sstring ctext searchstring searchdirn
8324
8325    focus $sstring
8326    $sstring icursor end
8327    set searchdirn -forwards
8328    if {$searchstring ne {}} {
8329        set sel [$ctext tag ranges sel]
8330        if {$sel ne {}} {
8331            set start "[lindex $sel 0] + 1c"
8332        } elseif {[catch {set start [$ctext index anchor]}]} {
8333            set start "@0,0"
8334        }
8335        set match [$ctext search -count mlen -- $searchstring $start]
8336        $ctext tag remove sel 1.0 end
8337        if {$match eq {}} {
8338            bell
8339            return
8340        }
8341        $ctext see $match
8342        suppress_highlighting_file_for_current_scrollpos
8343        highlightfile_for_scrollpos $match
8344        set mend "$match + $mlen c"
8345        $ctext tag add sel $match $mend
8346        $ctext mark unset anchor
8347        rehighlight_search_results
8348    }
8349}
8350
8351proc dosearchback {} {
8352    global sstring ctext searchstring searchdirn
8353
8354    focus $sstring
8355    $sstring icursor end
8356    set searchdirn -backwards
8357    if {$searchstring ne {}} {
8358        set sel [$ctext tag ranges sel]
8359        if {$sel ne {}} {
8360            set start [lindex $sel 0]
8361        } elseif {[catch {set start [$ctext index anchor]}]} {
8362            set start @0,[winfo height $ctext]
8363        }
8364        set match [$ctext search -backwards -count ml -- $searchstring $start]
8365        $ctext tag remove sel 1.0 end
8366        if {$match eq {}} {
8367            bell
8368            return
8369        }
8370        $ctext see $match
8371        suppress_highlighting_file_for_current_scrollpos
8372        highlightfile_for_scrollpos $match
8373        set mend "$match + $ml c"
8374        $ctext tag add sel $match $mend
8375        $ctext mark unset anchor
8376        rehighlight_search_results
8377    }
8378}
8379
8380proc rehighlight_search_results {} {
8381    global ctext searchstring
8382
8383    $ctext tag remove found 1.0 end
8384    $ctext tag remove currentsearchhit 1.0 end
8385
8386    if {$searchstring ne {}} {
8387        searchmarkvisible 1
8388    }
8389}
8390
8391proc searchmark {first last} {
8392    global ctext searchstring
8393
8394    set sel [$ctext tag ranges sel]
8395
8396    set mend $first.0
8397    while {1} {
8398        set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8399        if {$match eq {}} break
8400        set mend "$match + $mlen c"
8401        if {$sel ne {} && [$ctext compare $match == [lindex $sel 0]]} {
8402            $ctext tag add currentsearchhit $match $mend
8403        } else {
8404            $ctext tag add found $match $mend
8405        }
8406    }
8407}
8408
8409proc searchmarkvisible {doall} {
8410    global ctext smarktop smarkbot
8411
8412    set topline [lindex [split [$ctext index @0,0] .] 0]
8413    set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8414    if {$doall || $botline < $smarktop || $topline > $smarkbot} {
8415        # no overlap with previous
8416        searchmark $topline $botline
8417        set smarktop $topline
8418        set smarkbot $botline
8419    } else {
8420        if {$topline < $smarktop} {
8421            searchmark $topline [expr {$smarktop-1}]
8422            set smarktop $topline
8423        }
8424        if {$botline > $smarkbot} {
8425            searchmark [expr {$smarkbot+1}] $botline
8426            set smarkbot $botline
8427        }
8428    }
8429}
8430
8431proc suppress_highlighting_file_for_current_scrollpos {} {
8432    global ctext suppress_highlighting_file_for_this_scrollpos
8433
8434    set suppress_highlighting_file_for_this_scrollpos [$ctext index @0,0]
8435}
8436
8437proc scrolltext {f0 f1} {
8438    global searchstring cmitmode ctext
8439    global suppress_highlighting_file_for_this_scrollpos
8440
8441    set topidx [$ctext index @0,0]
8442    if {![info exists suppress_highlighting_file_for_this_scrollpos]
8443        || $topidx ne $suppress_highlighting_file_for_this_scrollpos} {
8444        highlightfile_for_scrollpos $topidx
8445    }
8446
8447    catch {unset suppress_highlighting_file_for_this_scrollpos}
8448
8449    .bleft.bottom.sb set $f0 $f1
8450    if {$searchstring ne {}} {
8451        searchmarkvisible 0
8452    }
8453}
8454
8455proc setcoords {} {
8456    global linespc charspc canvx0 canvy0
8457    global xspc1 xspc2 lthickness
8458
8459    set linespc [font metrics mainfont -linespace]
8460    set charspc [font measure mainfont "m"]
8461    set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8462    set canvx0 [expr {int(3 + 0.5 * $linespc)}]
8463    set lthickness [expr {int($linespc / 9) + 1}]
8464    set xspc1(0) $linespc
8465    set xspc2 $linespc
8466}
8467
8468proc redisplay {} {
8469    global canv
8470    global selectedline
8471
8472    set ymax [lindex [$canv cget -scrollregion] 3]
8473    if {$ymax eq {} || $ymax == 0} return
8474    set span [$canv yview]
8475    clear_display
8476    setcanvscroll
8477    allcanvs yview moveto [lindex $span 0]
8478    drawvisible
8479    if {$selectedline ne {}} {
8480        selectline $selectedline 0
8481        allcanvs yview moveto [lindex $span 0]
8482    }
8483}
8484
8485proc parsefont {f n} {
8486    global fontattr
8487
8488    set fontattr($f,family) [lindex $n 0]
8489    set s [lindex $n 1]
8490    if {$s eq {} || $s == 0} {
8491        set s 10
8492    } elseif {$s < 0} {
8493        set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
8494    }
8495    set fontattr($f,size) $s
8496    set fontattr($f,weight) normal
8497    set fontattr($f,slant) roman
8498    foreach style [lrange $n 2 end] {
8499        switch -- $style {
8500            "normal" -
8501            "bold"   {set fontattr($f,weight) $style}
8502            "roman" -
8503            "italic" {set fontattr($f,slant) $style}
8504        }
8505    }
8506}
8507
8508proc fontflags {f {isbold 0}} {
8509    global fontattr
8510
8511    return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8512                -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8513                -slant $fontattr($f,slant)]
8514}
8515
8516proc fontname {f} {
8517    global fontattr
8518
8519    set n [list $fontattr($f,family) $fontattr($f,size)]
8520    if {$fontattr($f,weight) eq "bold"} {
8521        lappend n "bold"
8522    }
8523    if {$fontattr($f,slant) eq "italic"} {
8524        lappend n "italic"
8525    }
8526    return $n
8527}
8528
8529proc incrfont {inc} {
8530    global mainfont textfont ctext canv cflist showrefstop
8531    global stopped entries fontattr
8532
8533    unmarkmatches
8534    set s $fontattr(mainfont,size)
8535    incr s $inc
8536    if {$s < 1} {
8537        set s 1
8538    }
8539    set fontattr(mainfont,size) $s
8540    font config mainfont -size $s
8541    font config mainfontbold -size $s
8542    set mainfont [fontname mainfont]
8543    set s $fontattr(textfont,size)
8544    incr s $inc
8545    if {$s < 1} {
8546        set s 1
8547    }
8548    set fontattr(textfont,size) $s
8549    font config textfont -size $s
8550    font config textfontbold -size $s
8551    set textfont [fontname textfont]
8552    setcoords
8553    settabs
8554    redisplay
8555}
8556
8557proc clearsha1 {} {
8558    global sha1entry sha1string
8559    if {[string length $sha1string] == 40} {
8560        $sha1entry delete 0 end
8561    }
8562}
8563
8564proc sha1change {n1 n2 op} {
8565    global sha1string currentid sha1but
8566    if {$sha1string == {}
8567        || ([info exists currentid] && $sha1string == $currentid)} {
8568        set state disabled
8569    } else {
8570        set state normal
8571    }
8572    if {[$sha1but cget -state] == $state} return
8573    if {$state == "normal"} {
8574        $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
8575    } else {
8576        $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
8577    }
8578}
8579
8580proc gotocommit {} {
8581    global sha1string tagids headids curview varcid
8582
8583    if {$sha1string == {}
8584        || ([info exists currentid] && $sha1string == $currentid)} return
8585    if {[info exists tagids($sha1string)]} {
8586        set id $tagids($sha1string)
8587    } elseif {[info exists headids($sha1string)]} {
8588        set id $headids($sha1string)
8589    } else {
8590        set id [string tolower $sha1string]
8591        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
8592            set matches [longid $id]
8593            if {$matches ne {}} {
8594                if {[llength $matches] > 1} {
8595                    error_popup [mc "Short SHA1 id %s is ambiguous" $id]
8596                    return
8597                }
8598                set id [lindex $matches 0]
8599            }
8600        } else {
8601            if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8602                error_popup [mc "Revision %s is not known" $sha1string]
8603                return
8604            }
8605        }
8606    }
8607    if {[commitinview $id $curview]} {
8608        selectline [rowofcommit $id] 1
8609        return
8610    }
8611    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
8612        set msg [mc "SHA1 id %s is not known" $sha1string]
8613    } else {
8614        set msg [mc "Revision %s is not in the current view" $sha1string]
8615    }
8616    error_popup $msg
8617}
8618
8619proc lineenter {x y id} {
8620    global hoverx hovery hoverid hovertimer
8621    global commitinfo canv
8622
8623    if {![info exists commitinfo($id)] && ![getcommit $id]} return
8624    set hoverx $x
8625    set hovery $y
8626    set hoverid $id
8627    if {[info exists hovertimer]} {
8628        after cancel $hovertimer
8629    }
8630    set hovertimer [after 500 linehover]
8631    $canv delete hover
8632}
8633
8634proc linemotion {x y id} {
8635    global hoverx hovery hoverid hovertimer
8636
8637    if {[info exists hoverid] && $id == $hoverid} {
8638        set hoverx $x
8639        set hovery $y
8640        if {[info exists hovertimer]} {
8641            after cancel $hovertimer
8642        }
8643        set hovertimer [after 500 linehover]
8644    }
8645}
8646
8647proc lineleave {id} {
8648    global hoverid hovertimer canv
8649
8650    if {[info exists hoverid] && $id == $hoverid} {
8651        $canv delete hover
8652        if {[info exists hovertimer]} {
8653            after cancel $hovertimer
8654            unset hovertimer
8655        }
8656        unset hoverid
8657    }
8658}
8659
8660proc linehover {} {
8661    global hoverx hovery hoverid hovertimer
8662    global canv linespc lthickness
8663    global linehoverbgcolor linehoverfgcolor linehoveroutlinecolor
8664
8665    global commitinfo
8666
8667    set text [lindex $commitinfo($hoverid) 0]
8668    set ymax [lindex [$canv cget -scrollregion] 3]
8669    if {$ymax == {}} return
8670    set yfrac [lindex [$canv yview] 0]
8671    set x [expr {$hoverx + 2 * $linespc}]
8672    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8673    set x0 [expr {$x - 2 * $lthickness}]
8674    set y0 [expr {$y - 2 * $lthickness}]
8675    set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
8676    set y1 [expr {$y + $linespc + 2 * $lthickness}]
8677    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8678               -fill $linehoverbgcolor -outline $linehoveroutlinecolor \
8679               -width 1 -tags hover]
8680    $canv raise $t
8681    set t [$canv create text $x $y -anchor nw -text $text -tags hover \
8682               -font mainfont -fill $linehoverfgcolor]
8683    $canv raise $t
8684}
8685
8686proc clickisonarrow {id y} {
8687    global lthickness
8688
8689    set ranges [rowranges $id]
8690    set thresh [expr {2 * $lthickness + 6}]
8691    set n [expr {[llength $ranges] - 1}]
8692    for {set i 1} {$i < $n} {incr i} {
8693        set row [lindex $ranges $i]
8694        if {abs([yc $row] - $y) < $thresh} {
8695            return $i
8696        }
8697    }
8698    return {}
8699}
8700
8701proc arrowjump {id n y} {
8702    global canv
8703
8704    # 1 <-> 2, 3 <-> 4, etc...
8705    set n [expr {(($n - 1) ^ 1) + 1}]
8706    set row [lindex [rowranges $id] $n]
8707    set yt [yc $row]
8708    set ymax [lindex [$canv cget -scrollregion] 3]
8709    if {$ymax eq {} || $ymax <= 0} return
8710    set view [$canv yview]
8711    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8712    set yfrac [expr {$yt / $ymax - $yspan / 2}]
8713    if {$yfrac < 0} {
8714        set yfrac 0
8715    }
8716    allcanvs yview moveto $yfrac
8717}
8718
8719proc lineclick {x y id isnew} {
8720    global ctext commitinfo children canv thickerline curview
8721
8722    if {![info exists commitinfo($id)] && ![getcommit $id]} return
8723    unmarkmatches
8724    unselectline
8725    normalline
8726    $canv delete hover
8727    # draw this line thicker than normal
8728    set thickerline $id
8729    drawlines $id
8730    if {$isnew} {
8731        set ymax [lindex [$canv cget -scrollregion] 3]
8732        if {$ymax eq {}} return
8733        set yfrac [lindex [$canv yview] 0]
8734        set y [expr {$y + $yfrac * $ymax}]
8735    }
8736    set dirn [clickisonarrow $id $y]
8737    if {$dirn ne {}} {
8738        arrowjump $id $dirn $y
8739        return
8740    }
8741
8742    if {$isnew} {
8743        addtohistory [list lineclick $x $y $id 0] savectextpos
8744    }
8745    # fill the details pane with info about this line
8746    $ctext conf -state normal
8747    clear_ctext
8748    settabs 0
8749    $ctext insert end "[mc "Parent"]:\t"
8750    $ctext insert end $id link0
8751    setlink $id link0
8752    set info $commitinfo($id)
8753    $ctext insert end "\n\t[lindex $info 0]\n"
8754    $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8755    set date [formatdate [lindex $info 2]]
8756    $ctext insert end "\t[mc "Date"]:\t$date\n"
8757    set kids $children($curview,$id)
8758    if {$kids ne {}} {
8759        $ctext insert end "\n[mc "Children"]:"
8760        set i 0
8761        foreach child $kids {
8762            incr i
8763            if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8764            set info $commitinfo($child)
8765            $ctext insert end "\n\t"
8766            $ctext insert end $child link$i
8767            setlink $child link$i
8768            $ctext insert end "\n\t[lindex $info 0]"
8769            $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8770            set date [formatdate [lindex $info 2]]
8771            $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8772        }
8773    }
8774    maybe_scroll_ctext 1
8775    $ctext conf -state disabled
8776    init_flist {}
8777}
8778
8779proc normalline {} {
8780    global thickerline
8781    if {[info exists thickerline]} {
8782        set id $thickerline
8783        unset thickerline
8784        drawlines $id
8785    }
8786}
8787
8788proc selbyid {id {isnew 1}} {
8789    global curview
8790    if {[commitinview $id $curview]} {
8791        selectline [rowofcommit $id] $isnew
8792    }
8793}
8794
8795proc mstime {} {
8796    global startmstime
8797    if {![info exists startmstime]} {
8798        set startmstime [clock clicks -milliseconds]
8799    }
8800    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8801}
8802
8803proc rowmenu {x y id} {
8804    global rowctxmenu selectedline rowmenuid curview
8805    global nullid nullid2 fakerowmenu mainhead markedid
8806
8807    stopfinding
8808    set rowmenuid $id
8809    if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8810        set state disabled
8811    } else {
8812        set state normal
8813    }
8814    if {[info exists markedid] && $markedid ne $id} {
8815        set mstate normal
8816    } else {
8817        set mstate disabled
8818    }
8819    if {$id ne $nullid && $id ne $nullid2} {
8820        set menu $rowctxmenu
8821        if {$mainhead ne {}} {
8822            $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead] -state normal
8823        } else {
8824            $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8825        }
8826        $menu entryconfigure 9 -state $mstate
8827        $menu entryconfigure 10 -state $mstate
8828        $menu entryconfigure 11 -state $mstate
8829    } else {
8830        set menu $fakerowmenu
8831    }
8832    $menu entryconfigure [mca "Diff this -> selected"] -state $state
8833    $menu entryconfigure [mca "Diff selected -> this"] -state $state
8834    $menu entryconfigure [mca "Make patch"] -state $state
8835    $menu entryconfigure [mca "Diff this -> marked commit"] -state $mstate
8836    $menu entryconfigure [mca "Diff marked commit -> this"] -state $mstate
8837    tk_popup $menu $x $y
8838}
8839
8840proc markhere {} {
8841    global rowmenuid markedid canv
8842
8843    set markedid $rowmenuid
8844    make_idmark $markedid
8845}
8846
8847proc gotomark {} {
8848    global markedid
8849
8850    if {[info exists markedid]} {
8851        selbyid $markedid
8852    }
8853}
8854
8855proc replace_by_kids {l r} {
8856    global curview children
8857
8858    set id [commitonrow $r]
8859    set l [lreplace $l 0 0]
8860    foreach kid $children($curview,$id) {
8861        lappend l [rowofcommit $kid]
8862    }
8863    return [lsort -integer -decreasing -unique $l]
8864}
8865
8866proc find_common_desc {} {
8867    global markedid rowmenuid curview children
8868
8869    if {![info exists markedid]} return
8870    if {![commitinview $markedid $curview] ||
8871        ![commitinview $rowmenuid $curview]} return
8872    #set t1 [clock clicks -milliseconds]
8873    set l1 [list [rowofcommit $markedid]]
8874    set l2 [list [rowofcommit $rowmenuid]]
8875    while 1 {
8876        set r1 [lindex $l1 0]
8877        set r2 [lindex $l2 0]
8878        if {$r1 eq {} || $r2 eq {}} break
8879        if {$r1 == $r2} {
8880            selectline $r1 1
8881            break
8882        }
8883        if {$r1 > $r2} {
8884            set l1 [replace_by_kids $l1 $r1]
8885        } else {
8886            set l2 [replace_by_kids $l2 $r2]
8887        }
8888    }
8889    #set t2 [clock clicks -milliseconds]
8890    #puts "took [expr {$t2-$t1}]ms"
8891}
8892
8893proc compare_commits {} {
8894    global markedid rowmenuid curview children
8895
8896    if {![info exists markedid]} return
8897    if {![commitinview $markedid $curview]} return
8898    addtohistory [list do_cmp_commits $markedid $rowmenuid]
8899    do_cmp_commits $markedid $rowmenuid
8900}
8901
8902proc getpatchid {id} {
8903    global patchids
8904
8905    if {![info exists patchids($id)]} {
8906        set cmd [diffcmd [list $id] {-p --root}]
8907        # trim off the initial "|"
8908        set cmd [lrange $cmd 1 end]
8909        if {[catch {
8910            set x [eval exec $cmd | git patch-id]
8911            set patchids($id) [lindex $x 0]
8912        }]} {
8913            set patchids($id) "error"
8914        }
8915    }
8916    return $patchids($id)
8917}
8918
8919proc do_cmp_commits {a b} {
8920    global ctext curview parents children patchids commitinfo
8921
8922    $ctext conf -state normal
8923    clear_ctext
8924    init_flist {}
8925    for {set i 0} {$i < 100} {incr i} {
8926        set skipa 0
8927        set skipb 0
8928        if {[llength $parents($curview,$a)] > 1} {
8929            appendshortlink $a [mc "Skipping merge commit "] "\n"
8930            set skipa 1
8931        } else {
8932            set patcha [getpatchid $a]
8933        }
8934        if {[llength $parents($curview,$b)] > 1} {
8935            appendshortlink $b [mc "Skipping merge commit "] "\n"
8936            set skipb 1
8937        } else {
8938            set patchb [getpatchid $b]
8939        }
8940        if {!$skipa && !$skipb} {
8941            set heada [lindex $commitinfo($a) 0]
8942            set headb [lindex $commitinfo($b) 0]
8943            if {$patcha eq "error"} {
8944                appendshortlink $a [mc "Error getting patch ID for "] \
8945                    [mc " - stopping\n"]
8946                break
8947            }
8948            if {$patchb eq "error"} {
8949                appendshortlink $b [mc "Error getting patch ID for "] \
8950                    [mc " - stopping\n"]
8951                break
8952            }
8953            if {$patcha eq $patchb} {
8954                if {$heada eq $headb} {
8955                    appendshortlink $a [mc "Commit "]
8956                    appendshortlink $b " == " "  $heada\n"
8957                } else {
8958                    appendshortlink $a [mc "Commit "] "  $heada\n"
8959                    appendshortlink $b [mc " is the same patch as\n       "] \
8960                        "  $headb\n"
8961                }
8962                set skipa 1
8963                set skipb 1
8964            } else {
8965                $ctext insert end "\n"
8966                appendshortlink $a [mc "Commit "] "  $heada\n"
8967                appendshortlink $b [mc " differs from\n       "] \
8968                    "  $headb\n"
8969                $ctext insert end [mc "Diff of commits:\n\n"]
8970                $ctext conf -state disabled
8971                update
8972                diffcommits $a $b
8973                return
8974            }
8975        }
8976        if {$skipa} {
8977            set kids [real_children $curview,$a]
8978            if {[llength $kids] != 1} {
8979                $ctext insert end "\n"
8980                appendshortlink $a [mc "Commit "] \
8981                    [mc " has %s children - stopping\n" [llength $kids]]
8982                break
8983            }
8984            set a [lindex $kids 0]
8985        }
8986        if {$skipb} {
8987            set kids [real_children $curview,$b]
8988            if {[llength $kids] != 1} {
8989                appendshortlink $b [mc "Commit "] \
8990                    [mc " has %s children - stopping\n" [llength $kids]]
8991                break
8992            }
8993            set b [lindex $kids 0]
8994        }
8995    }
8996    $ctext conf -state disabled
8997}
8998
8999proc diffcommits {a b} {
9000    global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
9001
9002    set tmpdir [gitknewtmpdir]
9003    set fna [file join $tmpdir "commit-[string range $a 0 7]"]
9004    set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
9005    if {[catch {
9006        exec git diff-tree -p --pretty $a >$fna
9007        exec git diff-tree -p --pretty $b >$fnb
9008    } err]} {
9009        error_popup [mc "Error writing commit to file: %s" $err]
9010        return
9011    }
9012    if {[catch {
9013        set fd [open "| diff -U$diffcontext $fna $fnb" r]
9014    } err]} {
9015        error_popup [mc "Error diffing commits: %s" $err]
9016        return
9017    }
9018    set diffids [list commits $a $b]
9019    set blobdifffd($diffids) $fd
9020    set diffinhdr 0
9021    set currdiffsubmod ""
9022    filerun $fd [list getblobdiffline $fd $diffids]
9023}
9024
9025proc diffvssel {dirn} {
9026    global rowmenuid selectedline
9027
9028    if {$selectedline eq {}} return
9029    if {$dirn} {
9030        set oldid [commitonrow $selectedline]
9031        set newid $rowmenuid
9032    } else {
9033        set oldid $rowmenuid
9034        set newid [commitonrow $selectedline]
9035    }
9036    addtohistory [list doseldiff $oldid $newid] savectextpos
9037    doseldiff $oldid $newid
9038}
9039
9040proc diffvsmark {dirn} {
9041    global rowmenuid markedid
9042
9043    if {![info exists markedid]} return
9044    if {$dirn} {
9045        set oldid $markedid
9046        set newid $rowmenuid
9047    } else {
9048        set oldid $rowmenuid
9049        set newid $markedid
9050    }
9051    addtohistory [list doseldiff $oldid $newid] savectextpos
9052    doseldiff $oldid $newid
9053}
9054
9055proc doseldiff {oldid newid} {
9056    global ctext
9057    global commitinfo
9058
9059    $ctext conf -state normal
9060    clear_ctext
9061    init_flist [mc "Top"]
9062    $ctext insert end "[mc "From"] "
9063    $ctext insert end $oldid link0
9064    setlink $oldid link0
9065    $ctext insert end "\n     "
9066    $ctext insert end [lindex $commitinfo($oldid) 0]
9067    $ctext insert end "\n\n[mc "To"]   "
9068    $ctext insert end $newid link1
9069    setlink $newid link1
9070    $ctext insert end "\n     "
9071    $ctext insert end [lindex $commitinfo($newid) 0]
9072    $ctext insert end "\n"
9073    $ctext conf -state disabled
9074    $ctext tag remove found 1.0 end
9075    startdiff [list $oldid $newid]
9076}
9077
9078proc mkpatch {} {
9079    global rowmenuid currentid commitinfo patchtop patchnum NS
9080
9081    if {![info exists currentid]} return
9082    set oldid $currentid
9083    set oldhead [lindex $commitinfo($oldid) 0]
9084    set newid $rowmenuid
9085    set newhead [lindex $commitinfo($newid) 0]
9086    set top .patch
9087    set patchtop $top
9088    catch {destroy $top}
9089    ttk_toplevel $top
9090    make_transient $top .
9091    ${NS}::label $top.title -text [mc "Generate patch"]
9092    grid $top.title - -pady 10
9093    ${NS}::label $top.from -text [mc "From:"]
9094    ${NS}::entry $top.fromsha1 -width 40
9095    $top.fromsha1 insert 0 $oldid
9096    $top.fromsha1 conf -state readonly
9097    grid $top.from $top.fromsha1 -sticky w
9098    ${NS}::entry $top.fromhead -width 60
9099    $top.fromhead insert 0 $oldhead
9100    $top.fromhead conf -state readonly
9101    grid x $top.fromhead -sticky w
9102    ${NS}::label $top.to -text [mc "To:"]
9103    ${NS}::entry $top.tosha1 -width 40
9104    $top.tosha1 insert 0 $newid
9105    $top.tosha1 conf -state readonly
9106    grid $top.to $top.tosha1 -sticky w
9107    ${NS}::entry $top.tohead -width 60
9108    $top.tohead insert 0 $newhead
9109    $top.tohead conf -state readonly
9110    grid x $top.tohead -sticky w
9111    ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
9112    grid $top.rev x -pady 10 -padx 5
9113    ${NS}::label $top.flab -text [mc "Output file:"]
9114    ${NS}::entry $top.fname -width 60
9115    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
9116    incr patchnum
9117    grid $top.flab $top.fname -sticky w
9118    ${NS}::frame $top.buts
9119    ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
9120    ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
9121    bind $top <Key-Return> mkpatchgo
9122    bind $top <Key-Escape> mkpatchcan
9123    grid $top.buts.gen $top.buts.can
9124    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9125    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9126    grid $top.buts - -pady 10 -sticky ew
9127    focus $top.fname
9128}
9129
9130proc mkpatchrev {} {
9131    global patchtop
9132
9133    set oldid [$patchtop.fromsha1 get]
9134    set oldhead [$patchtop.fromhead get]
9135    set newid [$patchtop.tosha1 get]
9136    set newhead [$patchtop.tohead get]
9137    foreach e [list fromsha1 fromhead tosha1 tohead] \
9138            v [list $newid $newhead $oldid $oldhead] {
9139        $patchtop.$e conf -state normal
9140        $patchtop.$e delete 0 end
9141        $patchtop.$e insert 0 $v
9142        $patchtop.$e conf -state readonly
9143    }
9144}
9145
9146proc mkpatchgo {} {
9147    global patchtop nullid nullid2
9148
9149    set oldid [$patchtop.fromsha1 get]
9150    set newid [$patchtop.tosha1 get]
9151    set fname [$patchtop.fname get]
9152    set cmd [diffcmd [list $oldid $newid] -p]
9153    # trim off the initial "|"
9154    set cmd [lrange $cmd 1 end]
9155    lappend cmd >$fname &
9156    if {[catch {eval exec $cmd} err]} {
9157        error_popup "[mc "Error creating patch:"] $err" $patchtop
9158    }
9159    catch {destroy $patchtop}
9160    unset patchtop
9161}
9162
9163proc mkpatchcan {} {
9164    global patchtop
9165
9166    catch {destroy $patchtop}
9167    unset patchtop
9168}
9169
9170proc mktag {} {
9171    global rowmenuid mktagtop commitinfo NS
9172
9173    set top .maketag
9174    set mktagtop $top
9175    catch {destroy $top}
9176    ttk_toplevel $top
9177    make_transient $top .
9178    ${NS}::label $top.title -text [mc "Create tag"]
9179    grid $top.title - -pady 10
9180    ${NS}::label $top.id -text [mc "ID:"]
9181    ${NS}::entry $top.sha1 -width 40
9182    $top.sha1 insert 0 $rowmenuid
9183    $top.sha1 conf -state readonly
9184    grid $top.id $top.sha1 -sticky w
9185    ${NS}::entry $top.head -width 60
9186    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9187    $top.head conf -state readonly
9188    grid x $top.head -sticky w
9189    ${NS}::label $top.tlab -text [mc "Tag name:"]
9190    ${NS}::entry $top.tag -width 60
9191    grid $top.tlab $top.tag -sticky w
9192    ${NS}::label $top.op -text [mc "Tag message is optional"]
9193    grid $top.op -columnspan 2 -sticky we
9194    ${NS}::label $top.mlab -text [mc "Tag message:"]
9195    ${NS}::entry $top.msg -width 60
9196    grid $top.mlab $top.msg -sticky w
9197    ${NS}::frame $top.buts
9198    ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
9199    ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
9200    bind $top <Key-Return> mktaggo
9201    bind $top <Key-Escape> mktagcan
9202    grid $top.buts.gen $top.buts.can
9203    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9204    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9205    grid $top.buts - -pady 10 -sticky ew
9206    focus $top.tag
9207}
9208
9209proc domktag {} {
9210    global mktagtop env tagids idtags
9211
9212    set id [$mktagtop.sha1 get]
9213    set tag [$mktagtop.tag get]
9214    set msg [$mktagtop.msg get]
9215    if {$tag == {}} {
9216        error_popup [mc "No tag name specified"] $mktagtop
9217        return 0
9218    }
9219    if {[info exists tagids($tag)]} {
9220        error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
9221        return 0
9222    }
9223    if {[catch {
9224        if {$msg != {}} {
9225            exec git tag -a -m $msg $tag $id
9226        } else {
9227            exec git tag $tag $id
9228        }
9229    } err]} {
9230        error_popup "[mc "Error creating tag:"] $err" $mktagtop
9231        return 0
9232    }
9233
9234    set tagids($tag) $id
9235    lappend idtags($id) $tag
9236    redrawtags $id
9237    addedtag $id
9238    dispneartags 0
9239    run refill_reflist
9240    return 1
9241}
9242
9243proc redrawtags {id} {
9244    global canv linehtag idpos currentid curview cmitlisted markedid
9245    global canvxmax iddrawn circleitem mainheadid circlecolors
9246    global mainheadcirclecolor
9247
9248    if {![commitinview $id $curview]} return
9249    if {![info exists iddrawn($id)]} return
9250    set row [rowofcommit $id]
9251    if {$id eq $mainheadid} {
9252        set ofill $mainheadcirclecolor
9253    } else {
9254        set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
9255    }
9256    $canv itemconf $circleitem($row) -fill $ofill
9257    $canv delete tag.$id
9258    set xt [eval drawtags $id $idpos($id)]
9259    $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
9260    set text [$canv itemcget $linehtag($id) -text]
9261    set font [$canv itemcget $linehtag($id) -font]
9262    set xr [expr {$xt + [font measure $font $text]}]
9263    if {$xr > $canvxmax} {
9264        set canvxmax $xr
9265        setcanvscroll
9266    }
9267    if {[info exists currentid] && $currentid == $id} {
9268        make_secsel $id
9269    }
9270    if {[info exists markedid] && $markedid eq $id} {
9271        make_idmark $id
9272    }
9273}
9274
9275proc mktagcan {} {
9276    global mktagtop
9277
9278    catch {destroy $mktagtop}
9279    unset mktagtop
9280}
9281
9282proc mktaggo {} {
9283    if {![domktag]} return
9284    mktagcan
9285}
9286
9287proc writecommit {} {
9288    global rowmenuid wrcomtop commitinfo wrcomcmd NS
9289
9290    set top .writecommit
9291    set wrcomtop $top
9292    catch {destroy $top}
9293    ttk_toplevel $top
9294    make_transient $top .
9295    ${NS}::label $top.title -text [mc "Write commit to file"]
9296    grid $top.title - -pady 10
9297    ${NS}::label $top.id -text [mc "ID:"]
9298    ${NS}::entry $top.sha1 -width 40
9299    $top.sha1 insert 0 $rowmenuid
9300    $top.sha1 conf -state readonly
9301    grid $top.id $top.sha1 -sticky w
9302    ${NS}::entry $top.head -width 60
9303    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9304    $top.head conf -state readonly
9305    grid x $top.head -sticky w
9306    ${NS}::label $top.clab -text [mc "Command:"]
9307    ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
9308    grid $top.clab $top.cmd -sticky w -pady 10
9309    ${NS}::label $top.flab -text [mc "Output file:"]
9310    ${NS}::entry $top.fname -width 60
9311    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
9312    grid $top.flab $top.fname -sticky w
9313    ${NS}::frame $top.buts
9314    ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
9315    ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
9316    bind $top <Key-Return> wrcomgo
9317    bind $top <Key-Escape> wrcomcan
9318    grid $top.buts.gen $top.buts.can
9319    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9320    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9321    grid $top.buts - -pady 10 -sticky ew
9322    focus $top.fname
9323}
9324
9325proc wrcomgo {} {
9326    global wrcomtop
9327
9328    set id [$wrcomtop.sha1 get]
9329    set cmd "echo $id | [$wrcomtop.cmd get]"
9330    set fname [$wrcomtop.fname get]
9331    if {[catch {exec sh -c $cmd >$fname &} err]} {
9332        error_popup "[mc "Error writing commit:"] $err" $wrcomtop
9333    }
9334    catch {destroy $wrcomtop}
9335    unset wrcomtop
9336}
9337
9338proc wrcomcan {} {
9339    global wrcomtop
9340
9341    catch {destroy $wrcomtop}
9342    unset wrcomtop
9343}
9344
9345proc mkbranch {} {
9346    global rowmenuid mkbrtop NS
9347
9348    set top .makebranch
9349    catch {destroy $top}
9350    ttk_toplevel $top
9351    make_transient $top .
9352    ${NS}::label $top.title -text [mc "Create new branch"]
9353    grid $top.title - -pady 10
9354    ${NS}::label $top.id -text [mc "ID:"]
9355    ${NS}::entry $top.sha1 -width 40
9356    $top.sha1 insert 0 $rowmenuid
9357    $top.sha1 conf -state readonly
9358    grid $top.id $top.sha1 -sticky w
9359    ${NS}::label $top.nlab -text [mc "Name:"]
9360    ${NS}::entry $top.name -width 40
9361    grid $top.nlab $top.name -sticky w
9362    ${NS}::frame $top.buts
9363    ${NS}::button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
9364    ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
9365    bind $top <Key-Return> [list mkbrgo $top]
9366    bind $top <Key-Escape> "catch {destroy $top}"
9367    grid $top.buts.go $top.buts.can
9368    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9369    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9370    grid $top.buts - -pady 10 -sticky ew
9371    focus $top.name
9372}
9373
9374proc mkbrgo {top} {
9375    global headids idheads
9376
9377    set name [$top.name get]
9378    set id [$top.sha1 get]
9379    set cmdargs {}
9380    set old_id {}
9381    if {$name eq {}} {
9382        error_popup [mc "Please specify a name for the new branch"] $top
9383        return
9384    }
9385    if {[info exists headids($name)]} {
9386        if {![confirm_popup [mc \
9387                "Branch '%s' already exists. Overwrite?" $name] $top]} {
9388            return
9389        }
9390        set old_id $headids($name)
9391        lappend cmdargs -f
9392    }
9393    catch {destroy $top}
9394    lappend cmdargs $name $id
9395    nowbusy newbranch
9396    update
9397    if {[catch {
9398        eval exec git branch $cmdargs
9399    } err]} {
9400        notbusy newbranch
9401        error_popup $err
9402    } else {
9403        notbusy newbranch
9404        if {$old_id ne {}} {
9405            movehead $id $name
9406            movedhead $id $name
9407            redrawtags $old_id
9408            redrawtags $id
9409        } else {
9410            set headids($name) $id
9411            lappend idheads($id) $name
9412            addedhead $id $name
9413            redrawtags $id
9414        }
9415        dispneartags 0
9416        run refill_reflist
9417    }
9418}
9419
9420proc exec_citool {tool_args {baseid {}}} {
9421    global commitinfo env
9422
9423    set save_env [array get env GIT_AUTHOR_*]
9424
9425    if {$baseid ne {}} {
9426        if {![info exists commitinfo($baseid)]} {
9427            getcommit $baseid
9428        }
9429        set author [lindex $commitinfo($baseid) 1]
9430        set date [lindex $commitinfo($baseid) 2]
9431        if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9432                    $author author name email]
9433            && $date ne {}} {
9434            set env(GIT_AUTHOR_NAME) $name
9435            set env(GIT_AUTHOR_EMAIL) $email
9436            set env(GIT_AUTHOR_DATE) $date
9437        }
9438    }
9439
9440    eval exec git citool $tool_args &
9441
9442    array unset env GIT_AUTHOR_*
9443    array set env $save_env
9444}
9445
9446proc cherrypick {} {
9447    global rowmenuid curview
9448    global mainhead mainheadid
9449    global gitdir
9450
9451    set oldhead [exec git rev-parse HEAD]
9452    set dheads [descheads $rowmenuid]
9453    if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
9454        set ok [confirm_popup [mc "Commit %s is already\
9455                included in branch %s -- really re-apply it?" \
9456                                   [string range $rowmenuid 0 7] $mainhead]]
9457        if {!$ok} return
9458    }
9459    nowbusy cherrypick [mc "Cherry-picking"]
9460    update
9461    # Unfortunately git-cherry-pick writes stuff to stderr even when
9462    # no error occurs, and exec takes that as an indication of error...
9463    if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9464        notbusy cherrypick
9465        if {[regexp -line \
9466                 {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9467                 $err msg fname]} {
9468            error_popup [mc "Cherry-pick failed because of local changes\
9469                        to file '%s'.\nPlease commit, reset or stash\
9470                        your changes and try again." $fname]
9471        } elseif {[regexp -line \
9472                       {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
9473                       $err]} {
9474            if {[confirm_popup [mc "Cherry-pick failed because of merge\
9475                        conflict.\nDo you wish to run git citool to\
9476                        resolve it?"]]} {
9477                # Force citool to read MERGE_MSG
9478                file delete [file join $gitdir "GITGUI_MSG"]
9479                exec_citool {} $rowmenuid
9480            }
9481        } else {
9482            error_popup $err
9483        }
9484        run updatecommits
9485        return
9486    }
9487    set newhead [exec git rev-parse HEAD]
9488    if {$newhead eq $oldhead} {
9489        notbusy cherrypick
9490        error_popup [mc "No changes committed"]
9491        return
9492    }
9493    addnewchild $newhead $oldhead
9494    if {[commitinview $oldhead $curview]} {
9495        # XXX this isn't right if we have a path limit...
9496        insertrow $newhead $oldhead $curview
9497        if {$mainhead ne {}} {
9498            movehead $newhead $mainhead
9499            movedhead $newhead $mainhead
9500        }
9501        set mainheadid $newhead
9502        redrawtags $oldhead
9503        redrawtags $newhead
9504        selbyid $newhead
9505    }
9506    notbusy cherrypick
9507}
9508
9509proc revert {} {
9510    global rowmenuid curview
9511    global mainhead mainheadid
9512    global gitdir
9513
9514    set oldhead [exec git rev-parse HEAD]
9515    set dheads [descheads $rowmenuid]
9516    if { $dheads eq {} || [lsearch -exact $dheads $oldhead] == -1 } {
9517       set ok [confirm_popup [mc "Commit %s is not\
9518           included in branch %s -- really revert it?" \
9519                      [string range $rowmenuid 0 7] $mainhead]]
9520       if {!$ok} return
9521    }
9522    nowbusy revert [mc "Reverting"]
9523    update
9524
9525    if [catch {exec git revert --no-edit $rowmenuid} err] {
9526        notbusy revert
9527        if [regexp {files would be overwritten by merge:(\n(( |\t)+[^\n]+\n)+)}\
9528                $err match files] {
9529            regsub {\n( |\t)+} $files "\n" files
9530            error_popup [mc "Revert failed because of local changes to\
9531                the following files:%s Please commit, reset or stash \
9532                your changes and try again." $files]
9533        } elseif [regexp {error: could not revert} $err] {
9534            if [confirm_popup [mc "Revert failed because of merge conflict.\n\
9535                Do you wish to run git citool to resolve it?"]] {
9536                # Force citool to read MERGE_MSG
9537                file delete [file join $gitdir "GITGUI_MSG"]
9538                exec_citool {} $rowmenuid
9539            }
9540        } else { error_popup $err }
9541        run updatecommits
9542        return
9543    }
9544
9545    set newhead [exec git rev-parse HEAD]
9546    if { $newhead eq $oldhead } {
9547        notbusy revert
9548        error_popup [mc "No changes committed"]
9549        return
9550    }
9551
9552    addnewchild $newhead $oldhead
9553
9554    if [commitinview $oldhead $curview] {
9555        # XXX this isn't right if we have a path limit...
9556        insertrow $newhead $oldhead $curview
9557        if {$mainhead ne {}} {
9558            movehead $newhead $mainhead
9559            movedhead $newhead $mainhead
9560        }
9561        set mainheadid $newhead
9562        redrawtags $oldhead
9563        redrawtags $newhead
9564        selbyid $newhead
9565    }
9566
9567    notbusy revert
9568}
9569
9570proc resethead {} {
9571    global mainhead rowmenuid confirm_ok resettype NS
9572
9573    set confirm_ok 0
9574    set w ".confirmreset"
9575    ttk_toplevel $w
9576    make_transient $w .
9577    wm title $w [mc "Confirm reset"]
9578    ${NS}::label $w.m -text \
9579        [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
9580    pack $w.m -side top -fill x -padx 20 -pady 20
9581    ${NS}::labelframe $w.f -text [mc "Reset type:"]
9582    set resettype mixed
9583    ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
9584        -text [mc "Soft: Leave working tree and index untouched"]
9585    grid $w.f.soft -sticky w
9586    ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
9587        -text [mc "Mixed: Leave working tree untouched, reset index"]
9588    grid $w.f.mixed -sticky w
9589    ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
9590        -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
9591    grid $w.f.hard -sticky w
9592    pack $w.f -side top -fill x -padx 4
9593    ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
9594    pack $w.ok -side left -fill x -padx 20 -pady 20
9595    ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
9596    bind $w <Key-Escape> [list destroy $w]
9597    pack $w.cancel -side right -fill x -padx 20 -pady 20
9598    bind $w <Visibility> "grab $w; focus $w"
9599    tkwait window $w
9600    if {!$confirm_ok} return
9601    if {[catch {set fd [open \
9602            [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
9603        error_popup $err
9604    } else {
9605        dohidelocalchanges
9606        filerun $fd [list readresetstat $fd]
9607        nowbusy reset [mc "Resetting"]
9608        selbyid $rowmenuid
9609    }
9610}
9611
9612proc readresetstat {fd} {
9613    global mainhead mainheadid showlocalchanges rprogcoord
9614
9615    if {[gets $fd line] >= 0} {
9616        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9617            set rprogcoord [expr {1.0 * $m / $n}]
9618            adjustprogress
9619        }
9620        return 1
9621    }
9622    set rprogcoord 0
9623    adjustprogress
9624    notbusy reset
9625    if {[catch {close $fd} err]} {
9626        error_popup $err
9627    }
9628    set oldhead $mainheadid
9629    set newhead [exec git rev-parse HEAD]
9630    if {$newhead ne $oldhead} {
9631        movehead $newhead $mainhead
9632        movedhead $newhead $mainhead
9633        set mainheadid $newhead
9634        redrawtags $oldhead
9635        redrawtags $newhead
9636    }
9637    if {$showlocalchanges} {
9638        doshowlocalchanges
9639    }
9640    return 0
9641}
9642
9643# context menu for a head
9644proc headmenu {x y id head} {
9645    global headmenuid headmenuhead headctxmenu mainhead
9646
9647    stopfinding
9648    set headmenuid $id
9649    set headmenuhead $head
9650    set state normal
9651    if {[string match "remotes/*" $head]} {
9652        set state disabled
9653    }
9654    if {$head eq $mainhead} {
9655        set state disabled
9656    }
9657    $headctxmenu entryconfigure 0 -state $state
9658    $headctxmenu entryconfigure 1 -state $state
9659    tk_popup $headctxmenu $x $y
9660}
9661
9662proc cobranch {} {
9663    global headmenuid headmenuhead headids
9664    global showlocalchanges
9665
9666    # check the tree is clean first??
9667    nowbusy checkout [mc "Checking out"]
9668    update
9669    dohidelocalchanges
9670    if {[catch {
9671        set fd [open [list | git checkout $headmenuhead 2>@1] r]
9672    } err]} {
9673        notbusy checkout
9674        error_popup $err
9675        if {$showlocalchanges} {
9676            dodiffindex
9677        }
9678    } else {
9679        filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
9680    }
9681}
9682
9683proc readcheckoutstat {fd newhead newheadid} {
9684    global mainhead mainheadid headids showlocalchanges progresscoords
9685    global viewmainheadid curview
9686
9687    if {[gets $fd line] >= 0} {
9688        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9689            set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9690            adjustprogress
9691        }
9692        return 1
9693    }
9694    set progresscoords {0 0}
9695    adjustprogress
9696    notbusy checkout
9697    if {[catch {close $fd} err]} {
9698        error_popup $err
9699    }
9700    set oldmainid $mainheadid
9701    set mainhead $newhead
9702    set mainheadid $newheadid
9703    set viewmainheadid($curview) $newheadid
9704    redrawtags $oldmainid
9705    redrawtags $newheadid
9706    selbyid $newheadid
9707    if {$showlocalchanges} {
9708        dodiffindex
9709    }
9710}
9711
9712proc rmbranch {} {
9713    global headmenuid headmenuhead mainhead
9714    global idheads
9715
9716    set head $headmenuhead
9717    set id $headmenuid
9718    # this check shouldn't be needed any more...
9719    if {$head eq $mainhead} {
9720        error_popup [mc "Cannot delete the currently checked-out branch"]
9721        return
9722    }
9723    set dheads [descheads $id]
9724    if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
9725        # the stuff on this branch isn't on any other branch
9726        if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9727                        branch.\nReally delete branch %s?" $head $head]]} return
9728    }
9729    nowbusy rmbranch
9730    update
9731    if {[catch {exec git branch -D $head} err]} {
9732        notbusy rmbranch
9733        error_popup $err
9734        return
9735    }
9736    removehead $id $head
9737    removedhead $id $head
9738    redrawtags $id
9739    notbusy rmbranch
9740    dispneartags 0
9741    run refill_reflist
9742}
9743
9744# Display a list of tags and heads
9745proc showrefs {} {
9746    global showrefstop bgcolor fgcolor selectbgcolor NS
9747    global bglist fglist reflistfilter reflist maincursor
9748
9749    set top .showrefs
9750    set showrefstop $top
9751    if {[winfo exists $top]} {
9752        raise $top
9753        refill_reflist
9754        return
9755    }
9756    ttk_toplevel $top
9757    wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
9758    make_transient $top .
9759    text $top.list -background $bgcolor -foreground $fgcolor \
9760        -selectbackground $selectbgcolor -font mainfont \
9761        -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
9762        -width 30 -height 20 -cursor $maincursor \
9763        -spacing1 1 -spacing3 1 -state disabled
9764    $top.list tag configure highlight -background $selectbgcolor
9765    lappend bglist $top.list
9766    lappend fglist $top.list
9767    ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
9768    ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
9769    grid $top.list $top.ysb -sticky nsew
9770    grid $top.xsb x -sticky ew
9771    ${NS}::frame $top.f
9772    ${NS}::label $top.f.l -text "[mc "Filter"]: "
9773    ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
9774    set reflistfilter "*"
9775    trace add variable reflistfilter write reflistfilter_change
9776    pack $top.f.e -side right -fill x -expand 1
9777    pack $top.f.l -side left
9778    grid $top.f - -sticky ew -pady 2
9779    ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
9780    bind $top <Key-Escape> [list destroy $top]
9781    grid $top.close -
9782    grid columnconfigure $top 0 -weight 1
9783    grid rowconfigure $top 0 -weight 1
9784    bind $top.list <1> {break}
9785    bind $top.list <B1-Motion> {break}
9786    bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
9787    set reflist {}
9788    refill_reflist
9789}
9790
9791proc sel_reflist {w x y} {
9792    global showrefstop reflist headids tagids otherrefids
9793
9794    if {![winfo exists $showrefstop]} return
9795    set l [lindex [split [$w index "@$x,$y"] "."] 0]
9796    set ref [lindex $reflist [expr {$l-1}]]
9797    set n [lindex $ref 0]
9798    switch -- [lindex $ref 1] {
9799        "H" {selbyid $headids($n)}
9800        "T" {selbyid $tagids($n)}
9801        "o" {selbyid $otherrefids($n)}
9802    }
9803    $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
9804}
9805
9806proc unsel_reflist {} {
9807    global showrefstop
9808
9809    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9810    $showrefstop.list tag remove highlight 0.0 end
9811}
9812
9813proc reflistfilter_change {n1 n2 op} {
9814    global reflistfilter
9815
9816    after cancel refill_reflist
9817    after 200 refill_reflist
9818}
9819
9820proc refill_reflist {} {
9821    global reflist reflistfilter showrefstop headids tagids otherrefids
9822    global curview
9823
9824    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9825    set refs {}
9826    foreach n [array names headids] {
9827        if {[string match $reflistfilter $n]} {
9828            if {[commitinview $headids($n) $curview]} {
9829                lappend refs [list $n H]
9830            } else {
9831                interestedin $headids($n) {run refill_reflist}
9832            }
9833        }
9834    }
9835    foreach n [array names tagids] {
9836        if {[string match $reflistfilter $n]} {
9837            if {[commitinview $tagids($n) $curview]} {
9838                lappend refs [list $n T]
9839            } else {
9840                interestedin $tagids($n) {run refill_reflist}
9841            }
9842        }
9843    }
9844    foreach n [array names otherrefids] {
9845        if {[string match $reflistfilter $n]} {
9846            if {[commitinview $otherrefids($n) $curview]} {
9847                lappend refs [list $n o]
9848            } else {
9849                interestedin $otherrefids($n) {run refill_reflist}
9850            }
9851        }
9852    }
9853    set refs [lsort -index 0 $refs]
9854    if {$refs eq $reflist} return
9855
9856    # Update the contents of $showrefstop.list according to the
9857    # differences between $reflist (old) and $refs (new)
9858    $showrefstop.list conf -state normal
9859    $showrefstop.list insert end "\n"
9860    set i 0
9861    set j 0
9862    while {$i < [llength $reflist] || $j < [llength $refs]} {
9863        if {$i < [llength $reflist]} {
9864            if {$j < [llength $refs]} {
9865                set cmp [string compare [lindex $reflist $i 0] \
9866                             [lindex $refs $j 0]]
9867                if {$cmp == 0} {
9868                    set cmp [string compare [lindex $reflist $i 1] \
9869                                 [lindex $refs $j 1]]
9870                }
9871            } else {
9872                set cmp -1
9873            }
9874        } else {
9875            set cmp 1
9876        }
9877        switch -- $cmp {
9878            -1 {
9879                $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
9880                incr i
9881            }
9882            0 {
9883                incr i
9884                incr j
9885            }
9886            1 {
9887                set l [expr {$j + 1}]
9888                $showrefstop.list image create $l.0 -align baseline \
9889                    -image reficon-[lindex $refs $j 1] -padx 2
9890                $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
9891                incr j
9892            }
9893        }
9894    }
9895    set reflist $refs
9896    # delete last newline
9897    $showrefstop.list delete end-2c end-1c
9898    $showrefstop.list conf -state disabled
9899}
9900
9901# Stuff for finding nearby tags
9902proc getallcommits {} {
9903    global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
9904    global idheads idtags idotherrefs allparents tagobjid
9905    global gitdir
9906
9907    if {![info exists allcommits]} {
9908        set nextarc 0
9909        set allcommits 0
9910        set seeds {}
9911        set allcwait 0
9912        set cachedarcs 0
9913        set allccache [file join $gitdir "gitk.cache"]
9914        if {![catch {
9915            set f [open $allccache r]
9916            set allcwait 1
9917            getcache $f
9918        }]} return
9919    }
9920
9921    if {$allcwait} {
9922        return
9923    }
9924    set cmd [list | git rev-list --parents]
9925    set allcupdate [expr {$seeds ne {}}]
9926    if {!$allcupdate} {
9927        set ids "--all"
9928    } else {
9929        set refs [concat [array names idheads] [array names idtags] \
9930                      [array names idotherrefs]]
9931        set ids {}
9932        set tagobjs {}
9933        foreach name [array names tagobjid] {
9934            lappend tagobjs $tagobjid($name)
9935        }
9936        foreach id [lsort -unique $refs] {
9937            if {![info exists allparents($id)] &&
9938                [lsearch -exact $tagobjs $id] < 0} {
9939                lappend ids $id
9940            }
9941        }
9942        if {$ids ne {}} {
9943            foreach id $seeds {
9944                lappend ids "^$id"
9945            }
9946        }
9947    }
9948    if {$ids ne {}} {
9949        set fd [open [concat $cmd $ids] r]
9950        fconfigure $fd -blocking 0
9951        incr allcommits
9952        nowbusy allcommits
9953        filerun $fd [list getallclines $fd]
9954    } else {
9955        dispneartags 0
9956    }
9957}
9958
9959# Since most commits have 1 parent and 1 child, we group strings of
9960# such commits into "arcs" joining branch/merge points (BMPs), which
9961# are commits that either don't have 1 parent or don't have 1 child.
9962#
9963# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
9964# arcout(id) - outgoing arcs for BMP
9965# arcids(a) - list of IDs on arc including end but not start
9966# arcstart(a) - BMP ID at start of arc
9967# arcend(a) - BMP ID at end of arc
9968# growing(a) - arc a is still growing
9969# arctags(a) - IDs out of arcids (excluding end) that have tags
9970# archeads(a) - IDs out of arcids (excluding end) that have heads
9971# The start of an arc is at the descendent end, so "incoming" means
9972# coming from descendents, and "outgoing" means going towards ancestors.
9973
9974proc getallclines {fd} {
9975    global allparents allchildren idtags idheads nextarc
9976    global arcnos arcids arctags arcout arcend arcstart archeads growing
9977    global seeds allcommits cachedarcs allcupdate
9978
9979    set nid 0
9980    while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
9981        set id [lindex $line 0]
9982        if {[info exists allparents($id)]} {
9983            # seen it already
9984            continue
9985        }
9986        set cachedarcs 0
9987        set olds [lrange $line 1 end]
9988        set allparents($id) $olds
9989        if {![info exists allchildren($id)]} {
9990            set allchildren($id) {}
9991            set arcnos($id) {}
9992            lappend seeds $id
9993        } else {
9994            set a $arcnos($id)
9995            if {[llength $olds] == 1 && [llength $a] == 1} {
9996                lappend arcids($a) $id
9997                if {[info exists idtags($id)]} {
9998                    lappend arctags($a) $id
9999                }
10000                if {[info exists idheads($id)]} {
10001                    lappend archeads($a) $id
10002                }
10003                if {[info exists allparents($olds)]} {
10004                    # seen parent already
10005                    if {![info exists arcout($olds)]} {
10006                        splitarc $olds
10007                    }
10008                    lappend arcids($a) $olds
10009                    set arcend($a) $olds
10010                    unset growing($a)
10011                }
10012                lappend allchildren($olds) $id
10013                lappend arcnos($olds) $a
10014                continue
10015            }
10016        }
10017        foreach a $arcnos($id) {
10018            lappend arcids($a) $id
10019            set arcend($a) $id
10020            unset growing($a)
10021        }
10022
10023        set ao {}
10024        foreach p $olds {
10025            lappend allchildren($p) $id
10026            set a [incr nextarc]
10027            set arcstart($a) $id
10028            set archeads($a) {}
10029            set arctags($a) {}
10030            set archeads($a) {}
10031            set arcids($a) {}
10032            lappend ao $a
10033            set growing($a) 1
10034            if {[info exists allparents($p)]} {
10035                # seen it already, may need to make a new branch
10036                if {![info exists arcout($p)]} {
10037                    splitarc $p
10038                }
10039                lappend arcids($a) $p
10040                set arcend($a) $p
10041                unset growing($a)
10042            }
10043            lappend arcnos($p) $a
10044        }
10045        set arcout($id) $ao
10046    }
10047    if {$nid > 0} {
10048        global cached_dheads cached_dtags cached_atags
10049        catch {unset cached_dheads}
10050        catch {unset cached_dtags}
10051        catch {unset cached_atags}
10052    }
10053    if {![eof $fd]} {
10054        return [expr {$nid >= 1000? 2: 1}]
10055    }
10056    set cacheok 1
10057    if {[catch {
10058        fconfigure $fd -blocking 1
10059        close $fd
10060    } err]} {
10061        # got an error reading the list of commits
10062        # if we were updating, try rereading the whole thing again
10063        if {$allcupdate} {
10064            incr allcommits -1
10065            dropcache $err
10066            return
10067        }
10068        error_popup "[mc "Error reading commit topology information;\
10069                branch and preceding/following tag information\
10070                will be incomplete."]\n($err)"
10071        set cacheok 0
10072    }
10073    if {[incr allcommits -1] == 0} {
10074        notbusy allcommits
10075        if {$cacheok} {
10076            run savecache
10077        }
10078    }
10079    dispneartags 0
10080    return 0
10081}
10082
10083proc recalcarc {a} {
10084    global arctags archeads arcids idtags idheads
10085
10086    set at {}
10087    set ah {}
10088    foreach id [lrange $arcids($a) 0 end-1] {
10089        if {[info exists idtags($id)]} {
10090            lappend at $id
10091        }
10092        if {[info exists idheads($id)]} {
10093            lappend ah $id
10094        }
10095    }
10096    set arctags($a) $at
10097    set archeads($a) $ah
10098}
10099
10100proc splitarc {p} {
10101    global arcnos arcids nextarc arctags archeads idtags idheads
10102    global arcstart arcend arcout allparents growing
10103
10104    set a $arcnos($p)
10105    if {[llength $a] != 1} {
10106        puts "oops splitarc called but [llength $a] arcs already"
10107        return
10108    }
10109    set a [lindex $a 0]
10110    set i [lsearch -exact $arcids($a) $p]
10111    if {$i < 0} {
10112        puts "oops splitarc $p not in arc $a"
10113        return
10114    }
10115    set na [incr nextarc]
10116    if {[info exists arcend($a)]} {
10117        set arcend($na) $arcend($a)
10118    } else {
10119        set l [lindex $allparents([lindex $arcids($a) end]) 0]
10120        set j [lsearch -exact $arcnos($l) $a]
10121        set arcnos($l) [lreplace $arcnos($l) $j $j $na]
10122    }
10123    set tail [lrange $arcids($a) [expr {$i+1}] end]
10124    set arcids($a) [lrange $arcids($a) 0 $i]
10125    set arcend($a) $p
10126    set arcstart($na) $p
10127    set arcout($p) $na
10128    set arcids($na) $tail
10129    if {[info exists growing($a)]} {
10130        set growing($na) 1
10131        unset growing($a)
10132    }
10133
10134    foreach id $tail {
10135        if {[llength $arcnos($id)] == 1} {
10136            set arcnos($id) $na
10137        } else {
10138            set j [lsearch -exact $arcnos($id) $a]
10139            set arcnos($id) [lreplace $arcnos($id) $j $j $na]
10140        }
10141    }
10142
10143    # reconstruct tags and heads lists
10144    if {$arctags($a) ne {} || $archeads($a) ne {}} {
10145        recalcarc $a
10146        recalcarc $na
10147    } else {
10148        set arctags($na) {}
10149        set archeads($na) {}
10150    }
10151}
10152
10153# Update things for a new commit added that is a child of one
10154# existing commit.  Used when cherry-picking.
10155proc addnewchild {id p} {
10156    global allparents allchildren idtags nextarc
10157    global arcnos arcids arctags arcout arcend arcstart archeads growing
10158    global seeds allcommits
10159
10160    if {![info exists allcommits] || ![info exists arcnos($p)]} return
10161    set allparents($id) [list $p]
10162    set allchildren($id) {}
10163    set arcnos($id) {}
10164    lappend seeds $id
10165    lappend allchildren($p) $id
10166    set a [incr nextarc]
10167    set arcstart($a) $id
10168    set archeads($a) {}
10169    set arctags($a) {}
10170    set arcids($a) [list $p]
10171    set arcend($a) $p
10172    if {![info exists arcout($p)]} {
10173        splitarc $p
10174    }
10175    lappend arcnos($p) $a
10176    set arcout($id) [list $a]
10177}
10178
10179# This implements a cache for the topology information.
10180# The cache saves, for each arc, the start and end of the arc,
10181# the ids on the arc, and the outgoing arcs from the end.
10182proc readcache {f} {
10183    global arcnos arcids arcout arcstart arcend arctags archeads nextarc
10184    global idtags idheads allparents cachedarcs possible_seeds seeds growing
10185    global allcwait
10186
10187    set a $nextarc
10188    set lim $cachedarcs
10189    if {$lim - $a > 500} {
10190        set lim [expr {$a + 500}]
10191    }
10192    if {[catch {
10193        if {$a == $lim} {
10194            # finish reading the cache and setting up arctags, etc.
10195            set line [gets $f]
10196            if {$line ne "1"} {error "bad final version"}
10197            close $f
10198            foreach id [array names idtags] {
10199                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10200                    [llength $allparents($id)] == 1} {
10201                    set a [lindex $arcnos($id) 0]
10202                    if {$arctags($a) eq {}} {
10203                        recalcarc $a
10204                    }
10205                }
10206            }
10207            foreach id [array names idheads] {
10208                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10209                    [llength $allparents($id)] == 1} {
10210                    set a [lindex $arcnos($id) 0]
10211                    if {$archeads($a) eq {}} {
10212                        recalcarc $a
10213                    }
10214                }
10215            }
10216            foreach id [lsort -unique $possible_seeds] {
10217                if {$arcnos($id) eq {}} {
10218                    lappend seeds $id
10219                }
10220            }
10221            set allcwait 0
10222        } else {
10223            while {[incr a] <= $lim} {
10224                set line [gets $f]
10225                if {[llength $line] != 3} {error "bad line"}
10226                set s [lindex $line 0]
10227                set arcstart($a) $s
10228                lappend arcout($s) $a
10229                if {![info exists arcnos($s)]} {
10230                    lappend possible_seeds $s
10231                    set arcnos($s) {}
10232                }
10233                set e [lindex $line 1]
10234                if {$e eq {}} {
10235                    set growing($a) 1
10236                } else {
10237                    set arcend($a) $e
10238                    if {![info exists arcout($e)]} {
10239                        set arcout($e) {}
10240                    }
10241                }
10242                set arcids($a) [lindex $line 2]
10243                foreach id $arcids($a) {
10244                    lappend allparents($s) $id
10245                    set s $id
10246                    lappend arcnos($id) $a
10247                }
10248                if {![info exists allparents($s)]} {
10249                    set allparents($s) {}
10250                }
10251                set arctags($a) {}
10252                set archeads($a) {}
10253            }
10254            set nextarc [expr {$a - 1}]
10255        }
10256    } err]} {
10257        dropcache $err
10258        return 0
10259    }
10260    if {!$allcwait} {
10261        getallcommits
10262    }
10263    return $allcwait
10264}
10265
10266proc getcache {f} {
10267    global nextarc cachedarcs possible_seeds
10268
10269    if {[catch {
10270        set line [gets $f]
10271        if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
10272        # make sure it's an integer
10273        set cachedarcs [expr {int([lindex $line 1])}]
10274        if {$cachedarcs < 0} {error "bad number of arcs"}
10275        set nextarc 0
10276        set possible_seeds {}
10277        run readcache $f
10278    } err]} {
10279        dropcache $err
10280    }
10281    return 0
10282}
10283
10284proc dropcache {err} {
10285    global allcwait nextarc cachedarcs seeds
10286
10287    #puts "dropping cache ($err)"
10288    foreach v {arcnos arcout arcids arcstart arcend growing \
10289                   arctags archeads allparents allchildren} {
10290        global $v
10291        catch {unset $v}
10292    }
10293    set allcwait 0
10294    set nextarc 0
10295    set cachedarcs 0
10296    set seeds {}
10297    getallcommits
10298}
10299
10300proc writecache {f} {
10301    global cachearc cachedarcs allccache
10302    global arcstart arcend arcnos arcids arcout
10303
10304    set a $cachearc
10305    set lim $cachedarcs
10306    if {$lim - $a > 1000} {
10307        set lim [expr {$a + 1000}]
10308    }
10309    if {[catch {
10310        while {[incr a] <= $lim} {
10311            if {[info exists arcend($a)]} {
10312                puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
10313            } else {
10314                puts $f [list $arcstart($a) {} $arcids($a)]
10315            }
10316        }
10317    } err]} {
10318        catch {close $f}
10319        catch {file delete $allccache}
10320        #puts "writing cache failed ($err)"
10321        return 0
10322    }
10323    set cachearc [expr {$a - 1}]
10324    if {$a > $cachedarcs} {
10325        puts $f "1"
10326        close $f
10327        return 0
10328    }
10329    return 1
10330}
10331
10332proc savecache {} {
10333    global nextarc cachedarcs cachearc allccache
10334
10335    if {$nextarc == $cachedarcs} return
10336    set cachearc 0
10337    set cachedarcs $nextarc
10338    catch {
10339        set f [open $allccache w]
10340        puts $f [list 1 $cachedarcs]
10341        run writecache $f
10342    }
10343}
10344
10345# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
10346# or 0 if neither is true.
10347proc anc_or_desc {a b} {
10348    global arcout arcstart arcend arcnos cached_isanc
10349
10350    if {$arcnos($a) eq $arcnos($b)} {
10351        # Both are on the same arc(s); either both are the same BMP,
10352        # or if one is not a BMP, the other is also not a BMP or is
10353        # the BMP at end of the arc (and it only has 1 incoming arc).
10354        # Or both can be BMPs with no incoming arcs.
10355        if {$a eq $b || $arcnos($a) eq {}} {
10356            return 0
10357        }
10358        # assert {[llength $arcnos($a)] == 1}
10359        set arc [lindex $arcnos($a) 0]
10360        set i [lsearch -exact $arcids($arc) $a]
10361        set j [lsearch -exact $arcids($arc) $b]
10362        if {$i < 0 || $i > $j} {
10363            return 1
10364        } else {
10365            return -1
10366        }
10367    }
10368
10369    if {![info exists arcout($a)]} {
10370        set arc [lindex $arcnos($a) 0]
10371        if {[info exists arcend($arc)]} {
10372            set aend $arcend($arc)
10373        } else {
10374            set aend {}
10375        }
10376        set a $arcstart($arc)
10377    } else {
10378        set aend $a
10379    }
10380    if {![info exists arcout($b)]} {
10381        set arc [lindex $arcnos($b) 0]
10382        if {[info exists arcend($arc)]} {
10383            set bend $arcend($arc)
10384        } else {
10385            set bend {}
10386        }
10387        set b $arcstart($arc)
10388    } else {
10389        set bend $b
10390    }
10391    if {$a eq $bend} {
10392        return 1
10393    }
10394    if {$b eq $aend} {
10395        return -1
10396    }
10397    if {[info exists cached_isanc($a,$bend)]} {
10398        if {$cached_isanc($a,$bend)} {
10399            return 1
10400        }
10401    }
10402    if {[info exists cached_isanc($b,$aend)]} {
10403        if {$cached_isanc($b,$aend)} {
10404            return -1
10405        }
10406        if {[info exists cached_isanc($a,$bend)]} {
10407            return 0
10408        }
10409    }
10410
10411    set todo [list $a $b]
10412    set anc($a) a
10413    set anc($b) b
10414    for {set i 0} {$i < [llength $todo]} {incr i} {
10415        set x [lindex $todo $i]
10416        if {$anc($x) eq {}} {
10417            continue
10418        }
10419        foreach arc $arcnos($x) {
10420            set xd $arcstart($arc)
10421            if {$xd eq $bend} {
10422                set cached_isanc($a,$bend) 1
10423                set cached_isanc($b,$aend) 0
10424                return 1
10425            } elseif {$xd eq $aend} {
10426                set cached_isanc($b,$aend) 1
10427                set cached_isanc($a,$bend) 0
10428                return -1
10429            }
10430            if {![info exists anc($xd)]} {
10431                set anc($xd) $anc($x)
10432                lappend todo $xd
10433            } elseif {$anc($xd) ne $anc($x)} {
10434                set anc($xd) {}
10435            }
10436        }
10437    }
10438    set cached_isanc($a,$bend) 0
10439    set cached_isanc($b,$aend) 0
10440    return 0
10441}
10442
10443# This identifies whether $desc has an ancestor that is
10444# a growing tip of the graph and which is not an ancestor of $anc
10445# and returns 0 if so and 1 if not.
10446# If we subsequently discover a tag on such a growing tip, and that
10447# turns out to be a descendent of $anc (which it could, since we
10448# don't necessarily see children before parents), then $desc
10449# isn't a good choice to display as a descendent tag of
10450# $anc (since it is the descendent of another tag which is
10451# a descendent of $anc).  Similarly, $anc isn't a good choice to
10452# display as a ancestor tag of $desc.
10453#
10454proc is_certain {desc anc} {
10455    global arcnos arcout arcstart arcend growing problems
10456
10457    set certain {}
10458    if {[llength $arcnos($anc)] == 1} {
10459        # tags on the same arc are certain
10460        if {$arcnos($desc) eq $arcnos($anc)} {
10461            return 1
10462        }
10463        if {![info exists arcout($anc)]} {
10464            # if $anc is partway along an arc, use the start of the arc instead
10465            set a [lindex $arcnos($anc) 0]
10466            set anc $arcstart($a)
10467        }
10468    }
10469    if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
10470        set x $desc
10471    } else {
10472        set a [lindex $arcnos($desc) 0]
10473        set x $arcend($a)
10474    }
10475    if {$x == $anc} {
10476        return 1
10477    }
10478    set anclist [list $x]
10479    set dl($x) 1
10480    set nnh 1
10481    set ngrowanc 0
10482    for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
10483        set x [lindex $anclist $i]
10484        if {$dl($x)} {
10485            incr nnh -1
10486        }
10487        set done($x) 1
10488        foreach a $arcout($x) {
10489            if {[info exists growing($a)]} {
10490                if {![info exists growanc($x)] && $dl($x)} {
10491                    set growanc($x) 1
10492                    incr ngrowanc
10493                }
10494            } else {
10495                set y $arcend($a)
10496                if {[info exists dl($y)]} {
10497                    if {$dl($y)} {
10498                        if {!$dl($x)} {
10499                            set dl($y) 0
10500                            if {![info exists done($y)]} {
10501                                incr nnh -1
10502                            }
10503                            if {[info exists growanc($x)]} {
10504                                incr ngrowanc -1
10505                            }
10506                            set xl [list $y]
10507                            for {set k 0} {$k < [llength $xl]} {incr k} {
10508                                set z [lindex $xl $k]
10509                                foreach c $arcout($z) {
10510                                    if {[info exists arcend($c)]} {
10511                                        set v $arcend($c)
10512                                        if {[info exists dl($v)] && $dl($v)} {
10513                                            set dl($v) 0
10514                                            if {![info exists done($v)]} {
10515                                                incr nnh -1
10516                                            }
10517                                            if {[info exists growanc($v)]} {
10518                                                incr ngrowanc -1
10519                                            }
10520                                            lappend xl $v
10521                                        }
10522                                    }
10523                                }
10524                            }
10525                        }
10526                    }
10527                } elseif {$y eq $anc || !$dl($x)} {
10528                    set dl($y) 0
10529                    lappend anclist $y
10530                } else {
10531                    set dl($y) 1
10532                    lappend anclist $y
10533                    incr nnh
10534                }
10535            }
10536        }
10537    }
10538    foreach x [array names growanc] {
10539        if {$dl($x)} {
10540            return 0
10541        }
10542        return 0
10543    }
10544    return 1
10545}
10546
10547proc validate_arctags {a} {
10548    global arctags idtags
10549
10550    set i -1
10551    set na $arctags($a)
10552    foreach id $arctags($a) {
10553        incr i
10554        if {![info exists idtags($id)]} {
10555            set na [lreplace $na $i $i]
10556            incr i -1
10557        }
10558    }
10559    set arctags($a) $na
10560}
10561
10562proc validate_archeads {a} {
10563    global archeads idheads
10564
10565    set i -1
10566    set na $archeads($a)
10567    foreach id $archeads($a) {
10568        incr i
10569        if {![info exists idheads($id)]} {
10570            set na [lreplace $na $i $i]
10571            incr i -1
10572        }
10573    }
10574    set archeads($a) $na
10575}
10576
10577# Return the list of IDs that have tags that are descendents of id,
10578# ignoring IDs that are descendents of IDs already reported.
10579proc desctags {id} {
10580    global arcnos arcstart arcids arctags idtags allparents
10581    global growing cached_dtags
10582
10583    if {![info exists allparents($id)]} {
10584        return {}
10585    }
10586    set t1 [clock clicks -milliseconds]
10587    set argid $id
10588    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10589        # part-way along an arc; check that arc first
10590        set a [lindex $arcnos($id) 0]
10591        if {$arctags($a) ne {}} {
10592            validate_arctags $a
10593            set i [lsearch -exact $arcids($a) $id]
10594            set tid {}
10595            foreach t $arctags($a) {
10596                set j [lsearch -exact $arcids($a) $t]
10597                if {$j >= $i} break
10598                set tid $t
10599            }
10600            if {$tid ne {}} {
10601                return $tid
10602            }
10603        }
10604        set id $arcstart($a)
10605        if {[info exists idtags($id)]} {
10606            return $id
10607        }
10608    }
10609    if {[info exists cached_dtags($id)]} {
10610        return $cached_dtags($id)
10611    }
10612
10613    set origid $id
10614    set todo [list $id]
10615    set queued($id) 1
10616    set nc 1
10617    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10618        set id [lindex $todo $i]
10619        set done($id) 1
10620        set ta [info exists hastaggedancestor($id)]
10621        if {!$ta} {
10622            incr nc -1
10623        }
10624        # ignore tags on starting node
10625        if {!$ta && $i > 0} {
10626            if {[info exists idtags($id)]} {
10627                set tagloc($id) $id
10628                set ta 1
10629            } elseif {[info exists cached_dtags($id)]} {
10630                set tagloc($id) $cached_dtags($id)
10631                set ta 1
10632            }
10633        }
10634        foreach a $arcnos($id) {
10635            set d $arcstart($a)
10636            if {!$ta && $arctags($a) ne {}} {
10637                validate_arctags $a
10638                if {$arctags($a) ne {}} {
10639                    lappend tagloc($id) [lindex $arctags($a) end]
10640                }
10641            }
10642            if {$ta || $arctags($a) ne {}} {
10643                set tomark [list $d]
10644                for {set j 0} {$j < [llength $tomark]} {incr j} {
10645                    set dd [lindex $tomark $j]
10646                    if {![info exists hastaggedancestor($dd)]} {
10647                        if {[info exists done($dd)]} {
10648                            foreach b $arcnos($dd) {
10649                                lappend tomark $arcstart($b)
10650                            }
10651                            if {[info exists tagloc($dd)]} {
10652                                unset tagloc($dd)
10653                            }
10654                        } elseif {[info exists queued($dd)]} {
10655                            incr nc -1
10656                        }
10657                        set hastaggedancestor($dd) 1
10658                    }
10659                }
10660            }
10661            if {![info exists queued($d)]} {
10662                lappend todo $d
10663                set queued($d) 1
10664                if {![info exists hastaggedancestor($d)]} {
10665                    incr nc
10666                }
10667            }
10668        }
10669    }
10670    set tags {}
10671    foreach id [array names tagloc] {
10672        if {![info exists hastaggedancestor($id)]} {
10673            foreach t $tagloc($id) {
10674                if {[lsearch -exact $tags $t] < 0} {
10675                    lappend tags $t
10676                }
10677            }
10678        }
10679    }
10680    set t2 [clock clicks -milliseconds]
10681    set loopix $i
10682
10683    # remove tags that are descendents of other tags
10684    for {set i 0} {$i < [llength $tags]} {incr i} {
10685        set a [lindex $tags $i]
10686        for {set j 0} {$j < $i} {incr j} {
10687            set b [lindex $tags $j]
10688            set r [anc_or_desc $a $b]
10689            if {$r == 1} {
10690                set tags [lreplace $tags $j $j]
10691                incr j -1
10692                incr i -1
10693            } elseif {$r == -1} {
10694                set tags [lreplace $tags $i $i]
10695                incr i -1
10696                break
10697            }
10698        }
10699    }
10700
10701    if {[array names growing] ne {}} {
10702        # graph isn't finished, need to check if any tag could get
10703        # eclipsed by another tag coming later.  Simply ignore any
10704        # tags that could later get eclipsed.
10705        set ctags {}
10706        foreach t $tags {
10707            if {[is_certain $t $origid]} {
10708                lappend ctags $t
10709            }
10710        }
10711        if {$tags eq $ctags} {
10712            set cached_dtags($origid) $tags
10713        } else {
10714            set tags $ctags
10715        }
10716    } else {
10717        set cached_dtags($origid) $tags
10718    }
10719    set t3 [clock clicks -milliseconds]
10720    if {0 && $t3 - $t1 >= 100} {
10721        puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10722            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10723    }
10724    return $tags
10725}
10726
10727proc anctags {id} {
10728    global arcnos arcids arcout arcend arctags idtags allparents
10729    global growing cached_atags
10730
10731    if {![info exists allparents($id)]} {
10732        return {}
10733    }
10734    set t1 [clock clicks -milliseconds]
10735    set argid $id
10736    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10737        # part-way along an arc; check that arc first
10738        set a [lindex $arcnos($id) 0]
10739        if {$arctags($a) ne {}} {
10740            validate_arctags $a
10741            set i [lsearch -exact $arcids($a) $id]
10742            foreach t $arctags($a) {
10743                set j [lsearch -exact $arcids($a) $t]
10744                if {$j > $i} {
10745                    return $t
10746                }
10747            }
10748        }
10749        if {![info exists arcend($a)]} {
10750            return {}
10751        }
10752        set id $arcend($a)
10753        if {[info exists idtags($id)]} {
10754            return $id
10755        }
10756    }
10757    if {[info exists cached_atags($id)]} {
10758        return $cached_atags($id)
10759    }
10760
10761    set origid $id
10762    set todo [list $id]
10763    set queued($id) 1
10764    set taglist {}
10765    set nc 1
10766    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10767        set id [lindex $todo $i]
10768        set done($id) 1
10769        set td [info exists hastaggeddescendent($id)]
10770        if {!$td} {
10771            incr nc -1
10772        }
10773        # ignore tags on starting node
10774        if {!$td && $i > 0} {
10775            if {[info exists idtags($id)]} {
10776                set tagloc($id) $id
10777                set td 1
10778            } elseif {[info exists cached_atags($id)]} {
10779                set tagloc($id) $cached_atags($id)
10780                set td 1
10781            }
10782        }
10783        foreach a $arcout($id) {
10784            if {!$td && $arctags($a) ne {}} {
10785                validate_arctags $a
10786                if {$arctags($a) ne {}} {
10787                    lappend tagloc($id) [lindex $arctags($a) 0]
10788                }
10789            }
10790            if {![info exists arcend($a)]} continue
10791            set d $arcend($a)
10792            if {$td || $arctags($a) ne {}} {
10793                set tomark [list $d]
10794                for {set j 0} {$j < [llength $tomark]} {incr j} {
10795                    set dd [lindex $tomark $j]
10796                    if {![info exists hastaggeddescendent($dd)]} {
10797                        if {[info exists done($dd)]} {
10798                            foreach b $arcout($dd) {
10799                                if {[info exists arcend($b)]} {
10800                                    lappend tomark $arcend($b)
10801                                }
10802                            }
10803                            if {[info exists tagloc($dd)]} {
10804                                unset tagloc($dd)
10805                            }
10806                        } elseif {[info exists queued($dd)]} {
10807                            incr nc -1
10808                        }
10809                        set hastaggeddescendent($dd) 1
10810                    }
10811                }
10812            }
10813            if {![info exists queued($d)]} {
10814                lappend todo $d
10815                set queued($d) 1
10816                if {![info exists hastaggeddescendent($d)]} {
10817                    incr nc
10818                }
10819            }
10820        }
10821    }
10822    set t2 [clock clicks -milliseconds]
10823    set loopix $i
10824    set tags {}
10825    foreach id [array names tagloc] {
10826        if {![info exists hastaggeddescendent($id)]} {
10827            foreach t $tagloc($id) {
10828                if {[lsearch -exact $tags $t] < 0} {
10829                    lappend tags $t
10830                }
10831            }
10832        }
10833    }
10834
10835    # remove tags that are ancestors of other tags
10836    for {set i 0} {$i < [llength $tags]} {incr i} {
10837        set a [lindex $tags $i]
10838        for {set j 0} {$j < $i} {incr j} {
10839            set b [lindex $tags $j]
10840            set r [anc_or_desc $a $b]
10841            if {$r == -1} {
10842                set tags [lreplace $tags $j $j]
10843                incr j -1
10844                incr i -1
10845            } elseif {$r == 1} {
10846                set tags [lreplace $tags $i $i]
10847                incr i -1
10848                break
10849            }
10850        }
10851    }
10852
10853    if {[array names growing] ne {}} {
10854        # graph isn't finished, need to check if any tag could get
10855        # eclipsed by another tag coming later.  Simply ignore any
10856        # tags that could later get eclipsed.
10857        set ctags {}
10858        foreach t $tags {
10859            if {[is_certain $origid $t]} {
10860                lappend ctags $t
10861            }
10862        }
10863        if {$tags eq $ctags} {
10864            set cached_atags($origid) $tags
10865        } else {
10866            set tags $ctags
10867        }
10868    } else {
10869        set cached_atags($origid) $tags
10870    }
10871    set t3 [clock clicks -milliseconds]
10872    if {0 && $t3 - $t1 >= 100} {
10873        puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
10874            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10875    }
10876    return $tags
10877}
10878
10879# Return the list of IDs that have heads that are descendents of id,
10880# including id itself if it has a head.
10881proc descheads {id} {
10882    global arcnos arcstart arcids archeads idheads cached_dheads
10883    global allparents arcout
10884
10885    if {![info exists allparents($id)]} {
10886        return {}
10887    }
10888    set aret {}
10889    if {![info exists arcout($id)]} {
10890        # part-way along an arc; check it first
10891        set a [lindex $arcnos($id) 0]
10892        if {$archeads($a) ne {}} {
10893            validate_archeads $a
10894            set i [lsearch -exact $arcids($a) $id]
10895            foreach t $archeads($a) {
10896                set j [lsearch -exact $arcids($a) $t]
10897                if {$j > $i} break
10898                lappend aret $t
10899            }
10900        }
10901        set id $arcstart($a)
10902    }
10903    set origid $id
10904    set todo [list $id]
10905    set seen($id) 1
10906    set ret {}
10907    for {set i 0} {$i < [llength $todo]} {incr i} {
10908        set id [lindex $todo $i]
10909        if {[info exists cached_dheads($id)]} {
10910            set ret [concat $ret $cached_dheads($id)]
10911        } else {
10912            if {[info exists idheads($id)]} {
10913                lappend ret $id
10914            }
10915            foreach a $arcnos($id) {
10916                if {$archeads($a) ne {}} {
10917                    validate_archeads $a
10918                    if {$archeads($a) ne {}} {
10919                        set ret [concat $ret $archeads($a)]
10920                    }
10921                }
10922                set d $arcstart($a)
10923                if {![info exists seen($d)]} {
10924                    lappend todo $d
10925                    set seen($d) 1
10926                }
10927            }
10928        }
10929    }
10930    set ret [lsort -unique $ret]
10931    set cached_dheads($origid) $ret
10932    return [concat $ret $aret]
10933}
10934
10935proc addedtag {id} {
10936    global arcnos arcout cached_dtags cached_atags
10937
10938    if {![info exists arcnos($id)]} return
10939    if {![info exists arcout($id)]} {
10940        recalcarc [lindex $arcnos($id) 0]
10941    }
10942    catch {unset cached_dtags}
10943    catch {unset cached_atags}
10944}
10945
10946proc addedhead {hid head} {
10947    global arcnos arcout cached_dheads
10948
10949    if {![info exists arcnos($hid)]} return
10950    if {![info exists arcout($hid)]} {
10951        recalcarc [lindex $arcnos($hid) 0]
10952    }
10953    catch {unset cached_dheads}
10954}
10955
10956proc removedhead {hid head} {
10957    global cached_dheads
10958
10959    catch {unset cached_dheads}
10960}
10961
10962proc movedhead {hid head} {
10963    global arcnos arcout cached_dheads
10964
10965    if {![info exists arcnos($hid)]} return
10966    if {![info exists arcout($hid)]} {
10967        recalcarc [lindex $arcnos($hid) 0]
10968    }
10969    catch {unset cached_dheads}
10970}
10971
10972proc changedrefs {} {
10973    global cached_dheads cached_dtags cached_atags cached_tagcontent
10974    global arctags archeads arcnos arcout idheads idtags
10975
10976    foreach id [concat [array names idheads] [array names idtags]] {
10977        if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
10978            set a [lindex $arcnos($id) 0]
10979            if {![info exists donearc($a)]} {
10980                recalcarc $a
10981                set donearc($a) 1
10982            }
10983        }
10984    }
10985    catch {unset cached_tagcontent}
10986    catch {unset cached_dtags}
10987    catch {unset cached_atags}
10988    catch {unset cached_dheads}
10989}
10990
10991proc rereadrefs {} {
10992    global idtags idheads idotherrefs mainheadid
10993
10994    set refids [concat [array names idtags] \
10995                    [array names idheads] [array names idotherrefs]]
10996    foreach id $refids {
10997        if {![info exists ref($id)]} {
10998            set ref($id) [listrefs $id]
10999        }
11000    }
11001    set oldmainhead $mainheadid
11002    readrefs
11003    changedrefs
11004    set refids [lsort -unique [concat $refids [array names idtags] \
11005                        [array names idheads] [array names idotherrefs]]]
11006    foreach id $refids {
11007        set v [listrefs $id]
11008        if {![info exists ref($id)] || $ref($id) != $v} {
11009            redrawtags $id
11010        }
11011    }
11012    if {$oldmainhead ne $mainheadid} {
11013        redrawtags $oldmainhead
11014        redrawtags $mainheadid
11015    }
11016    run refill_reflist
11017}
11018
11019proc listrefs {id} {
11020    global idtags idheads idotherrefs
11021
11022    set x {}
11023    if {[info exists idtags($id)]} {
11024        set x $idtags($id)
11025    }
11026    set y {}
11027    if {[info exists idheads($id)]} {
11028        set y $idheads($id)
11029    }
11030    set z {}
11031    if {[info exists idotherrefs($id)]} {
11032        set z $idotherrefs($id)
11033    }
11034    return [list $x $y $z]
11035}
11036
11037proc add_tag_ctext {tag} {
11038    global ctext cached_tagcontent tagids
11039
11040    if {![info exists cached_tagcontent($tag)]} {
11041        catch {
11042            set cached_tagcontent($tag) [exec git cat-file -p $tag]
11043        }
11044    }
11045    $ctext insert end "[mc "Tag"]: $tag\n" bold
11046    if {[info exists cached_tagcontent($tag)]} {
11047        set text $cached_tagcontent($tag)
11048    } else {
11049        set text "[mc "Id"]:  $tagids($tag)"
11050    }
11051    appendwithlinks $text {}
11052}
11053
11054proc showtag {tag isnew} {
11055    global ctext cached_tagcontent tagids linknum tagobjid
11056
11057    if {$isnew} {
11058        addtohistory [list showtag $tag 0] savectextpos
11059    }
11060    $ctext conf -state normal
11061    clear_ctext
11062    settabs 0
11063    set linknum 0
11064    add_tag_ctext $tag
11065    maybe_scroll_ctext 1
11066    $ctext conf -state disabled
11067    init_flist {}
11068}
11069
11070proc showtags {id isnew} {
11071    global idtags ctext linknum
11072
11073    if {$isnew} {
11074        addtohistory [list showtags $id 0] savectextpos
11075    }
11076    $ctext conf -state normal
11077    clear_ctext
11078    settabs 0
11079    set linknum 0
11080    set sep {}
11081    foreach tag $idtags($id) {
11082        $ctext insert end $sep
11083        add_tag_ctext $tag
11084        set sep "\n\n"
11085    }
11086    maybe_scroll_ctext 1
11087    $ctext conf -state disabled
11088    init_flist {}
11089}
11090
11091proc doquit {} {
11092    global stopped
11093    global gitktmpdir
11094
11095    set stopped 100
11096    savestuff .
11097    destroy .
11098
11099    if {[info exists gitktmpdir]} {
11100        catch {file delete -force $gitktmpdir}
11101    }
11102}
11103
11104proc mkfontdisp {font top which} {
11105    global fontattr fontpref $font NS use_ttk
11106
11107    set fontpref($font) [set $font]
11108    ${NS}::button $top.${font}but -text $which \
11109        -command [list choosefont $font $which]
11110    ${NS}::label $top.$font -relief flat -font $font \
11111        -text $fontattr($font,family) -justify left
11112    grid x $top.${font}but $top.$font -sticky w
11113}
11114
11115proc choosefont {font which} {
11116    global fontparam fontlist fonttop fontattr
11117    global prefstop NS
11118
11119    set fontparam(which) $which
11120    set fontparam(font) $font
11121    set fontparam(family) [font actual $font -family]
11122    set fontparam(size) $fontattr($font,size)
11123    set fontparam(weight) $fontattr($font,weight)
11124    set fontparam(slant) $fontattr($font,slant)
11125    set top .gitkfont
11126    set fonttop $top
11127    if {![winfo exists $top]} {
11128        font create sample
11129        eval font config sample [font actual $font]
11130        ttk_toplevel $top
11131        make_transient $top $prefstop
11132        wm title $top [mc "Gitk font chooser"]
11133        ${NS}::label $top.l -textvariable fontparam(which)
11134        pack $top.l -side top
11135        set fontlist [lsort [font families]]
11136        ${NS}::frame $top.f
11137        listbox $top.f.fam -listvariable fontlist \
11138            -yscrollcommand [list $top.f.sb set]
11139        bind $top.f.fam <<ListboxSelect>> selfontfam
11140        ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
11141        pack $top.f.sb -side right -fill y
11142        pack $top.f.fam -side left -fill both -expand 1
11143        pack $top.f -side top -fill both -expand 1
11144        ${NS}::frame $top.g
11145        spinbox $top.g.size -from 4 -to 40 -width 4 \
11146            -textvariable fontparam(size) \
11147            -validatecommand {string is integer -strict %s}
11148        checkbutton $top.g.bold -padx 5 \
11149            -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
11150            -variable fontparam(weight) -onvalue bold -offvalue normal
11151        checkbutton $top.g.ital -padx 5 \
11152            -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
11153            -variable fontparam(slant) -onvalue italic -offvalue roman
11154        pack $top.g.size $top.g.bold $top.g.ital -side left
11155        pack $top.g -side top
11156        canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
11157            -background white
11158        $top.c create text 100 25 -anchor center -text $which -font sample \
11159            -fill black -tags text
11160        bind $top.c <Configure> [list centertext $top.c]
11161        pack $top.c -side top -fill x
11162        ${NS}::frame $top.buts
11163        ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
11164        ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
11165        bind $top <Key-Return> fontok
11166        bind $top <Key-Escape> fontcan
11167        grid $top.buts.ok $top.buts.can
11168        grid columnconfigure $top.buts 0 -weight 1 -uniform a
11169        grid columnconfigure $top.buts 1 -weight 1 -uniform a
11170        pack $top.buts -side bottom -fill x
11171        trace add variable fontparam write chg_fontparam
11172    } else {
11173        raise $top
11174        $top.c itemconf text -text $which
11175    }
11176    set i [lsearch -exact $fontlist $fontparam(family)]
11177    if {$i >= 0} {
11178        $top.f.fam selection set $i
11179        $top.f.fam see $i
11180    }
11181}
11182
11183proc centertext {w} {
11184    $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
11185}
11186
11187proc fontok {} {
11188    global fontparam fontpref prefstop
11189
11190    set f $fontparam(font)
11191    set fontpref($f) [list $fontparam(family) $fontparam(size)]
11192    if {$fontparam(weight) eq "bold"} {
11193        lappend fontpref($f) "bold"
11194    }
11195    if {$fontparam(slant) eq "italic"} {
11196        lappend fontpref($f) "italic"
11197    }
11198    set w $prefstop.notebook.fonts.$f
11199    $w conf -text $fontparam(family) -font $fontpref($f)
11200
11201    fontcan
11202}
11203
11204proc fontcan {} {
11205    global fonttop fontparam
11206
11207    if {[info exists fonttop]} {
11208        catch {destroy $fonttop}
11209        catch {font delete sample}
11210        unset fonttop
11211        unset fontparam
11212    }
11213}
11214
11215if {[package vsatisfies [package provide Tk] 8.6]} {
11216    # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
11217    # function to make use of it.
11218    proc choosefont {font which} {
11219        tk fontchooser configure -title $which -font $font \
11220            -command [list on_choosefont $font $which]
11221        tk fontchooser show
11222    }
11223    proc on_choosefont {font which newfont} {
11224        global fontparam
11225        puts stderr "$font $newfont"
11226        array set f [font actual $newfont]
11227        set fontparam(which) $which
11228        set fontparam(font) $font
11229        set fontparam(family) $f(-family)
11230        set fontparam(size) $f(-size)
11231        set fontparam(weight) $f(-weight)
11232        set fontparam(slant) $f(-slant)
11233        fontok
11234    }
11235}
11236
11237proc selfontfam {} {
11238    global fonttop fontparam
11239
11240    set i [$fonttop.f.fam curselection]
11241    if {$i ne {}} {
11242        set fontparam(family) [$fonttop.f.fam get $i]
11243    }
11244}
11245
11246proc chg_fontparam {v sub op} {
11247    global fontparam
11248
11249    font config sample -$sub $fontparam($sub)
11250}
11251
11252# Create a property sheet tab page
11253proc create_prefs_page {w} {
11254    global NS
11255    set parent [join [lrange [split $w .] 0 end-1] .]
11256    if {[winfo class $parent] eq "TNotebook"} {
11257        ${NS}::frame $w
11258    } else {
11259        ${NS}::labelframe $w
11260    }
11261}
11262
11263proc prefspage_general {notebook} {
11264    global NS maxwidth maxgraphpct showneartags showlocalchanges
11265    global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11266    global hideremotes want_ttk have_ttk maxrefs
11267
11268    set page [create_prefs_page $notebook.general]
11269
11270    ${NS}::label $page.ldisp -text [mc "Commit list display options"]
11271    grid $page.ldisp - -sticky w -pady 10
11272    ${NS}::label $page.spacer -text " "
11273    ${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
11274    spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
11275    grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w
11276    ${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
11277    spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
11278    grid x $page.maxpctl $page.maxpct -sticky w
11279    ${NS}::checkbutton $page.showlocal -text [mc "Show local changes"] \
11280        -variable showlocalchanges
11281    grid x $page.showlocal -sticky w
11282    ${NS}::checkbutton $page.autoselect -text [mc "Auto-select SHA1 (length)"] \
11283        -variable autoselect
11284    spinbox $page.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
11285    grid x $page.autoselect $page.autosellen -sticky w
11286    ${NS}::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \
11287        -variable hideremotes
11288    grid x $page.hideremotes -sticky w
11289
11290    ${NS}::label $page.ddisp -text [mc "Diff display options"]
11291    grid $page.ddisp - -sticky w -pady 10
11292    ${NS}::label $page.tabstopl -text [mc "Tab spacing"]
11293    spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
11294    grid x $page.tabstopl $page.tabstop -sticky w
11295    ${NS}::checkbutton $page.ntag -text [mc "Display nearby tags/heads"] \
11296        -variable showneartags
11297    grid x $page.ntag -sticky w
11298    ${NS}::label $page.maxrefsl -text [mc "Maximum # tags/heads to show"]
11299    spinbox $page.maxrefs -from 1 -to 1000 -width 4 -textvariable maxrefs
11300    grid x $page.maxrefsl $page.maxrefs -sticky w
11301    ${NS}::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \
11302        -variable limitdiffs
11303    grid x $page.ldiff -sticky w
11304    ${NS}::checkbutton $page.lattr -text [mc "Support per-file encodings"] \
11305        -variable perfile_attrs
11306    grid x $page.lattr -sticky w
11307
11308    ${NS}::entry $page.extdifft -textvariable extdifftool
11309    ${NS}::frame $page.extdifff
11310    ${NS}::label $page.extdifff.l -text [mc "External diff tool" ]
11311    ${NS}::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff
11312    pack $page.extdifff.l $page.extdifff.b -side left
11313    pack configure $page.extdifff.l -padx 10
11314    grid x $page.extdifff $page.extdifft -sticky ew
11315
11316    ${NS}::label $page.lgen -text [mc "General options"]
11317    grid $page.lgen - -sticky w -pady 10
11318    ${NS}::checkbutton $page.want_ttk -variable want_ttk \
11319        -text [mc "Use themed widgets"]
11320    if {$have_ttk} {
11321        ${NS}::label $page.ttk_note -text [mc "(change requires restart)"]
11322    } else {
11323        ${NS}::label $page.ttk_note -text [mc "(currently unavailable)"]
11324    }
11325    grid x $page.want_ttk $page.ttk_note -sticky w
11326    return $page
11327}
11328
11329proc prefspage_colors {notebook} {
11330    global NS uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11331
11332    set page [create_prefs_page $notebook.colors]
11333
11334    ${NS}::label $page.cdisp -text [mc "Colors: press to choose"]
11335    grid $page.cdisp - -sticky w -pady 10
11336    label $page.ui -padx 40 -relief sunk -background $uicolor
11337    ${NS}::button $page.uibut -text [mc "Interface"] \
11338       -command [list choosecolor uicolor {} $page.ui [mc "interface"] setui]
11339    grid x $page.uibut $page.ui -sticky w
11340    label $page.bg -padx 40 -relief sunk -background $bgcolor
11341    ${NS}::button $page.bgbut -text [mc "Background"] \
11342        -command [list choosecolor bgcolor {} $page.bg [mc "background"] setbg]
11343    grid x $page.bgbut $page.bg -sticky w
11344    label $page.fg -padx 40 -relief sunk -background $fgcolor
11345    ${NS}::button $page.fgbut -text [mc "Foreground"] \
11346        -command [list choosecolor fgcolor {} $page.fg [mc "foreground"] setfg]
11347    grid x $page.fgbut $page.fg -sticky w
11348    label $page.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
11349    ${NS}::button $page.diffoldbut -text [mc "Diff: old lines"] \
11350        -command [list choosecolor diffcolors 0 $page.diffold [mc "diff old lines"] \
11351                      [list $ctext tag conf d0 -foreground]]
11352    grid x $page.diffoldbut $page.diffold -sticky w
11353    label $page.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
11354    ${NS}::button $page.diffnewbut -text [mc "Diff: new lines"] \
11355        -command [list choosecolor diffcolors 1 $page.diffnew [mc "diff new lines"] \
11356                      [list $ctext tag conf dresult -foreground]]
11357    grid x $page.diffnewbut $page.diffnew -sticky w
11358    label $page.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
11359    ${NS}::button $page.hunksepbut -text [mc "Diff: hunk header"] \
11360        -command [list choosecolor diffcolors 2 $page.hunksep \
11361                      [mc "diff hunk header"] \
11362                      [list $ctext tag conf hunksep -foreground]]
11363    grid x $page.hunksepbut $page.hunksep -sticky w
11364    label $page.markbgsep -padx 40 -relief sunk -background $markbgcolor
11365    ${NS}::button $page.markbgbut -text [mc "Marked line bg"] \
11366        -command [list choosecolor markbgcolor {} $page.markbgsep \
11367                      [mc "marked line background"] \
11368                      [list $ctext tag conf omark -background]]
11369    grid x $page.markbgbut $page.markbgsep -sticky w
11370    label $page.selbgsep -padx 40 -relief sunk -background $selectbgcolor
11371    ${NS}::button $page.selbgbut -text [mc "Select bg"] \
11372        -command [list choosecolor selectbgcolor {} $page.selbgsep [mc "background"] setselbg]
11373    grid x $page.selbgbut $page.selbgsep -sticky w
11374    return $page
11375}
11376
11377proc prefspage_fonts {notebook} {
11378    global NS
11379    set page [create_prefs_page $notebook.fonts]
11380    ${NS}::label $page.cfont -text [mc "Fonts: press to choose"]
11381    grid $page.cfont - -sticky w -pady 10
11382    mkfontdisp mainfont $page [mc "Main font"]
11383    mkfontdisp textfont $page [mc "Diff display font"]
11384    mkfontdisp uifont $page [mc "User interface font"]
11385    return $page
11386}
11387
11388proc doprefs {} {
11389    global maxwidth maxgraphpct use_ttk NS
11390    global oldprefs prefstop showneartags showlocalchanges
11391    global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11392    global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11393    global hideremotes want_ttk have_ttk
11394
11395    set top .gitkprefs
11396    set prefstop $top
11397    if {[winfo exists $top]} {
11398        raise $top
11399        return
11400    }
11401    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11402                   limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11403        set oldprefs($v) [set $v]
11404    }
11405    ttk_toplevel $top
11406    wm title $top [mc "Gitk preferences"]
11407    make_transient $top .
11408
11409    if {[set use_notebook [expr {$use_ttk && [info command ::ttk::notebook] ne ""}]]} {
11410        set notebook [ttk::notebook $top.notebook]
11411    } else {
11412        set notebook [${NS}::frame $top.notebook -borderwidth 0 -relief flat]
11413    }
11414
11415    lappend pages [prefspage_general $notebook] [mc "General"]
11416    lappend pages [prefspage_colors $notebook] [mc "Colors"]
11417    lappend pages [prefspage_fonts $notebook] [mc "Fonts"]
11418    set col 0
11419    foreach {page title} $pages {
11420        if {$use_notebook} {
11421            $notebook add $page -text $title
11422        } else {
11423            set btn [${NS}::button $notebook.b_[string map {. X} $page] \
11424                         -text $title -command [list raise $page]]
11425            $page configure -text $title
11426            grid $btn -row 0 -column [incr col] -sticky w
11427            grid $page -row 1 -column 0 -sticky news -columnspan 100
11428        }
11429    }
11430
11431    if {!$use_notebook} {
11432        grid columnconfigure $notebook 0 -weight 1
11433        grid rowconfigure $notebook 1 -weight 1
11434        raise [lindex $pages 0]
11435    }
11436
11437    grid $notebook -sticky news -padx 2 -pady 2
11438    grid rowconfigure $top 0 -weight 1
11439    grid columnconfigure $top 0 -weight 1
11440
11441    ${NS}::frame $top.buts
11442    ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
11443    ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
11444    bind $top <Key-Return> prefsok
11445    bind $top <Key-Escape> prefscan
11446    grid $top.buts.ok $top.buts.can
11447    grid columnconfigure $top.buts 0 -weight 1 -uniform a
11448    grid columnconfigure $top.buts 1 -weight 1 -uniform a
11449    grid $top.buts - - -pady 10 -sticky ew
11450    grid columnconfigure $top 2 -weight 1
11451    bind $top <Visibility> [list focus $top.buts.ok]
11452}
11453
11454proc choose_extdiff {} {
11455    global extdifftool
11456
11457    set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
11458    if {$prog ne {}} {
11459        set extdifftool $prog
11460    }
11461}
11462
11463proc choosecolor {v vi w x cmd} {
11464    global $v
11465
11466    set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
11467               -title [mc "Gitk: choose color for %s" $x]]
11468    if {$c eq {}} return
11469    $w conf -background $c
11470    lset $v $vi $c
11471    eval $cmd $c
11472}
11473
11474proc setselbg {c} {
11475    global bglist cflist
11476    foreach w $bglist {
11477        $w configure -selectbackground $c
11478    }
11479    $cflist tag configure highlight \
11480        -background [$cflist cget -selectbackground]
11481    allcanvs itemconf secsel -fill $c
11482}
11483
11484# This sets the background color and the color scheme for the whole UI.
11485# For some reason, tk_setPalette chooses a nasty dark red for selectColor
11486# if we don't specify one ourselves, which makes the checkbuttons and
11487# radiobuttons look bad.  This chooses white for selectColor if the
11488# background color is light, or black if it is dark.
11489proc setui {c} {
11490    if {[tk windowingsystem] eq "win32"} { return }
11491    set bg [winfo rgb . $c]
11492    set selc black
11493    if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
11494        set selc white
11495    }
11496    tk_setPalette background $c selectColor $selc
11497}
11498
11499proc setbg {c} {
11500    global bglist
11501
11502    foreach w $bglist {
11503        $w conf -background $c
11504    }
11505}
11506
11507proc setfg {c} {
11508    global fglist canv
11509
11510    foreach w $fglist {
11511        $w conf -foreground $c
11512    }
11513    allcanvs itemconf text -fill $c
11514    $canv itemconf circle -outline $c
11515    $canv itemconf markid -outline $c
11516}
11517
11518proc prefscan {} {
11519    global oldprefs prefstop
11520
11521    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11522                   limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11523        global $v
11524        set $v $oldprefs($v)
11525    }
11526    catch {destroy $prefstop}
11527    unset prefstop
11528    fontcan
11529}
11530
11531proc prefsok {} {
11532    global maxwidth maxgraphpct
11533    global oldprefs prefstop showneartags showlocalchanges
11534    global fontpref mainfont textfont uifont
11535    global limitdiffs treediffs perfile_attrs
11536    global hideremotes
11537
11538    catch {destroy $prefstop}
11539    unset prefstop
11540    fontcan
11541    set fontchanged 0
11542    if {$mainfont ne $fontpref(mainfont)} {
11543        set mainfont $fontpref(mainfont)
11544        parsefont mainfont $mainfont
11545        eval font configure mainfont [fontflags mainfont]
11546        eval font configure mainfontbold [fontflags mainfont 1]
11547        setcoords
11548        set fontchanged 1
11549    }
11550    if {$textfont ne $fontpref(textfont)} {
11551        set textfont $fontpref(textfont)
11552        parsefont textfont $textfont
11553        eval font configure textfont [fontflags textfont]
11554        eval font configure textfontbold [fontflags textfont 1]
11555    }
11556    if {$uifont ne $fontpref(uifont)} {
11557        set uifont $fontpref(uifont)
11558        parsefont uifont $uifont
11559        eval font configure uifont [fontflags uifont]
11560    }
11561    settabs
11562    if {$showlocalchanges != $oldprefs(showlocalchanges)} {
11563        if {$showlocalchanges} {
11564            doshowlocalchanges
11565        } else {
11566            dohidelocalchanges
11567        }
11568    }
11569    if {$limitdiffs != $oldprefs(limitdiffs) ||
11570        ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11571        # treediffs elements are limited by path;
11572        # won't have encodings cached if perfile_attrs was just turned on
11573        catch {unset treediffs}
11574    }
11575    if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
11576        || $maxgraphpct != $oldprefs(maxgraphpct)} {
11577        redisplay
11578    } elseif {$showneartags != $oldprefs(showneartags) ||
11579          $limitdiffs != $oldprefs(limitdiffs)} {
11580        reselectline
11581    }
11582    if {$hideremotes != $oldprefs(hideremotes)} {
11583        rereadrefs
11584    }
11585}
11586
11587proc formatdate {d} {
11588    global datetimeformat
11589    if {$d ne {}} {
11590        # If $datetimeformat includes a timezone, display in the
11591        # timezone of the argument.  Otherwise, display in local time.
11592        if {[string match {*%[zZ]*} $datetimeformat]} {
11593            if {[catch {set d [clock format [lindex $d 0] -timezone [lindex $d 1] -format $datetimeformat]}]} {
11594                # Tcl < 8.5 does not support -timezone.  Emulate it by
11595                # setting TZ (e.g. TZ=<-0430>+04:30).
11596                global env
11597                if {[info exists env(TZ)]} {
11598                    set savedTZ $env(TZ)
11599                }
11600                set zone [lindex $d 1]
11601                set sign [string map {+ - - +} [string index $zone 0]]
11602                set env(TZ) <$zone>$sign[string range $zone 1 2]:[string range $zone 3 4]
11603                set d [clock format [lindex $d 0] -format $datetimeformat]
11604                if {[info exists savedTZ]} {
11605                    set env(TZ) $savedTZ
11606                } else {
11607                    unset env(TZ)
11608                }
11609            }
11610        } else {
11611            set d [clock format [lindex $d 0] -format $datetimeformat]
11612        }
11613    }
11614    return $d
11615}
11616
11617# This list of encoding names and aliases is distilled from
11618# http://www.iana.org/assignments/character-sets.
11619# Not all of them are supported by Tcl.
11620set encoding_aliases {
11621    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11622      ISO646-US US-ASCII us IBM367 cp367 csASCII }
11623    { ISO-10646-UTF-1 csISO10646UTF1 }
11624    { ISO_646.basic:1983 ref csISO646basic1983 }
11625    { INVARIANT csINVARIANT }
11626    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11627    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11628    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11629    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11630    { NATS-DANO iso-ir-9-1 csNATSDANO }
11631    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11632    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11633    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11634    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11635    { ISO-2022-KR csISO2022KR }
11636    { EUC-KR csEUCKR }
11637    { ISO-2022-JP csISO2022JP }
11638    { ISO-2022-JP-2 csISO2022JP2 }
11639    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11640      csISO13JISC6220jp }
11641    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11642    { IT iso-ir-15 ISO646-IT csISO15Italian }
11643    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11644    { ES iso-ir-17 ISO646-ES csISO17Spanish }
11645    { greek7-old iso-ir-18 csISO18Greek7Old }
11646    { latin-greek iso-ir-19 csISO19LatinGreek }
11647    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11648    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11649    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11650    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11651    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11652    { BS_viewdata iso-ir-47 csISO47BSViewdata }
11653    { INIS iso-ir-49 csISO49INIS }
11654    { INIS-8 iso-ir-50 csISO50INIS8 }
11655    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11656    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11657    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11658    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11659    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11660    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11661      csISO60Norwegian1 }
11662    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11663    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11664    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11665    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11666    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11667    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11668    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11669    { greek7 iso-ir-88 csISO88Greek7 }
11670    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11671    { iso-ir-90 csISO90 }
11672    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11673    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11674      csISO92JISC62991984b }
11675    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11676    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11677    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11678      csISO95JIS62291984handadd }
11679    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11680    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11681    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11682    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11683      CP819 csISOLatin1 }
11684    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11685    { T.61-7bit iso-ir-102 csISO102T617bit }
11686    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11687    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
11688    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
11689    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
11690    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
11691    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
11692    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
11693    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
11694      arabic csISOLatinArabic }
11695    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
11696    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
11697    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
11698      greek greek8 csISOLatinGreek }
11699    { T.101-G2 iso-ir-128 csISO128T101G2 }
11700    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
11701      csISOLatinHebrew }
11702    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
11703    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
11704    { CSN_369103 iso-ir-139 csISO139CSN369103 }
11705    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
11706    { ISO_6937-2-add iso-ir-142 csISOTextComm }
11707    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
11708    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
11709      csISOLatinCyrillic }
11710    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
11711    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
11712    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
11713    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
11714    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
11715    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
11716    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
11717    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
11718    { ISO_10367-box iso-ir-155 csISO10367Box }
11719    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
11720    { latin-lap lap iso-ir-158 csISO158Lap }
11721    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
11722    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
11723    { us-dk csUSDK }
11724    { dk-us csDKUS }
11725    { JIS_X0201 X0201 csHalfWidthKatakana }
11726    { KSC5636 ISO646-KR csKSC5636 }
11727    { ISO-10646-UCS-2 csUnicode }
11728    { ISO-10646-UCS-4 csUCS4 }
11729    { DEC-MCS dec csDECMCS }
11730    { hp-roman8 roman8 r8 csHPRoman8 }
11731    { macintosh mac csMacintosh }
11732    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
11733      csIBM037 }
11734    { IBM038 EBCDIC-INT cp038 csIBM038 }
11735    { IBM273 CP273 csIBM273 }
11736    { IBM274 EBCDIC-BE CP274 csIBM274 }
11737    { IBM275 EBCDIC-BR cp275 csIBM275 }
11738    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
11739    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
11740    { IBM280 CP280 ebcdic-cp-it csIBM280 }
11741    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
11742    { IBM284 CP284 ebcdic-cp-es csIBM284 }
11743    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
11744    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
11745    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
11746    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
11747    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
11748    { IBM424 cp424 ebcdic-cp-he csIBM424 }
11749    { IBM437 cp437 437 csPC8CodePage437 }
11750    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
11751    { IBM775 cp775 csPC775Baltic }
11752    { IBM850 cp850 850 csPC850Multilingual }
11753    { IBM851 cp851 851 csIBM851 }
11754    { IBM852 cp852 852 csPCp852 }
11755    { IBM855 cp855 855 csIBM855 }
11756    { IBM857 cp857 857 csIBM857 }
11757    { IBM860 cp860 860 csIBM860 }
11758    { IBM861 cp861 861 cp-is csIBM861 }
11759    { IBM862 cp862 862 csPC862LatinHebrew }
11760    { IBM863 cp863 863 csIBM863 }
11761    { IBM864 cp864 csIBM864 }
11762    { IBM865 cp865 865 csIBM865 }
11763    { IBM866 cp866 866 csIBM866 }
11764    { IBM868 CP868 cp-ar csIBM868 }
11765    { IBM869 cp869 869 cp-gr csIBM869 }
11766    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
11767    { IBM871 CP871 ebcdic-cp-is csIBM871 }
11768    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
11769    { IBM891 cp891 csIBM891 }
11770    { IBM903 cp903 csIBM903 }
11771    { IBM904 cp904 904 csIBBM904 }
11772    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
11773    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
11774    { IBM1026 CP1026 csIBM1026 }
11775    { EBCDIC-AT-DE csIBMEBCDICATDE }
11776    { EBCDIC-AT-DE-A csEBCDICATDEA }
11777    { EBCDIC-CA-FR csEBCDICCAFR }
11778    { EBCDIC-DK-NO csEBCDICDKNO }
11779    { EBCDIC-DK-NO-A csEBCDICDKNOA }
11780    { EBCDIC-FI-SE csEBCDICFISE }
11781    { EBCDIC-FI-SE-A csEBCDICFISEA }
11782    { EBCDIC-FR csEBCDICFR }
11783    { EBCDIC-IT csEBCDICIT }
11784    { EBCDIC-PT csEBCDICPT }
11785    { EBCDIC-ES csEBCDICES }
11786    { EBCDIC-ES-A csEBCDICESA }
11787    { EBCDIC-ES-S csEBCDICESS }
11788    { EBCDIC-UK csEBCDICUK }
11789    { EBCDIC-US csEBCDICUS }
11790    { UNKNOWN-8BIT csUnknown8BiT }
11791    { MNEMONIC csMnemonic }
11792    { MNEM csMnem }
11793    { VISCII csVISCII }
11794    { VIQR csVIQR }
11795    { KOI8-R csKOI8R }
11796    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
11797    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
11798    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
11799    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
11800    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
11801    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
11802    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
11803    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
11804    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
11805    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
11806    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
11807    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
11808    { IBM1047 IBM-1047 }
11809    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
11810    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
11811    { UNICODE-1-1 csUnicode11 }
11812    { CESU-8 csCESU-8 }
11813    { BOCU-1 csBOCU-1 }
11814    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
11815    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
11816      l8 }
11817    { ISO-8859-15 ISO_8859-15 Latin-9 }
11818    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
11819    { GBK CP936 MS936 windows-936 }
11820    { JIS_Encoding csJISEncoding }
11821    { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
11822    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
11823      EUC-JP }
11824    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
11825    { ISO-10646-UCS-Basic csUnicodeASCII }
11826    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
11827    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
11828    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
11829    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
11830    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
11831    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
11832    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
11833    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
11834    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
11835    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
11836    { Adobe-Standard-Encoding csAdobeStandardEncoding }
11837    { Ventura-US csVenturaUS }
11838    { Ventura-International csVenturaInternational }
11839    { PC8-Danish-Norwegian csPC8DanishNorwegian }
11840    { PC8-Turkish csPC8Turkish }
11841    { IBM-Symbols csIBMSymbols }
11842    { IBM-Thai csIBMThai }
11843    { HP-Legal csHPLegal }
11844    { HP-Pi-font csHPPiFont }
11845    { HP-Math8 csHPMath8 }
11846    { Adobe-Symbol-Encoding csHPPSMath }
11847    { HP-DeskTop csHPDesktop }
11848    { Ventura-Math csVenturaMath }
11849    { Microsoft-Publishing csMicrosoftPublishing }
11850    { Windows-31J csWindows31J }
11851    { GB2312 csGB2312 }
11852    { Big5 csBig5 }
11853}
11854
11855proc tcl_encoding {enc} {
11856    global encoding_aliases tcl_encoding_cache
11857    if {[info exists tcl_encoding_cache($enc)]} {
11858        return $tcl_encoding_cache($enc)
11859    }
11860    set names [encoding names]
11861    set lcnames [string tolower $names]
11862    set enc [string tolower $enc]
11863    set i [lsearch -exact $lcnames $enc]
11864    if {$i < 0} {
11865        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
11866        if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
11867            set i [lsearch -exact $lcnames $encx]
11868        }
11869    }
11870    if {$i < 0} {
11871        foreach l $encoding_aliases {
11872            set ll [string tolower $l]
11873            if {[lsearch -exact $ll $enc] < 0} continue
11874            # look through the aliases for one that tcl knows about
11875            foreach e $ll {
11876                set i [lsearch -exact $lcnames $e]
11877                if {$i < 0} {
11878                    if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
11879                        set i [lsearch -exact $lcnames $ex]
11880                    }
11881                }
11882                if {$i >= 0} break
11883            }
11884            break
11885        }
11886    }
11887    set tclenc {}
11888    if {$i >= 0} {
11889        set tclenc [lindex $names $i]
11890    }
11891    set tcl_encoding_cache($enc) $tclenc
11892    return $tclenc
11893}
11894
11895proc gitattr {path attr default} {
11896    global path_attr_cache
11897    if {[info exists path_attr_cache($attr,$path)]} {
11898        set r $path_attr_cache($attr,$path)
11899    } else {
11900        set r "unspecified"
11901        if {![catch {set line [exec git check-attr $attr -- $path]}]} {
11902            regexp "(.*): $attr: (.*)" $line m f r
11903        }
11904        set path_attr_cache($attr,$path) $r
11905    }
11906    if {$r eq "unspecified"} {
11907        return $default
11908    }
11909    return $r
11910}
11911
11912proc cache_gitattr {attr pathlist} {
11913    global path_attr_cache
11914    set newlist {}
11915    foreach path $pathlist {
11916        if {![info exists path_attr_cache($attr,$path)]} {
11917            lappend newlist $path
11918        }
11919    }
11920    set lim 1000
11921    if {[tk windowingsystem] == "win32"} {
11922        # windows has a 32k limit on the arguments to a command...
11923        set lim 30
11924    }
11925    while {$newlist ne {}} {
11926        set head [lrange $newlist 0 [expr {$lim - 1}]]
11927        set newlist [lrange $newlist $lim end]
11928        if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
11929            foreach row [split $rlist "\n"] {
11930                if {[regexp "(.*): $attr: (.*)" $row m path value]} {
11931                    if {[string index $path 0] eq "\""} {
11932                        set path [encoding convertfrom [lindex $path 0]]
11933                    }
11934                    set path_attr_cache($attr,$path) $value
11935                }
11936            }
11937        }
11938    }
11939}
11940
11941proc get_path_encoding {path} {
11942    global gui_encoding perfile_attrs
11943    set tcl_enc $gui_encoding
11944    if {$path ne {} && $perfile_attrs} {
11945        set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
11946        if {$enc2 ne {}} {
11947            set tcl_enc $enc2
11948        }
11949    }
11950    return $tcl_enc
11951}
11952
11953# First check that Tcl/Tk is recent enough
11954if {[catch {package require Tk 8.4} err]} {
11955    show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
11956                     Gitk requires at least Tcl/Tk 8.4." list
11957    exit 1
11958}
11959
11960# on OSX bring the current Wish process window to front
11961if {[tk windowingsystem] eq "aqua"} {
11962    exec osascript -e [format {
11963        tell application "System Events"
11964            set frontmost of processes whose unix id is %d to true
11965        end tell
11966    } [pid] ]
11967}
11968
11969# Unset GIT_TRACE var if set
11970if { [info exists ::env(GIT_TRACE)] } {
11971    unset ::env(GIT_TRACE)
11972}
11973
11974# defaults...
11975set wrcomcmd "git diff-tree --stdin -p --pretty"
11976
11977set gitencoding {}
11978catch {
11979    set gitencoding [exec git config --get i18n.commitencoding]
11980}
11981catch {
11982    set gitencoding [exec git config --get i18n.logoutputencoding]
11983}
11984if {$gitencoding == ""} {
11985    set gitencoding "utf-8"
11986}
11987set tclencoding [tcl_encoding $gitencoding]
11988if {$tclencoding == {}} {
11989    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
11990}
11991
11992set gui_encoding [encoding system]
11993catch {
11994    set enc [exec git config --get gui.encoding]
11995    if {$enc ne {}} {
11996        set tclenc [tcl_encoding $enc]
11997        if {$tclenc ne {}} {
11998            set gui_encoding $tclenc
11999        } else {
12000            puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
12001        }
12002    }
12003}
12004
12005set log_showroot true
12006catch {
12007    set log_showroot [exec git config --bool --get log.showroot]
12008}
12009
12010if {[tk windowingsystem] eq "aqua"} {
12011    set mainfont {{Lucida Grande} 9}
12012    set textfont {Monaco 9}
12013    set uifont {{Lucida Grande} 9 bold}
12014} elseif {![catch {::tk::pkgconfig get fontsystem} xft] && $xft eq "xft"} {
12015    # fontconfig!
12016    set mainfont {sans 9}
12017    set textfont {monospace 9}
12018    set uifont {sans 9 bold}
12019} else {
12020    set mainfont {Helvetica 9}
12021    set textfont {Courier 9}
12022    set uifont {Helvetica 9 bold}
12023}
12024set tabstop 8
12025set findmergefiles 0
12026set maxgraphpct 50
12027set maxwidth 16
12028set revlistorder 0
12029set fastdate 0
12030set uparrowlen 5
12031set downarrowlen 5
12032set mingaplen 100
12033set cmitmode "patch"
12034set wrapcomment "none"
12035set showneartags 1
12036set hideremotes 0
12037set maxrefs 20
12038set maxlinelen 200
12039set showlocalchanges 1
12040set limitdiffs 1
12041set datetimeformat "%Y-%m-%d %H:%M:%S"
12042set autoselect 1
12043set autosellen 40
12044set perfile_attrs 0
12045set want_ttk 1
12046
12047if {[tk windowingsystem] eq "aqua"} {
12048    set extdifftool "opendiff"
12049} else {
12050    set extdifftool "meld"
12051}
12052
12053set colors {green red blue magenta darkgrey brown orange}
12054if {[tk windowingsystem] eq "win32"} {
12055    set uicolor SystemButtonFace
12056    set uifgcolor SystemButtonText
12057    set uifgdisabledcolor SystemDisabledText
12058    set bgcolor SystemWindow
12059    set fgcolor SystemWindowText
12060    set selectbgcolor SystemHighlight
12061} else {
12062    set uicolor grey85
12063    set uifgcolor black
12064    set uifgdisabledcolor "#999"
12065    set bgcolor white
12066    set fgcolor black
12067    set selectbgcolor gray85
12068}
12069set diffcolors {red "#00a000" blue}
12070set diffcontext 3
12071set mergecolors {red blue green purple brown "#009090" magenta "#808000" "#009000" "#ff0080" cyan "#b07070" "#70b0f0" "#70f0b0" "#f0b070" "#ff70b0"}
12072set ignorespace 0
12073set worddiff ""
12074set markbgcolor "#e0e0ff"
12075
12076set headbgcolor green
12077set headfgcolor black
12078set headoutlinecolor black
12079set remotebgcolor #ffddaa
12080set tagbgcolor yellow
12081set tagfgcolor black
12082set tagoutlinecolor black
12083set reflinecolor black
12084set filesepbgcolor #aaaaaa
12085set filesepfgcolor black
12086set linehoverbgcolor #ffff80
12087set linehoverfgcolor black
12088set linehoveroutlinecolor black
12089set mainheadcirclecolor yellow
12090set workingfilescirclecolor red
12091set indexcirclecolor green
12092set circlecolors {white blue gray blue blue}
12093set linkfgcolor blue
12094set circleoutlinecolor $fgcolor
12095set foundbgcolor yellow
12096set currentsearchhitbgcolor orange
12097
12098# button for popping up context menus
12099if {[tk windowingsystem] eq "aqua"} {
12100    set ctxbut <Button-2>
12101} else {
12102    set ctxbut <Button-3>
12103}
12104
12105## For msgcat loading, first locate the installation location.
12106if { [info exists ::env(GITK_MSGSDIR)] } {
12107    ## Msgsdir was manually set in the environment.
12108    set gitk_msgsdir $::env(GITK_MSGSDIR)
12109} else {
12110    ## Let's guess the prefix from argv0.
12111    set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
12112    set gitk_libdir [file join $gitk_prefix share gitk lib]
12113    set gitk_msgsdir [file join $gitk_libdir msgs]
12114    unset gitk_prefix
12115}
12116
12117## Internationalization (i18n) through msgcat and gettext. See
12118## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
12119package require msgcat
12120namespace import ::msgcat::mc
12121## And eventually load the actual message catalog
12122::msgcat::mcload $gitk_msgsdir
12123
12124catch {
12125    # follow the XDG base directory specification by default. See
12126    # http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html
12127    if {[info exists env(XDG_CONFIG_HOME)] && $env(XDG_CONFIG_HOME) ne ""} {
12128        # XDG_CONFIG_HOME environment variable is set
12129        set config_file [file join $env(XDG_CONFIG_HOME) git gitk]
12130        set config_file_tmp [file join $env(XDG_CONFIG_HOME) git gitk-tmp]
12131    } else {
12132        # default XDG_CONFIG_HOME
12133        set config_file "~/.config/git/gitk"
12134        set config_file_tmp "~/.config/git/gitk-tmp"
12135    }
12136    if {![file exists $config_file]} {
12137        # for backward compatibility use the old config file if it exists
12138        if {[file exists "~/.gitk"]} {
12139            set config_file "~/.gitk"
12140            set config_file_tmp "~/.gitk-tmp"
12141        } elseif {![file exists [file dirname $config_file]]} {
12142            file mkdir [file dirname $config_file]
12143        }
12144    }
12145    source $config_file
12146}
12147
12148parsefont mainfont $mainfont
12149eval font create mainfont [fontflags mainfont]
12150eval font create mainfontbold [fontflags mainfont 1]
12151
12152parsefont textfont $textfont
12153eval font create textfont [fontflags textfont]
12154eval font create textfontbold [fontflags textfont 1]
12155
12156parsefont uifont $uifont
12157eval font create uifont [fontflags uifont]
12158
12159setui $uicolor
12160
12161setoptions
12162
12163# check that we can find a .git directory somewhere...
12164if {[catch {set gitdir [exec git rev-parse --git-dir]}]} {
12165    show_error {} . [mc "Cannot find a git repository here."]
12166    exit 1
12167}
12168
12169set selecthead {}
12170set selectheadid {}
12171
12172set revtreeargs {}
12173set cmdline_files {}
12174set i 0
12175set revtreeargscmd {}
12176foreach arg $argv {
12177    switch -glob -- $arg {
12178        "" { }
12179        "--" {
12180            set cmdline_files [lrange $argv [expr {$i + 1}] end]
12181            break
12182        }
12183        "--select-commit=*" {
12184            set selecthead [string range $arg 16 end]
12185        }
12186        "--argscmd=*" {
12187            set revtreeargscmd [string range $arg 10 end]
12188        }
12189        default {
12190            lappend revtreeargs $arg
12191        }
12192    }
12193    incr i
12194}
12195
12196if {$selecthead eq "HEAD"} {
12197    set selecthead {}
12198}
12199
12200if {$i >= [llength $argv] && $revtreeargs ne {}} {
12201    # no -- on command line, but some arguments (other than --argscmd)
12202    if {[catch {
12203        set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
12204        set cmdline_files [split $f "\n"]
12205        set n [llength $cmdline_files]
12206        set revtreeargs [lrange $revtreeargs 0 end-$n]
12207        # Unfortunately git rev-parse doesn't produce an error when
12208        # something is both a revision and a filename.  To be consistent
12209        # with git log and git rev-list, check revtreeargs for filenames.
12210        foreach arg $revtreeargs {
12211            if {[file exists $arg]} {
12212                show_error {} . [mc "Ambiguous argument '%s': both revision\
12213                                 and filename" $arg]
12214                exit 1
12215            }
12216        }
12217    } err]} {
12218        # unfortunately we get both stdout and stderr in $err,
12219        # so look for "fatal:".
12220        set i [string first "fatal:" $err]
12221        if {$i > 0} {
12222            set err [string range $err [expr {$i + 6}] end]
12223        }
12224        show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
12225        exit 1
12226    }
12227}
12228
12229set nullid "0000000000000000000000000000000000000000"
12230set nullid2 "0000000000000000000000000000000000000001"
12231set nullfile "/dev/null"
12232
12233set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
12234if {![info exists have_ttk]} {
12235    set have_ttk [llength [info commands ::ttk::style]]
12236}
12237set use_ttk [expr {$have_ttk && $want_ttk}]
12238set NS [expr {$use_ttk ? "ttk" : ""}]
12239
12240regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
12241
12242set show_notes {}
12243if {[package vcompare $git_version "1.6.6.2"] >= 0} {
12244    set show_notes "--show-notes"
12245}
12246
12247set appname "gitk"
12248
12249set runq {}
12250set history {}
12251set historyindex 0
12252set fh_serial 0
12253set nhl_names {}
12254set highlight_paths {}
12255set findpattern {}
12256set searchdirn -forwards
12257set boldids {}
12258set boldnameids {}
12259set diffelide {0 0}
12260set markingmatches 0
12261set linkentercount 0
12262set need_redisplay 0
12263set nrows_drawn 0
12264set firsttabstop 0
12265
12266set nextviewnum 1
12267set curview 0
12268set selectedview 0
12269set selectedhlview [mc "None"]
12270set highlight_related [mc "None"]
12271set highlight_files {}
12272set viewfiles(0) {}
12273set viewperm(0) 0
12274set viewargs(0) {}
12275set viewargscmd(0) {}
12276
12277set selectedline {}
12278set numcommits 0
12279set loginstance 0
12280set cmdlineok 0
12281set stopped 0
12282set stuffsaved 0
12283set patchnum 0
12284set lserial 0
12285set hasworktree [hasworktree]
12286set cdup {}
12287if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} {
12288    set cdup [exec git rev-parse --show-cdup]
12289}
12290set worktree [exec git rev-parse --show-toplevel]
12291setcoords
12292makewindow
12293catch {
12294    image create photo gitlogo      -width 16 -height 16
12295
12296    image create photo gitlogominus -width  4 -height  2
12297    gitlogominus put #C00000 -to 0 0 4 2
12298    gitlogo copy gitlogominus -to  1 5
12299    gitlogo copy gitlogominus -to  6 5
12300    gitlogo copy gitlogominus -to 11 5
12301    image delete gitlogominus
12302
12303    image create photo gitlogoplus  -width  4 -height  4
12304    gitlogoplus  put #008000 -to 1 0 3 4
12305    gitlogoplus  put #008000 -to 0 1 4 3
12306    gitlogo copy gitlogoplus  -to  1 9
12307    gitlogo copy gitlogoplus  -to  6 9
12308    gitlogo copy gitlogoplus  -to 11 9
12309    image delete gitlogoplus
12310
12311    image create photo gitlogo32    -width 32 -height 32
12312    gitlogo32 copy gitlogo -zoom 2 2
12313
12314    wm iconphoto . -default gitlogo gitlogo32
12315}
12316# wait for the window to become visible
12317tkwait visibility .
12318wm title . "$appname: [reponame]"
12319update
12320readrefs
12321
12322if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
12323    # create a view for the files/dirs specified on the command line
12324    set curview 1
12325    set selectedview 1
12326    set nextviewnum 2
12327    set viewname(1) [mc "Command line"]
12328    set viewfiles(1) $cmdline_files
12329    set viewargs(1) $revtreeargs
12330    set viewargscmd(1) $revtreeargscmd
12331    set viewperm(1) 0
12332    set vdatemode(1) 0
12333    addviewmenu 1
12334    .bar.view entryconf [mca "Edit view..."] -state normal
12335    .bar.view entryconf [mca "Delete view"] -state normal
12336}
12337
12338if {[info exists permviews]} {
12339    foreach v $permviews {
12340        set n $nextviewnum
12341        incr nextviewnum
12342        set viewname($n) [lindex $v 0]
12343        set viewfiles($n) [lindex $v 1]
12344        set viewargs($n) [lindex $v 2]
12345        set viewargscmd($n) [lindex $v 3]
12346        set viewperm($n) 1
12347        addviewmenu $n
12348    }
12349}
12350
12351if {[tk windowingsystem] eq "win32"} {
12352    focus -force .
12353}
12354
12355getcommits {}
12356
12357# Local variables:
12358# mode: tcl
12359# indent-tabs-mode: t
12360# tab-width: 8
12361# End: