gitkon commit gitk: Show detached HEAD if --all is specified (4d5e1b1)
   1#!/bin/sh
   2# Tcl ignores the next line -*- tcl -*- \
   3exec wish "$0" -- "$@"
   4
   5# Copyright © 2005-2014 Paul Mackerras.  All rights reserved.
   6# This program is free software; it may be used, copied, modified
   7# and distributed under the terms of the GNU General Public Licence,
   8# either version 2, or (at your option) any later version.
   9
  10package require Tk
  11
  12proc hasworktree {} {
  13    return [expr {[exec git rev-parse --is-bare-repository] == "false" &&
  14                  [exec git rev-parse --is-inside-git-dir] == "false"}]
  15}
  16
  17proc reponame {} {
  18    global gitdir
  19    set n [file normalize $gitdir]
  20    if {[string match "*/.git" $n]} {
  21        set n [string range $n 0 end-5]
  22    }
  23    return [file tail $n]
  24}
  25
  26proc gitworktree {} {
  27    variable _gitworktree
  28    if {[info exists _gitworktree]} {
  29        return $_gitworktree
  30    }
  31    # v1.7.0 introduced --show-toplevel to return the canonical work-tree
  32    if {[catch {set _gitworktree [exec git rev-parse --show-toplevel]}]} {
  33        # try to set work tree from environment, core.worktree or use
  34        # cdup to obtain a relative path to the top of the worktree. If
  35        # run from the top, the ./ prefix ensures normalize expands pwd.
  36        if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
  37            catch {set _gitworktree [exec git config --get core.worktree]}
  38            if {$_gitworktree eq ""} {
  39                set _gitworktree [file normalize ./[exec git rev-parse --show-cdup]]
  40            }
  41        }
  42    }
  43    return $_gitworktree
  44}
  45
  46# A simple scheduler for compute-intensive stuff.
  47# The aim is to make sure that event handlers for GUI actions can
  48# run at least every 50-100 ms.  Unfortunately fileevent handlers are
  49# run before X event handlers, so reading from a fast source can
  50# make the GUI completely unresponsive.
  51proc run args {
  52    global isonrunq runq currunq
  53
  54    set script $args
  55    if {[info exists isonrunq($script)]} return
  56    if {$runq eq {} && ![info exists currunq]} {
  57        after idle dorunq
  58    }
  59    lappend runq [list {} $script]
  60    set isonrunq($script) 1
  61}
  62
  63proc filerun {fd script} {
  64    fileevent $fd readable [list filereadable $fd $script]
  65}
  66
  67proc filereadable {fd script} {
  68    global runq currunq
  69
  70    fileevent $fd readable {}
  71    if {$runq eq {} && ![info exists currunq]} {
  72        after idle dorunq
  73    }
  74    lappend runq [list $fd $script]
  75}
  76
  77proc nukefile {fd} {
  78    global runq
  79
  80    for {set i 0} {$i < [llength $runq]} {} {
  81        if {[lindex $runq $i 0] eq $fd} {
  82            set runq [lreplace $runq $i $i]
  83        } else {
  84            incr i
  85        }
  86    }
  87}
  88
  89proc dorunq {} {
  90    global isonrunq runq currunq
  91
  92    set tstart [clock clicks -milliseconds]
  93    set t0 $tstart
  94    while {[llength $runq] > 0} {
  95        set fd [lindex $runq 0 0]
  96        set script [lindex $runq 0 1]
  97        set currunq [lindex $runq 0]
  98        set runq [lrange $runq 1 end]
  99        set repeat [eval $script]
 100        unset currunq
 101        set t1 [clock clicks -milliseconds]
 102        set t [expr {$t1 - $t0}]
 103        if {$repeat ne {} && $repeat} {
 104            if {$fd eq {} || $repeat == 2} {
 105                # script returns 1 if it wants to be readded
 106                # file readers return 2 if they could do more straight away
 107                lappend runq [list $fd $script]
 108            } else {
 109                fileevent $fd readable [list filereadable $fd $script]
 110            }
 111        } elseif {$fd eq {}} {
 112            unset isonrunq($script)
 113        }
 114        set t0 $t1
 115        if {$t1 - $tstart >= 80} break
 116    }
 117    if {$runq ne {}} {
 118        after idle dorunq
 119    }
 120}
 121
 122proc reg_instance {fd} {
 123    global commfd leftover loginstance
 124
 125    set i [incr loginstance]
 126    set commfd($i) $fd
 127    set leftover($i) {}
 128    return $i
 129}
 130
 131proc unmerged_files {files} {
 132    global nr_unmerged
 133
 134    # find the list of unmerged files
 135    set mlist {}
 136    set nr_unmerged 0
 137    if {[catch {
 138        set fd [open "| git ls-files -u" r]
 139    } err]} {
 140        show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
 141        exit 1
 142    }
 143    while {[gets $fd line] >= 0} {
 144        set i [string first "\t" $line]
 145        if {$i < 0} continue
 146        set fname [string range $line [expr {$i+1}] end]
 147        if {[lsearch -exact $mlist $fname] >= 0} continue
 148        incr nr_unmerged
 149        if {$files eq {} || [path_filter $files $fname]} {
 150            lappend mlist $fname
 151        }
 152    }
 153    catch {close $fd}
 154    return $mlist
 155}
 156
 157proc parseviewargs {n arglist} {
 158    global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs env
 159    global vinlinediff
 160    global worddiff git_version
 161
 162    set vdatemode($n) 0
 163    set vmergeonly($n) 0
 164    set vinlinediff($n) 0
 165    set glflags {}
 166    set diffargs {}
 167    set nextisval 0
 168    set revargs {}
 169    set origargs $arglist
 170    set allknown 1
 171    set filtered 0
 172    set i -1
 173    foreach arg $arglist {
 174        incr i
 175        if {$nextisval} {
 176            lappend glflags $arg
 177            set nextisval 0
 178            continue
 179        }
 180        switch -glob -- $arg {
 181            "-d" -
 182            "--date-order" {
 183                set vdatemode($n) 1
 184                # remove from origargs in case we hit an unknown option
 185                set origargs [lreplace $origargs $i $i]
 186                incr i -1
 187            }
 188            "-[puabwcrRBMC]" -
 189            "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
 190            "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
 191            "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
 192            "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
 193            "--ignore-space-change" - "-U*" - "--unified=*" {
 194                # These request or affect diff output, which we don't want.
 195                # Some could be used to set our defaults for diff display.
 196                lappend diffargs $arg
 197            }
 198            "--raw" - "--patch-with-raw" - "--patch-with-stat" -
 199            "--name-only" - "--name-status" - "--color" -
 200            "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
 201            "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
 202            "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
 203            "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
 204            "--objects" - "--objects-edge" - "--reverse" {
 205                # These cause our parsing of git log's output to fail, or else
 206                # they're options we want to set ourselves, so ignore them.
 207            }
 208            "--color-words*" - "--word-diff=color" {
 209                # These trigger a word diff in the console interface,
 210                # so help the user by enabling our own support
 211                if {[package vcompare $git_version "1.7.2"] >= 0} {
 212                    set worddiff [mc "Color words"]
 213                }
 214            }
 215            "--word-diff*" {
 216                if {[package vcompare $git_version "1.7.2"] >= 0} {
 217                    set worddiff [mc "Markup words"]
 218                }
 219            }
 220            "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
 221            "--check" - "--exit-code" - "--quiet" - "--topo-order" -
 222            "--full-history" - "--dense" - "--sparse" -
 223            "--follow" - "--left-right" - "--encoding=*" {
 224                # These are harmless, and some are even useful
 225                lappend glflags $arg
 226            }
 227            "--diff-filter=*" - "--no-merges" - "--unpacked" -
 228            "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
 229            "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
 230            "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
 231            "--remove-empty" - "--first-parent" - "--cherry-pick" -
 232            "-S*" - "-G*" - "--pickaxe-all" - "--pickaxe-regex" -
 233            "--simplify-by-decoration" {
 234                # These mean that we get a subset of the commits
 235                set filtered 1
 236                lappend glflags $arg
 237            }
 238            "-L*" {
 239                # Line-log with 'stuck' argument (unstuck form is
 240                # not supported)
 241                set filtered 1
 242                set vinlinediff($n) 1
 243                set allknown 0
 244                lappend glflags $arg
 245            }
 246            "-n" {
 247                # This appears to be the only one that has a value as a
 248                # separate word following it
 249                set filtered 1
 250                set nextisval 1
 251                lappend glflags $arg
 252            }
 253            "--not" - "--all" {
 254                lappend revargs $arg
 255            }
 256            "--merge" {
 257                set vmergeonly($n) 1
 258                # git rev-parse doesn't understand --merge
 259                lappend revargs --gitk-symmetric-diff-marker MERGE_HEAD...HEAD
 260            }
 261            "--no-replace-objects" {
 262                set env(GIT_NO_REPLACE_OBJECTS) "1"
 263            }
 264            "-*" {
 265                # Other flag arguments including -<n>
 266                if {[string is digit -strict [string range $arg 1 end]]} {
 267                    set filtered 1
 268                } else {
 269                    # a flag argument that we don't recognize;
 270                    # that means we can't optimize
 271                    set allknown 0
 272                }
 273                lappend glflags $arg
 274            }
 275            default {
 276                # Non-flag arguments specify commits or ranges of commits
 277                if {[string match "*...*" $arg]} {
 278                    lappend revargs --gitk-symmetric-diff-marker
 279                }
 280                lappend revargs $arg
 281            }
 282        }
 283    }
 284    set vdflags($n) $diffargs
 285    set vflags($n) $glflags
 286    set vrevs($n) $revargs
 287    set vfiltered($n) $filtered
 288    set vorigargs($n) $origargs
 289    return $allknown
 290}
 291
 292proc parseviewrevs {view revs} {
 293    global vposids vnegids
 294
 295    if {$revs eq {}} {
 296        set revs HEAD
 297    } elseif {[lsearch -exact $revs --all] >= 0} {
 298        lappend revs HEAD
 299    }
 300    if {[catch {set ids [eval exec git rev-parse $revs]} err]} {
 301        # we get stdout followed by stderr in $err
 302        # for an unknown rev, git rev-parse echoes it and then errors out
 303        set errlines [split $err "\n"]
 304        set badrev {}
 305        for {set l 0} {$l < [llength $errlines]} {incr l} {
 306            set line [lindex $errlines $l]
 307            if {!([string length $line] == 40 && [string is xdigit $line])} {
 308                if {[string match "fatal:*" $line]} {
 309                    if {[string match "fatal: ambiguous argument*" $line]
 310                        && $badrev ne {}} {
 311                        if {[llength $badrev] == 1} {
 312                            set err "unknown revision $badrev"
 313                        } else {
 314                            set err "unknown revisions: [join $badrev ", "]"
 315                        }
 316                    } else {
 317                        set err [join [lrange $errlines $l end] "\n"]
 318                    }
 319                    break
 320                }
 321                lappend badrev $line
 322            }
 323        }
 324        error_popup "[mc "Error parsing revisions:"] $err"
 325        return {}
 326    }
 327    set ret {}
 328    set pos {}
 329    set neg {}
 330    set sdm 0
 331    foreach id [split $ids "\n"] {
 332        if {$id eq "--gitk-symmetric-diff-marker"} {
 333            set sdm 4
 334        } elseif {[string match "^*" $id]} {
 335            if {$sdm != 1} {
 336                lappend ret $id
 337                if {$sdm == 3} {
 338                    set sdm 0
 339                }
 340            }
 341            lappend neg [string range $id 1 end]
 342        } else {
 343            if {$sdm != 2} {
 344                lappend ret $id
 345            } else {
 346                lset ret end $id...[lindex $ret end]
 347            }
 348            lappend pos $id
 349        }
 350        incr sdm -1
 351    }
 352    set vposids($view) $pos
 353    set vnegids($view) $neg
 354    return $ret
 355}
 356
 357# Start off a git log process and arrange to read its output
 358proc start_rev_list {view} {
 359    global startmsecs commitidx viewcomplete curview
 360    global tclencoding
 361    global viewargs viewargscmd viewfiles vfilelimit
 362    global showlocalchanges
 363    global viewactive viewinstances vmergeonly
 364    global mainheadid viewmainheadid viewmainheadid_orig
 365    global vcanopt vflags vrevs vorigargs
 366    global show_notes
 367
 368    set startmsecs [clock clicks -milliseconds]
 369    set commitidx($view) 0
 370    # these are set this way for the error exits
 371    set viewcomplete($view) 1
 372    set viewactive($view) 0
 373    varcinit $view
 374
 375    set args $viewargs($view)
 376    if {$viewargscmd($view) ne {}} {
 377        if {[catch {
 378            set str [exec sh -c $viewargscmd($view)]
 379        } err]} {
 380            error_popup "[mc "Error executing --argscmd command:"] $err"
 381            return 0
 382        }
 383        set args [concat $args [split $str "\n"]]
 384    }
 385    set vcanopt($view) [parseviewargs $view $args]
 386
 387    set files $viewfiles($view)
 388    if {$vmergeonly($view)} {
 389        set files [unmerged_files $files]
 390        if {$files eq {}} {
 391            global nr_unmerged
 392            if {$nr_unmerged == 0} {
 393                error_popup [mc "No files selected: --merge specified but\
 394                             no files are unmerged."]
 395            } else {
 396                error_popup [mc "No files selected: --merge specified but\
 397                             no unmerged files are within file limit."]
 398            }
 399            return 0
 400        }
 401    }
 402    set vfilelimit($view) $files
 403
 404    if {$vcanopt($view)} {
 405        set revs [parseviewrevs $view $vrevs($view)]
 406        if {$revs eq {}} {
 407            return 0
 408        }
 409        set args [concat $vflags($view) $revs]
 410    } else {
 411        set args $vorigargs($view)
 412    }
 413
 414    if {[catch {
 415        set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
 416                        --parents --boundary $args "--" $files] r]
 417    } err]} {
 418        error_popup "[mc "Error executing git log:"] $err"
 419        return 0
 420    }
 421    set i [reg_instance $fd]
 422    set viewinstances($view) [list $i]
 423    set viewmainheadid($view) $mainheadid
 424    set viewmainheadid_orig($view) $mainheadid
 425    if {$files ne {} && $mainheadid ne {}} {
 426        get_viewmainhead $view
 427    }
 428    if {$showlocalchanges && $viewmainheadid($view) ne {}} {
 429        interestedin $viewmainheadid($view) dodiffindex
 430    }
 431    fconfigure $fd -blocking 0 -translation lf -eofchar {}
 432    if {$tclencoding != {}} {
 433        fconfigure $fd -encoding $tclencoding
 434    }
 435    filerun $fd [list getcommitlines $fd $i $view 0]
 436    nowbusy $view [mc "Reading"]
 437    set viewcomplete($view) 0
 438    set viewactive($view) 1
 439    return 1
 440}
 441
 442proc stop_instance {inst} {
 443    global commfd leftover
 444
 445    set fd $commfd($inst)
 446    catch {
 447        set pid [pid $fd]
 448
 449        if {$::tcl_platform(platform) eq {windows}} {
 450            exec taskkill /pid $pid
 451        } else {
 452            exec kill $pid
 453        }
 454    }
 455    catch {close $fd}
 456    nukefile $fd
 457    unset commfd($inst)
 458    unset leftover($inst)
 459}
 460
 461proc stop_backends {} {
 462    global commfd
 463
 464    foreach inst [array names commfd] {
 465        stop_instance $inst
 466    }
 467}
 468
 469proc stop_rev_list {view} {
 470    global viewinstances
 471
 472    foreach inst $viewinstances($view) {
 473        stop_instance $inst
 474    }
 475    set viewinstances($view) {}
 476}
 477
 478proc reset_pending_select {selid} {
 479    global pending_select mainheadid selectheadid
 480
 481    if {$selid ne {}} {
 482        set pending_select $selid
 483    } elseif {$selectheadid ne {}} {
 484        set pending_select $selectheadid
 485    } else {
 486        set pending_select $mainheadid
 487    }
 488}
 489
 490proc getcommits {selid} {
 491    global canv curview need_redisplay viewactive
 492
 493    initlayout
 494    if {[start_rev_list $curview]} {
 495        reset_pending_select $selid
 496        show_status [mc "Reading commits..."]
 497        set need_redisplay 1
 498    } else {
 499        show_status [mc "No commits selected"]
 500    }
 501}
 502
 503proc updatecommits {} {
 504    global curview vcanopt vorigargs vfilelimit viewinstances
 505    global viewactive viewcomplete tclencoding
 506    global startmsecs showneartags showlocalchanges
 507    global mainheadid viewmainheadid viewmainheadid_orig pending_select
 508    global hasworktree
 509    global varcid vposids vnegids vflags vrevs
 510    global show_notes
 511
 512    set hasworktree [hasworktree]
 513    rereadrefs
 514    set view $curview
 515    if {$mainheadid ne $viewmainheadid_orig($view)} {
 516        if {$showlocalchanges} {
 517            dohidelocalchanges
 518        }
 519        set viewmainheadid($view) $mainheadid
 520        set viewmainheadid_orig($view) $mainheadid
 521        if {$vfilelimit($view) ne {}} {
 522            get_viewmainhead $view
 523        }
 524    }
 525    if {$showlocalchanges} {
 526        doshowlocalchanges
 527    }
 528    if {$vcanopt($view)} {
 529        set oldpos $vposids($view)
 530        set oldneg $vnegids($view)
 531        set revs [parseviewrevs $view $vrevs($view)]
 532        if {$revs eq {}} {
 533            return
 534        }
 535        # note: getting the delta when negative refs change is hard,
 536        # and could require multiple git log invocations, so in that
 537        # case we ask git log for all the commits (not just the delta)
 538        if {$oldneg eq $vnegids($view)} {
 539            set newrevs {}
 540            set npos 0
 541            # take out positive refs that we asked for before or
 542            # that we have already seen
 543            foreach rev $revs {
 544                if {[string length $rev] == 40} {
 545                    if {[lsearch -exact $oldpos $rev] < 0
 546                        && ![info exists varcid($view,$rev)]} {
 547                        lappend newrevs $rev
 548                        incr npos
 549                    }
 550                } else {
 551                    lappend $newrevs $rev
 552                }
 553            }
 554            if {$npos == 0} return
 555            set revs $newrevs
 556            set vposids($view) [lsort -unique [concat $oldpos $vposids($view)]]
 557        }
 558        set args [concat $vflags($view) $revs --not $oldpos]
 559    } else {
 560        set args $vorigargs($view)
 561    }
 562    if {[catch {
 563        set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
 564                        --parents --boundary $args "--" $vfilelimit($view)] r]
 565    } err]} {
 566        error_popup "[mc "Error executing git log:"] $err"
 567        return
 568    }
 569    if {$viewactive($view) == 0} {
 570        set startmsecs [clock clicks -milliseconds]
 571    }
 572    set i [reg_instance $fd]
 573    lappend viewinstances($view) $i
 574    fconfigure $fd -blocking 0 -translation lf -eofchar {}
 575    if {$tclencoding != {}} {
 576        fconfigure $fd -encoding $tclencoding
 577    }
 578    filerun $fd [list getcommitlines $fd $i $view 1]
 579    incr viewactive($view)
 580    set viewcomplete($view) 0
 581    reset_pending_select {}
 582    nowbusy $view [mc "Reading"]
 583    if {$showneartags} {
 584        getallcommits
 585    }
 586}
 587
 588proc reloadcommits {} {
 589    global curview viewcomplete selectedline currentid thickerline
 590    global showneartags treediffs commitinterest cached_commitrow
 591    global targetid
 592
 593    set selid {}
 594    if {$selectedline ne {}} {
 595        set selid $currentid
 596    }
 597
 598    if {!$viewcomplete($curview)} {
 599        stop_rev_list $curview
 600    }
 601    resetvarcs $curview
 602    set selectedline {}
 603    catch {unset currentid}
 604    catch {unset thickerline}
 605    catch {unset treediffs}
 606    readrefs
 607    changedrefs
 608    if {$showneartags} {
 609        getallcommits
 610    }
 611    clear_display
 612    catch {unset commitinterest}
 613    catch {unset cached_commitrow}
 614    catch {unset targetid}
 615    setcanvscroll
 616    getcommits $selid
 617    return 0
 618}
 619
 620# This makes a string representation of a positive integer which
 621# sorts as a string in numerical order
 622proc strrep {n} {
 623    if {$n < 16} {
 624        return [format "%x" $n]
 625    } elseif {$n < 256} {
 626        return [format "x%.2x" $n]
 627    } elseif {$n < 65536} {
 628        return [format "y%.4x" $n]
 629    }
 630    return [format "z%.8x" $n]
 631}
 632
 633# Procedures used in reordering commits from git log (without
 634# --topo-order) into the order for display.
 635
 636proc varcinit {view} {
 637    global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
 638    global vtokmod varcmod vrowmod varcix vlastins
 639
 640    set varcstart($view) {{}}
 641    set vupptr($view) {0}
 642    set vdownptr($view) {0}
 643    set vleftptr($view) {0}
 644    set vbackptr($view) {0}
 645    set varctok($view) {{}}
 646    set varcrow($view) {{}}
 647    set vtokmod($view) {}
 648    set varcmod($view) 0
 649    set vrowmod($view) 0
 650    set varcix($view) {{}}
 651    set vlastins($view) {0}
 652}
 653
 654proc resetvarcs {view} {
 655    global varcid varccommits parents children vseedcount ordertok
 656    global vshortids
 657
 658    foreach vid [array names varcid $view,*] {
 659        unset varcid($vid)
 660        unset children($vid)
 661        unset parents($vid)
 662    }
 663    foreach vid [array names vshortids $view,*] {
 664        unset vshortids($vid)
 665    }
 666    # some commits might have children but haven't been seen yet
 667    foreach vid [array names children $view,*] {
 668        unset children($vid)
 669    }
 670    foreach va [array names varccommits $view,*] {
 671        unset varccommits($va)
 672    }
 673    foreach vd [array names vseedcount $view,*] {
 674        unset vseedcount($vd)
 675    }
 676    catch {unset ordertok}
 677}
 678
 679# returns a list of the commits with no children
 680proc seeds {v} {
 681    global vdownptr vleftptr varcstart
 682
 683    set ret {}
 684    set a [lindex $vdownptr($v) 0]
 685    while {$a != 0} {
 686        lappend ret [lindex $varcstart($v) $a]
 687        set a [lindex $vleftptr($v) $a]
 688    }
 689    return $ret
 690}
 691
 692proc newvarc {view id} {
 693    global varcid varctok parents children vdatemode
 694    global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
 695    global commitdata commitinfo vseedcount varccommits vlastins
 696
 697    set a [llength $varctok($view)]
 698    set vid $view,$id
 699    if {[llength $children($vid)] == 0 || $vdatemode($view)} {
 700        if {![info exists commitinfo($id)]} {
 701            parsecommit $id $commitdata($id) 1
 702        }
 703        set cdate [lindex [lindex $commitinfo($id) 4] 0]
 704        if {![string is integer -strict $cdate]} {
 705            set cdate 0
 706        }
 707        if {![info exists vseedcount($view,$cdate)]} {
 708            set vseedcount($view,$cdate) -1
 709        }
 710        set c [incr vseedcount($view,$cdate)]
 711        set cdate [expr {$cdate ^ 0xffffffff}]
 712        set tok "s[strrep $cdate][strrep $c]"
 713    } else {
 714        set tok {}
 715    }
 716    set ka 0
 717    if {[llength $children($vid)] > 0} {
 718        set kid [lindex $children($vid) end]
 719        set k $varcid($view,$kid)
 720        if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
 721            set ki $kid
 722            set ka $k
 723            set tok [lindex $varctok($view) $k]
 724        }
 725    }
 726    if {$ka != 0} {
 727        set i [lsearch -exact $parents($view,$ki) $id]
 728        set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
 729        append tok [strrep $j]
 730    }
 731    set c [lindex $vlastins($view) $ka]
 732    if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
 733        set c $ka
 734        set b [lindex $vdownptr($view) $ka]
 735    } else {
 736        set b [lindex $vleftptr($view) $c]
 737    }
 738    while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
 739        set c $b
 740        set b [lindex $vleftptr($view) $c]
 741    }
 742    if {$c == $ka} {
 743        lset vdownptr($view) $ka $a
 744        lappend vbackptr($view) 0
 745    } else {
 746        lset vleftptr($view) $c $a
 747        lappend vbackptr($view) $c
 748    }
 749    lset vlastins($view) $ka $a
 750    lappend vupptr($view) $ka
 751    lappend vleftptr($view) $b
 752    if {$b != 0} {
 753        lset vbackptr($view) $b $a
 754    }
 755    lappend varctok($view) $tok
 756    lappend varcstart($view) $id
 757    lappend vdownptr($view) 0
 758    lappend varcrow($view) {}
 759    lappend varcix($view) {}
 760    set varccommits($view,$a) {}
 761    lappend vlastins($view) 0
 762    return $a
 763}
 764
 765proc splitvarc {p v} {
 766    global varcid varcstart varccommits varctok vtokmod
 767    global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
 768
 769    set oa $varcid($v,$p)
 770    set otok [lindex $varctok($v) $oa]
 771    set ac $varccommits($v,$oa)
 772    set i [lsearch -exact $varccommits($v,$oa) $p]
 773    if {$i <= 0} return
 774    set na [llength $varctok($v)]
 775    # "%" sorts before "0"...
 776    set tok "$otok%[strrep $i]"
 777    lappend varctok($v) $tok
 778    lappend varcrow($v) {}
 779    lappend varcix($v) {}
 780    set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
 781    set varccommits($v,$na) [lrange $ac $i end]
 782    lappend varcstart($v) $p
 783    foreach id $varccommits($v,$na) {
 784        set varcid($v,$id) $na
 785    }
 786    lappend vdownptr($v) [lindex $vdownptr($v) $oa]
 787    lappend vlastins($v) [lindex $vlastins($v) $oa]
 788    lset vdownptr($v) $oa $na
 789    lset vlastins($v) $oa 0
 790    lappend vupptr($v) $oa
 791    lappend vleftptr($v) 0
 792    lappend vbackptr($v) 0
 793    for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
 794        lset vupptr($v) $b $na
 795    }
 796    if {[string compare $otok $vtokmod($v)] <= 0} {
 797        modify_arc $v $oa
 798    }
 799}
 800
 801proc renumbervarc {a v} {
 802    global parents children varctok varcstart varccommits
 803    global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
 804
 805    set t1 [clock clicks -milliseconds]
 806    set todo {}
 807    set isrelated($a) 1
 808    set kidchanged($a) 1
 809    set ntot 0
 810    while {$a != 0} {
 811        if {[info exists isrelated($a)]} {
 812            lappend todo $a
 813            set id [lindex $varccommits($v,$a) end]
 814            foreach p $parents($v,$id) {
 815                if {[info exists varcid($v,$p)]} {
 816                    set isrelated($varcid($v,$p)) 1
 817                }
 818            }
 819        }
 820        incr ntot
 821        set b [lindex $vdownptr($v) $a]
 822        if {$b == 0} {
 823            while {$a != 0} {
 824                set b [lindex $vleftptr($v) $a]
 825                if {$b != 0} break
 826                set a [lindex $vupptr($v) $a]
 827            }
 828        }
 829        set a $b
 830    }
 831    foreach a $todo {
 832        if {![info exists kidchanged($a)]} continue
 833        set id [lindex $varcstart($v) $a]
 834        if {[llength $children($v,$id)] > 1} {
 835            set children($v,$id) [lsort -command [list vtokcmp $v] \
 836                                      $children($v,$id)]
 837        }
 838        set oldtok [lindex $varctok($v) $a]
 839        if {!$vdatemode($v)} {
 840            set tok {}
 841        } else {
 842            set tok $oldtok
 843        }
 844        set ka 0
 845        set kid [last_real_child $v,$id]
 846        if {$kid ne {}} {
 847            set k $varcid($v,$kid)
 848            if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
 849                set ki $kid
 850                set ka $k
 851                set tok [lindex $varctok($v) $k]
 852            }
 853        }
 854        if {$ka != 0} {
 855            set i [lsearch -exact $parents($v,$ki) $id]
 856            set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
 857            append tok [strrep $j]
 858        }
 859        if {$tok eq $oldtok} {
 860            continue
 861        }
 862        set id [lindex $varccommits($v,$a) end]
 863        foreach p $parents($v,$id) {
 864            if {[info exists varcid($v,$p)]} {
 865                set kidchanged($varcid($v,$p)) 1
 866            } else {
 867                set sortkids($p) 1
 868            }
 869        }
 870        lset varctok($v) $a $tok
 871        set b [lindex $vupptr($v) $a]
 872        if {$b != $ka} {
 873            if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
 874                modify_arc $v $ka
 875            }
 876            if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
 877                modify_arc $v $b
 878            }
 879            set c [lindex $vbackptr($v) $a]
 880            set d [lindex $vleftptr($v) $a]
 881            if {$c == 0} {
 882                lset vdownptr($v) $b $d
 883            } else {
 884                lset vleftptr($v) $c $d
 885            }
 886            if {$d != 0} {
 887                lset vbackptr($v) $d $c
 888            }
 889            if {[lindex $vlastins($v) $b] == $a} {
 890                lset vlastins($v) $b $c
 891            }
 892            lset vupptr($v) $a $ka
 893            set c [lindex $vlastins($v) $ka]
 894            if {$c == 0 || \
 895                    [string compare $tok [lindex $varctok($v) $c]] < 0} {
 896                set c $ka
 897                set b [lindex $vdownptr($v) $ka]
 898            } else {
 899                set b [lindex $vleftptr($v) $c]
 900            }
 901            while {$b != 0 && \
 902                      [string compare $tok [lindex $varctok($v) $b]] >= 0} {
 903                set c $b
 904                set b [lindex $vleftptr($v) $c]
 905            }
 906            if {$c == $ka} {
 907                lset vdownptr($v) $ka $a
 908                lset vbackptr($v) $a 0
 909            } else {
 910                lset vleftptr($v) $c $a
 911                lset vbackptr($v) $a $c
 912            }
 913            lset vleftptr($v) $a $b
 914            if {$b != 0} {
 915                lset vbackptr($v) $b $a
 916            }
 917            lset vlastins($v) $ka $a
 918        }
 919    }
 920    foreach id [array names sortkids] {
 921        if {[llength $children($v,$id)] > 1} {
 922            set children($v,$id) [lsort -command [list vtokcmp $v] \
 923                                      $children($v,$id)]
 924        }
 925    }
 926    set t2 [clock clicks -milliseconds]
 927    #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
 928}
 929
 930# Fix up the graph after we have found out that in view $v,
 931# $p (a commit that we have already seen) is actually the parent
 932# of the last commit in arc $a.
 933proc fix_reversal {p a v} {
 934    global varcid varcstart varctok vupptr
 935
 936    set pa $varcid($v,$p)
 937    if {$p ne [lindex $varcstart($v) $pa]} {
 938        splitvarc $p $v
 939        set pa $varcid($v,$p)
 940    }
 941    # seeds always need to be renumbered
 942    if {[lindex $vupptr($v) $pa] == 0 ||
 943        [string compare [lindex $varctok($v) $a] \
 944             [lindex $varctok($v) $pa]] > 0} {
 945        renumbervarc $pa $v
 946    }
 947}
 948
 949proc insertrow {id p v} {
 950    global cmitlisted children parents varcid varctok vtokmod
 951    global varccommits ordertok commitidx numcommits curview
 952    global targetid targetrow vshortids
 953
 954    readcommit $id
 955    set vid $v,$id
 956    set cmitlisted($vid) 1
 957    set children($vid) {}
 958    set parents($vid) [list $p]
 959    set a [newvarc $v $id]
 960    set varcid($vid) $a
 961    lappend vshortids($v,[string range $id 0 3]) $id
 962    if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
 963        modify_arc $v $a
 964    }
 965    lappend varccommits($v,$a) $id
 966    set vp $v,$p
 967    if {[llength [lappend children($vp) $id]] > 1} {
 968        set children($vp) [lsort -command [list vtokcmp $v] $children($vp)]
 969        catch {unset ordertok}
 970    }
 971    fix_reversal $p $a $v
 972    incr commitidx($v)
 973    if {$v == $curview} {
 974        set numcommits $commitidx($v)
 975        setcanvscroll
 976        if {[info exists targetid]} {
 977            if {![comes_before $targetid $p]} {
 978                incr targetrow
 979            }
 980        }
 981    }
 982}
 983
 984proc insertfakerow {id p} {
 985    global varcid varccommits parents children cmitlisted
 986    global commitidx varctok vtokmod targetid targetrow curview numcommits
 987
 988    set v $curview
 989    set a $varcid($v,$p)
 990    set i [lsearch -exact $varccommits($v,$a) $p]
 991    if {$i < 0} {
 992        puts "oops: insertfakerow can't find [shortids $p] on arc $a"
 993        return
 994    }
 995    set children($v,$id) {}
 996    set parents($v,$id) [list $p]
 997    set varcid($v,$id) $a
 998    lappend children($v,$p) $id
 999    set cmitlisted($v,$id) 1
1000    set numcommits [incr commitidx($v)]
1001    # note we deliberately don't update varcstart($v) even if $i == 0
1002    set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
1003    modify_arc $v $a $i
1004    if {[info exists targetid]} {
1005        if {![comes_before $targetid $p]} {
1006            incr targetrow
1007        }
1008    }
1009    setcanvscroll
1010    drawvisible
1011}
1012
1013proc removefakerow {id} {
1014    global varcid varccommits parents children commitidx
1015    global varctok vtokmod cmitlisted currentid selectedline
1016    global targetid curview numcommits
1017
1018    set v $curview
1019    if {[llength $parents($v,$id)] != 1} {
1020        puts "oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
1021        return
1022    }
1023    set p [lindex $parents($v,$id) 0]
1024    set a $varcid($v,$id)
1025    set i [lsearch -exact $varccommits($v,$a) $id]
1026    if {$i < 0} {
1027        puts "oops: removefakerow can't find [shortids $id] on arc $a"
1028        return
1029    }
1030    unset varcid($v,$id)
1031    set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
1032    unset parents($v,$id)
1033    unset children($v,$id)
1034    unset cmitlisted($v,$id)
1035    set numcommits [incr commitidx($v) -1]
1036    set j [lsearch -exact $children($v,$p) $id]
1037    if {$j >= 0} {
1038        set children($v,$p) [lreplace $children($v,$p) $j $j]
1039    }
1040    modify_arc $v $a $i
1041    if {[info exist currentid] && $id eq $currentid} {
1042        unset currentid
1043        set selectedline {}
1044    }
1045    if {[info exists targetid] && $targetid eq $id} {
1046        set targetid $p
1047    }
1048    setcanvscroll
1049    drawvisible
1050}
1051
1052proc real_children {vp} {
1053    global children nullid nullid2
1054
1055    set kids {}
1056    foreach id $children($vp) {
1057        if {$id ne $nullid && $id ne $nullid2} {
1058            lappend kids $id
1059        }
1060    }
1061    return $kids
1062}
1063
1064proc first_real_child {vp} {
1065    global children nullid nullid2
1066
1067    foreach id $children($vp) {
1068        if {$id ne $nullid && $id ne $nullid2} {
1069            return $id
1070        }
1071    }
1072    return {}
1073}
1074
1075proc last_real_child {vp} {
1076    global children nullid nullid2
1077
1078    set kids $children($vp)
1079    for {set i [llength $kids]} {[incr i -1] >= 0} {} {
1080        set id [lindex $kids $i]
1081        if {$id ne $nullid && $id ne $nullid2} {
1082            return $id
1083        }
1084    }
1085    return {}
1086}
1087
1088proc vtokcmp {v a b} {
1089    global varctok varcid
1090
1091    return [string compare [lindex $varctok($v) $varcid($v,$a)] \
1092                [lindex $varctok($v) $varcid($v,$b)]]
1093}
1094
1095# This assumes that if lim is not given, the caller has checked that
1096# arc a's token is less than $vtokmod($v)
1097proc modify_arc {v a {lim {}}} {
1098    global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
1099
1100    if {$lim ne {}} {
1101        set c [string compare [lindex $varctok($v) $a] $vtokmod($v)]
1102        if {$c > 0} return
1103        if {$c == 0} {
1104            set r [lindex $varcrow($v) $a]
1105            if {$r ne {} && $vrowmod($v) <= $r + $lim} return
1106        }
1107    }
1108    set vtokmod($v) [lindex $varctok($v) $a]
1109    set varcmod($v) $a
1110    if {$v == $curview} {
1111        while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
1112            set a [lindex $vupptr($v) $a]
1113            set lim {}
1114        }
1115        set r 0
1116        if {$a != 0} {
1117            if {$lim eq {}} {
1118                set lim [llength $varccommits($v,$a)]
1119            }
1120            set r [expr {[lindex $varcrow($v) $a] + $lim}]
1121        }
1122        set vrowmod($v) $r
1123        undolayout $r
1124    }
1125}
1126
1127proc update_arcrows {v} {
1128    global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
1129    global varcid vrownum varcorder varcix varccommits
1130    global vupptr vdownptr vleftptr varctok
1131    global displayorder parentlist curview cached_commitrow
1132
1133    if {$vrowmod($v) == $commitidx($v)} return
1134    if {$v == $curview} {
1135        if {[llength $displayorder] > $vrowmod($v)} {
1136            set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
1137            set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
1138        }
1139        catch {unset cached_commitrow}
1140    }
1141    set narctot [expr {[llength $varctok($v)] - 1}]
1142    set a $varcmod($v)
1143    while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
1144        # go up the tree until we find something that has a row number,
1145        # or we get to a seed
1146        set a [lindex $vupptr($v) $a]
1147    }
1148    if {$a == 0} {
1149        set a [lindex $vdownptr($v) 0]
1150        if {$a == 0} return
1151        set vrownum($v) {0}
1152        set varcorder($v) [list $a]
1153        lset varcix($v) $a 0
1154        lset varcrow($v) $a 0
1155        set arcn 0
1156        set row 0
1157    } else {
1158        set arcn [lindex $varcix($v) $a]
1159        if {[llength $vrownum($v)] > $arcn + 1} {
1160            set vrownum($v) [lrange $vrownum($v) 0 $arcn]
1161            set varcorder($v) [lrange $varcorder($v) 0 $arcn]
1162        }
1163        set row [lindex $varcrow($v) $a]
1164    }
1165    while {1} {
1166        set p $a
1167        incr row [llength $varccommits($v,$a)]
1168        # go down if possible
1169        set b [lindex $vdownptr($v) $a]
1170        if {$b == 0} {
1171            # if not, go left, or go up until we can go left
1172            while {$a != 0} {
1173                set b [lindex $vleftptr($v) $a]
1174                if {$b != 0} break
1175                set a [lindex $vupptr($v) $a]
1176            }
1177            if {$a == 0} break
1178        }
1179        set a $b
1180        incr arcn
1181        lappend vrownum($v) $row
1182        lappend varcorder($v) $a
1183        lset varcix($v) $a $arcn
1184        lset varcrow($v) $a $row
1185    }
1186    set vtokmod($v) [lindex $varctok($v) $p]
1187    set varcmod($v) $p
1188    set vrowmod($v) $row
1189    if {[info exists currentid]} {
1190        set selectedline [rowofcommit $currentid]
1191    }
1192}
1193
1194# Test whether view $v contains commit $id
1195proc commitinview {id v} {
1196    global varcid
1197
1198    return [info exists varcid($v,$id)]
1199}
1200
1201# Return the row number for commit $id in the current view
1202proc rowofcommit {id} {
1203    global varcid varccommits varcrow curview cached_commitrow
1204    global varctok vtokmod
1205
1206    set v $curview
1207    if {![info exists varcid($v,$id)]} {
1208        puts "oops rowofcommit no arc for [shortids $id]"
1209        return {}
1210    }
1211    set a $varcid($v,$id)
1212    if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
1213        update_arcrows $v
1214    }
1215    if {[info exists cached_commitrow($id)]} {
1216        return $cached_commitrow($id)
1217    }
1218    set i [lsearch -exact $varccommits($v,$a) $id]
1219    if {$i < 0} {
1220        puts "oops didn't find commit [shortids $id] in arc $a"
1221        return {}
1222    }
1223    incr i [lindex $varcrow($v) $a]
1224    set cached_commitrow($id) $i
1225    return $i
1226}
1227
1228# Returns 1 if a is on an earlier row than b, otherwise 0
1229proc comes_before {a b} {
1230    global varcid varctok curview
1231
1232    set v $curview
1233    if {$a eq $b || ![info exists varcid($v,$a)] || \
1234            ![info exists varcid($v,$b)]} {
1235        return 0
1236    }
1237    if {$varcid($v,$a) != $varcid($v,$b)} {
1238        return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
1239                           [lindex $varctok($v) $varcid($v,$b)]] < 0}]
1240    }
1241    return [expr {[rowofcommit $a] < [rowofcommit $b]}]
1242}
1243
1244proc bsearch {l elt} {
1245    if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
1246        return 0
1247    }
1248    set lo 0
1249    set hi [llength $l]
1250    while {$hi - $lo > 1} {
1251        set mid [expr {int(($lo + $hi) / 2)}]
1252        set t [lindex $l $mid]
1253        if {$elt < $t} {
1254            set hi $mid
1255        } elseif {$elt > $t} {
1256            set lo $mid
1257        } else {
1258            return $mid
1259        }
1260    }
1261    return $lo
1262}
1263
1264# Make sure rows $start..$end-1 are valid in displayorder and parentlist
1265proc make_disporder {start end} {
1266    global vrownum curview commitidx displayorder parentlist
1267    global varccommits varcorder parents vrowmod varcrow
1268    global d_valid_start d_valid_end
1269
1270    if {$end > $vrowmod($curview)} {
1271        update_arcrows $curview
1272    }
1273    set ai [bsearch $vrownum($curview) $start]
1274    set start [lindex $vrownum($curview) $ai]
1275    set narc [llength $vrownum($curview)]
1276    for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
1277        set a [lindex $varcorder($curview) $ai]
1278        set l [llength $displayorder]
1279        set al [llength $varccommits($curview,$a)]
1280        if {$l < $r + $al} {
1281            if {$l < $r} {
1282                set pad [ntimes [expr {$r - $l}] {}]
1283                set displayorder [concat $displayorder $pad]
1284                set parentlist [concat $parentlist $pad]
1285            } elseif {$l > $r} {
1286                set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
1287                set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
1288            }
1289            foreach id $varccommits($curview,$a) {
1290                lappend displayorder $id
1291                lappend parentlist $parents($curview,$id)
1292            }
1293        } elseif {[lindex $displayorder [expr {$r + $al - 1}]] eq {}} {
1294            set i $r
1295            foreach id $varccommits($curview,$a) {
1296                lset displayorder $i $id
1297                lset parentlist $i $parents($curview,$id)
1298                incr i
1299            }
1300        }
1301        incr r $al
1302    }
1303}
1304
1305proc commitonrow {row} {
1306    global displayorder
1307
1308    set id [lindex $displayorder $row]
1309    if {$id eq {}} {
1310        make_disporder $row [expr {$row + 1}]
1311        set id [lindex $displayorder $row]
1312    }
1313    return $id
1314}
1315
1316proc closevarcs {v} {
1317    global varctok varccommits varcid parents children
1318    global cmitlisted commitidx vtokmod
1319
1320    set missing_parents 0
1321    set scripts {}
1322    set narcs [llength $varctok($v)]
1323    for {set a 1} {$a < $narcs} {incr a} {
1324        set id [lindex $varccommits($v,$a) end]
1325        foreach p $parents($v,$id) {
1326            if {[info exists varcid($v,$p)]} continue
1327            # add p as a new commit
1328            incr missing_parents
1329            set cmitlisted($v,$p) 0
1330            set parents($v,$p) {}
1331            if {[llength $children($v,$p)] == 1 &&
1332                [llength $parents($v,$id)] == 1} {
1333                set b $a
1334            } else {
1335                set b [newvarc $v $p]
1336            }
1337            set varcid($v,$p) $b
1338            if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
1339                modify_arc $v $b
1340            }
1341            lappend varccommits($v,$b) $p
1342            incr commitidx($v)
1343            set scripts [check_interest $p $scripts]
1344        }
1345    }
1346    if {$missing_parents > 0} {
1347        foreach s $scripts {
1348            eval $s
1349        }
1350    }
1351}
1352
1353# Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1354# Assumes we already have an arc for $rwid.
1355proc rewrite_commit {v id rwid} {
1356    global children parents varcid varctok vtokmod varccommits
1357
1358    foreach ch $children($v,$id) {
1359        # make $rwid be $ch's parent in place of $id
1360        set i [lsearch -exact $parents($v,$ch) $id]
1361        if {$i < 0} {
1362            puts "oops rewrite_commit didn't find $id in parent list for $ch"
1363        }
1364        set parents($v,$ch) [lreplace $parents($v,$ch) $i $i $rwid]
1365        # add $ch to $rwid's children and sort the list if necessary
1366        if {[llength [lappend children($v,$rwid) $ch]] > 1} {
1367            set children($v,$rwid) [lsort -command [list vtokcmp $v] \
1368                                        $children($v,$rwid)]
1369        }
1370        # fix the graph after joining $id to $rwid
1371        set a $varcid($v,$ch)
1372        fix_reversal $rwid $a $v
1373        # parentlist is wrong for the last element of arc $a
1374        # even if displayorder is right, hence the 3rd arg here
1375        modify_arc $v $a [expr {[llength $varccommits($v,$a)] - 1}]
1376    }
1377}
1378
1379# Mechanism for registering a command to be executed when we come
1380# across a particular commit.  To handle the case when only the
1381# prefix of the commit is known, the commitinterest array is now
1382# indexed by the first 4 characters of the ID.  Each element is a
1383# list of id, cmd pairs.
1384proc interestedin {id cmd} {
1385    global commitinterest
1386
1387    lappend commitinterest([string range $id 0 3]) $id $cmd
1388}
1389
1390proc check_interest {id scripts} {
1391    global commitinterest
1392
1393    set prefix [string range $id 0 3]
1394    if {[info exists commitinterest($prefix)]} {
1395        set newlist {}
1396        foreach {i script} $commitinterest($prefix) {
1397            if {[string match "$i*" $id]} {
1398                lappend scripts [string map [list "%I" $id "%P" $i] $script]
1399            } else {
1400                lappend newlist $i $script
1401            }
1402        }
1403        if {$newlist ne {}} {
1404            set commitinterest($prefix) $newlist
1405        } else {
1406            unset commitinterest($prefix)
1407        }
1408    }
1409    return $scripts
1410}
1411
1412proc getcommitlines {fd inst view updating}  {
1413    global cmitlisted leftover
1414    global commitidx commitdata vdatemode
1415    global parents children curview hlview
1416    global idpending ordertok
1417    global varccommits varcid varctok vtokmod vfilelimit vshortids
1418
1419    set stuff [read $fd 500000]
1420    # git log doesn't terminate the last commit with a null...
1421    if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
1422        set stuff "\0"
1423    }
1424    if {$stuff == {}} {
1425        if {![eof $fd]} {
1426            return 1
1427        }
1428        global commfd viewcomplete viewactive viewname
1429        global viewinstances
1430        unset commfd($inst)
1431        set i [lsearch -exact $viewinstances($view) $inst]
1432        if {$i >= 0} {
1433            set viewinstances($view) [lreplace $viewinstances($view) $i $i]
1434        }
1435        # set it blocking so we wait for the process to terminate
1436        fconfigure $fd -blocking 1
1437        if {[catch {close $fd} err]} {
1438            set fv {}
1439            if {$view != $curview} {
1440                set fv " for the \"$viewname($view)\" view"
1441            }
1442            if {[string range $err 0 4] == "usage"} {
1443                set err "Gitk: error reading commits$fv:\
1444                        bad arguments to git log."
1445                if {$viewname($view) eq "Command line"} {
1446                    append err \
1447                        "  (Note: arguments to gitk are passed to git log\
1448                         to allow selection of commits to be displayed.)"
1449                }
1450            } else {
1451                set err "Error reading commits$fv: $err"
1452            }
1453            error_popup $err
1454        }
1455        if {[incr viewactive($view) -1] <= 0} {
1456            set viewcomplete($view) 1
1457            # Check if we have seen any ids listed as parents that haven't
1458            # appeared in the list
1459            closevarcs $view
1460            notbusy $view
1461        }
1462        if {$view == $curview} {
1463            run chewcommits
1464        }
1465        return 0
1466    }
1467    set start 0
1468    set gotsome 0
1469    set scripts {}
1470    while 1 {
1471        set i [string first "\0" $stuff $start]
1472        if {$i < 0} {
1473            append leftover($inst) [string range $stuff $start end]
1474            break
1475        }
1476        if {$start == 0} {
1477            set cmit $leftover($inst)
1478            append cmit [string range $stuff 0 [expr {$i - 1}]]
1479            set leftover($inst) {}
1480        } else {
1481            set cmit [string range $stuff $start [expr {$i - 1}]]
1482        }
1483        set start [expr {$i + 1}]
1484        set j [string first "\n" $cmit]
1485        set ok 0
1486        set listed 1
1487        if {$j >= 0 && [string match "commit *" $cmit]} {
1488            set ids [string range $cmit 7 [expr {$j - 1}]]
1489            if {[string match {[-^<>]*} $ids]} {
1490                switch -- [string index $ids 0] {
1491                    "-" {set listed 0}
1492                    "^" {set listed 2}
1493                    "<" {set listed 3}
1494                    ">" {set listed 4}
1495                }
1496                set ids [string range $ids 1 end]
1497            }
1498            set ok 1
1499            foreach id $ids {
1500                if {[string length $id] != 40} {
1501                    set ok 0
1502                    break
1503                }
1504            }
1505        }
1506        if {!$ok} {
1507            set shortcmit $cmit
1508            if {[string length $shortcmit] > 80} {
1509                set shortcmit "[string range $shortcmit 0 80]..."
1510            }
1511            error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
1512            exit 1
1513        }
1514        set id [lindex $ids 0]
1515        set vid $view,$id
1516
1517        lappend vshortids($view,[string range $id 0 3]) $id
1518
1519        if {!$listed && $updating && ![info exists varcid($vid)] &&
1520            $vfilelimit($view) ne {}} {
1521            # git log doesn't rewrite parents for unlisted commits
1522            # when doing path limiting, so work around that here
1523            # by working out the rewritten parent with git rev-list
1524            # and if we already know about it, using the rewritten
1525            # parent as a substitute parent for $id's children.
1526            if {![catch {
1527                set rwid [exec git rev-list --first-parent --max-count=1 \
1528                              $id -- $vfilelimit($view)]
1529            }]} {
1530                if {$rwid ne {} && [info exists varcid($view,$rwid)]} {
1531                    # use $rwid in place of $id
1532                    rewrite_commit $view $id $rwid
1533                    continue
1534                }
1535            }
1536        }
1537
1538        set a 0
1539        if {[info exists varcid($vid)]} {
1540            if {$cmitlisted($vid) || !$listed} continue
1541            set a $varcid($vid)
1542        }
1543        if {$listed} {
1544            set olds [lrange $ids 1 end]
1545        } else {
1546            set olds {}
1547        }
1548        set commitdata($id) [string range $cmit [expr {$j + 1}] end]
1549        set cmitlisted($vid) $listed
1550        set parents($vid) $olds
1551        if {![info exists children($vid)]} {
1552            set children($vid) {}
1553        } elseif {$a == 0 && [llength $children($vid)] == 1} {
1554            set k [lindex $children($vid) 0]
1555            if {[llength $parents($view,$k)] == 1 &&
1556                (!$vdatemode($view) ||
1557                 $varcid($view,$k) == [llength $varctok($view)] - 1)} {
1558                set a $varcid($view,$k)
1559            }
1560        }
1561        if {$a == 0} {
1562            # new arc
1563            set a [newvarc $view $id]
1564        }
1565        if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
1566            modify_arc $view $a
1567        }
1568        if {![info exists varcid($vid)]} {
1569            set varcid($vid) $a
1570            lappend varccommits($view,$a) $id
1571            incr commitidx($view)
1572        }
1573
1574        set i 0
1575        foreach p $olds {
1576            if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
1577                set vp $view,$p
1578                if {[llength [lappend children($vp) $id]] > 1 &&
1579                    [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
1580                    set children($vp) [lsort -command [list vtokcmp $view] \
1581                                           $children($vp)]
1582                    catch {unset ordertok}
1583                }
1584                if {[info exists varcid($view,$p)]} {
1585                    fix_reversal $p $a $view
1586                }
1587            }
1588            incr i
1589        }
1590
1591        set scripts [check_interest $id $scripts]
1592        set gotsome 1
1593    }
1594    if {$gotsome} {
1595        global numcommits hlview
1596
1597        if {$view == $curview} {
1598            set numcommits $commitidx($view)
1599            run chewcommits
1600        }
1601        if {[info exists hlview] && $view == $hlview} {
1602            # we never actually get here...
1603            run vhighlightmore
1604        }
1605        foreach s $scripts {
1606            eval $s
1607        }
1608    }
1609    return 2
1610}
1611
1612proc chewcommits {} {
1613    global curview hlview viewcomplete
1614    global pending_select
1615
1616    layoutmore
1617    if {$viewcomplete($curview)} {
1618        global commitidx varctok
1619        global numcommits startmsecs
1620
1621        if {[info exists pending_select]} {
1622            update
1623            reset_pending_select {}
1624
1625            if {[commitinview $pending_select $curview]} {
1626                selectline [rowofcommit $pending_select] 1
1627            } else {
1628                set row [first_real_row]
1629                selectline $row 1
1630            }
1631        }
1632        if {$commitidx($curview) > 0} {
1633            #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1634            #puts "overall $ms ms for $numcommits commits"
1635            #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1636        } else {
1637            show_status [mc "No commits selected"]
1638        }
1639        notbusy layout
1640    }
1641    return 0
1642}
1643
1644proc do_readcommit {id} {
1645    global tclencoding
1646
1647    # Invoke git-log to handle automatic encoding conversion
1648    set fd [open [concat | git log --no-color --pretty=raw -1 $id] r]
1649    # Read the results using i18n.logoutputencoding
1650    fconfigure $fd -translation lf -eofchar {}
1651    if {$tclencoding != {}} {
1652        fconfigure $fd -encoding $tclencoding
1653    }
1654    set contents [read $fd]
1655    close $fd
1656    # Remove the heading line
1657    regsub {^commit [0-9a-f]+\n} $contents {} contents
1658
1659    return $contents
1660}
1661
1662proc readcommit {id} {
1663    if {[catch {set contents [do_readcommit $id]}]} return
1664    parsecommit $id $contents 1
1665}
1666
1667proc parsecommit {id contents listed} {
1668    global commitinfo
1669
1670    set inhdr 1
1671    set comment {}
1672    set headline {}
1673    set auname {}
1674    set audate {}
1675    set comname {}
1676    set comdate {}
1677    set hdrend [string first "\n\n" $contents]
1678    if {$hdrend < 0} {
1679        # should never happen...
1680        set hdrend [string length $contents]
1681    }
1682    set header [string range $contents 0 [expr {$hdrend - 1}]]
1683    set comment [string range $contents [expr {$hdrend + 2}] end]
1684    foreach line [split $header "\n"] {
1685        set line [split $line " "]
1686        set tag [lindex $line 0]
1687        if {$tag == "author"} {
1688            set audate [lrange $line end-1 end]
1689            set auname [join [lrange $line 1 end-2] " "]
1690        } elseif {$tag == "committer"} {
1691            set comdate [lrange $line end-1 end]
1692            set comname [join [lrange $line 1 end-2] " "]
1693        }
1694    }
1695    set headline {}
1696    # take the first non-blank line of the comment as the headline
1697    set headline [string trimleft $comment]
1698    set i [string first "\n" $headline]
1699    if {$i >= 0} {
1700        set headline [string range $headline 0 $i]
1701    }
1702    set headline [string trimright $headline]
1703    set i [string first "\r" $headline]
1704    if {$i >= 0} {
1705        set headline [string trimright [string range $headline 0 $i]]
1706    }
1707    if {!$listed} {
1708        # git log indents the comment by 4 spaces;
1709        # if we got this via git cat-file, add the indentation
1710        set newcomment {}
1711        foreach line [split $comment "\n"] {
1712            append newcomment "    "
1713            append newcomment $line
1714            append newcomment "\n"
1715        }
1716        set comment $newcomment
1717    }
1718    set hasnote [string first "\nNotes:\n" $contents]
1719    set diff ""
1720    # If there is diff output shown in the git-log stream, split it
1721    # out.  But get rid of the empty line that always precedes the
1722    # diff.
1723    set i [string first "\n\ndiff" $comment]
1724    if {$i >= 0} {
1725        set diff [string range $comment $i+1 end]
1726        set comment [string range $comment 0 $i-1]
1727    }
1728    set commitinfo($id) [list $headline $auname $audate \
1729                             $comname $comdate $comment $hasnote $diff]
1730}
1731
1732proc getcommit {id} {
1733    global commitdata commitinfo
1734
1735    if {[info exists commitdata($id)]} {
1736        parsecommit $id $commitdata($id) 1
1737    } else {
1738        readcommit $id
1739        if {![info exists commitinfo($id)]} {
1740            set commitinfo($id) [list [mc "No commit information available"]]
1741        }
1742    }
1743    return 1
1744}
1745
1746# Expand an abbreviated commit ID to a list of full 40-char IDs that match
1747# and are present in the current view.
1748# This is fairly slow...
1749proc longid {prefix} {
1750    global varcid curview vshortids
1751
1752    set ids {}
1753    if {[string length $prefix] >= 4} {
1754        set vshortid $curview,[string range $prefix 0 3]
1755        if {[info exists vshortids($vshortid)]} {
1756            foreach id $vshortids($vshortid) {
1757                if {[string match "$prefix*" $id]} {
1758                    if {[lsearch -exact $ids $id] < 0} {
1759                        lappend ids $id
1760                        if {[llength $ids] >= 2} break
1761                    }
1762                }
1763            }
1764        }
1765    } else {
1766        foreach match [array names varcid "$curview,$prefix*"] {
1767            lappend ids [lindex [split $match ","] 1]
1768            if {[llength $ids] >= 2} break
1769        }
1770    }
1771    return $ids
1772}
1773
1774proc readrefs {} {
1775    global tagids idtags headids idheads tagobjid
1776    global otherrefids idotherrefs mainhead mainheadid
1777    global selecthead selectheadid
1778    global hideremotes
1779
1780    foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
1781        catch {unset $v}
1782    }
1783    set refd [open [list | git show-ref -d] r]
1784    while {[gets $refd line] >= 0} {
1785        if {[string index $line 40] ne " "} continue
1786        set id [string range $line 0 39]
1787        set ref [string range $line 41 end]
1788        if {![string match "refs/*" $ref]} continue
1789        set name [string range $ref 5 end]
1790        if {[string match "remotes/*" $name]} {
1791            if {![string match "*/HEAD" $name] && !$hideremotes} {
1792                set headids($name) $id
1793                lappend idheads($id) $name
1794            }
1795        } elseif {[string match "heads/*" $name]} {
1796            set name [string range $name 6 end]
1797            set headids($name) $id
1798            lappend idheads($id) $name
1799        } elseif {[string match "tags/*" $name]} {
1800            # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1801            # which is what we want since the former is the commit ID
1802            set name [string range $name 5 end]
1803            if {[string match "*^{}" $name]} {
1804                set name [string range $name 0 end-3]
1805            } else {
1806                set tagobjid($name) $id
1807            }
1808            set tagids($name) $id
1809            lappend idtags($id) $name
1810        } else {
1811            set otherrefids($name) $id
1812            lappend idotherrefs($id) $name
1813        }
1814    }
1815    catch {close $refd}
1816    set mainhead {}
1817    set mainheadid {}
1818    catch {
1819        set mainheadid [exec git rev-parse HEAD]
1820        set thehead [exec git symbolic-ref HEAD]
1821        if {[string match "refs/heads/*" $thehead]} {
1822            set mainhead [string range $thehead 11 end]
1823        }
1824    }
1825    set selectheadid {}
1826    if {$selecthead ne {}} {
1827        catch {
1828            set selectheadid [exec git rev-parse --verify $selecthead]
1829        }
1830    }
1831}
1832
1833# skip over fake commits
1834proc first_real_row {} {
1835    global nullid nullid2 numcommits
1836
1837    for {set row 0} {$row < $numcommits} {incr row} {
1838        set id [commitonrow $row]
1839        if {$id ne $nullid && $id ne $nullid2} {
1840            break
1841        }
1842    }
1843    return $row
1844}
1845
1846# update things for a head moved to a child of its previous location
1847proc movehead {id name} {
1848    global headids idheads
1849
1850    removehead $headids($name) $name
1851    set headids($name) $id
1852    lappend idheads($id) $name
1853}
1854
1855# update things when a head has been removed
1856proc removehead {id name} {
1857    global headids idheads
1858
1859    if {$idheads($id) eq $name} {
1860        unset idheads($id)
1861    } else {
1862        set i [lsearch -exact $idheads($id) $name]
1863        if {$i >= 0} {
1864            set idheads($id) [lreplace $idheads($id) $i $i]
1865        }
1866    }
1867    unset headids($name)
1868}
1869
1870proc ttk_toplevel {w args} {
1871    global use_ttk
1872    eval [linsert $args 0 ::toplevel $w]
1873    if {$use_ttk} {
1874        place [ttk::frame $w._toplevel_background] -x 0 -y 0 -relwidth 1 -relheight 1
1875    }
1876    return $w
1877}
1878
1879proc make_transient {window origin} {
1880    global have_tk85
1881
1882    # In MacOS Tk 8.4 transient appears to work by setting
1883    # overrideredirect, which is utterly useless, since the
1884    # windows get no border, and are not even kept above
1885    # the parent.
1886    if {!$have_tk85 && [tk windowingsystem] eq {aqua}} return
1887
1888    wm transient $window $origin
1889
1890    # Windows fails to place transient windows normally, so
1891    # schedule a callback to center them on the parent.
1892    if {[tk windowingsystem] eq {win32}} {
1893        after idle [list tk::PlaceWindow $window widget $origin]
1894    }
1895}
1896
1897proc show_error {w top msg {mc mc}} {
1898    global NS
1899    if {![info exists NS]} {set NS ""}
1900    if {[wm state $top] eq "withdrawn"} { wm deiconify $top }
1901    message $w.m -text $msg -justify center -aspect 400
1902    pack $w.m -side top -fill x -padx 20 -pady 20
1903    ${NS}::button $w.ok -default active -text [$mc OK] -command "destroy $top"
1904    pack $w.ok -side bottom -fill x
1905    bind $top <Visibility> "grab $top; focus $top"
1906    bind $top <Key-Return> "destroy $top"
1907    bind $top <Key-space>  "destroy $top"
1908    bind $top <Key-Escape> "destroy $top"
1909    tkwait window $top
1910}
1911
1912proc error_popup {msg {owner .}} {
1913    if {[tk windowingsystem] eq "win32"} {
1914        tk_messageBox -icon error -type ok -title [wm title .] \
1915            -parent $owner -message $msg
1916    } else {
1917        set w .error
1918        ttk_toplevel $w
1919        make_transient $w $owner
1920        show_error $w $w $msg
1921    }
1922}
1923
1924proc confirm_popup {msg {owner .}} {
1925    global confirm_ok NS
1926    set confirm_ok 0
1927    set w .confirm
1928    ttk_toplevel $w
1929    make_transient $w $owner
1930    message $w.m -text $msg -justify center -aspect 400
1931    pack $w.m -side top -fill x -padx 20 -pady 20
1932    ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
1933    pack $w.ok -side left -fill x
1934    ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
1935    pack $w.cancel -side right -fill x
1936    bind $w <Visibility> "grab $w; focus $w"
1937    bind $w <Key-Return> "set confirm_ok 1; destroy $w"
1938    bind $w <Key-space>  "set confirm_ok 1; destroy $w"
1939    bind $w <Key-Escape> "destroy $w"
1940    tk::PlaceWindow $w widget $owner
1941    tkwait window $w
1942    return $confirm_ok
1943}
1944
1945proc setoptions {} {
1946    if {[tk windowingsystem] ne "win32"} {
1947        option add *Panedwindow.showHandle 1 startupFile
1948        option add *Panedwindow.sashRelief raised startupFile
1949        if {[tk windowingsystem] ne "aqua"} {
1950            option add *Menu.font uifont startupFile
1951        }
1952    } else {
1953        option add *Menu.TearOff 0 startupFile
1954    }
1955    option add *Button.font uifont startupFile
1956    option add *Checkbutton.font uifont startupFile
1957    option add *Radiobutton.font uifont startupFile
1958    option add *Menubutton.font uifont startupFile
1959    option add *Label.font uifont startupFile
1960    option add *Message.font uifont startupFile
1961    option add *Entry.font textfont startupFile
1962    option add *Text.font textfont startupFile
1963    option add *Labelframe.font uifont startupFile
1964    option add *Spinbox.font textfont startupFile
1965    option add *Listbox.font mainfont startupFile
1966}
1967
1968# Make a menu and submenus.
1969# m is the window name for the menu, items is the list of menu items to add.
1970# Each item is a list {mc label type description options...}
1971# mc is ignored; it's so we can put mc there to alert xgettext
1972# label is the string that appears in the menu
1973# type is cascade, command or radiobutton (should add checkbutton)
1974# description depends on type; it's the sublist for cascade, the
1975# command to invoke for command, or {variable value} for radiobutton
1976proc makemenu {m items} {
1977    menu $m
1978    if {[tk windowingsystem] eq {aqua}} {
1979        set Meta1 Cmd
1980    } else {
1981        set Meta1 Ctrl
1982    }
1983    foreach i $items {
1984        set name [mc [lindex $i 1]]
1985        set type [lindex $i 2]
1986        set thing [lindex $i 3]
1987        set params [list $type]
1988        if {$name ne {}} {
1989            set u [string first "&" [string map {&& x} $name]]
1990            lappend params -label [string map {&& & & {}} $name]
1991            if {$u >= 0} {
1992                lappend params -underline $u
1993            }
1994        }
1995        switch -- $type {
1996            "cascade" {
1997                set submenu [string tolower [string map {& ""} [lindex $i 1]]]
1998                lappend params -menu $m.$submenu
1999            }
2000            "command" {
2001                lappend params -command $thing
2002            }
2003            "radiobutton" {
2004                lappend params -variable [lindex $thing 0] \
2005                    -value [lindex $thing 1]
2006            }
2007        }
2008        set tail [lrange $i 4 end]
2009        regsub -all {\yMeta1\y} $tail $Meta1 tail
2010        eval $m add $params $tail
2011        if {$type eq "cascade"} {
2012            makemenu $m.$submenu $thing
2013        }
2014    }
2015}
2016
2017# translate string and remove ampersands
2018proc mca {str} {
2019    return [string map {&& & & {}} [mc $str]]
2020}
2021
2022proc cleardropsel {w} {
2023    $w selection clear
2024}
2025proc makedroplist {w varname args} {
2026    global use_ttk
2027    if {$use_ttk} {
2028        set width 0
2029        foreach label $args {
2030            set cx [string length $label]
2031            if {$cx > $width} {set width $cx}
2032        }
2033        set gm [ttk::combobox $w -width $width -state readonly\
2034                    -textvariable $varname -values $args \
2035                    -exportselection false]
2036        bind $gm <<ComboboxSelected>> [list $gm selection clear]
2037    } else {
2038        set gm [eval [linsert $args 0 tk_optionMenu $w $varname]]
2039    }
2040    return $gm
2041}
2042
2043proc makewindow {} {
2044    global canv canv2 canv3 linespc charspc ctext cflist cscroll
2045    global tabstop
2046    global findtype findtypemenu findloc findstring fstring geometry
2047    global entries sha1entry sha1string sha1but
2048    global diffcontextstring diffcontext
2049    global ignorespace
2050    global maincursor textcursor curtextcursor
2051    global rowctxmenu fakerowmenu mergemax wrapcomment
2052    global highlight_files gdttype
2053    global searchstring sstring
2054    global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
2055    global uifgcolor uifgdisabledcolor
2056    global filesepbgcolor filesepfgcolor
2057    global mergecolors foundbgcolor currentsearchhitbgcolor
2058    global headctxmenu progresscanv progressitem progresscoords statusw
2059    global fprogitem fprogcoord lastprogupdate progupdatepending
2060    global rprogitem rprogcoord rownumsel numcommits
2061    global have_tk85 use_ttk NS
2062    global git_version
2063    global worddiff
2064
2065    # The "mc" arguments here are purely so that xgettext
2066    # sees the following string as needing to be translated
2067    set file {
2068        mc "File" cascade {
2069            {mc "Update" command updatecommits -accelerator F5}
2070            {mc "Reload" command reloadcommits -accelerator Shift-F5}
2071            {mc "Reread references" command rereadrefs}
2072            {mc "List references" command showrefs -accelerator F2}
2073            {xx "" separator}
2074            {mc "Start git gui" command {exec git gui &}}
2075            {xx "" separator}
2076            {mc "Quit" command doquit -accelerator Meta1-Q}
2077        }}
2078    set edit {
2079        mc "Edit" cascade {
2080            {mc "Preferences" command doprefs}
2081        }}
2082    set view {
2083        mc "View" cascade {
2084            {mc "New view..." command {newview 0} -accelerator Shift-F4}
2085            {mc "Edit view..." command editview -state disabled -accelerator F4}
2086            {mc "Delete view" command delview -state disabled}
2087            {xx "" separator}
2088            {mc "All files" radiobutton {selectedview 0} -command {showview 0}}
2089        }}
2090    if {[tk windowingsystem] ne "aqua"} {
2091        set help {
2092        mc "Help" cascade {
2093            {mc "About gitk" command about}
2094            {mc "Key bindings" command keys}
2095        }}
2096        set bar [list $file $edit $view $help]
2097    } else {
2098        proc ::tk::mac::ShowPreferences {} {doprefs}
2099        proc ::tk::mac::Quit {} {doquit}
2100        lset file end [lreplace [lindex $file end] end-1 end]
2101        set apple {
2102        xx "Apple" cascade {
2103            {mc "About gitk" command about}
2104            {xx "" separator}
2105        }}
2106        set help {
2107        mc "Help" cascade {
2108            {mc "Key bindings" command keys}
2109        }}
2110        set bar [list $apple $file $view $help]
2111    }
2112    makemenu .bar $bar
2113    . configure -menu .bar
2114
2115    if {$use_ttk} {
2116        # cover the non-themed toplevel with a themed frame.
2117        place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1
2118    }
2119
2120    # the gui has upper and lower half, parts of a paned window.
2121    ${NS}::panedwindow .ctop -orient vertical
2122
2123    # possibly use assumed geometry
2124    if {![info exists geometry(pwsash0)]} {
2125        set geometry(topheight) [expr {15 * $linespc}]
2126        set geometry(topwidth) [expr {80 * $charspc}]
2127        set geometry(botheight) [expr {15 * $linespc}]
2128        set geometry(botwidth) [expr {50 * $charspc}]
2129        set geometry(pwsash0) [list [expr {40 * $charspc}] 2]
2130        set geometry(pwsash1) [list [expr {60 * $charspc}] 2]
2131    }
2132
2133    # the upper half will have a paned window, a scroll bar to the right, and some stuff below
2134    ${NS}::frame .tf -height $geometry(topheight) -width $geometry(topwidth)
2135    ${NS}::frame .tf.histframe
2136    ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal
2137    if {!$use_ttk} {
2138        .tf.histframe.pwclist configure -sashpad 0 -handlesize 4
2139    }
2140
2141    # create three canvases
2142    set cscroll .tf.histframe.csb
2143    set canv .tf.histframe.pwclist.canv
2144    canvas $canv \
2145        -selectbackground $selectbgcolor \
2146        -background $bgcolor -bd 0 \
2147        -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
2148    .tf.histframe.pwclist add $canv
2149    set canv2 .tf.histframe.pwclist.canv2
2150    canvas $canv2 \
2151        -selectbackground $selectbgcolor \
2152        -background $bgcolor -bd 0 -yscrollincr $linespc
2153    .tf.histframe.pwclist add $canv2
2154    set canv3 .tf.histframe.pwclist.canv3
2155    canvas $canv3 \
2156        -selectbackground $selectbgcolor \
2157        -background $bgcolor -bd 0 -yscrollincr $linespc
2158    .tf.histframe.pwclist add $canv3
2159    if {$use_ttk} {
2160        bind .tf.histframe.pwclist <Map> {
2161            bind %W <Map> {}
2162            .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0]
2163            .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0]
2164        }
2165    } else {
2166        eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
2167        eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
2168    }
2169
2170    # a scroll bar to rule them
2171    ${NS}::scrollbar $cscroll -command {allcanvs yview}
2172    if {!$use_ttk} {$cscroll configure -highlightthickness 0}
2173    pack $cscroll -side right -fill y
2174    bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
2175    lappend bglist $canv $canv2 $canv3
2176    pack .tf.histframe.pwclist -fill both -expand 1 -side left
2177
2178    # we have two button bars at bottom of top frame. Bar 1
2179    ${NS}::frame .tf.bar
2180    ${NS}::frame .tf.lbar -height 15
2181
2182    set sha1entry .tf.bar.sha1
2183    set entries $sha1entry
2184    set sha1but .tf.bar.sha1label
2185    button $sha1but -text "[mc "SHA1 ID:"] " -state disabled -relief flat \
2186        -command gotocommit -width 8
2187    $sha1but conf -disabledforeground [$sha1but cget -foreground]
2188    pack .tf.bar.sha1label -side left
2189    ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string
2190    trace add variable sha1string write sha1change
2191    pack $sha1entry -side left -pady 2
2192
2193    set bm_left_data {
2194        #define left_width 16
2195        #define left_height 16
2196        static unsigned char left_bits[] = {
2197        0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
2198        0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
2199        0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
2200    }
2201    set bm_right_data {
2202        #define right_width 16
2203        #define right_height 16
2204        static unsigned char right_bits[] = {
2205        0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
2206        0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
2207        0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
2208    }
2209    image create bitmap bm-left -data $bm_left_data -foreground $uifgcolor
2210    image create bitmap bm-left-gray -data $bm_left_data -foreground $uifgdisabledcolor
2211    image create bitmap bm-right -data $bm_right_data -foreground $uifgcolor
2212    image create bitmap bm-right-gray -data $bm_right_data -foreground $uifgdisabledcolor
2213
2214    ${NS}::button .tf.bar.leftbut -command goback -state disabled -width 26
2215    if {$use_ttk} {
2216        .tf.bar.leftbut configure -image [list bm-left disabled bm-left-gray]
2217    } else {
2218        .tf.bar.leftbut configure -image bm-left
2219    }
2220    pack .tf.bar.leftbut -side left -fill y
2221    ${NS}::button .tf.bar.rightbut -command goforw -state disabled -width 26
2222    if {$use_ttk} {
2223        .tf.bar.rightbut configure -image [list bm-right disabled bm-right-gray]
2224    } else {
2225        .tf.bar.rightbut configure -image bm-right
2226    }
2227    pack .tf.bar.rightbut -side left -fill y
2228
2229    ${NS}::label .tf.bar.rowlabel -text [mc "Row"]
2230    set rownumsel {}
2231    ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \
2232        -relief sunken -anchor e
2233    ${NS}::label .tf.bar.rowlabel2 -text "/"
2234    ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \
2235        -relief sunken -anchor e
2236    pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
2237        -side left
2238    if {!$use_ttk} {
2239        foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont}
2240    }
2241    global selectedline
2242    trace add variable selectedline write selectedline_change
2243
2244    # Status label and progress bar
2245    set statusw .tf.bar.status
2246    ${NS}::label $statusw -width 15 -relief sunken
2247    pack $statusw -side left -padx 5
2248    if {$use_ttk} {
2249        set progresscanv [ttk::progressbar .tf.bar.progress]
2250    } else {
2251        set h [expr {[font metrics uifont -linespace] + 2}]
2252        set progresscanv .tf.bar.progress
2253        canvas $progresscanv -relief sunken -height $h -borderwidth 2
2254        set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
2255        set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
2256        set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
2257    }
2258    pack $progresscanv -side right -expand 1 -fill x -padx {0 2}
2259    set progresscoords {0 0}
2260    set fprogcoord 0
2261    set rprogcoord 0
2262    bind $progresscanv <Configure> adjustprogress
2263    set lastprogupdate [clock clicks -milliseconds]
2264    set progupdatepending 0
2265
2266    # build up the bottom bar of upper window
2267    ${NS}::label .tf.lbar.flabel -text "[mc "Find"] "
2268
2269    set bm_down_data {
2270        #define down_width 16
2271        #define down_height 16
2272        static unsigned char down_bits[] = {
2273        0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2274        0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2275        0x87, 0xe1, 0x8e, 0x71, 0x9c, 0x39, 0xb8, 0x1d,
2276        0xf0, 0x0f, 0xe0, 0x07, 0xc0, 0x03, 0x80, 0x01};
2277    }
2278    image create bitmap bm-down -data $bm_down_data -foreground $uifgcolor
2279    ${NS}::button .tf.lbar.fnext -width 26 -command {dofind 1 1}
2280    .tf.lbar.fnext configure -image bm-down
2281
2282    set bm_up_data {
2283        #define up_width 16
2284        #define up_height 16
2285        static unsigned char up_bits[] = {
2286        0x80, 0x01, 0xc0, 0x03, 0xe0, 0x07, 0xf0, 0x0f,
2287        0xb8, 0x1d, 0x9c, 0x39, 0x8e, 0x71, 0x87, 0xe1,
2288        0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2289        0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01};
2290    }
2291    image create bitmap bm-up -data $bm_up_data -foreground $uifgcolor
2292    ${NS}::button .tf.lbar.fprev -width 26 -command {dofind -1 1}
2293    .tf.lbar.fprev configure -image bm-up
2294
2295    ${NS}::label .tf.lbar.flab2 -text " [mc "commit"] "
2296
2297    pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
2298        -side left -fill y
2299    set gdttype [mc "containing:"]
2300    set gm [makedroplist .tf.lbar.gdttype gdttype \
2301                [mc "containing:"] \
2302                [mc "touching paths:"] \
2303                [mc "adding/removing string:"] \
2304                [mc "changing lines matching:"]]
2305    trace add variable gdttype write gdttype_change
2306    pack .tf.lbar.gdttype -side left -fill y
2307
2308    set findstring {}
2309    set fstring .tf.lbar.findstring
2310    lappend entries $fstring
2311    ${NS}::entry $fstring -width 30 -textvariable findstring
2312    trace add variable findstring write find_change
2313    set findtype [mc "Exact"]
2314    set findtypemenu [makedroplist .tf.lbar.findtype \
2315                          findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
2316    trace add variable findtype write findcom_change
2317    set findloc [mc "All fields"]
2318    makedroplist .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
2319        [mc "Comments"] [mc "Author"] [mc "Committer"]
2320    trace add variable findloc write find_change
2321    pack .tf.lbar.findloc -side right
2322    pack .tf.lbar.findtype -side right
2323    pack $fstring -side left -expand 1 -fill x
2324
2325    # Finish putting the upper half of the viewer together
2326    pack .tf.lbar -in .tf -side bottom -fill x
2327    pack .tf.bar -in .tf -side bottom -fill x
2328    pack .tf.histframe -fill both -side top -expand 1
2329    .ctop add .tf
2330    if {!$use_ttk} {
2331        .ctop paneconfigure .tf -height $geometry(topheight)
2332        .ctop paneconfigure .tf -width $geometry(topwidth)
2333    }
2334
2335    # now build up the bottom
2336    ${NS}::panedwindow .pwbottom -orient horizontal
2337
2338    # lower left, a text box over search bar, scroll bar to the right
2339    # if we know window height, then that will set the lower text height, otherwise
2340    # we set lower text height which will drive window height
2341    if {[info exists geometry(main)]} {
2342        ${NS}::frame .bleft -width $geometry(botwidth)
2343    } else {
2344        ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
2345    }
2346    ${NS}::frame .bleft.top
2347    ${NS}::frame .bleft.mid
2348    ${NS}::frame .bleft.bottom
2349
2350    ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch
2351    pack .bleft.top.search -side left -padx 5
2352    set sstring .bleft.top.sstring
2353    set searchstring ""
2354    ${NS}::entry $sstring -width 20 -textvariable searchstring
2355    lappend entries $sstring
2356    trace add variable searchstring write incrsearch
2357    pack $sstring -side left -expand 1 -fill x
2358    ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \
2359        -command changediffdisp -variable diffelide -value {0 0}
2360    ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \
2361        -command changediffdisp -variable diffelide -value {0 1}
2362    ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \
2363        -command changediffdisp -variable diffelide -value {1 0}
2364    ${NS}::label .bleft.mid.labeldiffcontext -text "      [mc "Lines of context"]: "
2365    pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
2366    spinbox .bleft.mid.diffcontext -width 5 \
2367        -from 0 -increment 1 -to 10000000 \
2368        -validate all -validatecommand "diffcontextvalidate %P" \
2369        -textvariable diffcontextstring
2370    .bleft.mid.diffcontext set $diffcontext
2371    trace add variable diffcontextstring write diffcontextchange
2372    lappend entries .bleft.mid.diffcontext
2373    pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
2374    ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
2375        -command changeignorespace -variable ignorespace
2376    pack .bleft.mid.ignspace -side left -padx 5
2377
2378    set worddiff [mc "Line diff"]
2379    if {[package vcompare $git_version "1.7.2"] >= 0} {
2380        makedroplist .bleft.mid.worddiff worddiff [mc "Line diff"] \
2381            [mc "Markup words"] [mc "Color words"]
2382        trace add variable worddiff write changeworddiff
2383        pack .bleft.mid.worddiff -side left -padx 5
2384    }
2385
2386    set ctext .bleft.bottom.ctext
2387    text $ctext -background $bgcolor -foreground $fgcolor \
2388        -state disabled -font textfont \
2389        -yscrollcommand scrolltext -wrap none \
2390        -xscrollcommand ".bleft.bottom.sbhorizontal set"
2391    if {$have_tk85} {
2392        $ctext conf -tabstyle wordprocessor
2393    }
2394    ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview"
2395    ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h
2396    pack .bleft.top -side top -fill x
2397    pack .bleft.mid -side top -fill x
2398    grid $ctext .bleft.bottom.sb -sticky nsew
2399    grid .bleft.bottom.sbhorizontal -sticky ew
2400    grid columnconfigure .bleft.bottom 0 -weight 1
2401    grid rowconfigure .bleft.bottom 0 -weight 1
2402    grid rowconfigure .bleft.bottom 1 -weight 0
2403    pack .bleft.bottom -side top -fill both -expand 1
2404    lappend bglist $ctext
2405    lappend fglist $ctext
2406
2407    $ctext tag conf comment -wrap $wrapcomment
2408    $ctext tag conf filesep -font textfontbold -fore $filesepfgcolor -back $filesepbgcolor
2409    $ctext tag conf hunksep -fore [lindex $diffcolors 2]
2410    $ctext tag conf d0 -fore [lindex $diffcolors 0]
2411    $ctext tag conf dresult -fore [lindex $diffcolors 1]
2412    $ctext tag conf m0 -fore [lindex $mergecolors 0]
2413    $ctext tag conf m1 -fore [lindex $mergecolors 1]
2414    $ctext tag conf m2 -fore [lindex $mergecolors 2]
2415    $ctext tag conf m3 -fore [lindex $mergecolors 3]
2416    $ctext tag conf m4 -fore [lindex $mergecolors 4]
2417    $ctext tag conf m5 -fore [lindex $mergecolors 5]
2418    $ctext tag conf m6 -fore [lindex $mergecolors 6]
2419    $ctext tag conf m7 -fore [lindex $mergecolors 7]
2420    $ctext tag conf m8 -fore [lindex $mergecolors 8]
2421    $ctext tag conf m9 -fore [lindex $mergecolors 9]
2422    $ctext tag conf m10 -fore [lindex $mergecolors 10]
2423    $ctext tag conf m11 -fore [lindex $mergecolors 11]
2424    $ctext tag conf m12 -fore [lindex $mergecolors 12]
2425    $ctext tag conf m13 -fore [lindex $mergecolors 13]
2426    $ctext tag conf m14 -fore [lindex $mergecolors 14]
2427    $ctext tag conf m15 -fore [lindex $mergecolors 15]
2428    $ctext tag conf mmax -fore darkgrey
2429    set mergemax 16
2430    $ctext tag conf mresult -font textfontbold
2431    $ctext tag conf msep -font textfontbold
2432    $ctext tag conf found -back $foundbgcolor
2433    $ctext tag conf currentsearchhit -back $currentsearchhitbgcolor
2434    $ctext tag conf wwrap -wrap word -lmargin2 1c
2435    $ctext tag conf bold -font textfontbold
2436
2437    .pwbottom add .bleft
2438    if {!$use_ttk} {
2439        .pwbottom paneconfigure .bleft -width $geometry(botwidth)
2440    }
2441
2442    # lower right
2443    ${NS}::frame .bright
2444    ${NS}::frame .bright.mode
2445    ${NS}::radiobutton .bright.mode.patch -text [mc "Patch"] \
2446        -command reselectline -variable cmitmode -value "patch"
2447    ${NS}::radiobutton .bright.mode.tree -text [mc "Tree"] \
2448        -command reselectline -variable cmitmode -value "tree"
2449    grid .bright.mode.patch .bright.mode.tree -sticky ew
2450    pack .bright.mode -side top -fill x
2451    set cflist .bright.cfiles
2452    set indent [font measure mainfont "nn"]
2453    text $cflist \
2454        -selectbackground $selectbgcolor \
2455        -background $bgcolor -foreground $fgcolor \
2456        -font mainfont \
2457        -tabs [list $indent [expr {2 * $indent}]] \
2458        -yscrollcommand ".bright.sb set" \
2459        -cursor [. cget -cursor] \
2460        -spacing1 1 -spacing3 1
2461    lappend bglist $cflist
2462    lappend fglist $cflist
2463    ${NS}::scrollbar .bright.sb -command "$cflist yview"
2464    pack .bright.sb -side right -fill y
2465    pack $cflist -side left -fill both -expand 1
2466    $cflist tag configure highlight \
2467        -background [$cflist cget -selectbackground]
2468    $cflist tag configure bold -font mainfontbold
2469
2470    .pwbottom add .bright
2471    .ctop add .pwbottom
2472
2473    # restore window width & height if known
2474    if {[info exists geometry(main)]} {
2475        if {[scan $geometry(main) "%dx%d" w h] >= 2} {
2476            if {$w > [winfo screenwidth .]} {
2477                set w [winfo screenwidth .]
2478            }
2479            if {$h > [winfo screenheight .]} {
2480                set h [winfo screenheight .]
2481            }
2482            wm geometry . "${w}x$h"
2483        }
2484    }
2485
2486    if {[info exists geometry(state)] && $geometry(state) eq "zoomed"} {
2487        wm state . $geometry(state)
2488    }
2489
2490    if {[tk windowingsystem] eq {aqua}} {
2491        set M1B M1
2492        set ::BM "3"
2493    } else {
2494        set M1B Control
2495        set ::BM "2"
2496    }
2497
2498    if {$use_ttk} {
2499        bind .ctop <Map> {
2500            bind %W <Map> {}
2501            %W sashpos 0 $::geometry(topheight)
2502        }
2503        bind .pwbottom <Map> {
2504            bind %W <Map> {}
2505            %W sashpos 0 $::geometry(botwidth)
2506        }
2507    }
2508
2509    bind .pwbottom <Configure> {resizecdetpanes %W %w}
2510    pack .ctop -fill both -expand 1
2511    bindall <1> {selcanvline %W %x %y}
2512    #bindall <B1-Motion> {selcanvline %W %x %y}
2513    if {[tk windowingsystem] == "win32"} {
2514        bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
2515        bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
2516    } else {
2517        bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
2518        bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
2519        if {[tk windowingsystem] eq "aqua"} {
2520            bindall <MouseWheel> {
2521                set delta [expr {- (%D)}]
2522                allcanvs yview scroll $delta units
2523            }
2524            bindall <Shift-MouseWheel> {
2525                set delta [expr {- (%D)}]
2526                $canv xview scroll $delta units
2527            }
2528        }
2529    }
2530    bindall <$::BM> "canvscan mark %W %x %y"
2531    bindall <B$::BM-Motion> "canvscan dragto %W %x %y"
2532    bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2533    bind . <$M1B-Key-w> doquit
2534    bindkey <Home> selfirstline
2535    bindkey <End> sellastline
2536    bind . <Key-Up> "selnextline -1"
2537    bind . <Key-Down> "selnextline 1"
2538    bind . <Shift-Key-Up> "dofind -1 0"
2539    bind . <Shift-Key-Down> "dofind 1 0"
2540    bindkey <Key-Right> "goforw"
2541    bindkey <Key-Left> "goback"
2542    bind . <Key-Prior> "selnextpage -1"
2543    bind . <Key-Next> "selnextpage 1"
2544    bind . <$M1B-Home> "allcanvs yview moveto 0.0"
2545    bind . <$M1B-End> "allcanvs yview moveto 1.0"
2546    bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
2547    bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
2548    bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2549    bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
2550    bindkey <Key-Delete> "$ctext yview scroll -1 pages"
2551    bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
2552    bindkey <Key-space> "$ctext yview scroll 1 pages"
2553    bindkey p "selnextline -1"
2554    bindkey n "selnextline 1"
2555    bindkey z "goback"
2556    bindkey x "goforw"
2557    bindkey k "selnextline -1"
2558    bindkey j "selnextline 1"
2559    bindkey h "goback"
2560    bindkey l "goforw"
2561    bindkey b prevfile
2562    bindkey d "$ctext yview scroll 18 units"
2563    bindkey u "$ctext yview scroll -18 units"
2564    bindkey / {focus $fstring}
2565    bindkey <Key-KP_Divide> {focus $fstring}
2566    bindkey <Key-Return> {dofind 1 1}
2567    bindkey ? {dofind -1 1}
2568    bindkey f nextfile
2569    bind . <F5> updatecommits
2570    bindmodfunctionkey Shift 5 reloadcommits
2571    bind . <F2> showrefs
2572    bindmodfunctionkey Shift 4 {newview 0}
2573    bind . <F4> edit_or_newview
2574    bind . <$M1B-q> doquit
2575    bind . <$M1B-f> {dofind 1 1}
2576    bind . <$M1B-g> {dofind 1 0}
2577    bind . <$M1B-r> dosearchback
2578    bind . <$M1B-s> dosearch
2579    bind . <$M1B-equal> {incrfont 1}
2580    bind . <$M1B-plus> {incrfont 1}
2581    bind . <$M1B-KP_Add> {incrfont 1}
2582    bind . <$M1B-minus> {incrfont -1}
2583    bind . <$M1B-KP_Subtract> {incrfont -1}
2584    wm protocol . WM_DELETE_WINDOW doquit
2585    bind . <Destroy> {stop_backends}
2586    bind . <Button-1> "click %W"
2587    bind $fstring <Key-Return> {dofind 1 1}
2588    bind $sha1entry <Key-Return> {gotocommit; break}
2589    bind $sha1entry <<PasteSelection>> clearsha1
2590    bind $sha1entry <<Paste>> clearsha1
2591    bind $cflist <1> {sel_flist %W %x %y; break}
2592    bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
2593    bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
2594    global ctxbut
2595    bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
2596    bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
2597    bind $ctext <Button-1> {focus %W}
2598    bind $ctext <<Selection>> rehighlight_search_results
2599    for {set i 1} {$i < 10} {incr i} {
2600        bind . <$M1B-Key-$i> [list go_to_parent $i]
2601    }
2602
2603    set maincursor [. cget -cursor]
2604    set textcursor [$ctext cget -cursor]
2605    set curtextcursor $textcursor
2606
2607    set rowctxmenu .rowctxmenu
2608    makemenu $rowctxmenu {
2609        {mc "Diff this -> selected" command {diffvssel 0}}
2610        {mc "Diff selected -> this" command {diffvssel 1}}
2611        {mc "Make patch" command mkpatch}
2612        {mc "Create tag" command mktag}
2613        {mc "Write commit to file" command writecommit}
2614        {mc "Create new branch" command mkbranch}
2615        {mc "Cherry-pick this commit" command cherrypick}
2616        {mc "Reset HEAD branch to here" command resethead}
2617        {mc "Mark this commit" command markhere}
2618        {mc "Return to mark" command gotomark}
2619        {mc "Find descendant of this and mark" command find_common_desc}
2620        {mc "Compare with marked commit" command compare_commits}
2621        {mc "Diff this -> marked commit" command {diffvsmark 0}}
2622        {mc "Diff marked commit -> this" command {diffvsmark 1}}
2623        {mc "Revert this commit" command revert}
2624    }
2625    $rowctxmenu configure -tearoff 0
2626
2627    set fakerowmenu .fakerowmenu
2628    makemenu $fakerowmenu {
2629        {mc "Diff this -> selected" command {diffvssel 0}}
2630        {mc "Diff selected -> this" command {diffvssel 1}}
2631        {mc "Make patch" command mkpatch}
2632        {mc "Diff this -> marked commit" command {diffvsmark 0}}
2633        {mc "Diff marked commit -> this" command {diffvsmark 1}}
2634    }
2635    $fakerowmenu configure -tearoff 0
2636
2637    set headctxmenu .headctxmenu
2638    makemenu $headctxmenu {
2639        {mc "Check out this branch" command cobranch}
2640        {mc "Remove this branch" command rmbranch}
2641    }
2642    $headctxmenu configure -tearoff 0
2643
2644    global flist_menu
2645    set flist_menu .flistctxmenu
2646    makemenu $flist_menu {
2647        {mc "Highlight this too" command {flist_hl 0}}
2648        {mc "Highlight this only" command {flist_hl 1}}
2649        {mc "External diff" command {external_diff}}
2650        {mc "Blame parent commit" command {external_blame 1}}
2651    }
2652    $flist_menu configure -tearoff 0
2653
2654    global diff_menu
2655    set diff_menu .diffctxmenu
2656    makemenu $diff_menu {
2657        {mc "Show origin of this line" command show_line_source}
2658        {mc "Run git gui blame on this line" command {external_blame_diff}}
2659    }
2660    $diff_menu configure -tearoff 0
2661}
2662
2663# Windows sends all mouse wheel events to the current focused window, not
2664# the one where the mouse hovers, so bind those events here and redirect
2665# to the correct window
2666proc windows_mousewheel_redirector {W X Y D} {
2667    global canv canv2 canv3
2668    set w [winfo containing -displayof $W $X $Y]
2669    if {$w ne ""} {
2670        set u [expr {$D < 0 ? 5 : -5}]
2671        if {$w == $canv || $w == $canv2 || $w == $canv3} {
2672            allcanvs yview scroll $u units
2673        } else {
2674            catch {
2675                $w yview scroll $u units
2676            }
2677        }
2678    }
2679}
2680
2681# Update row number label when selectedline changes
2682proc selectedline_change {n1 n2 op} {
2683    global selectedline rownumsel
2684
2685    if {$selectedline eq {}} {
2686        set rownumsel {}
2687    } else {
2688        set rownumsel [expr {$selectedline + 1}]
2689    }
2690}
2691
2692# mouse-2 makes all windows scan vertically, but only the one
2693# the cursor is in scans horizontally
2694proc canvscan {op w x y} {
2695    global canv canv2 canv3
2696    foreach c [list $canv $canv2 $canv3] {
2697        if {$c == $w} {
2698            $c scan $op $x $y
2699        } else {
2700            $c scan $op 0 $y
2701        }
2702    }
2703}
2704
2705proc scrollcanv {cscroll f0 f1} {
2706    $cscroll set $f0 $f1
2707    drawvisible
2708    flushhighlights
2709}
2710
2711# when we make a key binding for the toplevel, make sure
2712# it doesn't get triggered when that key is pressed in the
2713# find string entry widget.
2714proc bindkey {ev script} {
2715    global entries
2716    bind . $ev $script
2717    set escript [bind Entry $ev]
2718    if {$escript == {}} {
2719        set escript [bind Entry <Key>]
2720    }
2721    foreach e $entries {
2722        bind $e $ev "$escript; break"
2723    }
2724}
2725
2726proc bindmodfunctionkey {mod n script} {
2727    bind . <$mod-F$n> $script
2728    catch { bind . <$mod-XF86_Switch_VT_$n> $script }
2729}
2730
2731# set the focus back to the toplevel for any click outside
2732# the entry widgets
2733proc click {w} {
2734    global ctext entries
2735    foreach e [concat $entries $ctext] {
2736        if {$w == $e} return
2737    }
2738    focus .
2739}
2740
2741# Adjust the progress bar for a change in requested extent or canvas size
2742proc adjustprogress {} {
2743    global progresscanv progressitem progresscoords
2744    global fprogitem fprogcoord lastprogupdate progupdatepending
2745    global rprogitem rprogcoord use_ttk
2746
2747    if {$use_ttk} {
2748        $progresscanv configure -value [expr {int($fprogcoord * 100)}]
2749        return
2750    }
2751
2752    set w [expr {[winfo width $progresscanv] - 4}]
2753    set x0 [expr {$w * [lindex $progresscoords 0]}]
2754    set x1 [expr {$w * [lindex $progresscoords 1]}]
2755    set h [winfo height $progresscanv]
2756    $progresscanv coords $progressitem $x0 0 $x1 $h
2757    $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2758    $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2759    set now [clock clicks -milliseconds]
2760    if {$now >= $lastprogupdate + 100} {
2761        set progupdatepending 0
2762        update
2763    } elseif {!$progupdatepending} {
2764        set progupdatepending 1
2765        after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2766    }
2767}
2768
2769proc doprogupdate {} {
2770    global lastprogupdate progupdatepending
2771
2772    if {$progupdatepending} {
2773        set progupdatepending 0
2774        set lastprogupdate [clock clicks -milliseconds]
2775        update
2776    }
2777}
2778
2779proc savestuff {w} {
2780    global canv canv2 canv3 mainfont textfont uifont tabstop
2781    global stuffsaved findmergefiles maxgraphpct
2782    global maxwidth showneartags showlocalchanges
2783    global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
2784    global cmitmode wrapcomment datetimeformat limitdiffs
2785    global colors uicolor bgcolor fgcolor diffcolors diffcontext selectbgcolor
2786    global uifgcolor uifgdisabledcolor
2787    global headbgcolor headfgcolor headoutlinecolor remotebgcolor
2788    global tagbgcolor tagfgcolor tagoutlinecolor
2789    global reflinecolor filesepbgcolor filesepfgcolor
2790    global mergecolors foundbgcolor currentsearchhitbgcolor
2791    global linehoverbgcolor linehoverfgcolor linehoveroutlinecolor circlecolors
2792    global mainheadcirclecolor workingfilescirclecolor indexcirclecolor
2793    global linkfgcolor circleoutlinecolor
2794    global autoselect autosellen extdifftool perfile_attrs markbgcolor use_ttk
2795    global hideremotes want_ttk maxrefs visiblerefs
2796    global config_file config_file_tmp
2797
2798    if {$stuffsaved} return
2799    if {![winfo viewable .]} return
2800    catch {
2801        if {[file exists $config_file_tmp]} {
2802            file delete -force $config_file_tmp
2803        }
2804        set f [open $config_file_tmp w]
2805        if {$::tcl_platform(platform) eq {windows}} {
2806            file attributes $config_file_tmp -hidden true
2807        }
2808        puts $f [list set mainfont $mainfont]
2809        puts $f [list set textfont $textfont]
2810        puts $f [list set uifont $uifont]
2811        puts $f [list set tabstop $tabstop]
2812        puts $f [list set findmergefiles $findmergefiles]
2813        puts $f [list set maxgraphpct $maxgraphpct]
2814        puts $f [list set maxwidth $maxwidth]
2815        puts $f [list set cmitmode $cmitmode]
2816        puts $f [list set wrapcomment $wrapcomment]
2817        puts $f [list set autoselect $autoselect]
2818        puts $f [list set autosellen $autosellen]
2819        puts $f [list set showneartags $showneartags]
2820        puts $f [list set maxrefs $maxrefs]
2821        puts $f [list set visiblerefs $visiblerefs]
2822        puts $f [list set hideremotes $hideremotes]
2823        puts $f [list set showlocalchanges $showlocalchanges]
2824        puts $f [list set datetimeformat $datetimeformat]
2825        puts $f [list set limitdiffs $limitdiffs]
2826        puts $f [list set uicolor $uicolor]
2827        puts $f [list set want_ttk $want_ttk]
2828        puts $f [list set bgcolor $bgcolor]
2829        puts $f [list set fgcolor $fgcolor]
2830        puts $f [list set uifgcolor $uifgcolor]
2831        puts $f [list set uifgdisabledcolor $uifgdisabledcolor]
2832        puts $f [list set colors $colors]
2833        puts $f [list set diffcolors $diffcolors]
2834        puts $f [list set mergecolors $mergecolors]
2835        puts $f [list set markbgcolor $markbgcolor]
2836        puts $f [list set diffcontext $diffcontext]
2837        puts $f [list set selectbgcolor $selectbgcolor]
2838        puts $f [list set foundbgcolor $foundbgcolor]
2839        puts $f [list set currentsearchhitbgcolor $currentsearchhitbgcolor]
2840        puts $f [list set extdifftool $extdifftool]
2841        puts $f [list set perfile_attrs $perfile_attrs]
2842        puts $f [list set headbgcolor $headbgcolor]
2843        puts $f [list set headfgcolor $headfgcolor]
2844        puts $f [list set headoutlinecolor $headoutlinecolor]
2845        puts $f [list set remotebgcolor $remotebgcolor]
2846        puts $f [list set tagbgcolor $tagbgcolor]
2847        puts $f [list set tagfgcolor $tagfgcolor]
2848        puts $f [list set tagoutlinecolor $tagoutlinecolor]
2849        puts $f [list set reflinecolor $reflinecolor]
2850        puts $f [list set filesepbgcolor $filesepbgcolor]
2851        puts $f [list set filesepfgcolor $filesepfgcolor]
2852        puts $f [list set linehoverbgcolor $linehoverbgcolor]
2853        puts $f [list set linehoverfgcolor $linehoverfgcolor]
2854        puts $f [list set linehoveroutlinecolor $linehoveroutlinecolor]
2855        puts $f [list set mainheadcirclecolor $mainheadcirclecolor]
2856        puts $f [list set workingfilescirclecolor $workingfilescirclecolor]
2857        puts $f [list set indexcirclecolor $indexcirclecolor]
2858        puts $f [list set circlecolors $circlecolors]
2859        puts $f [list set linkfgcolor $linkfgcolor]
2860        puts $f [list set circleoutlinecolor $circleoutlinecolor]
2861
2862        puts $f "set geometry(main) [wm geometry .]"
2863        puts $f "set geometry(state) [wm state .]"
2864        puts $f "set geometry(topwidth) [winfo width .tf]"
2865        puts $f "set geometry(topheight) [winfo height .tf]"
2866        if {$use_ttk} {
2867            puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
2868            puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
2869        } else {
2870            puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2871            puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2872        }
2873        puts $f "set geometry(botwidth) [winfo width .bleft]"
2874        puts $f "set geometry(botheight) [winfo height .bleft]"
2875
2876        puts -nonewline $f "set permviews {"
2877        for {set v 0} {$v < $nextviewnum} {incr v} {
2878            if {$viewperm($v)} {
2879                puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
2880            }
2881        }
2882        puts $f "}"
2883        close $f
2884        file rename -force $config_file_tmp $config_file
2885    }
2886    set stuffsaved 1
2887}
2888
2889proc resizeclistpanes {win w} {
2890    global oldwidth use_ttk
2891    if {[info exists oldwidth($win)]} {
2892        if {$use_ttk} {
2893            set s0 [$win sashpos 0]
2894            set s1 [$win sashpos 1]
2895        } else {
2896            set s0 [$win sash coord 0]
2897            set s1 [$win sash coord 1]
2898        }
2899        if {$w < 60} {
2900            set sash0 [expr {int($w/2 - 2)}]
2901            set sash1 [expr {int($w*5/6 - 2)}]
2902        } else {
2903            set factor [expr {1.0 * $w / $oldwidth($win)}]
2904            set sash0 [expr {int($factor * [lindex $s0 0])}]
2905            set sash1 [expr {int($factor * [lindex $s1 0])}]
2906            if {$sash0 < 30} {
2907                set sash0 30
2908            }
2909            if {$sash1 < $sash0 + 20} {
2910                set sash1 [expr {$sash0 + 20}]
2911            }
2912            if {$sash1 > $w - 10} {
2913                set sash1 [expr {$w - 10}]
2914                if {$sash0 > $sash1 - 20} {
2915                    set sash0 [expr {$sash1 - 20}]
2916                }
2917            }
2918        }
2919        if {$use_ttk} {
2920            $win sashpos 0 $sash0
2921            $win sashpos 1 $sash1
2922        } else {
2923            $win sash place 0 $sash0 [lindex $s0 1]
2924            $win sash place 1 $sash1 [lindex $s1 1]
2925        }
2926    }
2927    set oldwidth($win) $w
2928}
2929
2930proc resizecdetpanes {win w} {
2931    global oldwidth use_ttk
2932    if {[info exists oldwidth($win)]} {
2933        if {$use_ttk} {
2934            set s0 [$win sashpos 0]
2935        } else {
2936            set s0 [$win sash coord 0]
2937        }
2938        if {$w < 60} {
2939            set sash0 [expr {int($w*3/4 - 2)}]
2940        } else {
2941            set factor [expr {1.0 * $w / $oldwidth($win)}]
2942            set sash0 [expr {int($factor * [lindex $s0 0])}]
2943            if {$sash0 < 45} {
2944                set sash0 45
2945            }
2946            if {$sash0 > $w - 15} {
2947                set sash0 [expr {$w - 15}]
2948            }
2949        }
2950        if {$use_ttk} {
2951            $win sashpos 0 $sash0
2952        } else {
2953            $win sash place 0 $sash0 [lindex $s0 1]
2954        }
2955    }
2956    set oldwidth($win) $w
2957}
2958
2959proc allcanvs args {
2960    global canv canv2 canv3
2961    eval $canv $args
2962    eval $canv2 $args
2963    eval $canv3 $args
2964}
2965
2966proc bindall {event action} {
2967    global canv canv2 canv3
2968    bind $canv $event $action
2969    bind $canv2 $event $action
2970    bind $canv3 $event $action
2971}
2972
2973proc about {} {
2974    global uifont NS
2975    set w .about
2976    if {[winfo exists $w]} {
2977        raise $w
2978        return
2979    }
2980    ttk_toplevel $w
2981    wm title $w [mc "About gitk"]
2982    make_transient $w .
2983    message $w.m -text [mc "
2984Gitk - a commit viewer for git
2985
2986Copyright \u00a9 2005-2014 Paul Mackerras
2987
2988Use and redistribute under the terms of the GNU General Public License"] \
2989            -justify center -aspect 400 -border 2 -bg white -relief groove
2990    pack $w.m -side top -fill x -padx 2 -pady 2
2991    ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2992    pack $w.ok -side bottom
2993    bind $w <Visibility> "focus $w.ok"
2994    bind $w <Key-Escape> "destroy $w"
2995    bind $w <Key-Return> "destroy $w"
2996    tk::PlaceWindow $w widget .
2997}
2998
2999proc keys {} {
3000    global NS
3001    set w .keys
3002    if {[winfo exists $w]} {
3003        raise $w
3004        return
3005    }
3006    if {[tk windowingsystem] eq {aqua}} {
3007        set M1T Cmd
3008    } else {
3009        set M1T Ctrl
3010    }
3011    ttk_toplevel $w
3012    wm title $w [mc "Gitk key bindings"]
3013    make_transient $w .
3014    message $w.m -text "
3015[mc "Gitk key bindings:"]
3016
3017[mc "<%s-Q>             Quit" $M1T]
3018[mc "<%s-W>             Close window" $M1T]
3019[mc "<Home>             Move to first commit"]
3020[mc "<End>              Move to last commit"]
3021[mc "<Up>, p, k Move up one commit"]
3022[mc "<Down>, n, j       Move down one commit"]
3023[mc "<Left>, z, h       Go back in history list"]
3024[mc "<Right>, x, l      Go forward in history list"]
3025[mc "<%s-n>     Go to n-th parent of current commit in history list" $M1T]
3026[mc "<PageUp>   Move up one page in commit list"]
3027[mc "<PageDown> Move down one page in commit list"]
3028[mc "<%s-Home>  Scroll to top of commit list" $M1T]
3029[mc "<%s-End>   Scroll to bottom of commit list" $M1T]
3030[mc "<%s-Up>    Scroll commit list up one line" $M1T]
3031[mc "<%s-Down>  Scroll commit list down one line" $M1T]
3032[mc "<%s-PageUp>        Scroll commit list up one page" $M1T]
3033[mc "<%s-PageDown>      Scroll commit list down one page" $M1T]
3034[mc "<Shift-Up> Find backwards (upwards, later commits)"]
3035[mc "<Shift-Down>       Find forwards (downwards, earlier commits)"]
3036[mc "<Delete>, b        Scroll diff view up one page"]
3037[mc "<Backspace>        Scroll diff view up one page"]
3038[mc "<Space>            Scroll diff view down one page"]
3039[mc "u          Scroll diff view up 18 lines"]
3040[mc "d          Scroll diff view down 18 lines"]
3041[mc "<%s-F>             Find" $M1T]
3042[mc "<%s-G>             Move to next find hit" $M1T]
3043[mc "<Return>   Move to next find hit"]
3044[mc "/          Focus the search box"]
3045[mc "?          Move to previous find hit"]
3046[mc "f          Scroll diff view to next file"]
3047[mc "<%s-S>             Search for next hit in diff view" $M1T]
3048[mc "<%s-R>             Search for previous hit in diff view" $M1T]
3049[mc "<%s-KP+>   Increase font size" $M1T]
3050[mc "<%s-plus>  Increase font size" $M1T]
3051[mc "<%s-KP->   Decrease font size" $M1T]
3052[mc "<%s-minus> Decrease font size" $M1T]
3053[mc "<F5>               Update"]
3054" \
3055            -justify left -bg white -border 2 -relief groove
3056    pack $w.m -side top -fill both -padx 2 -pady 2
3057    ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
3058    bind $w <Key-Escape> [list destroy $w]
3059    pack $w.ok -side bottom
3060    bind $w <Visibility> "focus $w.ok"
3061    bind $w <Key-Escape> "destroy $w"
3062    bind $w <Key-Return> "destroy $w"
3063}
3064
3065# Procedures for manipulating the file list window at the
3066# bottom right of the overall window.
3067
3068proc treeview {w l openlevs} {
3069    global treecontents treediropen treeheight treeparent treeindex
3070
3071    set ix 0
3072    set treeindex() 0
3073    set lev 0
3074    set prefix {}
3075    set prefixend -1
3076    set prefendstack {}
3077    set htstack {}
3078    set ht 0
3079    set treecontents() {}
3080    $w conf -state normal
3081    foreach f $l {
3082        while {[string range $f 0 $prefixend] ne $prefix} {
3083            if {$lev <= $openlevs} {
3084                $w mark set e:$treeindex($prefix) "end -1c"
3085                $w mark gravity e:$treeindex($prefix) left
3086            }
3087            set treeheight($prefix) $ht
3088            incr ht [lindex $htstack end]
3089            set htstack [lreplace $htstack end end]
3090            set prefixend [lindex $prefendstack end]
3091            set prefendstack [lreplace $prefendstack end end]
3092            set prefix [string range $prefix 0 $prefixend]
3093            incr lev -1
3094        }
3095        set tail [string range $f [expr {$prefixend+1}] end]
3096        while {[set slash [string first "/" $tail]] >= 0} {
3097            lappend htstack $ht
3098            set ht 0
3099            lappend prefendstack $prefixend
3100            incr prefixend [expr {$slash + 1}]
3101            set d [string range $tail 0 $slash]
3102            lappend treecontents($prefix) $d
3103            set oldprefix $prefix
3104            append prefix $d
3105            set treecontents($prefix) {}
3106            set treeindex($prefix) [incr ix]
3107            set treeparent($prefix) $oldprefix
3108            set tail [string range $tail [expr {$slash+1}] end]
3109            if {$lev <= $openlevs} {
3110                set ht 1
3111                set treediropen($prefix) [expr {$lev < $openlevs}]
3112                set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
3113                $w mark set d:$ix "end -1c"
3114                $w mark gravity d:$ix left
3115                set str "\n"
3116                for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3117                $w insert end $str
3118                $w image create end -align center -image $bm -padx 1 \
3119                    -name a:$ix
3120                $w insert end $d [highlight_tag $prefix]
3121                $w mark set s:$ix "end -1c"
3122                $w mark gravity s:$ix left
3123            }
3124            incr lev
3125        }
3126        if {$tail ne {}} {
3127            if {$lev <= $openlevs} {
3128                incr ht
3129                set str "\n"
3130                for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3131                $w insert end $str
3132                $w insert end $tail [highlight_tag $f]
3133            }
3134            lappend treecontents($prefix) $tail
3135        }
3136    }
3137    while {$htstack ne {}} {
3138        set treeheight($prefix) $ht
3139        incr ht [lindex $htstack end]
3140        set htstack [lreplace $htstack end end]
3141        set prefixend [lindex $prefendstack end]
3142        set prefendstack [lreplace $prefendstack end end]
3143        set prefix [string range $prefix 0 $prefixend]
3144    }
3145    $w conf -state disabled
3146}
3147
3148proc linetoelt {l} {
3149    global treeheight treecontents
3150
3151    set y 2
3152    set prefix {}
3153    while {1} {
3154        foreach e $treecontents($prefix) {
3155            if {$y == $l} {
3156                return "$prefix$e"
3157            }
3158            set n 1
3159            if {[string index $e end] eq "/"} {
3160                set n $treeheight($prefix$e)
3161                if {$y + $n > $l} {
3162                    append prefix $e
3163                    incr y
3164                    break
3165                }
3166            }
3167            incr y $n
3168        }
3169    }
3170}
3171
3172proc highlight_tree {y prefix} {
3173    global treeheight treecontents cflist
3174
3175    foreach e $treecontents($prefix) {
3176        set path $prefix$e
3177        if {[highlight_tag $path] ne {}} {
3178            $cflist tag add bold $y.0 "$y.0 lineend"
3179        }
3180        incr y
3181        if {[string index $e end] eq "/" && $treeheight($path) > 1} {
3182            set y [highlight_tree $y $path]
3183        }
3184    }
3185    return $y
3186}
3187
3188proc treeclosedir {w dir} {
3189    global treediropen treeheight treeparent treeindex
3190
3191    set ix $treeindex($dir)
3192    $w conf -state normal
3193    $w delete s:$ix e:$ix
3194    set treediropen($dir) 0
3195    $w image configure a:$ix -image tri-rt
3196    $w conf -state disabled
3197    set n [expr {1 - $treeheight($dir)}]
3198    while {$dir ne {}} {
3199        incr treeheight($dir) $n
3200        set dir $treeparent($dir)
3201    }
3202}
3203
3204proc treeopendir {w dir} {
3205    global treediropen treeheight treeparent treecontents treeindex
3206
3207    set ix $treeindex($dir)
3208    $w conf -state normal
3209    $w image configure a:$ix -image tri-dn
3210    $w mark set e:$ix s:$ix
3211    $w mark gravity e:$ix right
3212    set lev 0
3213    set str "\n"
3214    set n [llength $treecontents($dir)]
3215    for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
3216        incr lev
3217        append str "\t"
3218        incr treeheight($x) $n
3219    }
3220    foreach e $treecontents($dir) {
3221        set de $dir$e
3222        if {[string index $e end] eq "/"} {
3223            set iy $treeindex($de)
3224            $w mark set d:$iy e:$ix
3225            $w mark gravity d:$iy left
3226            $w insert e:$ix $str
3227            set treediropen($de) 0
3228            $w image create e:$ix -align center -image tri-rt -padx 1 \
3229                -name a:$iy
3230            $w insert e:$ix $e [highlight_tag $de]
3231            $w mark set s:$iy e:$ix
3232            $w mark gravity s:$iy left
3233            set treeheight($de) 1
3234        } else {
3235            $w insert e:$ix $str
3236            $w insert e:$ix $e [highlight_tag $de]
3237        }
3238    }
3239    $w mark gravity e:$ix right
3240    $w conf -state disabled
3241    set treediropen($dir) 1
3242    set top [lindex [split [$w index @0,0] .] 0]
3243    set ht [$w cget -height]
3244    set l [lindex [split [$w index s:$ix] .] 0]
3245    if {$l < $top} {
3246        $w yview $l.0
3247    } elseif {$l + $n + 1 > $top + $ht} {
3248        set top [expr {$l + $n + 2 - $ht}]
3249        if {$l < $top} {
3250            set top $l
3251        }
3252        $w yview $top.0
3253    }
3254}
3255
3256proc treeclick {w x y} {
3257    global treediropen cmitmode ctext cflist cflist_top
3258
3259    if {$cmitmode ne "tree"} return
3260    if {![info exists cflist_top]} return
3261    set l [lindex [split [$w index "@$x,$y"] "."] 0]
3262    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3263    $cflist tag add highlight $l.0 "$l.0 lineend"
3264    set cflist_top $l
3265    if {$l == 1} {
3266        $ctext yview 1.0
3267        return
3268    }
3269    set e [linetoelt $l]
3270    if {[string index $e end] ne "/"} {
3271        showfile $e
3272    } elseif {$treediropen($e)} {
3273        treeclosedir $w $e
3274    } else {
3275        treeopendir $w $e
3276    }
3277}
3278
3279proc setfilelist {id} {
3280    global treefilelist cflist jump_to_here
3281
3282    treeview $cflist $treefilelist($id) 0
3283    if {$jump_to_here ne {}} {
3284        set f [lindex $jump_to_here 0]
3285        if {[lsearch -exact $treefilelist($id) $f] >= 0} {
3286            showfile $f
3287        }
3288    }
3289}
3290
3291image create bitmap tri-rt -background black -foreground blue -data {
3292    #define tri-rt_width 13
3293    #define tri-rt_height 13
3294    static unsigned char tri-rt_bits[] = {
3295       0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
3296       0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
3297       0x00, 0x00};
3298} -maskdata {
3299    #define tri-rt-mask_width 13
3300    #define tri-rt-mask_height 13
3301    static unsigned char tri-rt-mask_bits[] = {
3302       0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
3303       0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
3304       0x08, 0x00};
3305}
3306image create bitmap tri-dn -background black -foreground blue -data {
3307    #define tri-dn_width 13
3308    #define tri-dn_height 13
3309    static unsigned char tri-dn_bits[] = {
3310       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
3311       0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3312       0x00, 0x00};
3313} -maskdata {
3314    #define tri-dn-mask_width 13
3315    #define tri-dn-mask_height 13
3316    static unsigned char tri-dn-mask_bits[] = {
3317       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
3318       0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
3319       0x00, 0x00};
3320}
3321
3322image create bitmap reficon-T -background black -foreground yellow -data {
3323    #define tagicon_width 13
3324    #define tagicon_height 9
3325    static unsigned char tagicon_bits[] = {
3326       0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
3327       0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
3328} -maskdata {
3329    #define tagicon-mask_width 13
3330    #define tagicon-mask_height 9
3331    static unsigned char tagicon-mask_bits[] = {
3332       0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
3333       0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
3334}
3335set rectdata {
3336    #define headicon_width 13
3337    #define headicon_height 9
3338    static unsigned char headicon_bits[] = {
3339       0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3340       0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3341}
3342set rectmask {
3343    #define headicon-mask_width 13
3344    #define headicon-mask_height 9
3345    static unsigned char headicon-mask_bits[] = {
3346       0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3347       0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3348}
3349image create bitmap reficon-H -background black -foreground green \
3350    -data $rectdata -maskdata $rectmask
3351image create bitmap reficon-o -background black -foreground "#ddddff" \
3352    -data $rectdata -maskdata $rectmask
3353
3354proc init_flist {first} {
3355    global cflist cflist_top difffilestart
3356
3357    $cflist conf -state normal
3358    $cflist delete 0.0 end
3359    if {$first ne {}} {
3360        $cflist insert end $first
3361        set cflist_top 1
3362        $cflist tag add highlight 1.0 "1.0 lineend"
3363    } else {
3364        catch {unset cflist_top}
3365    }
3366    $cflist conf -state disabled
3367    set difffilestart {}
3368}
3369
3370proc highlight_tag {f} {
3371    global highlight_paths
3372
3373    foreach p $highlight_paths {
3374        if {[string match $p $f]} {
3375            return "bold"
3376        }
3377    }
3378    return {}
3379}
3380
3381proc highlight_filelist {} {
3382    global cmitmode cflist
3383
3384    $cflist conf -state normal
3385    if {$cmitmode ne "tree"} {
3386        set end [lindex [split [$cflist index end] .] 0]
3387        for {set l 2} {$l < $end} {incr l} {
3388            set line [$cflist get $l.0 "$l.0 lineend"]
3389            if {[highlight_tag $line] ne {}} {
3390                $cflist tag add bold $l.0 "$l.0 lineend"
3391            }
3392        }
3393    } else {
3394        highlight_tree 2 {}
3395    }
3396    $cflist conf -state disabled
3397}
3398
3399proc unhighlight_filelist {} {
3400    global cflist
3401
3402    $cflist conf -state normal
3403    $cflist tag remove bold 1.0 end
3404    $cflist conf -state disabled
3405}
3406
3407proc add_flist {fl} {
3408    global cflist
3409
3410    $cflist conf -state normal
3411    foreach f $fl {
3412        $cflist insert end "\n"
3413        $cflist insert end $f [highlight_tag $f]
3414    }
3415    $cflist conf -state disabled
3416}
3417
3418proc sel_flist {w x y} {
3419    global ctext difffilestart cflist cflist_top cmitmode
3420
3421    if {$cmitmode eq "tree"} return
3422    if {![info exists cflist_top]} return
3423    set l [lindex [split [$w index "@$x,$y"] "."] 0]
3424    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3425    $cflist tag add highlight $l.0 "$l.0 lineend"
3426    set cflist_top $l
3427    if {$l == 1} {
3428        $ctext yview 1.0
3429    } else {
3430        catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
3431    }
3432    suppress_highlighting_file_for_current_scrollpos
3433}
3434
3435proc pop_flist_menu {w X Y x y} {
3436    global ctext cflist cmitmode flist_menu flist_menu_file
3437    global treediffs diffids
3438
3439    stopfinding
3440    set l [lindex [split [$w index "@$x,$y"] "."] 0]
3441    if {$l <= 1} return
3442    if {$cmitmode eq "tree"} {
3443        set e [linetoelt $l]
3444        if {[string index $e end] eq "/"} return
3445    } else {
3446        set e [lindex $treediffs($diffids) [expr {$l-2}]]
3447    }
3448    set flist_menu_file $e
3449    set xdiffstate "normal"
3450    if {$cmitmode eq "tree"} {
3451        set xdiffstate "disabled"
3452    }
3453    # Disable "External diff" item in tree mode
3454    $flist_menu entryconf 2 -state $xdiffstate
3455    tk_popup $flist_menu $X $Y
3456}
3457
3458proc find_ctext_fileinfo {line} {
3459    global ctext_file_names ctext_file_lines
3460
3461    set ok [bsearch $ctext_file_lines $line]
3462    set tline [lindex $ctext_file_lines $ok]
3463
3464    if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3465        return {}
3466    } else {
3467        return [list [lindex $ctext_file_names $ok] $tline]
3468    }
3469}
3470
3471proc pop_diff_menu {w X Y x y} {
3472    global ctext diff_menu flist_menu_file
3473    global diff_menu_txtpos diff_menu_line
3474    global diff_menu_filebase
3475
3476    set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3477    set diff_menu_line [lindex $diff_menu_txtpos 0]
3478    # don't pop up the menu on hunk-separator or file-separator lines
3479    if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3480        return
3481    }
3482    stopfinding
3483    set f [find_ctext_fileinfo $diff_menu_line]
3484    if {$f eq {}} return
3485    set flist_menu_file [lindex $f 0]
3486    set diff_menu_filebase [lindex $f 1]
3487    tk_popup $diff_menu $X $Y
3488}
3489
3490proc flist_hl {only} {
3491    global flist_menu_file findstring gdttype
3492
3493    set x [shellquote $flist_menu_file]
3494    if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
3495        set findstring $x
3496    } else {
3497        append findstring " " $x
3498    }
3499    set gdttype [mc "touching paths:"]
3500}
3501
3502proc gitknewtmpdir {} {
3503    global diffnum gitktmpdir gitdir env
3504
3505    if {![info exists gitktmpdir]} {
3506        if {[info exists env(GITK_TMPDIR)]} {
3507            set tmpdir $env(GITK_TMPDIR)
3508        } elseif {[info exists env(TMPDIR)]} {
3509            set tmpdir $env(TMPDIR)
3510        } else {
3511            set tmpdir $gitdir
3512        }
3513        set gitktmpformat [file join $tmpdir ".gitk-tmp.XXXXXX"]
3514        if {[catch {set gitktmpdir [exec mktemp -d $gitktmpformat]}]} {
3515            set gitktmpdir [file join $gitdir [format ".gitk-tmp.%s" [pid]]]
3516        }
3517        if {[catch {file mkdir $gitktmpdir} err]} {
3518            error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3519            unset gitktmpdir
3520            return {}
3521        }
3522        set diffnum 0
3523    }
3524    incr diffnum
3525    set diffdir [file join $gitktmpdir $diffnum]
3526    if {[catch {file mkdir $diffdir} err]} {
3527        error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3528        return {}
3529    }
3530    return $diffdir
3531}
3532
3533proc save_file_from_commit {filename output what} {
3534    global nullfile
3535
3536    if {[catch {exec git show $filename -- > $output} err]} {
3537        if {[string match "fatal: bad revision *" $err]} {
3538            return $nullfile
3539        }
3540        error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
3541        return {}
3542    }
3543    return $output
3544}
3545
3546proc external_diff_get_one_file {diffid filename diffdir} {
3547    global nullid nullid2 nullfile
3548    global worktree
3549
3550    if {$diffid == $nullid} {
3551        set difffile [file join $worktree $filename]
3552        if {[file exists $difffile]} {
3553            return $difffile
3554        }
3555        return $nullfile
3556    }
3557    if {$diffid == $nullid2} {
3558        set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3559        return [save_file_from_commit :$filename $difffile index]
3560    }
3561    set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3562    return [save_file_from_commit $diffid:$filename $difffile \
3563               "revision $diffid"]
3564}
3565
3566proc external_diff {} {
3567    global nullid nullid2
3568    global flist_menu_file
3569    global diffids
3570    global extdifftool
3571
3572    if {[llength $diffids] == 1} {
3573        # no reference commit given
3574        set diffidto [lindex $diffids 0]
3575        if {$diffidto eq $nullid} {
3576            # diffing working copy with index
3577            set diffidfrom $nullid2
3578        } elseif {$diffidto eq $nullid2} {
3579            # diffing index with HEAD
3580            set diffidfrom "HEAD"
3581        } else {
3582            # use first parent commit
3583            global parentlist selectedline
3584            set diffidfrom [lindex $parentlist $selectedline 0]
3585        }
3586    } else {
3587        set diffidfrom [lindex $diffids 0]
3588        set diffidto [lindex $diffids 1]
3589    }
3590
3591    # make sure that several diffs wont collide
3592    set diffdir [gitknewtmpdir]
3593    if {$diffdir eq {}} return
3594
3595    # gather files to diff
3596    set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3597    set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3598
3599    if {$difffromfile ne {} && $difftofile ne {}} {
3600        set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
3601        if {[catch {set fl [open |$cmd r]} err]} {
3602            file delete -force $diffdir
3603            error_popup "$extdifftool: [mc "command failed:"] $err"
3604        } else {
3605            fconfigure $fl -blocking 0
3606            filerun $fl [list delete_at_eof $fl $diffdir]
3607        }
3608    }
3609}
3610
3611proc find_hunk_blamespec {base line} {
3612    global ctext
3613
3614    # Find and parse the hunk header
3615    set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3616    if {$s_lix eq {}} return
3617
3618    set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3619    if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3620            s_line old_specs osz osz1 new_line nsz]} {
3621        return
3622    }
3623
3624    # base lines for the parents
3625    set base_lines [list $new_line]
3626    foreach old_spec [lrange [split $old_specs " "] 1 end] {
3627        if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3628                old_spec old_line osz]} {
3629            return
3630        }
3631        lappend base_lines $old_line
3632    }
3633
3634    # Now scan the lines to determine offset within the hunk
3635    set max_parent [expr {[llength $base_lines]-2}]
3636    set dline 0
3637    set s_lno [lindex [split $s_lix "."] 0]
3638
3639    # Determine if the line is removed
3640    set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3641    if {[string match {[-+ ]*} $chunk]} {
3642        set removed_idx [string first "-" $chunk]
3643        # Choose a parent index
3644        if {$removed_idx >= 0} {
3645            set parent $removed_idx
3646        } else {
3647            set unchanged_idx [string first " " $chunk]
3648            if {$unchanged_idx >= 0} {
3649                set parent $unchanged_idx
3650            } else {
3651                # blame the current commit
3652                set parent -1
3653            }
3654        }
3655        # then count other lines that belong to it
3656        for {set i $line} {[incr i -1] > $s_lno} {} {
3657            set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3658            # Determine if the line is removed
3659            set removed_idx [string first "-" $chunk]
3660            if {$parent >= 0} {
3661                set code [string index $chunk $parent]
3662                if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3663                    incr dline
3664                }
3665            } else {
3666                if {$removed_idx < 0} {
3667                    incr dline
3668                }
3669            }
3670        }
3671        incr parent
3672    } else {
3673        set parent 0
3674    }
3675
3676    incr dline [lindex $base_lines $parent]
3677    return [list $parent $dline]
3678}
3679
3680proc external_blame_diff {} {
3681    global currentid cmitmode
3682    global diff_menu_txtpos diff_menu_line
3683    global diff_menu_filebase flist_menu_file
3684
3685    if {$cmitmode eq "tree"} {
3686        set parent_idx 0
3687        set line [expr {$diff_menu_line - $diff_menu_filebase}]
3688    } else {
3689        set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3690        if {$hinfo ne {}} {
3691            set parent_idx [lindex $hinfo 0]
3692            set line [lindex $hinfo 1]
3693        } else {
3694            set parent_idx 0
3695            set line 0
3696        }
3697    }
3698
3699    external_blame $parent_idx $line
3700}
3701
3702# Find the SHA1 ID of the blob for file $fname in the index
3703# at stage 0 or 2
3704proc index_sha1 {fname} {
3705    set f [open [list | git ls-files -s $fname] r]
3706    while {[gets $f line] >= 0} {
3707        set info [lindex [split $line "\t"] 0]
3708        set stage [lindex $info 2]
3709        if {$stage eq "0" || $stage eq "2"} {
3710            close $f
3711            return [lindex $info 1]
3712        }
3713    }
3714    close $f
3715    return {}
3716}
3717
3718# Turn an absolute path into one relative to the current directory
3719proc make_relative {f} {
3720    if {[file pathtype $f] eq "relative"} {
3721        return $f
3722    }
3723    set elts [file split $f]
3724    set here [file split [pwd]]
3725    set ei 0
3726    set hi 0
3727    set res {}
3728    foreach d $here {
3729        if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3730            lappend res ".."
3731        } else {
3732            incr ei
3733        }
3734        incr hi
3735    }
3736    set elts [concat $res [lrange $elts $ei end]]
3737    return [eval file join $elts]
3738}
3739
3740proc external_blame {parent_idx {line {}}} {
3741    global flist_menu_file cdup
3742    global nullid nullid2
3743    global parentlist selectedline currentid
3744
3745    if {$parent_idx > 0} {
3746        set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3747    } else {
3748        set base_commit $currentid
3749    }
3750
3751    if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3752        error_popup [mc "No such commit"]
3753        return
3754    }
3755
3756    set cmdline [list git gui blame]
3757    if {$line ne {} && $line > 1} {
3758        lappend cmdline "--line=$line"
3759    }
3760    set f [file join $cdup $flist_menu_file]
3761    # Unfortunately it seems git gui blame doesn't like
3762    # being given an absolute path...
3763    set f [make_relative $f]
3764    lappend cmdline $base_commit $f
3765    if {[catch {eval exec $cmdline &} err]} {
3766        error_popup "[mc "git gui blame: command failed:"] $err"
3767    }
3768}
3769
3770proc show_line_source {} {
3771    global cmitmode currentid parents curview blamestuff blameinst
3772    global diff_menu_line diff_menu_filebase flist_menu_file
3773    global nullid nullid2 gitdir cdup
3774
3775    set from_index {}
3776    if {$cmitmode eq "tree"} {
3777        set id $currentid
3778        set line [expr {$diff_menu_line - $diff_menu_filebase}]
3779    } else {
3780        set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3781        if {$h eq {}} return
3782        set pi [lindex $h 0]
3783        if {$pi == 0} {
3784            mark_ctext_line $diff_menu_line
3785            return
3786        }
3787        incr pi -1
3788        if {$currentid eq $nullid} {
3789            if {$pi > 0} {
3790                # must be a merge in progress...
3791                if {[catch {
3792                    # get the last line from .git/MERGE_HEAD
3793                    set f [open [file join $gitdir MERGE_HEAD] r]
3794                    set id [lindex [split [read $f] "\n"] end-1]
3795                    close $f
3796                } err]} {
3797                    error_popup [mc "Couldn't read merge head: %s" $err]
3798                    return
3799                }
3800            } elseif {$parents($curview,$currentid) eq $nullid2} {
3801                # need to do the blame from the index
3802                if {[catch {
3803                    set from_index [index_sha1 $flist_menu_file]
3804                } err]} {
3805                    error_popup [mc "Error reading index: %s" $err]
3806                    return
3807                }
3808            } else {
3809                set id $parents($curview,$currentid)
3810            }
3811        } else {
3812            set id [lindex $parents($curview,$currentid) $pi]
3813        }
3814        set line [lindex $h 1]
3815    }
3816    set blameargs {}
3817    if {$from_index ne {}} {
3818        lappend blameargs | git cat-file blob $from_index
3819    }
3820    lappend blameargs | git blame -p -L$line,+1
3821    if {$from_index ne {}} {
3822        lappend blameargs --contents -
3823    } else {
3824        lappend blameargs $id
3825    }
3826    lappend blameargs -- [file join $cdup $flist_menu_file]
3827    if {[catch {
3828        set f [open $blameargs r]
3829    } err]} {
3830        error_popup [mc "Couldn't start git blame: %s" $err]
3831        return
3832    }
3833    nowbusy blaming [mc "Searching"]
3834    fconfigure $f -blocking 0
3835    set i [reg_instance $f]
3836    set blamestuff($i) {}
3837    set blameinst $i
3838    filerun $f [list read_line_source $f $i]
3839}
3840
3841proc stopblaming {} {
3842    global blameinst
3843
3844    if {[info exists blameinst]} {
3845        stop_instance $blameinst
3846        unset blameinst
3847        notbusy blaming
3848    }
3849}
3850
3851proc read_line_source {fd inst} {
3852    global blamestuff curview commfd blameinst nullid nullid2
3853
3854    while {[gets $fd line] >= 0} {
3855        lappend blamestuff($inst) $line
3856    }
3857    if {![eof $fd]} {
3858        return 1
3859    }
3860    unset commfd($inst)
3861    unset blameinst
3862    notbusy blaming
3863    fconfigure $fd -blocking 1
3864    if {[catch {close $fd} err]} {
3865        error_popup [mc "Error running git blame: %s" $err]
3866        return 0
3867    }
3868
3869    set fname {}
3870    set line [split [lindex $blamestuff($inst) 0] " "]
3871    set id [lindex $line 0]
3872    set lnum [lindex $line 1]
3873    if {[string length $id] == 40 && [string is xdigit $id] &&
3874        [string is digit -strict $lnum]} {
3875        # look for "filename" line
3876        foreach l $blamestuff($inst) {
3877            if {[string match "filename *" $l]} {
3878                set fname [string range $l 9 end]
3879                break
3880            }
3881        }
3882    }
3883    if {$fname ne {}} {
3884        # all looks good, select it
3885        if {$id eq $nullid} {
3886            # blame uses all-zeroes to mean not committed,
3887            # which would mean a change in the index
3888            set id $nullid2
3889        }
3890        if {[commitinview $id $curview]} {
3891            selectline [rowofcommit $id] 1 [list $fname $lnum] 1
3892        } else {
3893            error_popup [mc "That line comes from commit %s, \
3894                             which is not in this view" [shortids $id]]
3895        }
3896    } else {
3897        puts "oops couldn't parse git blame output"
3898    }
3899    return 0
3900}
3901
3902# delete $dir when we see eof on $f (presumably because the child has exited)
3903proc delete_at_eof {f dir} {
3904    while {[gets $f line] >= 0} {}
3905    if {[eof $f]} {
3906        if {[catch {close $f} err]} {
3907            error_popup "[mc "External diff viewer failed:"] $err"
3908        }
3909        file delete -force $dir
3910        return 0
3911    }
3912    return 1
3913}
3914
3915# Functions for adding and removing shell-type quoting
3916
3917proc shellquote {str} {
3918    if {![string match "*\['\"\\ \t]*" $str]} {
3919        return $str
3920    }
3921    if {![string match "*\['\"\\]*" $str]} {
3922        return "\"$str\""
3923    }
3924    if {![string match "*'*" $str]} {
3925        return "'$str'"
3926    }
3927    return "\"[string map {\" \\\" \\ \\\\} $str]\""
3928}
3929
3930proc shellarglist {l} {
3931    set str {}
3932    foreach a $l {
3933        if {$str ne {}} {
3934            append str " "
3935        }
3936        append str [shellquote $a]
3937    }
3938    return $str
3939}
3940
3941proc shelldequote {str} {
3942    set ret {}
3943    set used -1
3944    while {1} {
3945        incr used
3946        if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
3947            append ret [string range $str $used end]
3948            set used [string length $str]
3949            break
3950        }
3951        set first [lindex $first 0]
3952        set ch [string index $str $first]
3953        if {$first > $used} {
3954            append ret [string range $str $used [expr {$first - 1}]]
3955            set used $first
3956        }
3957        if {$ch eq " " || $ch eq "\t"} break
3958        incr used
3959        if {$ch eq "'"} {
3960            set first [string first "'" $str $used]
3961            if {$first < 0} {
3962                error "unmatched single-quote"
3963            }
3964            append ret [string range $str $used [expr {$first - 1}]]
3965            set used $first
3966            continue
3967        }
3968        if {$ch eq "\\"} {
3969            if {$used >= [string length $str]} {
3970                error "trailing backslash"
3971            }
3972            append ret [string index $str $used]
3973            continue
3974        }
3975        # here ch == "\""
3976        while {1} {
3977            if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
3978                error "unmatched double-quote"
3979            }
3980            set first [lindex $first 0]
3981            set ch [string index $str $first]
3982            if {$first > $used} {
3983                append ret [string range $str $used [expr {$first - 1}]]
3984                set used $first
3985            }
3986            if {$ch eq "\""} break
3987            incr used
3988            append ret [string index $str $used]
3989            incr used
3990        }
3991    }
3992    return [list $used $ret]
3993}
3994
3995proc shellsplit {str} {
3996    set l {}
3997    while {1} {
3998        set str [string trimleft $str]
3999        if {$str eq {}} break
4000        set dq [shelldequote $str]
4001        set n [lindex $dq 0]
4002        set word [lindex $dq 1]
4003        set str [string range $str $n end]
4004        lappend l $word
4005    }
4006    return $l
4007}
4008
4009# Code to implement multiple views
4010
4011proc newview {ishighlight} {
4012    global nextviewnum newviewname newishighlight
4013    global revtreeargs viewargscmd newviewopts curview
4014
4015    set newishighlight $ishighlight
4016    set top .gitkview
4017    if {[winfo exists $top]} {
4018        raise $top
4019        return
4020    }
4021    decode_view_opts $nextviewnum $revtreeargs
4022    set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
4023    set newviewopts($nextviewnum,perm) 0
4024    set newviewopts($nextviewnum,cmd)  $viewargscmd($curview)
4025    vieweditor $top $nextviewnum [mc "Gitk view definition"]
4026}
4027
4028set known_view_options {
4029    {perm      b    .  {}               {mc "Remember this view"}}
4030    {reflabel  l    +  {}               {mc "References (space separated list):"}}
4031    {refs      t15  .. {}               {mc "Branches & tags:"}}
4032    {allrefs   b    *. "--all"          {mc "All refs"}}
4033    {branches  b    .  "--branches"     {mc "All (local) branches"}}
4034    {tags      b    .  "--tags"         {mc "All tags"}}
4035    {remotes   b    .  "--remotes"      {mc "All remote-tracking branches"}}
4036    {commitlbl l    +  {}               {mc "Commit Info (regular expressions):"}}
4037    {author    t15  .. "--author=*"     {mc "Author:"}}
4038    {committer t15  .  "--committer=*"  {mc "Committer:"}}
4039    {loginfo   t15  .. "--grep=*"       {mc "Commit Message:"}}
4040    {allmatch  b    .. "--all-match"    {mc "Matches all Commit Info criteria"}}
4041    {changes_l l    +  {}               {mc "Changes to Files:"}}
4042    {pickaxe_s r0   .  {}               {mc "Fixed String"}}
4043    {pickaxe_t r1   .  "--pickaxe-regex"  {mc "Regular Expression"}}
4044    {pickaxe   t15  .. "-S*"            {mc "Search string:"}}
4045    {datelabel l    +  {}               {mc "Commit Dates (\"2 weeks ago\", \"2009-03-17 15:27:38\", \"March 17, 2009 15:27:38\"):"}}
4046    {since     t15  ..  {"--since=*" "--after=*"}  {mc "Since:"}}
4047    {until     t15  .   {"--until=*" "--before=*"} {mc "Until:"}}
4048    {limit_lbl l    +  {}               {mc "Limit and/or skip a number of revisions (positive integer):"}}
4049    {limit     t10  *. "--max-count=*"  {mc "Number to show:"}}
4050    {skip      t10  .  "--skip=*"       {mc "Number to skip:"}}
4051    {misc_lbl  l    +  {}               {mc "Miscellaneous options:"}}
4052    {dorder    b    *. {"--date-order" "-d"}      {mc "Strictly sort by date"}}
4053    {lright    b    .  "--left-right"   {mc "Mark branch sides"}}
4054    {first     b    .  "--first-parent" {mc "Limit to first parent"}}
4055    {smplhst   b    .  "--simplify-by-decoration"   {mc "Simple history"}}
4056    {args      t50  *. {}               {mc "Additional arguments to git log:"}}
4057    {allpaths  path +  {}               {mc "Enter files and directories to include, one per line:"}}
4058    {cmd       t50= +  {}               {mc "Command to generate more commits to include:"}}
4059    }
4060
4061# Convert $newviewopts($n, ...) into args for git log.
4062proc encode_view_opts {n} {
4063    global known_view_options newviewopts
4064
4065    set rargs [list]
4066    foreach opt $known_view_options {
4067        set patterns [lindex $opt 3]
4068        if {$patterns eq {}} continue
4069        set pattern [lindex $patterns 0]
4070
4071        if {[lindex $opt 1] eq "b"} {
4072            set val $newviewopts($n,[lindex $opt 0])
4073            if {$val} {
4074                lappend rargs $pattern
4075            }
4076        } elseif {[regexp {^r(\d+)$} [lindex $opt 1] type value]} {
4077            regexp {^(.*_)} [lindex $opt 0] uselessvar button_id
4078            set val $newviewopts($n,$button_id)
4079            if {$val eq $value} {
4080                lappend rargs $pattern
4081            }
4082        } else {
4083            set val $newviewopts($n,[lindex $opt 0])
4084            set val [string trim $val]
4085            if {$val ne {}} {
4086                set pfix [string range $pattern 0 end-1]
4087                lappend rargs $pfix$val
4088            }
4089        }
4090    }
4091    set rargs [concat $rargs [shellsplit $newviewopts($n,refs)]]
4092    return [concat $rargs [shellsplit $newviewopts($n,args)]]
4093}
4094
4095# Fill $newviewopts($n, ...) based on args for git log.
4096proc decode_view_opts {n view_args} {
4097    global known_view_options newviewopts
4098
4099    foreach opt $known_view_options {
4100        set id [lindex $opt 0]
4101        if {[lindex $opt 1] eq "b"} {
4102            # Checkboxes
4103            set val 0
4104        } elseif {[regexp {^r(\d+)$} [lindex $opt 1]]} {
4105            # Radiobuttons
4106            regexp {^(.*_)} $id uselessvar id
4107            set val 0
4108        } else {
4109            # Text fields
4110            set val {}
4111        }
4112        set newviewopts($n,$id) $val
4113    }
4114    set oargs [list]
4115    set refargs [list]
4116    foreach arg $view_args {
4117        if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
4118            && ![info exists found(limit)]} {
4119            set newviewopts($n,limit) $cnt
4120            set found(limit) 1
4121            continue
4122        }
4123        catch { unset val }
4124        foreach opt $known_view_options {
4125            set id [lindex $opt 0]
4126            if {[info exists found($id)]} continue
4127            foreach pattern [lindex $opt 3] {
4128                if {![string match $pattern $arg]} continue
4129                if {[lindex $opt 1] eq "b"} {
4130                    # Check buttons
4131                    set val 1
4132                } elseif {[regexp {^r(\d+)$} [lindex $opt 1] match num]} {
4133                    # Radio buttons
4134                    regexp {^(.*_)} $id uselessvar id
4135                    set val $num
4136                } else {
4137                    # Text input fields
4138                    set size [string length $pattern]
4139                    set val [string range $arg [expr {$size-1}] end]
4140                }
4141                set newviewopts($n,$id) $val
4142                set found($id) 1
4143                break
4144            }
4145            if {[info exists val]} break
4146        }
4147        if {[info exists val]} continue
4148        if {[regexp {^-} $arg]} {
4149            lappend oargs $arg
4150        } else {
4151            lappend refargs $arg
4152        }
4153    }
4154    set newviewopts($n,refs) [shellarglist $refargs]
4155    set newviewopts($n,args) [shellarglist $oargs]
4156}
4157
4158proc edit_or_newview {} {
4159    global curview
4160
4161    if {$curview > 0} {
4162        editview
4163    } else {
4164        newview 0
4165    }
4166}
4167
4168proc editview {} {
4169    global curview
4170    global viewname viewperm newviewname newviewopts
4171    global viewargs viewargscmd
4172
4173    set top .gitkvedit-$curview
4174    if {[winfo exists $top]} {
4175        raise $top
4176        return
4177    }
4178    decode_view_opts $curview $viewargs($curview)
4179    set newviewname($curview)      $viewname($curview)
4180    set newviewopts($curview,perm) $viewperm($curview)
4181    set newviewopts($curview,cmd)  $viewargscmd($curview)
4182    vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
4183}
4184
4185proc vieweditor {top n title} {
4186    global newviewname newviewopts viewfiles bgcolor
4187    global known_view_options NS
4188
4189    ttk_toplevel $top
4190    wm title $top [concat $title [mc "-- criteria for selecting revisions"]]
4191    make_transient $top .
4192
4193    # View name
4194    ${NS}::frame $top.nfr
4195    ${NS}::label $top.nl -text [mc "View Name"]
4196    ${NS}::entry $top.name -width 20 -textvariable newviewname($n)
4197    pack $top.nfr -in $top -fill x -pady 5 -padx 3
4198    pack $top.nl -in $top.nfr -side left -padx {0 5}
4199    pack $top.name -in $top.nfr -side left -padx {0 25}
4200
4201    # View options
4202    set cframe $top.nfr
4203    set cexpand 0
4204    set cnt 0
4205    foreach opt $known_view_options {
4206        set id [lindex $opt 0]
4207        set type [lindex $opt 1]
4208        set flags [lindex $opt 2]
4209        set title [eval [lindex $opt 4]]
4210        set lxpad 0
4211
4212        if {$flags eq "+" || $flags eq "*"} {
4213            set cframe $top.fr$cnt
4214            incr cnt
4215            ${NS}::frame $cframe
4216            pack $cframe -in $top -fill x -pady 3 -padx 3
4217            set cexpand [expr {$flags eq "*"}]
4218        } elseif {$flags eq ".." || $flags eq "*."} {
4219            set cframe $top.fr$cnt
4220            incr cnt
4221            ${NS}::frame $cframe
4222            pack $cframe -in $top -fill x -pady 3 -padx [list 15 3]
4223            set cexpand [expr {$flags eq "*."}]
4224        } else {
4225            set lxpad 5
4226        }
4227
4228        if {$type eq "l"} {
4229            ${NS}::label $cframe.l_$id -text $title
4230            pack $cframe.l_$id -in $cframe -side left -pady [list 3 0] -anchor w
4231        } elseif {$type eq "b"} {
4232            ${NS}::checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
4233            pack $cframe.c_$id -in $cframe -side left \
4234                -padx [list $lxpad 0] -expand $cexpand -anchor w
4235        } elseif {[regexp {^r(\d+)$} $type type sz]} {
4236            regexp {^(.*_)} $id uselessvar button_id
4237            ${NS}::radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz
4238            pack $cframe.c_$id -in $cframe -side left \
4239                -padx [list $lxpad 0] -expand $cexpand -anchor w
4240        } elseif {[regexp {^t(\d+)$} $type type sz]} {
4241            ${NS}::label $cframe.l_$id -text $title
4242            ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4243                -textvariable newviewopts($n,$id)
4244            pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
4245            pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
4246        } elseif {[regexp {^t(\d+)=$} $type type sz]} {
4247            ${NS}::label $cframe.l_$id -text $title
4248            ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4249                -textvariable newviewopts($n,$id)
4250            pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
4251            pack $cframe.e_$id -in $cframe -side top -fill x
4252        } elseif {$type eq "path"} {
4253            ${NS}::label $top.l -text $title
4254            pack $top.l -in $top -side top -pady [list 3 0] -anchor w -padx 3
4255            text $top.t -width 40 -height 5 -background $bgcolor
4256            if {[info exists viewfiles($n)]} {
4257                foreach f $viewfiles($n) {
4258                    $top.t insert end $f
4259                    $top.t insert end "\n"
4260                }
4261                $top.t delete {end - 1c} end
4262                $top.t mark set insert 0.0
4263            }
4264            pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
4265        }
4266    }
4267
4268    ${NS}::frame $top.buts
4269    ${NS}::button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
4270    ${NS}::button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
4271    ${NS}::button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
4272    bind $top <Control-Return> [list newviewok $top $n]
4273    bind $top <F5> [list newviewok $top $n 1]
4274    bind $top <Escape> [list destroy $top]
4275    grid $top.buts.ok $top.buts.apply $top.buts.can
4276    grid columnconfigure $top.buts 0 -weight 1 -uniform a
4277    grid columnconfigure $top.buts 1 -weight 1 -uniform a
4278    grid columnconfigure $top.buts 2 -weight 1 -uniform a
4279    pack $top.buts -in $top -side top -fill x
4280    focus $top.t
4281}
4282
4283proc doviewmenu {m first cmd op argv} {
4284    set nmenu [$m index end]
4285    for {set i $first} {$i <= $nmenu} {incr i} {
4286        if {[$m entrycget $i -command] eq $cmd} {
4287            eval $m $op $i $argv
4288            break
4289        }
4290    }
4291}
4292
4293proc allviewmenus {n op args} {
4294    # global viewhlmenu
4295
4296    doviewmenu .bar.view 5 [list showview $n] $op $args
4297    # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
4298}
4299
4300proc newviewok {top n {apply 0}} {
4301    global nextviewnum newviewperm newviewname newishighlight
4302    global viewname viewfiles viewperm selectedview curview
4303    global viewargs viewargscmd newviewopts viewhlmenu
4304
4305    if {[catch {
4306        set newargs [encode_view_opts $n]
4307    } err]} {
4308        error_popup "[mc "Error in commit selection arguments:"] $err" $top
4309        return
4310    }
4311    set files {}
4312    foreach f [split [$top.t get 0.0 end] "\n"] {
4313        set ft [string trim $f]
4314        if {$ft ne {}} {
4315            lappend files $ft
4316        }
4317    }
4318    if {![info exists viewfiles($n)]} {
4319        # creating a new view
4320        incr nextviewnum
4321        set viewname($n) $newviewname($n)
4322        set viewperm($n) $newviewopts($n,perm)
4323        set viewfiles($n) $files
4324        set viewargs($n) $newargs
4325        set viewargscmd($n) $newviewopts($n,cmd)
4326        addviewmenu $n
4327        if {!$newishighlight} {
4328            run showview $n
4329        } else {
4330            run addvhighlight $n
4331        }
4332    } else {
4333        # editing an existing view
4334        set viewperm($n) $newviewopts($n,perm)
4335        if {$newviewname($n) ne $viewname($n)} {
4336            set viewname($n) $newviewname($n)
4337            doviewmenu .bar.view 5 [list showview $n] \
4338                entryconf [list -label $viewname($n)]
4339            # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
4340                # entryconf [list -label $viewname($n) -value $viewname($n)]
4341        }
4342        if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
4343                $newviewopts($n,cmd) ne $viewargscmd($n)} {
4344            set viewfiles($n) $files
4345            set viewargs($n) $newargs
4346            set viewargscmd($n) $newviewopts($n,cmd)
4347            if {$curview == $n} {
4348                run reloadcommits
4349            }
4350        }
4351    }
4352    if {$apply} return
4353    catch {destroy $top}
4354}
4355
4356proc delview {} {
4357    global curview viewperm hlview selectedhlview
4358
4359    if {$curview == 0} return
4360    if {[info exists hlview] && $hlview == $curview} {
4361        set selectedhlview [mc "None"]
4362        unset hlview
4363    }
4364    allviewmenus $curview delete
4365    set viewperm($curview) 0
4366    showview 0
4367}
4368
4369proc addviewmenu {n} {
4370    global viewname viewhlmenu
4371
4372    .bar.view add radiobutton -label $viewname($n) \
4373        -command [list showview $n] -variable selectedview -value $n
4374    #$viewhlmenu add radiobutton -label $viewname($n) \
4375    #   -command [list addvhighlight $n] -variable selectedhlview
4376}
4377
4378proc showview {n} {
4379    global curview cached_commitrow ordertok
4380    global displayorder parentlist rowidlist rowisopt rowfinal
4381    global colormap rowtextx nextcolor canvxmax
4382    global numcommits viewcomplete
4383    global selectedline currentid canv canvy0
4384    global treediffs
4385    global pending_select mainheadid
4386    global commitidx
4387    global selectedview
4388    global hlview selectedhlview commitinterest
4389
4390    if {$n == $curview} return
4391    set selid {}
4392    set ymax [lindex [$canv cget -scrollregion] 3]
4393    set span [$canv yview]
4394    set ytop [expr {[lindex $span 0] * $ymax}]
4395    set ybot [expr {[lindex $span 1] * $ymax}]
4396    set yscreen [expr {($ybot - $ytop) / 2}]
4397    if {$selectedline ne {}} {
4398        set selid $currentid
4399        set y [yc $selectedline]
4400        if {$ytop < $y && $y < $ybot} {
4401            set yscreen [expr {$y - $ytop}]
4402        }
4403    } elseif {[info exists pending_select]} {
4404        set selid $pending_select
4405        unset pending_select
4406    }
4407    unselectline
4408    normalline
4409    catch {unset treediffs}
4410    clear_display
4411    if {[info exists hlview] && $hlview == $n} {
4412        unset hlview
4413        set selectedhlview [mc "None"]
4414    }
4415    catch {unset commitinterest}
4416    catch {unset cached_commitrow}
4417    catch {unset ordertok}
4418
4419    set curview $n
4420    set selectedview $n
4421    .bar.view entryconf [mca "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
4422    .bar.view entryconf [mca "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
4423
4424    run refill_reflist
4425    if {![info exists viewcomplete($n)]} {
4426        getcommits $selid
4427        return
4428    }
4429
4430    set displayorder {}
4431    set parentlist {}
4432    set rowidlist {}
4433    set rowisopt {}
4434    set rowfinal {}
4435    set numcommits $commitidx($n)
4436
4437    catch {unset colormap}
4438    catch {unset rowtextx}
4439    set nextcolor 0
4440    set canvxmax [$canv cget -width]
4441    set curview $n
4442    set row 0
4443    setcanvscroll
4444    set yf 0
4445    set row {}
4446    if {$selid ne {} && [commitinview $selid $n]} {
4447        set row [rowofcommit $selid]
4448        # try to get the selected row in the same position on the screen
4449        set ymax [lindex [$canv cget -scrollregion] 3]
4450        set ytop [expr {[yc $row] - $yscreen}]
4451        if {$ytop < 0} {
4452            set ytop 0
4453        }
4454        set yf [expr {$ytop * 1.0 / $ymax}]
4455    }
4456    allcanvs yview moveto $yf
4457    drawvisible
4458    if {$row ne {}} {
4459        selectline $row 0
4460    } elseif {!$viewcomplete($n)} {
4461        reset_pending_select $selid
4462    } else {
4463        reset_pending_select {}
4464
4465        if {[commitinview $pending_select $curview]} {
4466            selectline [rowofcommit $pending_select] 1
4467        } else {
4468            set row [first_real_row]
4469            if {$row < $numcommits} {
4470                selectline $row 0
4471            }
4472        }
4473    }
4474    if {!$viewcomplete($n)} {
4475        if {$numcommits == 0} {
4476            show_status [mc "Reading commits..."]
4477        }
4478    } elseif {$numcommits == 0} {
4479        show_status [mc "No commits selected"]
4480    }
4481}
4482
4483# Stuff relating to the highlighting facility
4484
4485proc ishighlighted {id} {
4486    global vhighlights fhighlights nhighlights rhighlights
4487
4488    if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
4489        return $nhighlights($id)
4490    }
4491    if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
4492        return $vhighlights($id)
4493    }
4494    if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
4495        return $fhighlights($id)
4496    }
4497    if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4498        return $rhighlights($id)
4499    }
4500    return 0
4501}
4502
4503proc bolden {id font} {
4504    global canv linehtag currentid boldids need_redisplay markedid
4505
4506    # need_redisplay = 1 means the display is stale and about to be redrawn
4507    if {$need_redisplay} return
4508    lappend boldids $id
4509    $canv itemconf $linehtag($id) -font $font
4510    if {[info exists currentid] && $id eq $currentid} {
4511        $canv delete secsel
4512        set t [eval $canv create rect [$canv bbox $linehtag($id)] \
4513                   -outline {{}} -tags secsel \
4514                   -fill [$canv cget -selectbackground]]
4515        $canv lower $t
4516    }
4517    if {[info exists markedid] && $id eq $markedid} {
4518        make_idmark $id
4519    }
4520}
4521
4522proc bolden_name {id font} {
4523    global canv2 linentag currentid boldnameids need_redisplay
4524
4525    if {$need_redisplay} return
4526    lappend boldnameids $id
4527    $canv2 itemconf $linentag($id) -font $font
4528    if {[info exists currentid] && $id eq $currentid} {
4529        $canv2 delete secsel
4530        set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
4531                   -outline {{}} -tags secsel \
4532                   -fill [$canv2 cget -selectbackground]]
4533        $canv2 lower $t
4534    }
4535}
4536
4537proc unbolden {} {
4538    global boldids
4539
4540    set stillbold {}
4541    foreach id $boldids {
4542        if {![ishighlighted $id]} {
4543            bolden $id mainfont
4544        } else {
4545            lappend stillbold $id
4546        }
4547    }
4548    set boldids $stillbold
4549}
4550
4551proc addvhighlight {n} {
4552    global hlview viewcomplete curview vhl_done commitidx
4553
4554    if {[info exists hlview]} {
4555        delvhighlight
4556    }
4557    set hlview $n
4558    if {$n != $curview && ![info exists viewcomplete($n)]} {
4559        start_rev_list $n
4560    }
4561    set vhl_done $commitidx($hlview)
4562    if {$vhl_done > 0} {
4563        drawvisible
4564    }
4565}
4566
4567proc delvhighlight {} {
4568    global hlview vhighlights
4569
4570    if {![info exists hlview]} return
4571    unset hlview
4572    catch {unset vhighlights}
4573    unbolden
4574}
4575
4576proc vhighlightmore {} {
4577    global hlview vhl_done commitidx vhighlights curview
4578
4579    set max $commitidx($hlview)
4580    set vr [visiblerows]
4581    set r0 [lindex $vr 0]
4582    set r1 [lindex $vr 1]
4583    for {set i $vhl_done} {$i < $max} {incr i} {
4584        set id [commitonrow $i $hlview]
4585        if {[commitinview $id $curview]} {
4586            set row [rowofcommit $id]
4587            if {$r0 <= $row && $row <= $r1} {
4588                if {![highlighted $row]} {
4589                    bolden $id mainfontbold
4590                }
4591                set vhighlights($id) 1
4592            }
4593        }
4594    }
4595    set vhl_done $max
4596    return 0
4597}
4598
4599proc askvhighlight {row id} {
4600    global hlview vhighlights iddrawn
4601
4602    if {[commitinview $id $hlview]} {
4603        if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
4604            bolden $id mainfontbold
4605        }
4606        set vhighlights($id) 1
4607    } else {
4608        set vhighlights($id) 0
4609    }
4610}
4611
4612proc hfiles_change {} {
4613    global highlight_files filehighlight fhighlights fh_serial
4614    global highlight_paths
4615
4616    if {[info exists filehighlight]} {
4617        # delete previous highlights
4618        catch {close $filehighlight}
4619        unset filehighlight
4620        catch {unset fhighlights}
4621        unbolden
4622        unhighlight_filelist
4623    }
4624    set highlight_paths {}
4625    after cancel do_file_hl $fh_serial
4626    incr fh_serial
4627    if {$highlight_files ne {}} {
4628        after 300 do_file_hl $fh_serial
4629    }
4630}
4631
4632proc gdttype_change {name ix op} {
4633    global gdttype highlight_files findstring findpattern
4634
4635    stopfinding
4636    if {$findstring ne {}} {
4637        if {$gdttype eq [mc "containing:"]} {
4638            if {$highlight_files ne {}} {
4639                set highlight_files {}
4640                hfiles_change
4641            }
4642            findcom_change
4643        } else {
4644            if {$findpattern ne {}} {
4645                set findpattern {}
4646                findcom_change
4647            }
4648            set highlight_files $findstring
4649            hfiles_change
4650        }
4651        drawvisible
4652    }
4653    # enable/disable findtype/findloc menus too
4654}
4655
4656proc find_change {name ix op} {
4657    global gdttype findstring highlight_files
4658
4659    stopfinding
4660    if {$gdttype eq [mc "containing:"]} {
4661        findcom_change
4662    } else {
4663        if {$highlight_files ne $findstring} {
4664            set highlight_files $findstring
4665            hfiles_change
4666        }
4667    }
4668    drawvisible
4669}
4670
4671proc findcom_change args {
4672    global nhighlights boldnameids
4673    global findpattern findtype findstring gdttype
4674
4675    stopfinding
4676    # delete previous highlights, if any
4677    foreach id $boldnameids {
4678        bolden_name $id mainfont
4679    }
4680    set boldnameids {}
4681    catch {unset nhighlights}
4682    unbolden
4683    unmarkmatches
4684    if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
4685        set findpattern {}
4686    } elseif {$findtype eq [mc "Regexp"]} {
4687        set findpattern $findstring
4688    } else {
4689        set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4690                   $findstring]
4691        set findpattern "*$e*"
4692    }
4693}
4694
4695proc makepatterns {l} {
4696    set ret {}
4697    foreach e $l {
4698        set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4699        if {[string index $ee end] eq "/"} {
4700            lappend ret "$ee*"
4701        } else {
4702            lappend ret $ee
4703            lappend ret "$ee/*"
4704        }
4705    }
4706    return $ret
4707}
4708
4709proc do_file_hl {serial} {
4710    global highlight_files filehighlight highlight_paths gdttype fhl_list
4711    global cdup findtype
4712
4713    if {$gdttype eq [mc "touching paths:"]} {
4714        # If "exact" match then convert backslashes to forward slashes.
4715        # Most useful to support Windows-flavoured file paths.
4716        if {$findtype eq [mc "Exact"]} {
4717            set highlight_files [string map {"\\" "/"} $highlight_files]
4718        }
4719        if {[catch {set paths [shellsplit $highlight_files]}]} return
4720        set highlight_paths [makepatterns $paths]
4721        highlight_filelist
4722        set relative_paths {}
4723        foreach path $paths {
4724            lappend relative_paths [file join $cdup $path]
4725        }
4726        set gdtargs [concat -- $relative_paths]
4727    } elseif {$gdttype eq [mc "adding/removing string:"]} {
4728        set gdtargs [list "-S$highlight_files"]
4729    } elseif {$gdttype eq [mc "changing lines matching:"]} {
4730        set gdtargs [list "-G$highlight_files"]
4731    } else {
4732        # must be "containing:", i.e. we're searching commit info
4733        return
4734    }
4735    set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
4736    set filehighlight [open $cmd r+]
4737    fconfigure $filehighlight -blocking 0
4738    filerun $filehighlight readfhighlight
4739    set fhl_list {}
4740    drawvisible
4741    flushhighlights
4742}
4743
4744proc flushhighlights {} {
4745    global filehighlight fhl_list
4746
4747    if {[info exists filehighlight]} {
4748        lappend fhl_list {}
4749        puts $filehighlight ""
4750        flush $filehighlight
4751    }
4752}
4753
4754proc askfilehighlight {row id} {
4755    global filehighlight fhighlights fhl_list
4756
4757    lappend fhl_list $id
4758    set fhighlights($id) -1
4759    puts $filehighlight $id
4760}
4761
4762proc readfhighlight {} {
4763    global filehighlight fhighlights curview iddrawn
4764    global fhl_list find_dirn
4765
4766    if {![info exists filehighlight]} {
4767        return 0
4768    }
4769    set nr 0
4770    while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4771        set line [string trim $line]
4772        set i [lsearch -exact $fhl_list $line]
4773        if {$i < 0} continue
4774        for {set j 0} {$j < $i} {incr j} {
4775            set id [lindex $fhl_list $j]
4776            set fhighlights($id) 0
4777        }
4778        set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4779        if {$line eq {}} continue
4780        if {![commitinview $line $curview]} continue
4781        if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4782            bolden $line mainfontbold
4783        }
4784        set fhighlights($line) 1
4785    }
4786    if {[eof $filehighlight]} {
4787        # strange...
4788        puts "oops, git diff-tree died"
4789        catch {close $filehighlight}
4790        unset filehighlight
4791        return 0
4792    }
4793    if {[info exists find_dirn]} {
4794        run findmore
4795    }
4796    return 1
4797}
4798
4799proc doesmatch {f} {
4800    global findtype findpattern
4801
4802    if {$findtype eq [mc "Regexp"]} {
4803        return [regexp $findpattern $f]
4804    } elseif {$findtype eq [mc "IgnCase"]} {
4805        return [string match -nocase $findpattern $f]
4806    } else {
4807        return [string match $findpattern $f]
4808    }
4809}
4810
4811proc askfindhighlight {row id} {
4812    global nhighlights commitinfo iddrawn
4813    global findloc
4814    global markingmatches
4815
4816    if {![info exists commitinfo($id)]} {
4817        getcommit $id
4818    }
4819    set info $commitinfo($id)
4820    set isbold 0
4821    set fldtypes [list [mc Headline] [mc Author] "" [mc Committer] "" [mc Comments]]
4822    foreach f $info ty $fldtypes {
4823        if {$ty eq ""} continue
4824        if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4825            [doesmatch $f]} {
4826            if {$ty eq [mc "Author"]} {
4827                set isbold 2
4828                break
4829            }
4830            set isbold 1
4831        }
4832    }
4833    if {$isbold && [info exists iddrawn($id)]} {
4834        if {![ishighlighted $id]} {
4835            bolden $id mainfontbold
4836            if {$isbold > 1} {
4837                bolden_name $id mainfontbold
4838            }
4839        }
4840        if {$markingmatches} {
4841            markrowmatches $row $id
4842        }
4843    }
4844    set nhighlights($id) $isbold
4845}
4846
4847proc markrowmatches {row id} {
4848    global canv canv2 linehtag linentag commitinfo findloc
4849
4850    set headline [lindex $commitinfo($id) 0]
4851    set author [lindex $commitinfo($id) 1]
4852    $canv delete match$row
4853    $canv2 delete match$row
4854    if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4855        set m [findmatches $headline]
4856        if {$m ne {}} {
4857            markmatches $canv $row $headline $linehtag($id) $m \
4858                [$canv itemcget $linehtag($id) -font] $row
4859        }
4860    }
4861    if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4862        set m [findmatches $author]
4863        if {$m ne {}} {
4864            markmatches $canv2 $row $author $linentag($id) $m \
4865                [$canv2 itemcget $linentag($id) -font] $row
4866        }
4867    }
4868}
4869
4870proc vrel_change {name ix op} {
4871    global highlight_related
4872
4873    rhighlight_none
4874    if {$highlight_related ne [mc "None"]} {
4875        run drawvisible
4876    }
4877}
4878
4879# prepare for testing whether commits are descendents or ancestors of a
4880proc rhighlight_sel {a} {
4881    global descendent desc_todo ancestor anc_todo
4882    global highlight_related
4883
4884    catch {unset descendent}
4885    set desc_todo [list $a]
4886    catch {unset ancestor}
4887    set anc_todo [list $a]
4888    if {$highlight_related ne [mc "None"]} {
4889        rhighlight_none
4890        run drawvisible
4891    }
4892}
4893
4894proc rhighlight_none {} {
4895    global rhighlights
4896
4897    catch {unset rhighlights}
4898    unbolden
4899}
4900
4901proc is_descendent {a} {
4902    global curview children descendent desc_todo
4903
4904    set v $curview
4905    set la [rowofcommit $a]
4906    set todo $desc_todo
4907    set leftover {}
4908    set done 0
4909    for {set i 0} {$i < [llength $todo]} {incr i} {
4910        set do [lindex $todo $i]
4911        if {[rowofcommit $do] < $la} {
4912            lappend leftover $do
4913            continue
4914        }
4915        foreach nk $children($v,$do) {
4916            if {![info exists descendent($nk)]} {
4917                set descendent($nk) 1
4918                lappend todo $nk
4919                if {$nk eq $a} {
4920                    set done 1
4921                }
4922            }
4923        }
4924        if {$done} {
4925            set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4926            return
4927        }
4928    }
4929    set descendent($a) 0
4930    set desc_todo $leftover
4931}
4932
4933proc is_ancestor {a} {
4934    global curview parents ancestor anc_todo
4935
4936    set v $curview
4937    set la [rowofcommit $a]
4938    set todo $anc_todo
4939    set leftover {}
4940    set done 0
4941    for {set i 0} {$i < [llength $todo]} {incr i} {
4942        set do [lindex $todo $i]
4943        if {![commitinview $do $v] || [rowofcommit $do] > $la} {
4944            lappend leftover $do
4945            continue
4946        }
4947        foreach np $parents($v,$do) {
4948            if {![info exists ancestor($np)]} {
4949                set ancestor($np) 1
4950                lappend todo $np
4951                if {$np eq $a} {
4952                    set done 1
4953                }
4954            }
4955        }
4956        if {$done} {
4957            set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4958            return
4959        }
4960    }
4961    set ancestor($a) 0
4962    set anc_todo $leftover
4963}
4964
4965proc askrelhighlight {row id} {
4966    global descendent highlight_related iddrawn rhighlights
4967    global selectedline ancestor
4968
4969    if {$selectedline eq {}} return
4970    set isbold 0
4971    if {$highlight_related eq [mc "Descendant"] ||
4972        $highlight_related eq [mc "Not descendant"]} {
4973        if {![info exists descendent($id)]} {
4974            is_descendent $id
4975        }
4976        if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
4977            set isbold 1
4978        }
4979    } elseif {$highlight_related eq [mc "Ancestor"] ||
4980              $highlight_related eq [mc "Not ancestor"]} {
4981        if {![info exists ancestor($id)]} {
4982            is_ancestor $id
4983        }
4984        if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
4985            set isbold 1
4986        }
4987    }
4988    if {[info exists iddrawn($id)]} {
4989        if {$isbold && ![ishighlighted $id]} {
4990            bolden $id mainfontbold
4991        }
4992    }
4993    set rhighlights($id) $isbold
4994}
4995
4996# Graph layout functions
4997
4998proc shortids {ids} {
4999    set res {}
5000    foreach id $ids {
5001        if {[llength $id] > 1} {
5002            lappend res [shortids $id]
5003        } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
5004            lappend res [string range $id 0 7]
5005        } else {
5006            lappend res $id
5007        }
5008    }
5009    return $res
5010}
5011
5012proc ntimes {n o} {
5013    set ret {}
5014    set o [list $o]
5015    for {set mask 1} {$mask <= $n} {incr mask $mask} {
5016        if {($n & $mask) != 0} {
5017            set ret [concat $ret $o]
5018        }
5019        set o [concat $o $o]
5020    }
5021    return $ret
5022}
5023
5024proc ordertoken {id} {
5025    global ordertok curview varcid varcstart varctok curview parents children
5026    global nullid nullid2
5027
5028    if {[info exists ordertok($id)]} {
5029        return $ordertok($id)
5030    }
5031    set origid $id
5032    set todo {}
5033    while {1} {
5034        if {[info exists varcid($curview,$id)]} {
5035            set a $varcid($curview,$id)
5036            set p [lindex $varcstart($curview) $a]
5037        } else {
5038            set p [lindex $children($curview,$id) 0]
5039        }
5040        if {[info exists ordertok($p)]} {
5041            set tok $ordertok($p)
5042            break
5043        }
5044        set id [first_real_child $curview,$p]
5045        if {$id eq {}} {
5046            # it's a root
5047            set tok [lindex $varctok($curview) $varcid($curview,$p)]
5048            break
5049        }
5050        if {[llength $parents($curview,$id)] == 1} {
5051            lappend todo [list $p {}]
5052        } else {
5053            set j [lsearch -exact $parents($curview,$id) $p]
5054            if {$j < 0} {
5055                puts "oops didn't find [shortids $p] in parents of [shortids $id]"
5056            }
5057            lappend todo [list $p [strrep $j]]
5058        }
5059    }
5060    for {set i [llength $todo]} {[incr i -1] >= 0} {} {
5061        set p [lindex $todo $i 0]
5062        append tok [lindex $todo $i 1]
5063        set ordertok($p) $tok
5064    }
5065    set ordertok($origid) $tok
5066    return $tok
5067}
5068
5069# Work out where id should go in idlist so that order-token
5070# values increase from left to right
5071proc idcol {idlist id {i 0}} {
5072    set t [ordertoken $id]
5073    if {$i < 0} {
5074        set i 0
5075    }
5076    if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
5077        if {$i > [llength $idlist]} {
5078            set i [llength $idlist]
5079        }
5080        while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
5081        incr i
5082    } else {
5083        if {$t > [ordertoken [lindex $idlist $i]]} {
5084            while {[incr i] < [llength $idlist] &&
5085                   $t >= [ordertoken [lindex $idlist $i]]} {}
5086        }
5087    }
5088    return $i
5089}
5090
5091proc initlayout {} {
5092    global rowidlist rowisopt rowfinal displayorder parentlist
5093    global numcommits canvxmax canv
5094    global nextcolor
5095    global colormap rowtextx
5096
5097    set numcommits 0
5098    set displayorder {}
5099    set parentlist {}
5100    set nextcolor 0
5101    set rowidlist {}
5102    set rowisopt {}
5103    set rowfinal {}
5104    set canvxmax [$canv cget -width]
5105    catch {unset colormap}
5106    catch {unset rowtextx}
5107    setcanvscroll
5108}
5109
5110proc setcanvscroll {} {
5111    global canv canv2 canv3 numcommits linespc canvxmax canvy0
5112    global lastscrollset lastscrollrows
5113
5114    set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
5115    $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
5116    $canv2 conf -scrollregion [list 0 0 0 $ymax]
5117    $canv3 conf -scrollregion [list 0 0 0 $ymax]
5118    set lastscrollset [clock clicks -milliseconds]
5119    set lastscrollrows $numcommits
5120}
5121
5122proc visiblerows {} {
5123    global canv numcommits linespc
5124
5125    set ymax [lindex [$canv cget -scrollregion] 3]
5126    if {$ymax eq {} || $ymax == 0} return
5127    set f [$canv yview]
5128    set y0 [expr {int([lindex $f 0] * $ymax)}]
5129    set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
5130    if {$r0 < 0} {
5131        set r0 0
5132    }
5133    set y1 [expr {int([lindex $f 1] * $ymax)}]
5134    set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
5135    if {$r1 >= $numcommits} {
5136        set r1 [expr {$numcommits - 1}]
5137    }
5138    return [list $r0 $r1]
5139}
5140
5141proc layoutmore {} {
5142    global commitidx viewcomplete curview
5143    global numcommits pending_select curview
5144    global lastscrollset lastscrollrows
5145
5146    if {$lastscrollrows < 100 || $viewcomplete($curview) ||
5147        [clock clicks -milliseconds] - $lastscrollset > 500} {
5148        setcanvscroll
5149    }
5150    if {[info exists pending_select] &&
5151        [commitinview $pending_select $curview]} {
5152        update
5153        selectline [rowofcommit $pending_select] 1
5154    }
5155    drawvisible
5156}
5157
5158# With path limiting, we mightn't get the actual HEAD commit,
5159# so ask git rev-list what is the first ancestor of HEAD that
5160# touches a file in the path limit.
5161proc get_viewmainhead {view} {
5162    global viewmainheadid vfilelimit viewinstances mainheadid
5163
5164    catch {
5165        set rfd [open [concat | git rev-list -1 $mainheadid \
5166                           -- $vfilelimit($view)] r]
5167        set j [reg_instance $rfd]
5168        lappend viewinstances($view) $j
5169        fconfigure $rfd -blocking 0
5170        filerun $rfd [list getviewhead $rfd $j $view]
5171        set viewmainheadid($curview) {}
5172    }
5173}
5174
5175# git rev-list should give us just 1 line to use as viewmainheadid($view)
5176proc getviewhead {fd inst view} {
5177    global viewmainheadid commfd curview viewinstances showlocalchanges
5178
5179    set id {}
5180    if {[gets $fd line] < 0} {
5181        if {![eof $fd]} {
5182            return 1
5183        }
5184    } elseif {[string length $line] == 40 && [string is xdigit $line]} {
5185        set id $line
5186    }
5187    set viewmainheadid($view) $id
5188    close $fd
5189    unset commfd($inst)
5190    set i [lsearch -exact $viewinstances($view) $inst]
5191    if {$i >= 0} {
5192        set viewinstances($view) [lreplace $viewinstances($view) $i $i]
5193    }
5194    if {$showlocalchanges && $id ne {} && $view == $curview} {
5195        doshowlocalchanges
5196    }
5197    return 0
5198}
5199
5200proc doshowlocalchanges {} {
5201    global curview viewmainheadid
5202
5203    if {$viewmainheadid($curview) eq {}} return
5204    if {[commitinview $viewmainheadid($curview) $curview]} {
5205        dodiffindex
5206    } else {
5207        interestedin $viewmainheadid($curview) dodiffindex
5208    }
5209}
5210
5211proc dohidelocalchanges {} {
5212    global nullid nullid2 lserial curview
5213
5214    if {[commitinview $nullid $curview]} {
5215        removefakerow $nullid
5216    }
5217    if {[commitinview $nullid2 $curview]} {
5218        removefakerow $nullid2
5219    }
5220    incr lserial
5221}
5222
5223# spawn off a process to do git diff-index --cached HEAD
5224proc dodiffindex {} {
5225    global lserial showlocalchanges vfilelimit curview
5226    global hasworktree git_version
5227
5228    if {!$showlocalchanges || !$hasworktree} return
5229    incr lserial
5230    if {[package vcompare $git_version "1.7.2"] >= 0} {
5231        set cmd "|git diff-index --cached --ignore-submodules=dirty HEAD"
5232    } else {
5233        set cmd "|git diff-index --cached HEAD"
5234    }
5235    if {$vfilelimit($curview) ne {}} {
5236        set cmd [concat $cmd -- $vfilelimit($curview)]
5237    }
5238    set fd [open $cmd r]
5239    fconfigure $fd -blocking 0
5240    set i [reg_instance $fd]
5241    filerun $fd [list readdiffindex $fd $lserial $i]
5242}
5243
5244proc readdiffindex {fd serial inst} {
5245    global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
5246    global vfilelimit
5247
5248    set isdiff 1
5249    if {[gets $fd line] < 0} {
5250        if {![eof $fd]} {
5251            return 1
5252        }
5253        set isdiff 0
5254    }
5255    # we only need to see one line and we don't really care what it says...
5256    stop_instance $inst
5257
5258    if {$serial != $lserial} {
5259        return 0
5260    }
5261
5262    # now see if there are any local changes not checked in to the index
5263    set cmd "|git diff-files"
5264    if {$vfilelimit($curview) ne {}} {
5265        set cmd [concat $cmd -- $vfilelimit($curview)]
5266    }
5267    set fd [open $cmd r]
5268    fconfigure $fd -blocking 0
5269    set i [reg_instance $fd]
5270    filerun $fd [list readdifffiles $fd $serial $i]
5271
5272    if {$isdiff && ![commitinview $nullid2 $curview]} {
5273        # add the line for the changes in the index to the graph
5274        set hl [mc "Local changes checked in to index but not committed"]
5275        set commitinfo($nullid2) [list  $hl {} {} {} {} "    $hl\n"]
5276        set commitdata($nullid2) "\n    $hl\n"
5277        if {[commitinview $nullid $curview]} {
5278            removefakerow $nullid
5279        }
5280        insertfakerow $nullid2 $viewmainheadid($curview)
5281    } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
5282        if {[commitinview $nullid $curview]} {
5283            removefakerow $nullid
5284        }
5285        removefakerow $nullid2
5286    }
5287    return 0
5288}
5289
5290proc readdifffiles {fd serial inst} {
5291    global viewmainheadid nullid nullid2 curview
5292    global commitinfo commitdata lserial
5293
5294    set isdiff 1
5295    if {[gets $fd line] < 0} {
5296        if {![eof $fd]} {
5297            return 1
5298        }
5299        set isdiff 0
5300    }
5301    # we only need to see one line and we don't really care what it says...
5302    stop_instance $inst
5303
5304    if {$serial != $lserial} {
5305        return 0
5306    }
5307
5308    if {$isdiff && ![commitinview $nullid $curview]} {
5309        # add the line for the local diff to the graph
5310        set hl [mc "Local uncommitted changes, not checked in to index"]
5311        set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
5312        set commitdata($nullid) "\n    $hl\n"
5313        if {[commitinview $nullid2 $curview]} {
5314            set p $nullid2
5315        } else {
5316            set p $viewmainheadid($curview)
5317        }
5318        insertfakerow $nullid $p
5319    } elseif {!$isdiff && [commitinview $nullid $curview]} {
5320        removefakerow $nullid
5321    }
5322    return 0
5323}
5324
5325proc nextuse {id row} {
5326    global curview children
5327
5328    if {[info exists children($curview,$id)]} {
5329        foreach kid $children($curview,$id) {
5330            if {![commitinview $kid $curview]} {
5331                return -1
5332            }
5333            if {[rowofcommit $kid] > $row} {
5334                return [rowofcommit $kid]
5335            }
5336        }
5337    }
5338    if {[commitinview $id $curview]} {
5339        return [rowofcommit $id]
5340    }
5341    return -1
5342}
5343
5344proc prevuse {id row} {
5345    global curview children
5346
5347    set ret -1
5348    if {[info exists children($curview,$id)]} {
5349        foreach kid $children($curview,$id) {
5350            if {![commitinview $kid $curview]} break
5351            if {[rowofcommit $kid] < $row} {
5352                set ret [rowofcommit $kid]
5353            }
5354        }
5355    }
5356    return $ret
5357}
5358
5359proc make_idlist {row} {
5360    global displayorder parentlist uparrowlen downarrowlen mingaplen
5361    global commitidx curview children
5362
5363    set r [expr {$row - $mingaplen - $downarrowlen - 1}]
5364    if {$r < 0} {
5365        set r 0
5366    }
5367    set ra [expr {$row - $downarrowlen}]
5368    if {$ra < 0} {
5369        set ra 0
5370    }
5371    set rb [expr {$row + $uparrowlen}]
5372    if {$rb > $commitidx($curview)} {
5373        set rb $commitidx($curview)
5374    }
5375    make_disporder $r [expr {$rb + 1}]
5376    set ids {}
5377    for {} {$r < $ra} {incr r} {
5378        set nextid [lindex $displayorder [expr {$r + 1}]]
5379        foreach p [lindex $parentlist $r] {
5380            if {$p eq $nextid} continue
5381            set rn [nextuse $p $r]
5382            if {$rn >= $row &&
5383                $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
5384                lappend ids [list [ordertoken $p] $p]
5385            }
5386        }
5387    }
5388    for {} {$r < $row} {incr r} {
5389        set nextid [lindex $displayorder [expr {$r + 1}]]
5390        foreach p [lindex $parentlist $r] {
5391            if {$p eq $nextid} continue
5392            set rn [nextuse $p $r]
5393            if {$rn < 0 || $rn >= $row} {
5394                lappend ids [list [ordertoken $p] $p]
5395            }
5396        }
5397    }
5398    set id [lindex $displayorder $row]
5399    lappend ids [list [ordertoken $id] $id]
5400    while {$r < $rb} {
5401        foreach p [lindex $parentlist $r] {
5402            set firstkid [lindex $children($curview,$p) 0]
5403            if {[rowofcommit $firstkid] < $row} {
5404                lappend ids [list [ordertoken $p] $p]
5405            }
5406        }
5407        incr r
5408        set id [lindex $displayorder $r]
5409        if {$id ne {}} {
5410            set firstkid [lindex $children($curview,$id) 0]
5411            if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
5412                lappend ids [list [ordertoken $id] $id]
5413            }
5414        }
5415    }
5416    set idlist {}
5417    foreach idx [lsort -unique $ids] {
5418        lappend idlist [lindex $idx 1]
5419    }
5420    return $idlist
5421}
5422
5423proc rowsequal {a b} {
5424    while {[set i [lsearch -exact $a {}]] >= 0} {
5425        set a [lreplace $a $i $i]
5426    }
5427    while {[set i [lsearch -exact $b {}]] >= 0} {
5428        set b [lreplace $b $i $i]
5429    }
5430    return [expr {$a eq $b}]
5431}
5432
5433proc makeupline {id row rend col} {
5434    global rowidlist uparrowlen downarrowlen mingaplen
5435
5436    for {set r $rend} {1} {set r $rstart} {
5437        set rstart [prevuse $id $r]
5438        if {$rstart < 0} return
5439        if {$rstart < $row} break
5440    }
5441    if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5442        set rstart [expr {$rend - $uparrowlen - 1}]
5443    }
5444    for {set r $rstart} {[incr r] <= $row} {} {
5445        set idlist [lindex $rowidlist $r]
5446        if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5447            set col [idcol $idlist $id $col]
5448            lset rowidlist $r [linsert $idlist $col $id]
5449            changedrow $r
5450        }
5451    }
5452}
5453
5454proc layoutrows {row endrow} {
5455    global rowidlist rowisopt rowfinal displayorder
5456    global uparrowlen downarrowlen maxwidth mingaplen
5457    global children parentlist
5458    global commitidx viewcomplete curview
5459
5460    make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
5461    set idlist {}
5462    if {$row > 0} {
5463        set rm1 [expr {$row - 1}]
5464        foreach id [lindex $rowidlist $rm1] {
5465            if {$id ne {}} {
5466                lappend idlist $id
5467            }
5468        }
5469        set final [lindex $rowfinal $rm1]
5470    }
5471    for {} {$row < $endrow} {incr row} {
5472        set rm1 [expr {$row - 1}]
5473        if {$rm1 < 0 || $idlist eq {}} {
5474            set idlist [make_idlist $row]
5475            set final 1
5476        } else {
5477            set id [lindex $displayorder $rm1]
5478            set col [lsearch -exact $idlist $id]
5479            set idlist [lreplace $idlist $col $col]
5480            foreach p [lindex $parentlist $rm1] {
5481                if {[lsearch -exact $idlist $p] < 0} {
5482                    set col [idcol $idlist $p $col]
5483                    set idlist [linsert $idlist $col $p]
5484                    # if not the first child, we have to insert a line going up
5485                    if {$id ne [lindex $children($curview,$p) 0]} {
5486                        makeupline $p $rm1 $row $col
5487                    }
5488                }
5489            }
5490            set id [lindex $displayorder $row]
5491            if {$row > $downarrowlen} {
5492                set termrow [expr {$row - $downarrowlen - 1}]
5493                foreach p [lindex $parentlist $termrow] {
5494                    set i [lsearch -exact $idlist $p]
5495                    if {$i < 0} continue
5496                    set nr [nextuse $p $termrow]
5497                    if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5498                        set idlist [lreplace $idlist $i $i]
5499                    }
5500                }
5501            }
5502            set col [lsearch -exact $idlist $id]
5503            if {$col < 0} {
5504                set col [idcol $idlist $id]
5505                set idlist [linsert $idlist $col $id]
5506                if {$children($curview,$id) ne {}} {
5507                    makeupline $id $rm1 $row $col
5508                }
5509            }
5510            set r [expr {$row + $uparrowlen - 1}]
5511            if {$r < $commitidx($curview)} {
5512                set x $col
5513                foreach p [lindex $parentlist $r] {
5514                    if {[lsearch -exact $idlist $p] >= 0} continue
5515                    set fk [lindex $children($curview,$p) 0]
5516                    if {[rowofcommit $fk] < $row} {
5517                        set x [idcol $idlist $p $x]
5518                        set idlist [linsert $idlist $x $p]
5519                    }
5520                }
5521                if {[incr r] < $commitidx($curview)} {
5522                    set p [lindex $displayorder $r]
5523                    if {[lsearch -exact $idlist $p] < 0} {
5524                        set fk [lindex $children($curview,$p) 0]
5525                        if {$fk ne {} && [rowofcommit $fk] < $row} {
5526                            set x [idcol $idlist $p $x]
5527                            set idlist [linsert $idlist $x $p]
5528                        }
5529                    }
5530                }
5531            }
5532        }
5533        if {$final && !$viewcomplete($curview) &&
5534            $row + $uparrowlen + $mingaplen + $downarrowlen
5535                >= $commitidx($curview)} {
5536            set final 0
5537        }
5538        set l [llength $rowidlist]
5539        if {$row == $l} {
5540            lappend rowidlist $idlist
5541            lappend rowisopt 0
5542            lappend rowfinal $final
5543        } elseif {$row < $l} {
5544            if {![rowsequal $idlist [lindex $rowidlist $row]]} {
5545                lset rowidlist $row $idlist
5546                changedrow $row
5547            }
5548            lset rowfinal $row $final
5549        } else {
5550            set pad [ntimes [expr {$row - $l}] {}]
5551            set rowidlist [concat $rowidlist $pad]
5552            lappend rowidlist $idlist
5553            set rowfinal [concat $rowfinal $pad]
5554            lappend rowfinal $final
5555            set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5556        }
5557    }
5558    return $row
5559}
5560
5561proc changedrow {row} {
5562    global displayorder iddrawn rowisopt need_redisplay
5563
5564    set l [llength $rowisopt]
5565    if {$row < $l} {
5566        lset rowisopt $row 0
5567        if {$row + 1 < $l} {
5568            lset rowisopt [expr {$row + 1}] 0
5569            if {$row + 2 < $l} {
5570                lset rowisopt [expr {$row + 2}] 0
5571            }
5572        }
5573    }
5574    set id [lindex $displayorder $row]
5575    if {[info exists iddrawn($id)]} {
5576        set need_redisplay 1
5577    }
5578}
5579
5580proc insert_pad {row col npad} {
5581    global rowidlist
5582
5583    set pad [ntimes $npad {}]
5584    set idlist [lindex $rowidlist $row]
5585    set bef [lrange $idlist 0 [expr {$col - 1}]]
5586    set aft [lrange $idlist $col end]
5587    set i [lsearch -exact $aft {}]
5588    if {$i > 0} {
5589        set aft [lreplace $aft $i $i]
5590    }
5591    lset rowidlist $row [concat $bef $pad $aft]
5592    changedrow $row
5593}
5594
5595proc optimize_rows {row col endrow} {
5596    global rowidlist rowisopt displayorder curview children
5597
5598    if {$row < 1} {
5599        set row 1
5600    }
5601    for {} {$row < $endrow} {incr row; set col 0} {
5602        if {[lindex $rowisopt $row]} continue
5603        set haspad 0
5604        set y0 [expr {$row - 1}]
5605        set ym [expr {$row - 2}]
5606        set idlist [lindex $rowidlist $row]
5607        set previdlist [lindex $rowidlist $y0]
5608        if {$idlist eq {} || $previdlist eq {}} continue
5609        if {$ym >= 0} {
5610            set pprevidlist [lindex $rowidlist $ym]
5611            if {$pprevidlist eq {}} continue
5612        } else {
5613            set pprevidlist {}
5614        }
5615        set x0 -1
5616        set xm -1
5617        for {} {$col < [llength $idlist]} {incr col} {
5618            set id [lindex $idlist $col]
5619            if {[lindex $previdlist $col] eq $id} continue
5620            if {$id eq {}} {
5621                set haspad 1
5622                continue
5623            }
5624            set x0 [lsearch -exact $previdlist $id]
5625            if {$x0 < 0} continue
5626            set z [expr {$x0 - $col}]
5627            set isarrow 0
5628            set z0 {}
5629            if {$ym >= 0} {
5630                set xm [lsearch -exact $pprevidlist $id]
5631                if {$xm >= 0} {
5632                    set z0 [expr {$xm - $x0}]
5633                }
5634            }
5635            if {$z0 eq {}} {
5636                # if row y0 is the first child of $id then it's not an arrow
5637                if {[lindex $children($curview,$id) 0] ne
5638                    [lindex $displayorder $y0]} {
5639                    set isarrow 1
5640                }
5641            }
5642            if {!$isarrow && $id ne [lindex $displayorder $row] &&
5643                [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5644                set isarrow 1
5645            }
5646            # Looking at lines from this row to the previous row,
5647            # make them go straight up if they end in an arrow on
5648            # the previous row; otherwise make them go straight up
5649            # or at 45 degrees.
5650            if {$z < -1 || ($z < 0 && $isarrow)} {
5651                # Line currently goes left too much;
5652                # insert pads in the previous row, then optimize it
5653                set npad [expr {-1 - $z + $isarrow}]
5654                insert_pad $y0 $x0 $npad
5655                if {$y0 > 0} {
5656                    optimize_rows $y0 $x0 $row
5657                }
5658                set previdlist [lindex $rowidlist $y0]
5659                set x0 [lsearch -exact $previdlist $id]
5660                set z [expr {$x0 - $col}]
5661                if {$z0 ne {}} {
5662                    set pprevidlist [lindex $rowidlist $ym]
5663                    set xm [lsearch -exact $pprevidlist $id]
5664                    set z0 [expr {$xm - $x0}]
5665                }
5666            } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5667                # Line currently goes right too much;
5668                # insert pads in this line
5669                set npad [expr {$z - 1 + $isarrow}]
5670                insert_pad $row $col $npad
5671                set idlist [lindex $rowidlist $row]
5672                incr col $npad
5673                set z [expr {$x0 - $col}]
5674                set haspad 1
5675            }
5676            if {$z0 eq {} && !$isarrow && $ym >= 0} {
5677                # this line links to its first child on row $row-2
5678                set id [lindex $displayorder $ym]
5679                set xc [lsearch -exact $pprevidlist $id]
5680                if {$xc >= 0} {
5681                    set z0 [expr {$xc - $x0}]
5682                }
5683            }
5684            # avoid lines jigging left then immediately right
5685            if {$z0 ne {} && $z < 0 && $z0 > 0} {
5686                insert_pad $y0 $x0 1
5687                incr x0
5688                optimize_rows $y0 $x0 $row
5689                set previdlist [lindex $rowidlist $y0]
5690            }
5691        }
5692        if {!$haspad} {
5693            # Find the first column that doesn't have a line going right
5694            for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5695                set id [lindex $idlist $col]
5696                if {$id eq {}} break
5697                set x0 [lsearch -exact $previdlist $id]
5698                if {$x0 < 0} {
5699                    # check if this is the link to the first child
5700                    set kid [lindex $displayorder $y0]
5701                    if {[lindex $children($curview,$id) 0] eq $kid} {
5702                        # it is, work out offset to child
5703                        set x0 [lsearch -exact $previdlist $kid]
5704                    }
5705                }
5706                if {$x0 <= $col} break
5707            }
5708            # Insert a pad at that column as long as it has a line and
5709            # isn't the last column
5710            if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5711                set idlist [linsert $idlist $col {}]
5712                lset rowidlist $row $idlist
5713                changedrow $row
5714            }
5715        }
5716    }
5717}
5718
5719proc xc {row col} {
5720    global canvx0 linespc
5721    return [expr {$canvx0 + $col * $linespc}]
5722}
5723
5724proc yc {row} {
5725    global canvy0 linespc
5726    return [expr {$canvy0 + $row * $linespc}]
5727}
5728
5729proc linewidth {id} {
5730    global thickerline lthickness
5731
5732    set wid $lthickness
5733    if {[info exists thickerline] && $id eq $thickerline} {
5734        set wid [expr {2 * $lthickness}]
5735    }
5736    return $wid
5737}
5738
5739proc rowranges {id} {
5740    global curview children uparrowlen downarrowlen
5741    global rowidlist
5742
5743    set kids $children($curview,$id)
5744    if {$kids eq {}} {
5745        return {}
5746    }
5747    set ret {}
5748    lappend kids $id
5749    foreach child $kids {
5750        if {![commitinview $child $curview]} break
5751        set row [rowofcommit $child]
5752        if {![info exists prev]} {
5753            lappend ret [expr {$row + 1}]
5754        } else {
5755            if {$row <= $prevrow} {
5756                puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5757            }
5758            # see if the line extends the whole way from prevrow to row
5759            if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5760                [lsearch -exact [lindex $rowidlist \
5761                            [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5762                # it doesn't, see where it ends
5763                set r [expr {$prevrow + $downarrowlen}]
5764                if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5765                    while {[incr r -1] > $prevrow &&
5766                           [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5767                } else {
5768                    while {[incr r] <= $row &&
5769                           [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5770                    incr r -1
5771                }
5772                lappend ret $r
5773                # see where it starts up again
5774                set r [expr {$row - $uparrowlen}]
5775                if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5776                    while {[incr r] < $row &&
5777                           [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5778                } else {
5779                    while {[incr r -1] >= $prevrow &&
5780                           [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5781                    incr r
5782                }
5783                lappend ret $r
5784            }
5785        }
5786        if {$child eq $id} {
5787            lappend ret $row
5788        }
5789        set prev $child
5790        set prevrow $row
5791    }
5792    return $ret
5793}
5794
5795proc drawlineseg {id row endrow arrowlow} {
5796    global rowidlist displayorder iddrawn linesegs
5797    global canv colormap linespc curview maxlinelen parentlist
5798
5799    set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5800    set le [expr {$row + 1}]
5801    set arrowhigh 1
5802    while {1} {
5803        set c [lsearch -exact [lindex $rowidlist $le] $id]
5804        if {$c < 0} {
5805            incr le -1
5806            break
5807        }
5808        lappend cols $c
5809        set x [lindex $displayorder $le]
5810        if {$x eq $id} {
5811            set arrowhigh 0
5812            break
5813        }
5814        if {[info exists iddrawn($x)] || $le == $endrow} {
5815            set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5816            if {$c >= 0} {
5817                lappend cols $c
5818                set arrowhigh 0
5819            }
5820            break
5821        }
5822        incr le
5823    }
5824    if {$le <= $row} {
5825        return $row
5826    }
5827
5828    set lines {}
5829    set i 0
5830    set joinhigh 0
5831    if {[info exists linesegs($id)]} {
5832        set lines $linesegs($id)
5833        foreach li $lines {
5834            set r0 [lindex $li 0]
5835            if {$r0 > $row} {
5836                if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5837                    set joinhigh 1
5838                }
5839                break
5840            }
5841            incr i
5842        }
5843    }
5844    set joinlow 0
5845    if {$i > 0} {
5846        set li [lindex $lines [expr {$i-1}]]
5847        set r1 [lindex $li 1]
5848        if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5849            set joinlow 1
5850        }
5851    }
5852
5853    set x [lindex $cols [expr {$le - $row}]]
5854    set xp [lindex $cols [expr {$le - 1 - $row}]]
5855    set dir [expr {$xp - $x}]
5856    if {$joinhigh} {
5857        set ith [lindex $lines $i 2]
5858        set coords [$canv coords $ith]
5859        set ah [$canv itemcget $ith -arrow]
5860        set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5861        set x2 [lindex $cols [expr {$le + 1 - $row}]]
5862        if {$x2 ne {} && $x - $x2 == $dir} {
5863            set coords [lrange $coords 0 end-2]
5864        }
5865    } else {
5866        set coords [list [xc $le $x] [yc $le]]
5867    }
5868    if {$joinlow} {
5869        set itl [lindex $lines [expr {$i-1}] 2]
5870        set al [$canv itemcget $itl -arrow]
5871        set arrowlow [expr {$al eq "last" || $al eq "both"}]
5872    } elseif {$arrowlow} {
5873        if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5874            [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5875            set arrowlow 0
5876        }
5877    }
5878    set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5879    for {set y $le} {[incr y -1] > $row} {} {
5880        set x $xp
5881        set xp [lindex $cols [expr {$y - 1 - $row}]]
5882        set ndir [expr {$xp - $x}]
5883        if {$dir != $ndir || $xp < 0} {
5884            lappend coords [xc $y $x] [yc $y]
5885        }
5886        set dir $ndir
5887    }
5888    if {!$joinlow} {
5889        if {$xp < 0} {
5890            # join parent line to first child
5891            set ch [lindex $displayorder $row]
5892            set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5893            if {$xc < 0} {
5894                puts "oops: drawlineseg: child $ch not on row $row"
5895            } elseif {$xc != $x} {
5896                if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5897                    set d [expr {int(0.5 * $linespc)}]
5898                    set x1 [xc $row $x]
5899                    if {$xc < $x} {
5900                        set x2 [expr {$x1 - $d}]
5901                    } else {
5902                        set x2 [expr {$x1 + $d}]
5903                    }
5904                    set y2 [yc $row]
5905                    set y1 [expr {$y2 + $d}]
5906                    lappend coords $x1 $y1 $x2 $y2
5907                } elseif {$xc < $x - 1} {
5908                    lappend coords [xc $row [expr {$x-1}]] [yc $row]
5909                } elseif {$xc > $x + 1} {
5910                    lappend coords [xc $row [expr {$x+1}]] [yc $row]
5911                }
5912                set x $xc
5913            }
5914            lappend coords [xc $row $x] [yc $row]
5915        } else {
5916            set xn [xc $row $xp]
5917            set yn [yc $row]
5918            lappend coords $xn $yn
5919        }
5920        if {!$joinhigh} {
5921            assigncolor $id
5922            set t [$canv create line $coords -width [linewidth $id] \
5923                       -fill $colormap($id) -tags lines.$id -arrow $arrow]
5924            $canv lower $t
5925            bindline $t $id
5926            set lines [linsert $lines $i [list $row $le $t]]
5927        } else {
5928            $canv coords $ith $coords
5929            if {$arrow ne $ah} {
5930                $canv itemconf $ith -arrow $arrow
5931            }
5932            lset lines $i 0 $row
5933        }
5934    } else {
5935        set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
5936        set ndir [expr {$xo - $xp}]
5937        set clow [$canv coords $itl]
5938        if {$dir == $ndir} {
5939            set clow [lrange $clow 2 end]
5940        }
5941        set coords [concat $coords $clow]
5942        if {!$joinhigh} {
5943            lset lines [expr {$i-1}] 1 $le
5944        } else {
5945            # coalesce two pieces
5946            $canv delete $ith
5947            set b [lindex $lines [expr {$i-1}] 0]
5948            set e [lindex $lines $i 1]
5949            set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
5950        }
5951        $canv coords $itl $coords
5952        if {$arrow ne $al} {
5953            $canv itemconf $itl -arrow $arrow
5954        }
5955    }
5956
5957    set linesegs($id) $lines
5958    return $le
5959}
5960
5961proc drawparentlinks {id row} {
5962    global rowidlist canv colormap curview parentlist
5963    global idpos linespc
5964
5965    set rowids [lindex $rowidlist $row]
5966    set col [lsearch -exact $rowids $id]
5967    if {$col < 0} return
5968    set olds [lindex $parentlist $row]
5969    set row2 [expr {$row + 1}]
5970    set x [xc $row $col]
5971    set y [yc $row]
5972    set y2 [yc $row2]
5973    set d [expr {int(0.5 * $linespc)}]
5974    set ymid [expr {$y + $d}]
5975    set ids [lindex $rowidlist $row2]
5976    # rmx = right-most X coord used
5977    set rmx 0
5978    foreach p $olds {
5979        set i [lsearch -exact $ids $p]
5980        if {$i < 0} {
5981            puts "oops, parent $p of $id not in list"
5982            continue
5983        }
5984        set x2 [xc $row2 $i]
5985        if {$x2 > $rmx} {
5986            set rmx $x2
5987        }
5988        set j [lsearch -exact $rowids $p]
5989        if {$j < 0} {
5990            # drawlineseg will do this one for us
5991            continue
5992        }
5993        assigncolor $p
5994        # should handle duplicated parents here...
5995        set coords [list $x $y]
5996        if {$i != $col} {
5997            # if attaching to a vertical segment, draw a smaller
5998            # slant for visual distinctness
5999            if {$i == $j} {
6000                if {$i < $col} {
6001                    lappend coords [expr {$x2 + $d}] $y $x2 $ymid
6002                } else {
6003                    lappend coords [expr {$x2 - $d}] $y $x2 $ymid
6004                }
6005            } elseif {$i < $col && $i < $j} {
6006                # segment slants towards us already
6007                lappend coords [xc $row $j] $y
6008            } else {
6009                if {$i < $col - 1} {
6010                    lappend coords [expr {$x2 + $linespc}] $y
6011                } elseif {$i > $col + 1} {
6012                    lappend coords [expr {$x2 - $linespc}] $y
6013                }
6014                lappend coords $x2 $y2
6015            }
6016        } else {
6017            lappend coords $x2 $y2
6018        }
6019        set t [$canv create line $coords -width [linewidth $p] \
6020                   -fill $colormap($p) -tags lines.$p]
6021        $canv lower $t
6022        bindline $t $p
6023    }
6024    if {$rmx > [lindex $idpos($id) 1]} {
6025        lset idpos($id) 1 $rmx
6026        redrawtags $id
6027    }
6028}
6029
6030proc drawlines {id} {
6031    global canv
6032
6033    $canv itemconf lines.$id -width [linewidth $id]
6034}
6035
6036proc drawcmittext {id row col} {
6037    global linespc canv canv2 canv3 fgcolor curview
6038    global cmitlisted commitinfo rowidlist parentlist
6039    global rowtextx idpos idtags idheads idotherrefs
6040    global linehtag linentag linedtag selectedline
6041    global canvxmax boldids boldnameids fgcolor markedid
6042    global mainheadid nullid nullid2 circleitem circlecolors ctxbut
6043    global mainheadcirclecolor workingfilescirclecolor indexcirclecolor
6044    global circleoutlinecolor
6045
6046    # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
6047    set listed $cmitlisted($curview,$id)
6048    if {$id eq $nullid} {
6049        set ofill $workingfilescirclecolor
6050    } elseif {$id eq $nullid2} {
6051        set ofill $indexcirclecolor
6052    } elseif {$id eq $mainheadid} {
6053        set ofill $mainheadcirclecolor
6054    } else {
6055        set ofill [lindex $circlecolors $listed]
6056    }
6057    set x [xc $row $col]
6058    set y [yc $row]
6059    set orad [expr {$linespc / 3}]
6060    if {$listed <= 2} {
6061        set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
6062                   [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6063                   -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6064    } elseif {$listed == 3} {
6065        # triangle pointing left for left-side commits
6066        set t [$canv create polygon \
6067                   [expr {$x - $orad}] $y \
6068                   [expr {$x + $orad - 1}] [expr {$y - $orad}] \
6069                   [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6070                   -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6071    } else {
6072        # triangle pointing right for right-side commits
6073        set t [$canv create polygon \
6074                   [expr {$x + $orad - 1}] $y \
6075                   [expr {$x - $orad}] [expr {$y - $orad}] \
6076                   [expr {$x - $orad}] [expr {$y + $orad - 1}] \
6077                   -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6078    }
6079    set circleitem($row) $t
6080    $canv raise $t
6081    $canv bind $t <1> {selcanvline {} %x %y}
6082    set rmx [llength [lindex $rowidlist $row]]
6083    set olds [lindex $parentlist $row]
6084    if {$olds ne {}} {
6085        set nextids [lindex $rowidlist [expr {$row + 1}]]
6086        foreach p $olds {
6087            set i [lsearch -exact $nextids $p]
6088            if {$i > $rmx} {
6089                set rmx $i
6090            }
6091        }
6092    }
6093    set xt [xc $row $rmx]
6094    set rowtextx($row) $xt
6095    set idpos($id) [list $x $xt $y]
6096    if {[info exists idtags($id)] || [info exists idheads($id)]
6097        || [info exists idotherrefs($id)]} {
6098        set xt [drawtags $id $x $xt $y]
6099    }
6100    if {[lindex $commitinfo($id) 6] > 0} {
6101        set xt [drawnotesign $xt $y]
6102    }
6103    set headline [lindex $commitinfo($id) 0]
6104    set name [lindex $commitinfo($id) 1]
6105    set date [lindex $commitinfo($id) 2]
6106    set date [formatdate $date]
6107    set font mainfont
6108    set nfont mainfont
6109    set isbold [ishighlighted $id]
6110    if {$isbold > 0} {
6111        lappend boldids $id
6112        set font mainfontbold
6113        if {$isbold > 1} {
6114            lappend boldnameids $id
6115            set nfont mainfontbold
6116        }
6117    }
6118    set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
6119                           -text $headline -font $font -tags text]
6120    $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
6121    set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
6122                           -text $name -font $nfont -tags text]
6123    set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
6124                           -text $date -font mainfont -tags text]
6125    if {$selectedline == $row} {
6126        make_secsel $id
6127    }
6128    if {[info exists markedid] && $markedid eq $id} {
6129        make_idmark $id
6130    }
6131    set xr [expr {$xt + [font measure $font $headline]}]
6132    if {$xr > $canvxmax} {
6133        set canvxmax $xr
6134        setcanvscroll
6135    }
6136}
6137
6138proc drawcmitrow {row} {
6139    global displayorder rowidlist nrows_drawn
6140    global iddrawn markingmatches
6141    global commitinfo numcommits
6142    global filehighlight fhighlights findpattern nhighlights
6143    global hlview vhighlights
6144    global highlight_related rhighlights
6145
6146    if {$row >= $numcommits} return
6147
6148    set id [lindex $displayorder $row]
6149    if {[info exists hlview] && ![info exists vhighlights($id)]} {
6150        askvhighlight $row $id
6151    }
6152    if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
6153        askfilehighlight $row $id
6154    }
6155    if {$findpattern ne {} && ![info exists nhighlights($id)]} {
6156        askfindhighlight $row $id
6157    }
6158    if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
6159        askrelhighlight $row $id
6160    }
6161    if {![info exists iddrawn($id)]} {
6162        set col [lsearch -exact [lindex $rowidlist $row] $id]
6163        if {$col < 0} {
6164            puts "oops, row $row id $id not in list"
6165            return
6166        }
6167        if {![info exists commitinfo($id)]} {
6168            getcommit $id
6169        }
6170        assigncolor $id
6171        drawcmittext $id $row $col
6172        set iddrawn($id) 1
6173        incr nrows_drawn
6174    }
6175    if {$markingmatches} {
6176        markrowmatches $row $id
6177    }
6178}
6179
6180proc drawcommits {row {endrow {}}} {
6181    global numcommits iddrawn displayorder curview need_redisplay
6182    global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
6183
6184    if {$row < 0} {
6185        set row 0
6186    }
6187    if {$endrow eq {}} {
6188        set endrow $row
6189    }
6190    if {$endrow >= $numcommits} {
6191        set endrow [expr {$numcommits - 1}]
6192    }
6193
6194    set rl1 [expr {$row - $downarrowlen - 3}]
6195    if {$rl1 < 0} {
6196        set rl1 0
6197    }
6198    set ro1 [expr {$row - 3}]
6199    if {$ro1 < 0} {
6200        set ro1 0
6201    }
6202    set r2 [expr {$endrow + $uparrowlen + 3}]
6203    if {$r2 > $numcommits} {
6204        set r2 $numcommits
6205    }
6206    for {set r $rl1} {$r < $r2} {incr r} {
6207        if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
6208            if {$rl1 < $r} {
6209                layoutrows $rl1 $r
6210            }
6211            set rl1 [expr {$r + 1}]
6212        }
6213    }
6214    if {$rl1 < $r} {
6215        layoutrows $rl1 $r
6216    }
6217    optimize_rows $ro1 0 $r2
6218    if {$need_redisplay || $nrows_drawn > 2000} {
6219        clear_display
6220    }
6221
6222    # make the lines join to already-drawn rows either side
6223    set r [expr {$row - 1}]
6224    if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
6225        set r $row
6226    }
6227    set er [expr {$endrow + 1}]
6228    if {$er >= $numcommits ||
6229        ![info exists iddrawn([lindex $displayorder $er])]} {
6230        set er $endrow
6231    }
6232    for {} {$r <= $er} {incr r} {
6233        set id [lindex $displayorder $r]
6234        set wasdrawn [info exists iddrawn($id)]
6235        drawcmitrow $r
6236        if {$r == $er} break
6237        set nextid [lindex $displayorder [expr {$r + 1}]]
6238        if {$wasdrawn && [info exists iddrawn($nextid)]} continue
6239        drawparentlinks $id $r
6240
6241        set rowids [lindex $rowidlist $r]
6242        foreach lid $rowids {
6243            if {$lid eq {}} continue
6244            if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
6245            if {$lid eq $id} {
6246                # see if this is the first child of any of its parents
6247                foreach p [lindex $parentlist $r] {
6248                    if {[lsearch -exact $rowids $p] < 0} {
6249                        # make this line extend up to the child
6250                        set lineend($p) [drawlineseg $p $r $er 0]
6251                    }
6252                }
6253            } else {
6254                set lineend($lid) [drawlineseg $lid $r $er 1]
6255            }
6256        }
6257    }
6258}
6259
6260proc undolayout {row} {
6261    global uparrowlen mingaplen downarrowlen
6262    global rowidlist rowisopt rowfinal need_redisplay
6263
6264    set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
6265    if {$r < 0} {
6266        set r 0
6267    }
6268    if {[llength $rowidlist] > $r} {
6269        incr r -1
6270        set rowidlist [lrange $rowidlist 0 $r]
6271        set rowfinal [lrange $rowfinal 0 $r]
6272        set rowisopt [lrange $rowisopt 0 $r]
6273        set need_redisplay 1
6274        run drawvisible
6275    }
6276}
6277
6278proc drawvisible {} {
6279    global canv linespc curview vrowmod selectedline targetrow targetid
6280    global need_redisplay cscroll numcommits
6281
6282    set fs [$canv yview]
6283    set ymax [lindex [$canv cget -scrollregion] 3]
6284    if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
6285    set f0 [lindex $fs 0]
6286    set f1 [lindex $fs 1]
6287    set y0 [expr {int($f0 * $ymax)}]
6288    set y1 [expr {int($f1 * $ymax)}]
6289
6290    if {[info exists targetid]} {
6291        if {[commitinview $targetid $curview]} {
6292            set r [rowofcommit $targetid]
6293            if {$r != $targetrow} {
6294                # Fix up the scrollregion and change the scrolling position
6295                # now that our target row has moved.
6296                set diff [expr {($r - $targetrow) * $linespc}]
6297                set targetrow $r
6298                setcanvscroll
6299                set ymax [lindex [$canv cget -scrollregion] 3]
6300                incr y0 $diff
6301                incr y1 $diff
6302                set f0 [expr {$y0 / $ymax}]
6303                set f1 [expr {$y1 / $ymax}]
6304                allcanvs yview moveto $f0
6305                $cscroll set $f0 $f1
6306                set need_redisplay 1
6307            }
6308        } else {
6309            unset targetid
6310        }
6311    }
6312
6313    set row [expr {int(($y0 - 3) / $linespc) - 1}]
6314    set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
6315    if {$endrow >= $vrowmod($curview)} {
6316        update_arcrows $curview
6317    }
6318    if {$selectedline ne {} &&
6319        $row <= $selectedline && $selectedline <= $endrow} {
6320        set targetrow $selectedline
6321    } elseif {[info exists targetid]} {
6322        set targetrow [expr {int(($row + $endrow) / 2)}]
6323    }
6324    if {[info exists targetrow]} {
6325        if {$targetrow >= $numcommits} {
6326            set targetrow [expr {$numcommits - 1}]
6327        }
6328        set targetid [commitonrow $targetrow]
6329    }
6330    drawcommits $row $endrow
6331}
6332
6333proc clear_display {} {
6334    global iddrawn linesegs need_redisplay nrows_drawn
6335    global vhighlights fhighlights nhighlights rhighlights
6336    global linehtag linentag linedtag boldids boldnameids
6337
6338    allcanvs delete all
6339    catch {unset iddrawn}
6340    catch {unset linesegs}
6341    catch {unset linehtag}
6342    catch {unset linentag}
6343    catch {unset linedtag}
6344    set boldids {}
6345    set boldnameids {}
6346    catch {unset vhighlights}
6347    catch {unset fhighlights}
6348    catch {unset nhighlights}
6349    catch {unset rhighlights}
6350    set need_redisplay 0
6351    set nrows_drawn 0
6352}
6353
6354proc findcrossings {id} {
6355    global rowidlist parentlist numcommits displayorder
6356
6357    set cross {}
6358    set ccross {}
6359    foreach {s e} [rowranges $id] {
6360        if {$e >= $numcommits} {
6361            set e [expr {$numcommits - 1}]
6362        }
6363        if {$e <= $s} continue
6364        for {set row $e} {[incr row -1] >= $s} {} {
6365            set x [lsearch -exact [lindex $rowidlist $row] $id]
6366            if {$x < 0} break
6367            set olds [lindex $parentlist $row]
6368            set kid [lindex $displayorder $row]
6369            set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
6370            if {$kidx < 0} continue
6371            set nextrow [lindex $rowidlist [expr {$row + 1}]]
6372            foreach p $olds {
6373                set px [lsearch -exact $nextrow $p]
6374                if {$px < 0} continue
6375                if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
6376                    if {[lsearch -exact $ccross $p] >= 0} continue
6377                    if {$x == $px + ($kidx < $px? -1: 1)} {
6378                        lappend ccross $p
6379                    } elseif {[lsearch -exact $cross $p] < 0} {
6380                        lappend cross $p
6381                    }
6382                }
6383            }
6384        }
6385    }
6386    return [concat $ccross {{}} $cross]
6387}
6388
6389proc assigncolor {id} {
6390    global colormap colors nextcolor
6391    global parents children children curview
6392
6393    if {[info exists colormap($id)]} return
6394    set ncolors [llength $colors]
6395    if {[info exists children($curview,$id)]} {
6396        set kids $children($curview,$id)
6397    } else {
6398        set kids {}
6399    }
6400    if {[llength $kids] == 1} {
6401        set child [lindex $kids 0]
6402        if {[info exists colormap($child)]
6403            && [llength $parents($curview,$child)] == 1} {
6404            set colormap($id) $colormap($child)
6405            return
6406        }
6407    }
6408    set badcolors {}
6409    set origbad {}
6410    foreach x [findcrossings $id] {
6411        if {$x eq {}} {
6412            # delimiter between corner crossings and other crossings
6413            if {[llength $badcolors] >= $ncolors - 1} break
6414            set origbad $badcolors
6415        }
6416        if {[info exists colormap($x)]
6417            && [lsearch -exact $badcolors $colormap($x)] < 0} {
6418            lappend badcolors $colormap($x)
6419        }
6420    }
6421    if {[llength $badcolors] >= $ncolors} {
6422        set badcolors $origbad
6423    }
6424    set origbad $badcolors
6425    if {[llength $badcolors] < $ncolors - 1} {
6426        foreach child $kids {
6427            if {[info exists colormap($child)]
6428                && [lsearch -exact $badcolors $colormap($child)] < 0} {
6429                lappend badcolors $colormap($child)
6430            }
6431            foreach p $parents($curview,$child) {
6432                if {[info exists colormap($p)]
6433                    && [lsearch -exact $badcolors $colormap($p)] < 0} {
6434                    lappend badcolors $colormap($p)
6435                }
6436            }
6437        }
6438        if {[llength $badcolors] >= $ncolors} {
6439            set badcolors $origbad
6440        }
6441    }
6442    for {set i 0} {$i <= $ncolors} {incr i} {
6443        set c [lindex $colors $nextcolor]
6444        if {[incr nextcolor] >= $ncolors} {
6445            set nextcolor 0
6446        }
6447        if {[lsearch -exact $badcolors $c]} break
6448    }
6449    set colormap($id) $c
6450}
6451
6452proc bindline {t id} {
6453    global canv
6454
6455    $canv bind $t <Enter> "lineenter %x %y $id"
6456    $canv bind $t <Motion> "linemotion %x %y $id"
6457    $canv bind $t <Leave> "lineleave $id"
6458    $canv bind $t <Button-1> "lineclick %x %y $id 1"
6459}
6460
6461proc graph_pane_width {} {
6462    global use_ttk
6463
6464    if {$use_ttk} {
6465        set g [.tf.histframe.pwclist sashpos 0]
6466    } else {
6467        set g [.tf.histframe.pwclist sash coord 0]
6468    }
6469    return [lindex $g 0]
6470}
6471
6472proc totalwidth {l font extra} {
6473    set tot 0
6474    foreach str $l {
6475        set tot [expr {$tot + [font measure $font $str] + $extra}]
6476    }
6477    return $tot
6478}
6479
6480proc drawtags {id x xt y1} {
6481    global idtags idheads idotherrefs mainhead
6482    global linespc lthickness
6483    global canv rowtextx curview fgcolor bgcolor ctxbut
6484    global headbgcolor headfgcolor headoutlinecolor remotebgcolor
6485    global tagbgcolor tagfgcolor tagoutlinecolor
6486    global reflinecolor
6487
6488    set marks {}
6489    set ntags 0
6490    set nheads 0
6491    set singletag 0
6492    set maxtags 3
6493    set maxtagpct 25
6494    set maxwidth [expr {[graph_pane_width] * $maxtagpct / 100}]
6495    set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6496    set extra [expr {$delta + $lthickness + $linespc}]
6497
6498    if {[info exists idtags($id)]} {
6499        set marks $idtags($id)
6500        set ntags [llength $marks]
6501        if {$ntags > $maxtags ||
6502            [totalwidth $marks mainfont $extra] > $maxwidth} {
6503            # show just a single "n tags..." tag
6504            set singletag 1
6505            if {$ntags == 1} {
6506                set marks [list "tag..."]
6507            } else {
6508                set marks [list [format "%d tags..." $ntags]]
6509            }
6510            set ntags 1
6511        }
6512    }
6513    if {[info exists idheads($id)]} {
6514        set marks [concat $marks $idheads($id)]
6515        set nheads [llength $idheads($id)]
6516    }
6517    if {[info exists idotherrefs($id)]} {
6518        set marks [concat $marks $idotherrefs($id)]
6519    }
6520    if {$marks eq {}} {
6521        return $xt
6522    }
6523
6524    set yt [expr {$y1 - 0.5 * $linespc}]
6525    set yb [expr {$yt + $linespc - 1}]
6526    set xvals {}
6527    set wvals {}
6528    set i -1
6529    foreach tag $marks {
6530        incr i
6531        if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
6532            set wid [font measure mainfontbold $tag]
6533        } else {
6534            set wid [font measure mainfont $tag]
6535        }
6536        lappend xvals $xt
6537        lappend wvals $wid
6538        set xt [expr {$xt + $wid + $extra}]
6539    }
6540    set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
6541               -width $lthickness -fill $reflinecolor -tags tag.$id]
6542    $canv lower $t
6543    foreach tag $marks x $xvals wid $wvals {
6544        set tag_quoted [string map {% %%} $tag]
6545        set xl [expr {$x + $delta}]
6546        set xr [expr {$x + $delta + $wid + $lthickness}]
6547        set font mainfont
6548        if {[incr ntags -1] >= 0} {
6549            # draw a tag
6550            set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6551                       $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
6552                       -width 1 -outline $tagoutlinecolor -fill $tagbgcolor \
6553                       -tags tag.$id]
6554            if {$singletag} {
6555                set tagclick [list showtags $id 1]
6556            } else {
6557                set tagclick [list showtag $tag_quoted 1]
6558            }
6559            $canv bind $t <1> $tagclick
6560            set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
6561        } else {
6562            # draw a head or other ref
6563            if {[incr nheads -1] >= 0} {
6564                set col $headbgcolor
6565                if {$tag eq $mainhead} {
6566                    set font mainfontbold
6567                }
6568            } else {
6569                set col "#ddddff"
6570            }
6571            set xl [expr {$xl - $delta/2}]
6572            $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
6573                -width 1 -outline black -fill $col -tags tag.$id
6574            if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
6575                set rwid [font measure mainfont $remoteprefix]
6576                set xi [expr {$x + 1}]
6577                set yti [expr {$yt + 1}]
6578                set xri [expr {$x + $rwid}]
6579                $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6580                        -width 0 -fill $remotebgcolor -tags tag.$id
6581            }
6582        }
6583        set t [$canv create text $xl $y1 -anchor w -text $tag -fill $headfgcolor \
6584                   -font $font -tags [list tag.$id text]]
6585        if {$ntags >= 0} {
6586            $canv bind $t <1> $tagclick
6587        } elseif {$nheads >= 0} {
6588            $canv bind $t $ctxbut [list headmenu %X %Y $id $tag_quoted]
6589        }
6590    }
6591    return $xt
6592}
6593
6594proc drawnotesign {xt y} {
6595    global linespc canv fgcolor
6596
6597    set orad [expr {$linespc / 3}]
6598    set t [$canv create rectangle [expr {$xt - $orad}] [expr {$y - $orad}] \
6599               [expr {$xt + $orad - 1}] [expr {$y + $orad - 1}] \
6600               -fill yellow -outline $fgcolor -width 1 -tags circle]
6601    set xt [expr {$xt + $orad * 3}]
6602    return $xt
6603}
6604
6605proc xcoord {i level ln} {
6606    global canvx0 xspc1 xspc2
6607
6608    set x [expr {$canvx0 + $i * $xspc1($ln)}]
6609    if {$i > 0 && $i == $level} {
6610        set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6611    } elseif {$i > $level} {
6612        set x [expr {$x + $xspc2 - $xspc1($ln)}]
6613    }
6614    return $x
6615}
6616
6617proc show_status {msg} {
6618    global canv fgcolor
6619
6620    clear_display
6621    $canv create text 3 3 -anchor nw -text $msg -font mainfont \
6622        -tags text -fill $fgcolor
6623}
6624
6625# Don't change the text pane cursor if it is currently the hand cursor,
6626# showing that we are over a sha1 ID link.
6627proc settextcursor {c} {
6628    global ctext curtextcursor
6629
6630    if {[$ctext cget -cursor] == $curtextcursor} {
6631        $ctext config -cursor $c
6632    }
6633    set curtextcursor $c
6634}
6635
6636proc nowbusy {what {name {}}} {
6637    global isbusy busyname statusw
6638
6639    if {[array names isbusy] eq {}} {
6640        . config -cursor watch
6641        settextcursor watch
6642    }
6643    set isbusy($what) 1
6644    set busyname($what) $name
6645    if {$name ne {}} {
6646        $statusw conf -text $name
6647    }
6648}
6649
6650proc notbusy {what} {
6651    global isbusy maincursor textcursor busyname statusw
6652
6653    catch {
6654        unset isbusy($what)
6655        if {$busyname($what) ne {} &&
6656            [$statusw cget -text] eq $busyname($what)} {
6657            $statusw conf -text {}
6658        }
6659    }
6660    if {[array names isbusy] eq {}} {
6661        . config -cursor $maincursor
6662        settextcursor $textcursor
6663    }
6664}
6665
6666proc findmatches {f} {
6667    global findtype findstring
6668    if {$findtype == [mc "Regexp"]} {
6669        set matches [regexp -indices -all -inline $findstring $f]
6670    } else {
6671        set fs $findstring
6672        if {$findtype == [mc "IgnCase"]} {
6673            set f [string tolower $f]
6674            set fs [string tolower $fs]
6675        }
6676        set matches {}
6677        set i 0
6678        set l [string length $fs]
6679        while {[set j [string first $fs $f $i]] >= 0} {
6680            lappend matches [list $j [expr {$j+$l-1}]]
6681            set i [expr {$j + $l}]
6682        }
6683    }
6684    return $matches
6685}
6686
6687proc dofind {{dirn 1} {wrap 1}} {
6688    global findstring findstartline findcurline selectedline numcommits
6689    global gdttype filehighlight fh_serial find_dirn findallowwrap
6690
6691    if {[info exists find_dirn]} {
6692        if {$find_dirn == $dirn} return
6693        stopfinding
6694    }
6695    focus .
6696    if {$findstring eq {} || $numcommits == 0} return
6697    if {$selectedline eq {}} {
6698        set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6699    } else {
6700        set findstartline $selectedline
6701    }
6702    set findcurline $findstartline
6703    nowbusy finding [mc "Searching"]
6704    if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6705        after cancel do_file_hl $fh_serial
6706        do_file_hl $fh_serial
6707    }
6708    set find_dirn $dirn
6709    set findallowwrap $wrap
6710    run findmore
6711}
6712
6713proc stopfinding {} {
6714    global find_dirn findcurline fprogcoord
6715
6716    if {[info exists find_dirn]} {
6717        unset find_dirn
6718        unset findcurline
6719        notbusy finding
6720        set fprogcoord 0
6721        adjustprogress
6722    }
6723    stopblaming
6724}
6725
6726proc findmore {} {
6727    global commitdata commitinfo numcommits findpattern findloc
6728    global findstartline findcurline findallowwrap
6729    global find_dirn gdttype fhighlights fprogcoord
6730    global curview varcorder vrownum varccommits vrowmod
6731
6732    if {![info exists find_dirn]} {
6733        return 0
6734    }
6735    set fldtypes [list [mc "Headline"] [mc "Author"] "" [mc "Committer"] "" [mc "Comments"]]
6736    set l $findcurline
6737    set moretodo 0
6738    if {$find_dirn > 0} {
6739        incr l
6740        if {$l >= $numcommits} {
6741            set l 0
6742        }
6743        if {$l <= $findstartline} {
6744            set lim [expr {$findstartline + 1}]
6745        } else {
6746            set lim $numcommits
6747            set moretodo $findallowwrap
6748        }
6749    } else {
6750        if {$l == 0} {
6751            set l $numcommits
6752        }
6753        incr l -1
6754        if {$l >= $findstartline} {
6755            set lim [expr {$findstartline - 1}]
6756        } else {
6757            set lim -1
6758            set moretodo $findallowwrap
6759        }
6760    }
6761    set n [expr {($lim - $l) * $find_dirn}]
6762    if {$n > 500} {
6763        set n 500
6764        set moretodo 1
6765    }
6766    if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6767        update_arcrows $curview
6768    }
6769    set found 0
6770    set domore 1
6771    set ai [bsearch $vrownum($curview) $l]
6772    set a [lindex $varcorder($curview) $ai]
6773    set arow [lindex $vrownum($curview) $ai]
6774    set ids [lindex $varccommits($curview,$a)]
6775    set arowend [expr {$arow + [llength $ids]}]
6776    if {$gdttype eq [mc "containing:"]} {
6777        for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6778            if {$l < $arow || $l >= $arowend} {
6779                incr ai $find_dirn
6780                set a [lindex $varcorder($curview) $ai]
6781                set arow [lindex $vrownum($curview) $ai]
6782                set ids [lindex $varccommits($curview,$a)]
6783                set arowend [expr {$arow + [llength $ids]}]
6784            }
6785            set id [lindex $ids [expr {$l - $arow}]]
6786            # shouldn't happen unless git log doesn't give all the commits...
6787            if {![info exists commitdata($id)] ||
6788                ![doesmatch $commitdata($id)]} {
6789                continue
6790            }
6791            if {![info exists commitinfo($id)]} {
6792                getcommit $id
6793            }
6794            set info $commitinfo($id)
6795            foreach f $info ty $fldtypes {
6796                if {$ty eq ""} continue
6797                if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6798                    [doesmatch $f]} {
6799                    set found 1
6800                    break
6801                }
6802            }
6803            if {$found} break
6804        }
6805    } else {
6806        for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6807            if {$l < $arow || $l >= $arowend} {
6808                incr ai $find_dirn
6809                set a [lindex $varcorder($curview) $ai]
6810                set arow [lindex $vrownum($curview) $ai]
6811                set ids [lindex $varccommits($curview,$a)]
6812                set arowend [expr {$arow + [llength $ids]}]
6813            }
6814            set id [lindex $ids [expr {$l - $arow}]]
6815            if {![info exists fhighlights($id)]} {
6816                # this sets fhighlights($id) to -1
6817                askfilehighlight $l $id
6818            }
6819            if {$fhighlights($id) > 0} {
6820                set found $domore
6821                break
6822            }
6823            if {$fhighlights($id) < 0} {
6824                if {$domore} {
6825                    set domore 0
6826                    set findcurline [expr {$l - $find_dirn}]
6827                }
6828            }
6829        }
6830    }
6831    if {$found || ($domore && !$moretodo)} {
6832        unset findcurline
6833        unset find_dirn
6834        notbusy finding
6835        set fprogcoord 0
6836        adjustprogress
6837        if {$found} {
6838            findselectline $l
6839        } else {
6840            bell
6841        }
6842        return 0
6843    }
6844    if {!$domore} {
6845        flushhighlights
6846    } else {
6847        set findcurline [expr {$l - $find_dirn}]
6848    }
6849    set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6850    if {$n < 0} {
6851        incr n $numcommits
6852    }
6853    set fprogcoord [expr {$n * 1.0 / $numcommits}]
6854    adjustprogress
6855    return $domore
6856}
6857
6858proc findselectline {l} {
6859    global findloc commentend ctext findcurline markingmatches gdttype
6860
6861    set markingmatches [expr {$gdttype eq [mc "containing:"]}]
6862    set findcurline $l
6863    selectline $l 1
6864    if {$markingmatches &&
6865        ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
6866        # highlight the matches in the comments
6867        set f [$ctext get 1.0 $commentend]
6868        set matches [findmatches $f]
6869        foreach match $matches {
6870            set start [lindex $match 0]
6871            set end [expr {[lindex $match 1] + 1}]
6872            $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6873        }
6874    }
6875    drawvisible
6876}
6877
6878# mark the bits of a headline or author that match a find string
6879proc markmatches {canv l str tag matches font row} {
6880    global selectedline
6881
6882    set bbox [$canv bbox $tag]
6883    set x0 [lindex $bbox 0]
6884    set y0 [lindex $bbox 1]
6885    set y1 [lindex $bbox 3]
6886    foreach match $matches {
6887        set start [lindex $match 0]
6888        set end [lindex $match 1]
6889        if {$start > $end} continue
6890        set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6891        set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6892        set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6893                   [expr {$x0+$xlen+2}] $y1 \
6894                   -outline {} -tags [list match$l matches] -fill yellow]
6895        $canv lower $t
6896        if {$row == $selectedline} {
6897            $canv raise $t secsel
6898        }
6899    }
6900}
6901
6902proc unmarkmatches {} {
6903    global markingmatches
6904
6905    allcanvs delete matches
6906    set markingmatches 0
6907    stopfinding
6908}
6909
6910proc selcanvline {w x y} {
6911    global canv canvy0 ctext linespc
6912    global rowtextx
6913    set ymax [lindex [$canv cget -scrollregion] 3]
6914    if {$ymax == {}} return
6915    set yfrac [lindex [$canv yview] 0]
6916    set y [expr {$y + $yfrac * $ymax}]
6917    set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6918    if {$l < 0} {
6919        set l 0
6920    }
6921    if {$w eq $canv} {
6922        set xmax [lindex [$canv cget -scrollregion] 2]
6923        set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6924        if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
6925    }
6926    unmarkmatches
6927    selectline $l 1
6928}
6929
6930proc commit_descriptor {p} {
6931    global commitinfo
6932    if {![info exists commitinfo($p)]} {
6933        getcommit $p
6934    }
6935    set l "..."
6936    if {[llength $commitinfo($p)] > 1} {
6937        set l [lindex $commitinfo($p) 0]
6938    }
6939    return "$p ($l)\n"
6940}
6941
6942# append some text to the ctext widget, and make any SHA1 ID
6943# that we know about be a clickable link.
6944proc appendwithlinks {text tags} {
6945    global ctext linknum curview
6946
6947    set start [$ctext index "end - 1c"]
6948    $ctext insert end $text $tags
6949    set links [regexp -indices -all -inline {(?:\m|-g)[0-9a-f]{6,40}\M} $text]
6950    foreach l $links {
6951        set s [lindex $l 0]
6952        set e [lindex $l 1]
6953        set linkid [string range $text $s $e]
6954        incr e
6955        $ctext tag delete link$linknum
6956        $ctext tag add link$linknum "$start + $s c" "$start + $e c"
6957        setlink $linkid link$linknum
6958        incr linknum
6959    }
6960}
6961
6962proc setlink {id lk} {
6963    global curview ctext pendinglinks
6964    global linkfgcolor
6965
6966    if {[string range $id 0 1] eq "-g"} {
6967      set id [string range $id 2 end]
6968    }
6969
6970    set known 0
6971    if {[string length $id] < 40} {
6972        set matches [longid $id]
6973        if {[llength $matches] > 0} {
6974            if {[llength $matches] > 1} return
6975            set known 1
6976            set id [lindex $matches 0]
6977        }
6978    } else {
6979        set known [commitinview $id $curview]
6980    }
6981    if {$known} {
6982        $ctext tag conf $lk -foreground $linkfgcolor -underline 1
6983        $ctext tag bind $lk <1> [list selbyid $id]
6984        $ctext tag bind $lk <Enter> {linkcursor %W 1}
6985        $ctext tag bind $lk <Leave> {linkcursor %W -1}
6986    } else {
6987        lappend pendinglinks($id) $lk
6988        interestedin $id {makelink %P}
6989    }
6990}
6991
6992proc appendshortlink {id {pre {}} {post {}}} {
6993    global ctext linknum
6994
6995    $ctext insert end $pre
6996    $ctext tag delete link$linknum
6997    $ctext insert end [string range $id 0 7] link$linknum
6998    $ctext insert end $post
6999    setlink $id link$linknum
7000    incr linknum
7001}
7002
7003proc makelink {id} {
7004    global pendinglinks
7005
7006    if {![info exists pendinglinks($id)]} return
7007    foreach lk $pendinglinks($id) {
7008        setlink $id $lk
7009    }
7010    unset pendinglinks($id)
7011}
7012
7013proc linkcursor {w inc} {
7014    global linkentercount curtextcursor
7015
7016    if {[incr linkentercount $inc] > 0} {
7017        $w configure -cursor hand2
7018    } else {
7019        $w configure -cursor $curtextcursor
7020        if {$linkentercount < 0} {
7021            set linkentercount 0
7022        }
7023    }
7024}
7025
7026proc viewnextline {dir} {
7027    global canv linespc
7028
7029    $canv delete hover
7030    set ymax [lindex [$canv cget -scrollregion] 3]
7031    set wnow [$canv yview]
7032    set wtop [expr {[lindex $wnow 0] * $ymax}]
7033    set newtop [expr {$wtop + $dir * $linespc}]
7034    if {$newtop < 0} {
7035        set newtop 0
7036    } elseif {$newtop > $ymax} {
7037        set newtop $ymax
7038    }
7039    allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7040}
7041
7042# add a list of tag or branch names at position pos
7043# returns the number of names inserted
7044proc appendrefs {pos ids var} {
7045    global ctext linknum curview $var maxrefs visiblerefs mainheadid
7046
7047    if {[catch {$ctext index $pos}]} {
7048        return 0
7049    }
7050    $ctext conf -state normal
7051    $ctext delete $pos "$pos lineend"
7052    set tags {}
7053    foreach id $ids {
7054        foreach tag [set $var\($id\)] {
7055            lappend tags [list $tag $id]
7056        }
7057    }
7058
7059    set sep {}
7060    set tags [lsort -index 0 -decreasing $tags]
7061    set nutags 0
7062
7063    if {[llength $tags] > $maxrefs} {
7064        # If we are displaying heads, and there are too many,
7065        # see if there are some important heads to display.
7066        # Currently that are the current head and heads listed in $visiblerefs option
7067        set itags {}
7068        if {$var eq "idheads"} {
7069            set utags {}
7070            foreach ti $tags {
7071                set hname [lindex $ti 0]
7072                set id [lindex $ti 1]
7073                if {([lsearch -exact $visiblerefs $hname] != -1 || $id eq $mainheadid) &&
7074                    [llength $itags] < $maxrefs} {
7075                    lappend itags $ti
7076                } else {
7077                    lappend utags $ti
7078                }
7079            }
7080            set tags $utags
7081        }
7082        if {$itags ne {}} {
7083            set str [mc "and many more"]
7084            set sep " "
7085        } else {
7086            set str [mc "many"]
7087        }
7088        $ctext insert $pos "$str ([llength $tags])"
7089        set nutags [llength $tags]
7090        set tags $itags
7091    }
7092
7093    foreach ti $tags {
7094        set id [lindex $ti 1]
7095        set lk link$linknum
7096        incr linknum
7097        $ctext tag delete $lk
7098        $ctext insert $pos $sep
7099        $ctext insert $pos [lindex $ti 0] $lk
7100        setlink $id $lk
7101        set sep ", "
7102    }
7103    $ctext tag add wwrap "$pos linestart" "$pos lineend"
7104    $ctext conf -state disabled
7105    return [expr {[llength $tags] + $nutags}]
7106}
7107
7108# called when we have finished computing the nearby tags
7109proc dispneartags {delay} {
7110    global selectedline currentid showneartags tagphase
7111
7112    if {$selectedline eq {} || !$showneartags} return
7113    after cancel dispnexttag
7114    if {$delay} {
7115        after 200 dispnexttag
7116        set tagphase -1
7117    } else {
7118        after idle dispnexttag
7119        set tagphase 0
7120    }
7121}
7122
7123proc dispnexttag {} {
7124    global selectedline currentid showneartags tagphase ctext
7125
7126    if {$selectedline eq {} || !$showneartags} return
7127    switch -- $tagphase {
7128        0 {
7129            set dtags [desctags $currentid]
7130            if {$dtags ne {}} {
7131                appendrefs precedes $dtags idtags
7132            }
7133        }
7134        1 {
7135            set atags [anctags $currentid]
7136            if {$atags ne {}} {
7137                appendrefs follows $atags idtags
7138            }
7139        }
7140        2 {
7141            set dheads [descheads $currentid]
7142            if {$dheads ne {}} {
7143                if {[appendrefs branch $dheads idheads] > 1
7144                    && [$ctext get "branch -3c"] eq "h"} {
7145                    # turn "Branch" into "Branches"
7146                    $ctext conf -state normal
7147                    $ctext insert "branch -2c" "es"
7148                    $ctext conf -state disabled
7149                }
7150            }
7151        }
7152    }
7153    if {[incr tagphase] <= 2} {
7154        after idle dispnexttag
7155    }
7156}
7157
7158proc make_secsel {id} {
7159    global linehtag linentag linedtag canv canv2 canv3
7160
7161    if {![info exists linehtag($id)]} return
7162    $canv delete secsel
7163    set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
7164               -tags secsel -fill [$canv cget -selectbackground]]
7165    $canv lower $t
7166    $canv2 delete secsel
7167    set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
7168               -tags secsel -fill [$canv2 cget -selectbackground]]
7169    $canv2 lower $t
7170    $canv3 delete secsel
7171    set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
7172               -tags secsel -fill [$canv3 cget -selectbackground]]
7173    $canv3 lower $t
7174}
7175
7176proc make_idmark {id} {
7177    global linehtag canv fgcolor
7178
7179    if {![info exists linehtag($id)]} return
7180    $canv delete markid
7181    set t [eval $canv create rect [$canv bbox $linehtag($id)] \
7182               -tags markid -outline $fgcolor]
7183    $canv raise $t
7184}
7185
7186proc selectline {l isnew {desired_loc {}} {switch_to_patch 0}} {
7187    global canv ctext commitinfo selectedline
7188    global canvy0 linespc parents children curview
7189    global currentid sha1entry
7190    global commentend idtags linknum
7191    global mergemax numcommits pending_select
7192    global cmitmode showneartags allcommits
7193    global targetrow targetid lastscrollrows
7194    global autoselect autosellen jump_to_here
7195    global vinlinediff
7196
7197    catch {unset pending_select}
7198    $canv delete hover
7199    normalline
7200    unsel_reflist
7201    stopfinding
7202    if {$l < 0 || $l >= $numcommits} return
7203    set id [commitonrow $l]
7204    set targetid $id
7205    set targetrow $l
7206    set selectedline $l
7207    set currentid $id
7208    if {$lastscrollrows < $numcommits} {
7209        setcanvscroll
7210    }
7211
7212    if {$cmitmode ne "patch" && $switch_to_patch} {
7213        set cmitmode "patch"
7214    }
7215
7216    set y [expr {$canvy0 + $l * $linespc}]
7217    set ymax [lindex [$canv cget -scrollregion] 3]
7218    set ytop [expr {$y - $linespc - 1}]
7219    set ybot [expr {$y + $linespc + 1}]
7220    set wnow [$canv yview]
7221    set wtop [expr {[lindex $wnow 0] * $ymax}]
7222    set wbot [expr {[lindex $wnow 1] * $ymax}]
7223    set wh [expr {$wbot - $wtop}]
7224    set newtop $wtop
7225    if {$ytop < $wtop} {
7226        if {$ybot < $wtop} {
7227            set newtop [expr {$y - $wh / 2.0}]
7228        } else {
7229            set newtop $ytop
7230            if {$newtop > $wtop - $linespc} {
7231                set newtop [expr {$wtop - $linespc}]
7232            }
7233        }
7234    } elseif {$ybot > $wbot} {
7235        if {$ytop > $wbot} {
7236            set newtop [expr {$y - $wh / 2.0}]
7237        } else {
7238            set newtop [expr {$ybot - $wh}]
7239            if {$newtop < $wtop + $linespc} {
7240                set newtop [expr {$wtop + $linespc}]
7241            }
7242        }
7243    }
7244    if {$newtop != $wtop} {
7245        if {$newtop < 0} {
7246            set newtop 0
7247        }
7248        allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7249        drawvisible
7250    }
7251
7252    make_secsel $id
7253
7254    if {$isnew} {
7255        addtohistory [list selbyid $id 0] savecmitpos
7256    }
7257
7258    $sha1entry delete 0 end
7259    $sha1entry insert 0 $id
7260    if {$autoselect} {
7261        $sha1entry selection range 0 $autosellen
7262    }
7263    rhighlight_sel $id
7264
7265    $ctext conf -state normal
7266    clear_ctext
7267    set linknum 0
7268    if {![info exists commitinfo($id)]} {
7269        getcommit $id
7270    }
7271    set info $commitinfo($id)
7272    set date [formatdate [lindex $info 2]]
7273    $ctext insert end "[mc "Author"]: [lindex $info 1]  $date\n"
7274    set date [formatdate [lindex $info 4]]
7275    $ctext insert end "[mc "Committer"]: [lindex $info 3]  $date\n"
7276    if {[info exists idtags($id)]} {
7277        $ctext insert end [mc "Tags:"]
7278        foreach tag $idtags($id) {
7279            $ctext insert end " $tag"
7280        }
7281        $ctext insert end "\n"
7282    }
7283
7284    set headers {}
7285    set olds $parents($curview,$id)
7286    if {[llength $olds] > 1} {
7287        set np 0
7288        foreach p $olds {
7289            if {$np >= $mergemax} {
7290                set tag mmax
7291            } else {
7292                set tag m$np
7293            }
7294            $ctext insert end "[mc "Parent"]: " $tag
7295            appendwithlinks [commit_descriptor $p] {}
7296            incr np
7297        }
7298    } else {
7299        foreach p $olds {
7300            append headers "[mc "Parent"]: [commit_descriptor $p]"
7301        }
7302    }
7303
7304    foreach c $children($curview,$id) {
7305        append headers "[mc "Child"]:  [commit_descriptor $c]"
7306    }
7307
7308    # make anything that looks like a SHA1 ID be a clickable link
7309    appendwithlinks $headers {}
7310    if {$showneartags} {
7311        if {![info exists allcommits]} {
7312            getallcommits
7313        }
7314        $ctext insert end "[mc "Branch"]: "
7315        $ctext mark set branch "end -1c"
7316        $ctext mark gravity branch left
7317        $ctext insert end "\n[mc "Follows"]: "
7318        $ctext mark set follows "end -1c"
7319        $ctext mark gravity follows left
7320        $ctext insert end "\n[mc "Precedes"]: "
7321        $ctext mark set precedes "end -1c"
7322        $ctext mark gravity precedes left
7323        $ctext insert end "\n"
7324        dispneartags 1
7325    }
7326    $ctext insert end "\n"
7327    set comment [lindex $info 5]
7328    if {[string first "\r" $comment] >= 0} {
7329        set comment [string map {"\r" "\n    "} $comment]
7330    }
7331    appendwithlinks $comment {comment}
7332
7333    $ctext tag remove found 1.0 end
7334    $ctext conf -state disabled
7335    set commentend [$ctext index "end - 1c"]
7336
7337    set jump_to_here $desired_loc
7338    init_flist [mc "Comments"]
7339    if {$cmitmode eq "tree"} {
7340        gettree $id
7341    } elseif {$vinlinediff($curview) == 1} {
7342        showinlinediff $id
7343    } elseif {[llength $olds] <= 1} {
7344        startdiff $id
7345    } else {
7346        mergediff $id
7347    }
7348}
7349
7350proc selfirstline {} {
7351    unmarkmatches
7352    selectline 0 1
7353}
7354
7355proc sellastline {} {
7356    global numcommits
7357    unmarkmatches
7358    set l [expr {$numcommits - 1}]
7359    selectline $l 1
7360}
7361
7362proc selnextline {dir} {
7363    global selectedline
7364    focus .
7365    if {$selectedline eq {}} return
7366    set l [expr {$selectedline + $dir}]
7367    unmarkmatches
7368    selectline $l 1
7369}
7370
7371proc selnextpage {dir} {
7372    global canv linespc selectedline numcommits
7373
7374    set lpp [expr {([winfo height $canv] - 2) / $linespc}]
7375    if {$lpp < 1} {
7376        set lpp 1
7377    }
7378    allcanvs yview scroll [expr {$dir * $lpp}] units
7379    drawvisible
7380    if {$selectedline eq {}} return
7381    set l [expr {$selectedline + $dir * $lpp}]
7382    if {$l < 0} {
7383        set l 0
7384    } elseif {$l >= $numcommits} {
7385        set l [expr $numcommits - 1]
7386    }
7387    unmarkmatches
7388    selectline $l 1
7389}
7390
7391proc unselectline {} {
7392    global selectedline currentid
7393
7394    set selectedline {}
7395    catch {unset currentid}
7396    allcanvs delete secsel
7397    rhighlight_none
7398}
7399
7400proc reselectline {} {
7401    global selectedline
7402
7403    if {$selectedline ne {}} {
7404        selectline $selectedline 0
7405    }
7406}
7407
7408proc addtohistory {cmd {saveproc {}}} {
7409    global history historyindex curview
7410
7411    unset_posvars
7412    save_position
7413    set elt [list $curview $cmd $saveproc {}]
7414    if {$historyindex > 0
7415        && [lindex $history [expr {$historyindex - 1}]] == $elt} {
7416        return
7417    }
7418
7419    if {$historyindex < [llength $history]} {
7420        set history [lreplace $history $historyindex end $elt]
7421    } else {
7422        lappend history $elt
7423    }
7424    incr historyindex
7425    if {$historyindex > 1} {
7426        .tf.bar.leftbut conf -state normal
7427    } else {
7428        .tf.bar.leftbut conf -state disabled
7429    }
7430    .tf.bar.rightbut conf -state disabled
7431}
7432
7433# save the scrolling position of the diff display pane
7434proc save_position {} {
7435    global historyindex history
7436
7437    if {$historyindex < 1} return
7438    set hi [expr {$historyindex - 1}]
7439    set fn [lindex $history $hi 2]
7440    if {$fn ne {}} {
7441        lset history $hi 3 [eval $fn]
7442    }
7443}
7444
7445proc unset_posvars {} {
7446    global last_posvars
7447
7448    if {[info exists last_posvars]} {
7449        foreach {var val} $last_posvars {
7450            global $var
7451            catch {unset $var}
7452        }
7453        unset last_posvars
7454    }
7455}
7456
7457proc godo {elt} {
7458    global curview last_posvars
7459
7460    set view [lindex $elt 0]
7461    set cmd [lindex $elt 1]
7462    set pv [lindex $elt 3]
7463    if {$curview != $view} {
7464        showview $view
7465    }
7466    unset_posvars
7467    foreach {var val} $pv {
7468        global $var
7469        set $var $val
7470    }
7471    set last_posvars $pv
7472    eval $cmd
7473}
7474
7475proc goback {} {
7476    global history historyindex
7477    focus .
7478
7479    if {$historyindex > 1} {
7480        save_position
7481        incr historyindex -1
7482        godo [lindex $history [expr {$historyindex - 1}]]
7483        .tf.bar.rightbut conf -state normal
7484    }
7485    if {$historyindex <= 1} {
7486        .tf.bar.leftbut conf -state disabled
7487    }
7488}
7489
7490proc goforw {} {
7491    global history historyindex
7492    focus .
7493
7494    if {$historyindex < [llength $history]} {
7495        save_position
7496        set cmd [lindex $history $historyindex]
7497        incr historyindex
7498        godo $cmd
7499        .tf.bar.leftbut conf -state normal
7500    }
7501    if {$historyindex >= [llength $history]} {
7502        .tf.bar.rightbut conf -state disabled
7503    }
7504}
7505
7506proc go_to_parent {i} {
7507    global parents curview targetid
7508    set ps $parents($curview,$targetid)
7509    if {[llength $ps] >= $i} {
7510        selbyid [lindex $ps [expr $i - 1]]
7511    }
7512}
7513
7514proc gettree {id} {
7515    global treefilelist treeidlist diffids diffmergeid treepending
7516    global nullid nullid2
7517
7518    set diffids $id
7519    catch {unset diffmergeid}
7520    if {![info exists treefilelist($id)]} {
7521        if {![info exists treepending]} {
7522            if {$id eq $nullid} {
7523                set cmd [list | git ls-files]
7524            } elseif {$id eq $nullid2} {
7525                set cmd [list | git ls-files --stage -t]
7526            } else {
7527                set cmd [list | git ls-tree -r $id]
7528            }
7529            if {[catch {set gtf [open $cmd r]}]} {
7530                return
7531            }
7532            set treepending $id
7533            set treefilelist($id) {}
7534            set treeidlist($id) {}
7535            fconfigure $gtf -blocking 0 -encoding binary
7536            filerun $gtf [list gettreeline $gtf $id]
7537        }
7538    } else {
7539        setfilelist $id
7540    }
7541}
7542
7543proc gettreeline {gtf id} {
7544    global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
7545
7546    set nl 0
7547    while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
7548        if {$diffids eq $nullid} {
7549            set fname $line
7550        } else {
7551            set i [string first "\t" $line]
7552            if {$i < 0} continue
7553            set fname [string range $line [expr {$i+1}] end]
7554            set line [string range $line 0 [expr {$i-1}]]
7555            if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7556            set sha1 [lindex $line 2]
7557            lappend treeidlist($id) $sha1
7558        }
7559        if {[string index $fname 0] eq "\""} {
7560            set fname [lindex $fname 0]
7561        }
7562        set fname [encoding convertfrom $fname]
7563        lappend treefilelist($id) $fname
7564    }
7565    if {![eof $gtf]} {
7566        return [expr {$nl >= 1000? 2: 1}]
7567    }
7568    close $gtf
7569    unset treepending
7570    if {$cmitmode ne "tree"} {
7571        if {![info exists diffmergeid]} {
7572            gettreediffs $diffids
7573        }
7574    } elseif {$id ne $diffids} {
7575        gettree $diffids
7576    } else {
7577        setfilelist $id
7578    }
7579    return 0
7580}
7581
7582proc showfile {f} {
7583    global treefilelist treeidlist diffids nullid nullid2
7584    global ctext_file_names ctext_file_lines
7585    global ctext commentend
7586
7587    set i [lsearch -exact $treefilelist($diffids) $f]
7588    if {$i < 0} {
7589        puts "oops, $f not in list for id $diffids"
7590        return
7591    }
7592    if {$diffids eq $nullid} {
7593        if {[catch {set bf [open $f r]} err]} {
7594            puts "oops, can't read $f: $err"
7595            return
7596        }
7597    } else {
7598        set blob [lindex $treeidlist($diffids) $i]
7599        if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7600            puts "oops, error reading blob $blob: $err"
7601            return
7602        }
7603    }
7604    fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7605    filerun $bf [list getblobline $bf $diffids]
7606    $ctext config -state normal
7607    clear_ctext $commentend
7608    lappend ctext_file_names $f
7609    lappend ctext_file_lines [lindex [split $commentend "."] 0]
7610    $ctext insert end "\n"
7611    $ctext insert end "$f\n" filesep
7612    $ctext config -state disabled
7613    $ctext yview $commentend
7614    settabs 0
7615}
7616
7617proc getblobline {bf id} {
7618    global diffids cmitmode ctext
7619
7620    if {$id ne $diffids || $cmitmode ne "tree"} {
7621        catch {close $bf}
7622        return 0
7623    }
7624    $ctext config -state normal
7625    set nl 0
7626    while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7627        $ctext insert end "$line\n"
7628    }
7629    if {[eof $bf]} {
7630        global jump_to_here ctext_file_names commentend
7631
7632        # delete last newline
7633        $ctext delete "end - 2c" "end - 1c"
7634        close $bf
7635        if {$jump_to_here ne {} &&
7636            [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7637            set lnum [expr {[lindex $jump_to_here 1] +
7638                            [lindex [split $commentend .] 0]}]
7639            mark_ctext_line $lnum
7640        }
7641        $ctext config -state disabled
7642        return 0
7643    }
7644    $ctext config -state disabled
7645    return [expr {$nl >= 1000? 2: 1}]
7646}
7647
7648proc mark_ctext_line {lnum} {
7649    global ctext markbgcolor
7650
7651    $ctext tag delete omark
7652    $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7653    $ctext tag conf omark -background $markbgcolor
7654    $ctext see $lnum.0
7655}
7656
7657proc mergediff {id} {
7658    global diffmergeid
7659    global diffids treediffs
7660    global parents curview
7661
7662    set diffmergeid $id
7663    set diffids $id
7664    set treediffs($id) {}
7665    set np [llength $parents($curview,$id)]
7666    settabs $np
7667    getblobdiffs $id
7668}
7669
7670proc startdiff {ids} {
7671    global treediffs diffids treepending diffmergeid nullid nullid2
7672
7673    settabs 1
7674    set diffids $ids
7675    catch {unset diffmergeid}
7676    if {![info exists treediffs($ids)] ||
7677        [lsearch -exact $ids $nullid] >= 0 ||
7678        [lsearch -exact $ids $nullid2] >= 0} {
7679        if {![info exists treepending]} {
7680            gettreediffs $ids
7681        }
7682    } else {
7683        addtocflist $ids
7684    }
7685}
7686
7687proc showinlinediff {ids} {
7688    global commitinfo commitdata ctext
7689    global treediffs
7690
7691    set info $commitinfo($ids)
7692    set diff [lindex $info 7]
7693    set difflines [split $diff "\n"]
7694
7695    initblobdiffvars
7696    set treediff {}
7697
7698    set inhdr 0
7699    foreach line $difflines {
7700        if {![string compare -length 5 "diff " $line]} {
7701            set inhdr 1
7702        } elseif {$inhdr && ![string compare -length 4 "+++ " $line]} {
7703            # offset also accounts for the b/ prefix
7704            lappend treediff [string range $line 6 end]
7705            set inhdr 0
7706        }
7707    }
7708
7709    set treediffs($ids) $treediff
7710    add_flist $treediff
7711
7712    $ctext conf -state normal
7713    foreach line $difflines {
7714        parseblobdiffline $ids $line
7715    }
7716    maybe_scroll_ctext 1
7717    $ctext conf -state disabled
7718}
7719
7720# If the filename (name) is under any of the passed filter paths
7721# then return true to include the file in the listing.
7722proc path_filter {filter name} {
7723    set worktree [gitworktree]
7724    foreach p $filter {
7725        set fq_p [file normalize $p]
7726        set fq_n [file normalize [file join $worktree $name]]
7727        if {[string match [file normalize $fq_p]* $fq_n]} {
7728            return 1
7729        }
7730    }
7731    return 0
7732}
7733
7734proc addtocflist {ids} {
7735    global treediffs
7736
7737    add_flist $treediffs($ids)
7738    getblobdiffs $ids
7739}
7740
7741proc diffcmd {ids flags} {
7742    global log_showroot nullid nullid2 git_version
7743
7744    set i [lsearch -exact $ids $nullid]
7745    set j [lsearch -exact $ids $nullid2]
7746    if {$i >= 0} {
7747        if {[llength $ids] > 1 && $j < 0} {
7748            # comparing working directory with some specific revision
7749            set cmd [concat | git diff-index $flags]
7750            if {$i == 0} {
7751                lappend cmd -R [lindex $ids 1]
7752            } else {
7753                lappend cmd [lindex $ids 0]
7754            }
7755        } else {
7756            # comparing working directory with index
7757            set cmd [concat | git diff-files $flags]
7758            if {$j == 1} {
7759                lappend cmd -R
7760            }
7761        }
7762    } elseif {$j >= 0} {
7763        if {[package vcompare $git_version "1.7.2"] >= 0} {
7764            set flags "$flags --ignore-submodules=dirty"
7765        }
7766        set cmd [concat | git diff-index --cached $flags]
7767        if {[llength $ids] > 1} {
7768            # comparing index with specific revision
7769            if {$j == 0} {
7770                lappend cmd -R [lindex $ids 1]
7771            } else {
7772                lappend cmd [lindex $ids 0]
7773            }
7774        } else {
7775            # comparing index with HEAD
7776            lappend cmd HEAD
7777        }
7778    } else {
7779        if {$log_showroot} {
7780            lappend flags --root
7781        }
7782        set cmd [concat | git diff-tree -r $flags $ids]
7783    }
7784    return $cmd
7785}
7786
7787proc gettreediffs {ids} {
7788    global treediff treepending limitdiffs vfilelimit curview
7789
7790    set cmd [diffcmd $ids {--no-commit-id}]
7791    if {$limitdiffs && $vfilelimit($curview) ne {}} {
7792            set cmd [concat $cmd -- $vfilelimit($curview)]
7793    }
7794    if {[catch {set gdtf [open $cmd r]}]} return
7795
7796    set treepending $ids
7797    set treediff {}
7798    fconfigure $gdtf -blocking 0 -encoding binary
7799    filerun $gdtf [list gettreediffline $gdtf $ids]
7800}
7801
7802proc gettreediffline {gdtf ids} {
7803    global treediff treediffs treepending diffids diffmergeid
7804    global cmitmode vfilelimit curview limitdiffs perfile_attrs
7805
7806    set nr 0
7807    set sublist {}
7808    set max 1000
7809    if {$perfile_attrs} {
7810        # cache_gitattr is slow, and even slower on win32 where we
7811        # have to invoke it for only about 30 paths at a time
7812        set max 500
7813        if {[tk windowingsystem] == "win32"} {
7814            set max 120
7815        }
7816    }
7817    while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7818        set i [string first "\t" $line]
7819        if {$i >= 0} {
7820            set file [string range $line [expr {$i+1}] end]
7821            if {[string index $file 0] eq "\""} {
7822                set file [lindex $file 0]
7823            }
7824            set file [encoding convertfrom $file]
7825            if {$file ne [lindex $treediff end]} {
7826                lappend treediff $file
7827                lappend sublist $file
7828            }
7829        }
7830    }
7831    if {$perfile_attrs} {
7832        cache_gitattr encoding $sublist
7833    }
7834    if {![eof $gdtf]} {
7835        return [expr {$nr >= $max? 2: 1}]
7836    }
7837    close $gdtf
7838    set treediffs($ids) $treediff
7839    unset treepending
7840    if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7841        gettree $diffids
7842    } elseif {$ids != $diffids} {
7843        if {![info exists diffmergeid]} {
7844            gettreediffs $diffids
7845        }
7846    } else {
7847        addtocflist $ids
7848    }
7849    return 0
7850}
7851
7852# empty string or positive integer
7853proc diffcontextvalidate {v} {
7854    return [regexp {^(|[1-9][0-9]*)$} $v]
7855}
7856
7857proc diffcontextchange {n1 n2 op} {
7858    global diffcontextstring diffcontext
7859
7860    if {[string is integer -strict $diffcontextstring]} {
7861        if {$diffcontextstring >= 0} {
7862            set diffcontext $diffcontextstring
7863            reselectline
7864        }
7865    }
7866}
7867
7868proc changeignorespace {} {
7869    reselectline
7870}
7871
7872proc changeworddiff {name ix op} {
7873    reselectline
7874}
7875
7876proc initblobdiffvars {} {
7877    global diffencoding targetline diffnparents
7878    global diffinhdr currdiffsubmod diffseehere
7879    set targetline {}
7880    set diffnparents 0
7881    set diffinhdr 0
7882    set diffencoding [get_path_encoding {}]
7883    set currdiffsubmod ""
7884    set diffseehere -1
7885}
7886
7887proc getblobdiffs {ids} {
7888    global blobdifffd diffids env
7889    global treediffs
7890    global diffcontext
7891    global ignorespace
7892    global worddiff
7893    global limitdiffs vfilelimit curview
7894    global git_version
7895
7896    set textconv {}
7897    if {[package vcompare $git_version "1.6.1"] >= 0} {
7898        set textconv "--textconv"
7899    }
7900    set submodule {}
7901    if {[package vcompare $git_version "1.6.6"] >= 0} {
7902        set submodule "--submodule"
7903    }
7904    set cmd [diffcmd $ids "-p $textconv $submodule  -C --cc --no-commit-id -U$diffcontext"]
7905    if {$ignorespace} {
7906        append cmd " -w"
7907    }
7908    if {$worddiff ne [mc "Line diff"]} {
7909        append cmd " --word-diff=porcelain"
7910    }
7911    if {$limitdiffs && $vfilelimit($curview) ne {}} {
7912        set cmd [concat $cmd -- $vfilelimit($curview)]
7913    }
7914    if {[catch {set bdf [open $cmd r]} err]} {
7915        error_popup [mc "Error getting diffs: %s" $err]
7916        return
7917    }
7918    fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
7919    set blobdifffd($ids) $bdf
7920    initblobdiffvars
7921    filerun $bdf [list getblobdiffline $bdf $diffids]
7922}
7923
7924proc savecmitpos {} {
7925    global ctext cmitmode
7926
7927    if {$cmitmode eq "tree"} {
7928        return {}
7929    }
7930    return [list target_scrollpos [$ctext index @0,0]]
7931}
7932
7933proc savectextpos {} {
7934    global ctext
7935
7936    return [list target_scrollpos [$ctext index @0,0]]
7937}
7938
7939proc maybe_scroll_ctext {ateof} {
7940    global ctext target_scrollpos
7941
7942    if {![info exists target_scrollpos]} return
7943    if {!$ateof} {
7944        set nlines [expr {[winfo height $ctext]
7945                          / [font metrics textfont -linespace]}]
7946        if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
7947    }
7948    $ctext yview $target_scrollpos
7949    unset target_scrollpos
7950}
7951
7952proc setinlist {var i val} {
7953    global $var
7954
7955    while {[llength [set $var]] < $i} {
7956        lappend $var {}
7957    }
7958    if {[llength [set $var]] == $i} {
7959        lappend $var $val
7960    } else {
7961        lset $var $i $val
7962    }
7963}
7964
7965proc makediffhdr {fname ids} {
7966    global ctext curdiffstart treediffs diffencoding
7967    global ctext_file_names jump_to_here targetline diffline
7968
7969    set fname [encoding convertfrom $fname]
7970    set diffencoding [get_path_encoding $fname]
7971    set i [lsearch -exact $treediffs($ids) $fname]
7972    if {$i >= 0} {
7973        setinlist difffilestart $i $curdiffstart
7974    }
7975    lset ctext_file_names end $fname
7976    set l [expr {(78 - [string length $fname]) / 2}]
7977    set pad [string range "----------------------------------------" 1 $l]
7978    $ctext insert $curdiffstart "$pad $fname $pad" filesep
7979    set targetline {}
7980    if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
7981        set targetline [lindex $jump_to_here 1]
7982    }
7983    set diffline 0
7984}
7985
7986proc blobdiffmaybeseehere {ateof} {
7987    global diffseehere
7988    if {$diffseehere >= 0} {
7989        mark_ctext_line [lindex [split $diffseehere .] 0]
7990    }
7991    maybe_scroll_ctext $ateof
7992}
7993
7994proc getblobdiffline {bdf ids} {
7995    global diffids blobdifffd
7996    global ctext
7997
7998    set nr 0
7999    $ctext conf -state normal
8000    while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
8001        if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
8002            catch {close $bdf}
8003            return 0
8004        }
8005        parseblobdiffline $ids $line
8006    }
8007    $ctext conf -state disabled
8008    blobdiffmaybeseehere [eof $bdf]
8009    if {[eof $bdf]} {
8010        catch {close $bdf}
8011        return 0
8012    }
8013    return [expr {$nr >= 1000? 2: 1}]
8014}
8015
8016proc parseblobdiffline {ids line} {
8017    global ctext curdiffstart
8018    global diffnexthead diffnextnote difffilestart
8019    global ctext_file_names ctext_file_lines
8020    global diffinhdr treediffs mergemax diffnparents
8021    global diffencoding jump_to_here targetline diffline currdiffsubmod
8022    global worddiff diffseehere
8023
8024    if {![string compare -length 5 "diff " $line]} {
8025        if {![regexp {^diff (--cc|--git) } $line m type]} {
8026            set line [encoding convertfrom $line]
8027            $ctext insert end "$line\n" hunksep
8028            continue
8029        }
8030        # start of a new file
8031        set diffinhdr 1
8032        $ctext insert end "\n"
8033        set curdiffstart [$ctext index "end - 1c"]
8034        lappend ctext_file_names ""
8035        lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8036        $ctext insert end "\n" filesep
8037
8038        if {$type eq "--cc"} {
8039            # start of a new file in a merge diff
8040            set fname [string range $line 10 end]
8041            if {[lsearch -exact $treediffs($ids) $fname] < 0} {
8042                lappend treediffs($ids) $fname
8043                add_flist [list $fname]
8044            }
8045
8046        } else {
8047            set line [string range $line 11 end]
8048            # If the name hasn't changed the length will be odd,
8049            # the middle char will be a space, and the two bits either
8050            # side will be a/name and b/name, or "a/name" and "b/name".
8051            # If the name has changed we'll get "rename from" and
8052            # "rename to" or "copy from" and "copy to" lines following
8053            # this, and we'll use them to get the filenames.
8054            # This complexity is necessary because spaces in the
8055            # filename(s) don't get escaped.
8056            set l [string length $line]
8057            set i [expr {$l / 2}]
8058            if {!(($l & 1) && [string index $line $i] eq " " &&
8059                  [string range $line 2 [expr {$i - 1}]] eq \
8060                      [string range $line [expr {$i + 3}] end])} {
8061                return
8062            }
8063            # unescape if quoted and chop off the a/ from the front
8064            if {[string index $line 0] eq "\""} {
8065                set fname [string range [lindex $line 0] 2 end]
8066            } else {
8067                set fname [string range $line 2 [expr {$i - 1}]]
8068            }
8069        }
8070        makediffhdr $fname $ids
8071
8072    } elseif {![string compare -length 16 "* Unmerged path " $line]} {
8073        set fname [encoding convertfrom [string range $line 16 end]]
8074        $ctext insert end "\n"
8075        set curdiffstart [$ctext index "end - 1c"]
8076        lappend ctext_file_names $fname
8077        lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8078        $ctext insert end "$line\n" filesep
8079        set i [lsearch -exact $treediffs($ids) $fname]
8080        if {$i >= 0} {
8081            setinlist difffilestart $i $curdiffstart
8082        }
8083
8084    } elseif {![string compare -length 2 "@@" $line]} {
8085        regexp {^@@+} $line ats
8086        set line [encoding convertfrom $diffencoding $line]
8087        $ctext insert end "$line\n" hunksep
8088        if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
8089            set diffline $nl
8090        }
8091        set diffnparents [expr {[string length $ats] - 1}]
8092        set diffinhdr 0
8093
8094    } elseif {![string compare -length 10 "Submodule " $line]} {
8095        # start of a new submodule
8096        if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
8097            set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
8098        } else {
8099            set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
8100        }
8101        if {$currdiffsubmod != $fname} {
8102            $ctext insert end "\n";     # Add newline after commit message
8103        }
8104        set curdiffstart [$ctext index "end - 1c"]
8105        lappend ctext_file_names ""
8106        if {$currdiffsubmod != $fname} {
8107            lappend ctext_file_lines $fname
8108            makediffhdr $fname $ids
8109            set currdiffsubmod $fname
8110            $ctext insert end "\n$line\n" filesep
8111        } else {
8112            $ctext insert end "$line\n" filesep
8113        }
8114    } elseif {![string compare -length 3 "  >" $line]} {
8115        set $currdiffsubmod ""
8116        set line [encoding convertfrom $diffencoding $line]
8117        $ctext insert end "$line\n" dresult
8118    } elseif {![string compare -length 3 "  <" $line]} {
8119        set $currdiffsubmod ""
8120        set line [encoding convertfrom $diffencoding $line]
8121        $ctext insert end "$line\n" d0
8122    } elseif {$diffinhdr} {
8123        if {![string compare -length 12 "rename from " $line]} {
8124            set fname [string range $line [expr 6 + [string first " from " $line] ] end]
8125            if {[string index $fname 0] eq "\""} {
8126                set fname [lindex $fname 0]
8127            }
8128            set fname [encoding convertfrom $fname]
8129            set i [lsearch -exact $treediffs($ids) $fname]
8130            if {$i >= 0} {
8131                setinlist difffilestart $i $curdiffstart
8132            }
8133        } elseif {![string compare -length 10 $line "rename to "] ||
8134                  ![string compare -length 8 $line "copy to "]} {
8135            set fname [string range $line [expr 4 + [string first " to " $line] ] end]
8136            if {[string index $fname 0] eq "\""} {
8137                set fname [lindex $fname 0]
8138            }
8139            makediffhdr $fname $ids
8140        } elseif {[string compare -length 3 $line "---"] == 0} {
8141            # do nothing
8142            return
8143        } elseif {[string compare -length 3 $line "+++"] == 0} {
8144            set diffinhdr 0
8145            return
8146        }
8147        $ctext insert end "$line\n" filesep
8148
8149    } else {
8150        set line [string map {\x1A ^Z} \
8151                      [encoding convertfrom $diffencoding $line]]
8152        # parse the prefix - one ' ', '-' or '+' for each parent
8153        set prefix [string range $line 0 [expr {$diffnparents - 1}]]
8154        set tag [expr {$diffnparents > 1? "m": "d"}]
8155        set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
8156        set words_pre_markup ""
8157        set words_post_markup ""
8158        if {[string trim $prefix " -+"] eq {}} {
8159            # prefix only has " ", "-" and "+" in it: normal diff line
8160            set num [string first "-" $prefix]
8161            if {$dowords} {
8162                set line [string range $line 1 end]
8163            }
8164            if {$num >= 0} {
8165                # removed line, first parent with line is $num
8166                if {$num >= $mergemax} {
8167                    set num "max"
8168                }
8169                if {$dowords && $worddiff eq [mc "Markup words"]} {
8170                    $ctext insert end "\[-$line-\]" $tag$num
8171                } else {
8172                    $ctext insert end "$line" $tag$num
8173                }
8174                if {!$dowords} {
8175                    $ctext insert end "\n" $tag$num
8176                }
8177            } else {
8178                set tags {}
8179                if {[string first "+" $prefix] >= 0} {
8180                    # added line
8181                    lappend tags ${tag}result
8182                    if {$diffnparents > 1} {
8183                        set num [string first " " $prefix]
8184                        if {$num >= 0} {
8185                            if {$num >= $mergemax} {
8186                                set num "max"
8187                            }
8188                            lappend tags m$num
8189                        }
8190                    }
8191                    set words_pre_markup "{+"
8192                    set words_post_markup "+}"
8193                }
8194                if {$targetline ne {}} {
8195                    if {$diffline == $targetline} {
8196                        set diffseehere [$ctext index "end - 1 chars"]
8197                        set targetline {}
8198                    } else {
8199                        incr diffline
8200                    }
8201                }
8202                if {$dowords && $worddiff eq [mc "Markup words"]} {
8203                    $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
8204                } else {
8205                    $ctext insert end "$line" $tags
8206                }
8207                if {!$dowords} {
8208                    $ctext insert end "\n" $tags
8209                }
8210            }
8211        } elseif {$dowords && $prefix eq "~"} {
8212            $ctext insert end "\n" {}
8213        } else {
8214            # "\ No newline at end of file",
8215            # or something else we don't recognize
8216            $ctext insert end "$line\n" hunksep
8217        }
8218    }
8219}
8220
8221proc changediffdisp {} {
8222    global ctext diffelide
8223
8224    $ctext tag conf d0 -elide [lindex $diffelide 0]
8225    $ctext tag conf dresult -elide [lindex $diffelide 1]
8226}
8227
8228proc highlightfile {cline} {
8229    global cflist cflist_top
8230
8231    if {![info exists cflist_top]} return
8232
8233    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
8234    $cflist tag add highlight $cline.0 "$cline.0 lineend"
8235    $cflist see $cline.0
8236    set cflist_top $cline
8237}
8238
8239proc highlightfile_for_scrollpos {topidx} {
8240    global cmitmode difffilestart
8241
8242    if {$cmitmode eq "tree"} return
8243    if {![info exists difffilestart]} return
8244
8245    set top [lindex [split $topidx .] 0]
8246    if {$difffilestart eq {} || $top < [lindex $difffilestart 0]} {
8247        highlightfile 0
8248    } else {
8249        highlightfile [expr {[bsearch $difffilestart $top] + 2}]
8250    }
8251}
8252
8253proc prevfile {} {
8254    global difffilestart ctext cmitmode
8255
8256    if {$cmitmode eq "tree"} return
8257    set prev 0.0
8258    set here [$ctext index @0,0]
8259    foreach loc $difffilestart {
8260        if {[$ctext compare $loc >= $here]} {
8261            $ctext yview $prev
8262            return
8263        }
8264        set prev $loc
8265    }
8266    $ctext yview $prev
8267}
8268
8269proc nextfile {} {
8270    global difffilestart ctext cmitmode
8271
8272    if {$cmitmode eq "tree"} return
8273    set here [$ctext index @0,0]
8274    foreach loc $difffilestart {
8275        if {[$ctext compare $loc > $here]} {
8276            $ctext yview $loc
8277            return
8278        }
8279    }
8280}
8281
8282proc clear_ctext {{first 1.0}} {
8283    global ctext smarktop smarkbot
8284    global ctext_file_names ctext_file_lines
8285    global pendinglinks
8286
8287    set l [lindex [split $first .] 0]
8288    if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
8289        set smarktop $l
8290    }
8291    if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
8292        set smarkbot $l
8293    }
8294    $ctext delete $first end
8295    if {$first eq "1.0"} {
8296        catch {unset pendinglinks}
8297    }
8298    set ctext_file_names {}
8299    set ctext_file_lines {}
8300}
8301
8302proc settabs {{firstab {}}} {
8303    global firsttabstop tabstop ctext have_tk85
8304
8305    if {$firstab ne {} && $have_tk85} {
8306        set firsttabstop $firstab
8307    }
8308    set w [font measure textfont "0"]
8309    if {$firsttabstop != 0} {
8310        $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
8311                               [expr {($firsttabstop + 2 * $tabstop) * $w}]]
8312    } elseif {$have_tk85 || $tabstop != 8} {
8313        $ctext conf -tabs [expr {$tabstop * $w}]
8314    } else {
8315        $ctext conf -tabs {}
8316    }
8317}
8318
8319proc incrsearch {name ix op} {
8320    global ctext searchstring searchdirn
8321
8322    if {[catch {$ctext index anchor}]} {
8323        # no anchor set, use start of selection, or of visible area
8324        set sel [$ctext tag ranges sel]
8325        if {$sel ne {}} {
8326            $ctext mark set anchor [lindex $sel 0]
8327        } elseif {$searchdirn eq "-forwards"} {
8328            $ctext mark set anchor @0,0
8329        } else {
8330            $ctext mark set anchor @0,[winfo height $ctext]
8331        }
8332    }
8333    if {$searchstring ne {}} {
8334        set here [$ctext search -count mlen $searchdirn -- $searchstring anchor]
8335        if {$here ne {}} {
8336            $ctext see $here
8337            set mend "$here + $mlen c"
8338            $ctext tag remove sel 1.0 end
8339            $ctext tag add sel $here $mend
8340            suppress_highlighting_file_for_current_scrollpos
8341            highlightfile_for_scrollpos $here
8342        }
8343    }
8344    rehighlight_search_results
8345}
8346
8347proc dosearch {} {
8348    global sstring ctext searchstring searchdirn
8349
8350    focus $sstring
8351    $sstring icursor end
8352    set searchdirn -forwards
8353    if {$searchstring ne {}} {
8354        set sel [$ctext tag ranges sel]
8355        if {$sel ne {}} {
8356            set start "[lindex $sel 0] + 1c"
8357        } elseif {[catch {set start [$ctext index anchor]}]} {
8358            set start "@0,0"
8359        }
8360        set match [$ctext search -count mlen -- $searchstring $start]
8361        $ctext tag remove sel 1.0 end
8362        if {$match eq {}} {
8363            bell
8364            return
8365        }
8366        $ctext see $match
8367        suppress_highlighting_file_for_current_scrollpos
8368        highlightfile_for_scrollpos $match
8369        set mend "$match + $mlen c"
8370        $ctext tag add sel $match $mend
8371        $ctext mark unset anchor
8372        rehighlight_search_results
8373    }
8374}
8375
8376proc dosearchback {} {
8377    global sstring ctext searchstring searchdirn
8378
8379    focus $sstring
8380    $sstring icursor end
8381    set searchdirn -backwards
8382    if {$searchstring ne {}} {
8383        set sel [$ctext tag ranges sel]
8384        if {$sel ne {}} {
8385            set start [lindex $sel 0]
8386        } elseif {[catch {set start [$ctext index anchor]}]} {
8387            set start @0,[winfo height $ctext]
8388        }
8389        set match [$ctext search -backwards -count ml -- $searchstring $start]
8390        $ctext tag remove sel 1.0 end
8391        if {$match eq {}} {
8392            bell
8393            return
8394        }
8395        $ctext see $match
8396        suppress_highlighting_file_for_current_scrollpos
8397        highlightfile_for_scrollpos $match
8398        set mend "$match + $ml c"
8399        $ctext tag add sel $match $mend
8400        $ctext mark unset anchor
8401        rehighlight_search_results
8402    }
8403}
8404
8405proc rehighlight_search_results {} {
8406    global ctext searchstring
8407
8408    $ctext tag remove found 1.0 end
8409    $ctext tag remove currentsearchhit 1.0 end
8410
8411    if {$searchstring ne {}} {
8412        searchmarkvisible 1
8413    }
8414}
8415
8416proc searchmark {first last} {
8417    global ctext searchstring
8418
8419    set sel [$ctext tag ranges sel]
8420
8421    set mend $first.0
8422    while {1} {
8423        set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8424        if {$match eq {}} break
8425        set mend "$match + $mlen c"
8426        if {$sel ne {} && [$ctext compare $match == [lindex $sel 0]]} {
8427            $ctext tag add currentsearchhit $match $mend
8428        } else {
8429            $ctext tag add found $match $mend
8430        }
8431    }
8432}
8433
8434proc searchmarkvisible {doall} {
8435    global ctext smarktop smarkbot
8436
8437    set topline [lindex [split [$ctext index @0,0] .] 0]
8438    set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8439    if {$doall || $botline < $smarktop || $topline > $smarkbot} {
8440        # no overlap with previous
8441        searchmark $topline $botline
8442        set smarktop $topline
8443        set smarkbot $botline
8444    } else {
8445        if {$topline < $smarktop} {
8446            searchmark $topline [expr {$smarktop-1}]
8447            set smarktop $topline
8448        }
8449        if {$botline > $smarkbot} {
8450            searchmark [expr {$smarkbot+1}] $botline
8451            set smarkbot $botline
8452        }
8453    }
8454}
8455
8456proc suppress_highlighting_file_for_current_scrollpos {} {
8457    global ctext suppress_highlighting_file_for_this_scrollpos
8458
8459    set suppress_highlighting_file_for_this_scrollpos [$ctext index @0,0]
8460}
8461
8462proc scrolltext {f0 f1} {
8463    global searchstring cmitmode ctext
8464    global suppress_highlighting_file_for_this_scrollpos
8465
8466    set topidx [$ctext index @0,0]
8467    if {![info exists suppress_highlighting_file_for_this_scrollpos]
8468        || $topidx ne $suppress_highlighting_file_for_this_scrollpos} {
8469        highlightfile_for_scrollpos $topidx
8470    }
8471
8472    catch {unset suppress_highlighting_file_for_this_scrollpos}
8473
8474    .bleft.bottom.sb set $f0 $f1
8475    if {$searchstring ne {}} {
8476        searchmarkvisible 0
8477    }
8478}
8479
8480proc setcoords {} {
8481    global linespc charspc canvx0 canvy0
8482    global xspc1 xspc2 lthickness
8483
8484    set linespc [font metrics mainfont -linespace]
8485    set charspc [font measure mainfont "m"]
8486    set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8487    set canvx0 [expr {int(3 + 0.5 * $linespc)}]
8488    set lthickness [expr {int($linespc / 9) + 1}]
8489    set xspc1(0) $linespc
8490    set xspc2 $linespc
8491}
8492
8493proc redisplay {} {
8494    global canv
8495    global selectedline
8496
8497    set ymax [lindex [$canv cget -scrollregion] 3]
8498    if {$ymax eq {} || $ymax == 0} return
8499    set span [$canv yview]
8500    clear_display
8501    setcanvscroll
8502    allcanvs yview moveto [lindex $span 0]
8503    drawvisible
8504    if {$selectedline ne {}} {
8505        selectline $selectedline 0
8506        allcanvs yview moveto [lindex $span 0]
8507    }
8508}
8509
8510proc parsefont {f n} {
8511    global fontattr
8512
8513    set fontattr($f,family) [lindex $n 0]
8514    set s [lindex $n 1]
8515    if {$s eq {} || $s == 0} {
8516        set s 10
8517    } elseif {$s < 0} {
8518        set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
8519    }
8520    set fontattr($f,size) $s
8521    set fontattr($f,weight) normal
8522    set fontattr($f,slant) roman
8523    foreach style [lrange $n 2 end] {
8524        switch -- $style {
8525            "normal" -
8526            "bold"   {set fontattr($f,weight) $style}
8527            "roman" -
8528            "italic" {set fontattr($f,slant) $style}
8529        }
8530    }
8531}
8532
8533proc fontflags {f {isbold 0}} {
8534    global fontattr
8535
8536    return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8537                -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8538                -slant $fontattr($f,slant)]
8539}
8540
8541proc fontname {f} {
8542    global fontattr
8543
8544    set n [list $fontattr($f,family) $fontattr($f,size)]
8545    if {$fontattr($f,weight) eq "bold"} {
8546        lappend n "bold"
8547    }
8548    if {$fontattr($f,slant) eq "italic"} {
8549        lappend n "italic"
8550    }
8551    return $n
8552}
8553
8554proc incrfont {inc} {
8555    global mainfont textfont ctext canv cflist showrefstop
8556    global stopped entries fontattr
8557
8558    unmarkmatches
8559    set s $fontattr(mainfont,size)
8560    incr s $inc
8561    if {$s < 1} {
8562        set s 1
8563    }
8564    set fontattr(mainfont,size) $s
8565    font config mainfont -size $s
8566    font config mainfontbold -size $s
8567    set mainfont [fontname mainfont]
8568    set s $fontattr(textfont,size)
8569    incr s $inc
8570    if {$s < 1} {
8571        set s 1
8572    }
8573    set fontattr(textfont,size) $s
8574    font config textfont -size $s
8575    font config textfontbold -size $s
8576    set textfont [fontname textfont]
8577    setcoords
8578    settabs
8579    redisplay
8580}
8581
8582proc clearsha1 {} {
8583    global sha1entry sha1string
8584    if {[string length $sha1string] == 40} {
8585        $sha1entry delete 0 end
8586    }
8587}
8588
8589proc sha1change {n1 n2 op} {
8590    global sha1string currentid sha1but
8591    if {$sha1string == {}
8592        || ([info exists currentid] && $sha1string == $currentid)} {
8593        set state disabled
8594    } else {
8595        set state normal
8596    }
8597    if {[$sha1but cget -state] == $state} return
8598    if {$state == "normal"} {
8599        $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
8600    } else {
8601        $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
8602    }
8603}
8604
8605proc gotocommit {} {
8606    global sha1string tagids headids curview varcid
8607
8608    if {$sha1string == {}
8609        || ([info exists currentid] && $sha1string == $currentid)} return
8610    if {[info exists tagids($sha1string)]} {
8611        set id $tagids($sha1string)
8612    } elseif {[info exists headids($sha1string)]} {
8613        set id $headids($sha1string)
8614    } else {
8615        set id [string tolower $sha1string]
8616        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
8617            set matches [longid $id]
8618            if {$matches ne {}} {
8619                if {[llength $matches] > 1} {
8620                    error_popup [mc "Short SHA1 id %s is ambiguous" $id]
8621                    return
8622                }
8623                set id [lindex $matches 0]
8624            }
8625        } else {
8626            if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8627                error_popup [mc "Revision %s is not known" $sha1string]
8628                return
8629            }
8630        }
8631    }
8632    if {[commitinview $id $curview]} {
8633        selectline [rowofcommit $id] 1
8634        return
8635    }
8636    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
8637        set msg [mc "SHA1 id %s is not known" $sha1string]
8638    } else {
8639        set msg [mc "Revision %s is not in the current view" $sha1string]
8640    }
8641    error_popup $msg
8642}
8643
8644proc lineenter {x y id} {
8645    global hoverx hovery hoverid hovertimer
8646    global commitinfo canv
8647
8648    if {![info exists commitinfo($id)] && ![getcommit $id]} return
8649    set hoverx $x
8650    set hovery $y
8651    set hoverid $id
8652    if {[info exists hovertimer]} {
8653        after cancel $hovertimer
8654    }
8655    set hovertimer [after 500 linehover]
8656    $canv delete hover
8657}
8658
8659proc linemotion {x y id} {
8660    global hoverx hovery hoverid hovertimer
8661
8662    if {[info exists hoverid] && $id == $hoverid} {
8663        set hoverx $x
8664        set hovery $y
8665        if {[info exists hovertimer]} {
8666            after cancel $hovertimer
8667        }
8668        set hovertimer [after 500 linehover]
8669    }
8670}
8671
8672proc lineleave {id} {
8673    global hoverid hovertimer canv
8674
8675    if {[info exists hoverid] && $id == $hoverid} {
8676        $canv delete hover
8677        if {[info exists hovertimer]} {
8678            after cancel $hovertimer
8679            unset hovertimer
8680        }
8681        unset hoverid
8682    }
8683}
8684
8685proc linehover {} {
8686    global hoverx hovery hoverid hovertimer
8687    global canv linespc lthickness
8688    global linehoverbgcolor linehoverfgcolor linehoveroutlinecolor
8689
8690    global commitinfo
8691
8692    set text [lindex $commitinfo($hoverid) 0]
8693    set ymax [lindex [$canv cget -scrollregion] 3]
8694    if {$ymax == {}} return
8695    set yfrac [lindex [$canv yview] 0]
8696    set x [expr {$hoverx + 2 * $linespc}]
8697    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8698    set x0 [expr {$x - 2 * $lthickness}]
8699    set y0 [expr {$y - 2 * $lthickness}]
8700    set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
8701    set y1 [expr {$y + $linespc + 2 * $lthickness}]
8702    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8703               -fill $linehoverbgcolor -outline $linehoveroutlinecolor \
8704               -width 1 -tags hover]
8705    $canv raise $t
8706    set t [$canv create text $x $y -anchor nw -text $text -tags hover \
8707               -font mainfont -fill $linehoverfgcolor]
8708    $canv raise $t
8709}
8710
8711proc clickisonarrow {id y} {
8712    global lthickness
8713
8714    set ranges [rowranges $id]
8715    set thresh [expr {2 * $lthickness + 6}]
8716    set n [expr {[llength $ranges] - 1}]
8717    for {set i 1} {$i < $n} {incr i} {
8718        set row [lindex $ranges $i]
8719        if {abs([yc $row] - $y) < $thresh} {
8720            return $i
8721        }
8722    }
8723    return {}
8724}
8725
8726proc arrowjump {id n y} {
8727    global canv
8728
8729    # 1 <-> 2, 3 <-> 4, etc...
8730    set n [expr {(($n - 1) ^ 1) + 1}]
8731    set row [lindex [rowranges $id] $n]
8732    set yt [yc $row]
8733    set ymax [lindex [$canv cget -scrollregion] 3]
8734    if {$ymax eq {} || $ymax <= 0} return
8735    set view [$canv yview]
8736    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8737    set yfrac [expr {$yt / $ymax - $yspan / 2}]
8738    if {$yfrac < 0} {
8739        set yfrac 0
8740    }
8741    allcanvs yview moveto $yfrac
8742}
8743
8744proc lineclick {x y id isnew} {
8745    global ctext commitinfo children canv thickerline curview
8746
8747    if {![info exists commitinfo($id)] && ![getcommit $id]} return
8748    unmarkmatches
8749    unselectline
8750    normalline
8751    $canv delete hover
8752    # draw this line thicker than normal
8753    set thickerline $id
8754    drawlines $id
8755    if {$isnew} {
8756        set ymax [lindex [$canv cget -scrollregion] 3]
8757        if {$ymax eq {}} return
8758        set yfrac [lindex [$canv yview] 0]
8759        set y [expr {$y + $yfrac * $ymax}]
8760    }
8761    set dirn [clickisonarrow $id $y]
8762    if {$dirn ne {}} {
8763        arrowjump $id $dirn $y
8764        return
8765    }
8766
8767    if {$isnew} {
8768        addtohistory [list lineclick $x $y $id 0] savectextpos
8769    }
8770    # fill the details pane with info about this line
8771    $ctext conf -state normal
8772    clear_ctext
8773    settabs 0
8774    $ctext insert end "[mc "Parent"]:\t"
8775    $ctext insert end $id link0
8776    setlink $id link0
8777    set info $commitinfo($id)
8778    $ctext insert end "\n\t[lindex $info 0]\n"
8779    $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8780    set date [formatdate [lindex $info 2]]
8781    $ctext insert end "\t[mc "Date"]:\t$date\n"
8782    set kids $children($curview,$id)
8783    if {$kids ne {}} {
8784        $ctext insert end "\n[mc "Children"]:"
8785        set i 0
8786        foreach child $kids {
8787            incr i
8788            if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8789            set info $commitinfo($child)
8790            $ctext insert end "\n\t"
8791            $ctext insert end $child link$i
8792            setlink $child link$i
8793            $ctext insert end "\n\t[lindex $info 0]"
8794            $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8795            set date [formatdate [lindex $info 2]]
8796            $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8797        }
8798    }
8799    maybe_scroll_ctext 1
8800    $ctext conf -state disabled
8801    init_flist {}
8802}
8803
8804proc normalline {} {
8805    global thickerline
8806    if {[info exists thickerline]} {
8807        set id $thickerline
8808        unset thickerline
8809        drawlines $id
8810    }
8811}
8812
8813proc selbyid {id {isnew 1}} {
8814    global curview
8815    if {[commitinview $id $curview]} {
8816        selectline [rowofcommit $id] $isnew
8817    }
8818}
8819
8820proc mstime {} {
8821    global startmstime
8822    if {![info exists startmstime]} {
8823        set startmstime [clock clicks -milliseconds]
8824    }
8825    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8826}
8827
8828proc rowmenu {x y id} {
8829    global rowctxmenu selectedline rowmenuid curview
8830    global nullid nullid2 fakerowmenu mainhead markedid
8831
8832    stopfinding
8833    set rowmenuid $id
8834    if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8835        set state disabled
8836    } else {
8837        set state normal
8838    }
8839    if {[info exists markedid] && $markedid ne $id} {
8840        set mstate normal
8841    } else {
8842        set mstate disabled
8843    }
8844    if {$id ne $nullid && $id ne $nullid2} {
8845        set menu $rowctxmenu
8846        if {$mainhead ne {}} {
8847            $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead] -state normal
8848        } else {
8849            $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8850        }
8851        $menu entryconfigure 9 -state $mstate
8852        $menu entryconfigure 10 -state $mstate
8853        $menu entryconfigure 11 -state $mstate
8854    } else {
8855        set menu $fakerowmenu
8856    }
8857    $menu entryconfigure [mca "Diff this -> selected"] -state $state
8858    $menu entryconfigure [mca "Diff selected -> this"] -state $state
8859    $menu entryconfigure [mca "Make patch"] -state $state
8860    $menu entryconfigure [mca "Diff this -> marked commit"] -state $mstate
8861    $menu entryconfigure [mca "Diff marked commit -> this"] -state $mstate
8862    tk_popup $menu $x $y
8863}
8864
8865proc markhere {} {
8866    global rowmenuid markedid canv
8867
8868    set markedid $rowmenuid
8869    make_idmark $markedid
8870}
8871
8872proc gotomark {} {
8873    global markedid
8874
8875    if {[info exists markedid]} {
8876        selbyid $markedid
8877    }
8878}
8879
8880proc replace_by_kids {l r} {
8881    global curview children
8882
8883    set id [commitonrow $r]
8884    set l [lreplace $l 0 0]
8885    foreach kid $children($curview,$id) {
8886        lappend l [rowofcommit $kid]
8887    }
8888    return [lsort -integer -decreasing -unique $l]
8889}
8890
8891proc find_common_desc {} {
8892    global markedid rowmenuid curview children
8893
8894    if {![info exists markedid]} return
8895    if {![commitinview $markedid $curview] ||
8896        ![commitinview $rowmenuid $curview]} return
8897    #set t1 [clock clicks -milliseconds]
8898    set l1 [list [rowofcommit $markedid]]
8899    set l2 [list [rowofcommit $rowmenuid]]
8900    while 1 {
8901        set r1 [lindex $l1 0]
8902        set r2 [lindex $l2 0]
8903        if {$r1 eq {} || $r2 eq {}} break
8904        if {$r1 == $r2} {
8905            selectline $r1 1
8906            break
8907        }
8908        if {$r1 > $r2} {
8909            set l1 [replace_by_kids $l1 $r1]
8910        } else {
8911            set l2 [replace_by_kids $l2 $r2]
8912        }
8913    }
8914    #set t2 [clock clicks -milliseconds]
8915    #puts "took [expr {$t2-$t1}]ms"
8916}
8917
8918proc compare_commits {} {
8919    global markedid rowmenuid curview children
8920
8921    if {![info exists markedid]} return
8922    if {![commitinview $markedid $curview]} return
8923    addtohistory [list do_cmp_commits $markedid $rowmenuid]
8924    do_cmp_commits $markedid $rowmenuid
8925}
8926
8927proc getpatchid {id} {
8928    global patchids
8929
8930    if {![info exists patchids($id)]} {
8931        set cmd [diffcmd [list $id] {-p --root}]
8932        # trim off the initial "|"
8933        set cmd [lrange $cmd 1 end]
8934        if {[catch {
8935            set x [eval exec $cmd | git patch-id]
8936            set patchids($id) [lindex $x 0]
8937        }]} {
8938            set patchids($id) "error"
8939        }
8940    }
8941    return $patchids($id)
8942}
8943
8944proc do_cmp_commits {a b} {
8945    global ctext curview parents children patchids commitinfo
8946
8947    $ctext conf -state normal
8948    clear_ctext
8949    init_flist {}
8950    for {set i 0} {$i < 100} {incr i} {
8951        set skipa 0
8952        set skipb 0
8953        if {[llength $parents($curview,$a)] > 1} {
8954            appendshortlink $a [mc "Skipping merge commit "] "\n"
8955            set skipa 1
8956        } else {
8957            set patcha [getpatchid $a]
8958        }
8959        if {[llength $parents($curview,$b)] > 1} {
8960            appendshortlink $b [mc "Skipping merge commit "] "\n"
8961            set skipb 1
8962        } else {
8963            set patchb [getpatchid $b]
8964        }
8965        if {!$skipa && !$skipb} {
8966            set heada [lindex $commitinfo($a) 0]
8967            set headb [lindex $commitinfo($b) 0]
8968            if {$patcha eq "error"} {
8969                appendshortlink $a [mc "Error getting patch ID for "] \
8970                    [mc " - stopping\n"]
8971                break
8972            }
8973            if {$patchb eq "error"} {
8974                appendshortlink $b [mc "Error getting patch ID for "] \
8975                    [mc " - stopping\n"]
8976                break
8977            }
8978            if {$patcha eq $patchb} {
8979                if {$heada eq $headb} {
8980                    appendshortlink $a [mc "Commit "]
8981                    appendshortlink $b " == " "  $heada\n"
8982                } else {
8983                    appendshortlink $a [mc "Commit "] "  $heada\n"
8984                    appendshortlink $b [mc " is the same patch as\n       "] \
8985                        "  $headb\n"
8986                }
8987                set skipa 1
8988                set skipb 1
8989            } else {
8990                $ctext insert end "\n"
8991                appendshortlink $a [mc "Commit "] "  $heada\n"
8992                appendshortlink $b [mc " differs from\n       "] \
8993                    "  $headb\n"
8994                $ctext insert end [mc "Diff of commits:\n\n"]
8995                $ctext conf -state disabled
8996                update
8997                diffcommits $a $b
8998                return
8999            }
9000        }
9001        if {$skipa} {
9002            set kids [real_children $curview,$a]
9003            if {[llength $kids] != 1} {
9004                $ctext insert end "\n"
9005                appendshortlink $a [mc "Commit "] \
9006                    [mc " has %s children - stopping\n" [llength $kids]]
9007                break
9008            }
9009            set a [lindex $kids 0]
9010        }
9011        if {$skipb} {
9012            set kids [real_children $curview,$b]
9013            if {[llength $kids] != 1} {
9014                appendshortlink $b [mc "Commit "] \
9015                    [mc " has %s children - stopping\n" [llength $kids]]
9016                break
9017            }
9018            set b [lindex $kids 0]
9019        }
9020    }
9021    $ctext conf -state disabled
9022}
9023
9024proc diffcommits {a b} {
9025    global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
9026
9027    set tmpdir [gitknewtmpdir]
9028    set fna [file join $tmpdir "commit-[string range $a 0 7]"]
9029    set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
9030    if {[catch {
9031        exec git diff-tree -p --pretty $a >$fna
9032        exec git diff-tree -p --pretty $b >$fnb
9033    } err]} {
9034        error_popup [mc "Error writing commit to file: %s" $err]
9035        return
9036    }
9037    if {[catch {
9038        set fd [open "| diff -U$diffcontext $fna $fnb" r]
9039    } err]} {
9040        error_popup [mc "Error diffing commits: %s" $err]
9041        return
9042    }
9043    set diffids [list commits $a $b]
9044    set blobdifffd($diffids) $fd
9045    set diffinhdr 0
9046    set currdiffsubmod ""
9047    filerun $fd [list getblobdiffline $fd $diffids]
9048}
9049
9050proc diffvssel {dirn} {
9051    global rowmenuid selectedline
9052
9053    if {$selectedline eq {}} return
9054    if {$dirn} {
9055        set oldid [commitonrow $selectedline]
9056        set newid $rowmenuid
9057    } else {
9058        set oldid $rowmenuid
9059        set newid [commitonrow $selectedline]
9060    }
9061    addtohistory [list doseldiff $oldid $newid] savectextpos
9062    doseldiff $oldid $newid
9063}
9064
9065proc diffvsmark {dirn} {
9066    global rowmenuid markedid
9067
9068    if {![info exists markedid]} return
9069    if {$dirn} {
9070        set oldid $markedid
9071        set newid $rowmenuid
9072    } else {
9073        set oldid $rowmenuid
9074        set newid $markedid
9075    }
9076    addtohistory [list doseldiff $oldid $newid] savectextpos
9077    doseldiff $oldid $newid
9078}
9079
9080proc doseldiff {oldid newid} {
9081    global ctext
9082    global commitinfo
9083
9084    $ctext conf -state normal
9085    clear_ctext
9086    init_flist [mc "Top"]
9087    $ctext insert end "[mc "From"] "
9088    $ctext insert end $oldid link0
9089    setlink $oldid link0
9090    $ctext insert end "\n     "
9091    $ctext insert end [lindex $commitinfo($oldid) 0]
9092    $ctext insert end "\n\n[mc "To"]   "
9093    $ctext insert end $newid link1
9094    setlink $newid link1
9095    $ctext insert end "\n     "
9096    $ctext insert end [lindex $commitinfo($newid) 0]
9097    $ctext insert end "\n"
9098    $ctext conf -state disabled
9099    $ctext tag remove found 1.0 end
9100    startdiff [list $oldid $newid]
9101}
9102
9103proc mkpatch {} {
9104    global rowmenuid currentid commitinfo patchtop patchnum NS
9105
9106    if {![info exists currentid]} return
9107    set oldid $currentid
9108    set oldhead [lindex $commitinfo($oldid) 0]
9109    set newid $rowmenuid
9110    set newhead [lindex $commitinfo($newid) 0]
9111    set top .patch
9112    set patchtop $top
9113    catch {destroy $top}
9114    ttk_toplevel $top
9115    make_transient $top .
9116    ${NS}::label $top.title -text [mc "Generate patch"]
9117    grid $top.title - -pady 10
9118    ${NS}::label $top.from -text [mc "From:"]
9119    ${NS}::entry $top.fromsha1 -width 40
9120    $top.fromsha1 insert 0 $oldid
9121    $top.fromsha1 conf -state readonly
9122    grid $top.from $top.fromsha1 -sticky w
9123    ${NS}::entry $top.fromhead -width 60
9124    $top.fromhead insert 0 $oldhead
9125    $top.fromhead conf -state readonly
9126    grid x $top.fromhead -sticky w
9127    ${NS}::label $top.to -text [mc "To:"]
9128    ${NS}::entry $top.tosha1 -width 40
9129    $top.tosha1 insert 0 $newid
9130    $top.tosha1 conf -state readonly
9131    grid $top.to $top.tosha1 -sticky w
9132    ${NS}::entry $top.tohead -width 60
9133    $top.tohead insert 0 $newhead
9134    $top.tohead conf -state readonly
9135    grid x $top.tohead -sticky w
9136    ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
9137    grid $top.rev x -pady 10 -padx 5
9138    ${NS}::label $top.flab -text [mc "Output file:"]
9139    ${NS}::entry $top.fname -width 60
9140    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
9141    incr patchnum
9142    grid $top.flab $top.fname -sticky w
9143    ${NS}::frame $top.buts
9144    ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
9145    ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
9146    bind $top <Key-Return> mkpatchgo
9147    bind $top <Key-Escape> mkpatchcan
9148    grid $top.buts.gen $top.buts.can
9149    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9150    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9151    grid $top.buts - -pady 10 -sticky ew
9152    focus $top.fname
9153}
9154
9155proc mkpatchrev {} {
9156    global patchtop
9157
9158    set oldid [$patchtop.fromsha1 get]
9159    set oldhead [$patchtop.fromhead get]
9160    set newid [$patchtop.tosha1 get]
9161    set newhead [$patchtop.tohead get]
9162    foreach e [list fromsha1 fromhead tosha1 tohead] \
9163            v [list $newid $newhead $oldid $oldhead] {
9164        $patchtop.$e conf -state normal
9165        $patchtop.$e delete 0 end
9166        $patchtop.$e insert 0 $v
9167        $patchtop.$e conf -state readonly
9168    }
9169}
9170
9171proc mkpatchgo {} {
9172    global patchtop nullid nullid2
9173
9174    set oldid [$patchtop.fromsha1 get]
9175    set newid [$patchtop.tosha1 get]
9176    set fname [$patchtop.fname get]
9177    set cmd [diffcmd [list $oldid $newid] -p]
9178    # trim off the initial "|"
9179    set cmd [lrange $cmd 1 end]
9180    lappend cmd >$fname &
9181    if {[catch {eval exec $cmd} err]} {
9182        error_popup "[mc "Error creating patch:"] $err" $patchtop
9183    }
9184    catch {destroy $patchtop}
9185    unset patchtop
9186}
9187
9188proc mkpatchcan {} {
9189    global patchtop
9190
9191    catch {destroy $patchtop}
9192    unset patchtop
9193}
9194
9195proc mktag {} {
9196    global rowmenuid mktagtop commitinfo NS
9197
9198    set top .maketag
9199    set mktagtop $top
9200    catch {destroy $top}
9201    ttk_toplevel $top
9202    make_transient $top .
9203    ${NS}::label $top.title -text [mc "Create tag"]
9204    grid $top.title - -pady 10
9205    ${NS}::label $top.id -text [mc "ID:"]
9206    ${NS}::entry $top.sha1 -width 40
9207    $top.sha1 insert 0 $rowmenuid
9208    $top.sha1 conf -state readonly
9209    grid $top.id $top.sha1 -sticky w
9210    ${NS}::entry $top.head -width 60
9211    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9212    $top.head conf -state readonly
9213    grid x $top.head -sticky w
9214    ${NS}::label $top.tlab -text [mc "Tag name:"]
9215    ${NS}::entry $top.tag -width 60
9216    grid $top.tlab $top.tag -sticky w
9217    ${NS}::label $top.op -text [mc "Tag message is optional"]
9218    grid $top.op -columnspan 2 -sticky we
9219    ${NS}::label $top.mlab -text [mc "Tag message:"]
9220    ${NS}::entry $top.msg -width 60
9221    grid $top.mlab $top.msg -sticky w
9222    ${NS}::frame $top.buts
9223    ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
9224    ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
9225    bind $top <Key-Return> mktaggo
9226    bind $top <Key-Escape> mktagcan
9227    grid $top.buts.gen $top.buts.can
9228    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9229    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9230    grid $top.buts - -pady 10 -sticky ew
9231    focus $top.tag
9232}
9233
9234proc domktag {} {
9235    global mktagtop env tagids idtags
9236
9237    set id [$mktagtop.sha1 get]
9238    set tag [$mktagtop.tag get]
9239    set msg [$mktagtop.msg get]
9240    if {$tag == {}} {
9241        error_popup [mc "No tag name specified"] $mktagtop
9242        return 0
9243    }
9244    if {[info exists tagids($tag)]} {
9245        error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
9246        return 0
9247    }
9248    if {[catch {
9249        if {$msg != {}} {
9250            exec git tag -a -m $msg $tag $id
9251        } else {
9252            exec git tag $tag $id
9253        }
9254    } err]} {
9255        error_popup "[mc "Error creating tag:"] $err" $mktagtop
9256        return 0
9257    }
9258
9259    set tagids($tag) $id
9260    lappend idtags($id) $tag
9261    redrawtags $id
9262    addedtag $id
9263    dispneartags 0
9264    run refill_reflist
9265    return 1
9266}
9267
9268proc redrawtags {id} {
9269    global canv linehtag idpos currentid curview cmitlisted markedid
9270    global canvxmax iddrawn circleitem mainheadid circlecolors
9271    global mainheadcirclecolor
9272
9273    if {![commitinview $id $curview]} return
9274    if {![info exists iddrawn($id)]} return
9275    set row [rowofcommit $id]
9276    if {$id eq $mainheadid} {
9277        set ofill $mainheadcirclecolor
9278    } else {
9279        set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
9280    }
9281    $canv itemconf $circleitem($row) -fill $ofill
9282    $canv delete tag.$id
9283    set xt [eval drawtags $id $idpos($id)]
9284    $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
9285    set text [$canv itemcget $linehtag($id) -text]
9286    set font [$canv itemcget $linehtag($id) -font]
9287    set xr [expr {$xt + [font measure $font $text]}]
9288    if {$xr > $canvxmax} {
9289        set canvxmax $xr
9290        setcanvscroll
9291    }
9292    if {[info exists currentid] && $currentid == $id} {
9293        make_secsel $id
9294    }
9295    if {[info exists markedid] && $markedid eq $id} {
9296        make_idmark $id
9297    }
9298}
9299
9300proc mktagcan {} {
9301    global mktagtop
9302
9303    catch {destroy $mktagtop}
9304    unset mktagtop
9305}
9306
9307proc mktaggo {} {
9308    if {![domktag]} return
9309    mktagcan
9310}
9311
9312proc writecommit {} {
9313    global rowmenuid wrcomtop commitinfo wrcomcmd NS
9314
9315    set top .writecommit
9316    set wrcomtop $top
9317    catch {destroy $top}
9318    ttk_toplevel $top
9319    make_transient $top .
9320    ${NS}::label $top.title -text [mc "Write commit to file"]
9321    grid $top.title - -pady 10
9322    ${NS}::label $top.id -text [mc "ID:"]
9323    ${NS}::entry $top.sha1 -width 40
9324    $top.sha1 insert 0 $rowmenuid
9325    $top.sha1 conf -state readonly
9326    grid $top.id $top.sha1 -sticky w
9327    ${NS}::entry $top.head -width 60
9328    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9329    $top.head conf -state readonly
9330    grid x $top.head -sticky w
9331    ${NS}::label $top.clab -text [mc "Command:"]
9332    ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
9333    grid $top.clab $top.cmd -sticky w -pady 10
9334    ${NS}::label $top.flab -text [mc "Output file:"]
9335    ${NS}::entry $top.fname -width 60
9336    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
9337    grid $top.flab $top.fname -sticky w
9338    ${NS}::frame $top.buts
9339    ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
9340    ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
9341    bind $top <Key-Return> wrcomgo
9342    bind $top <Key-Escape> wrcomcan
9343    grid $top.buts.gen $top.buts.can
9344    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9345    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9346    grid $top.buts - -pady 10 -sticky ew
9347    focus $top.fname
9348}
9349
9350proc wrcomgo {} {
9351    global wrcomtop
9352
9353    set id [$wrcomtop.sha1 get]
9354    set cmd "echo $id | [$wrcomtop.cmd get]"
9355    set fname [$wrcomtop.fname get]
9356    if {[catch {exec sh -c $cmd >$fname &} err]} {
9357        error_popup "[mc "Error writing commit:"] $err" $wrcomtop
9358    }
9359    catch {destroy $wrcomtop}
9360    unset wrcomtop
9361}
9362
9363proc wrcomcan {} {
9364    global wrcomtop
9365
9366    catch {destroy $wrcomtop}
9367    unset wrcomtop
9368}
9369
9370proc mkbranch {} {
9371    global rowmenuid mkbrtop NS
9372
9373    set top .makebranch
9374    catch {destroy $top}
9375    ttk_toplevel $top
9376    make_transient $top .
9377    ${NS}::label $top.title -text [mc "Create new branch"]
9378    grid $top.title - -pady 10
9379    ${NS}::label $top.id -text [mc "ID:"]
9380    ${NS}::entry $top.sha1 -width 40
9381    $top.sha1 insert 0 $rowmenuid
9382    $top.sha1 conf -state readonly
9383    grid $top.id $top.sha1 -sticky w
9384    ${NS}::label $top.nlab -text [mc "Name:"]
9385    ${NS}::entry $top.name -width 40
9386    grid $top.nlab $top.name -sticky w
9387    ${NS}::frame $top.buts
9388    ${NS}::button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
9389    ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
9390    bind $top <Key-Return> [list mkbrgo $top]
9391    bind $top <Key-Escape> "catch {destroy $top}"
9392    grid $top.buts.go $top.buts.can
9393    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9394    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9395    grid $top.buts - -pady 10 -sticky ew
9396    focus $top.name
9397}
9398
9399proc mkbrgo {top} {
9400    global headids idheads
9401
9402    set name [$top.name get]
9403    set id [$top.sha1 get]
9404    set cmdargs {}
9405    set old_id {}
9406    if {$name eq {}} {
9407        error_popup [mc "Please specify a name for the new branch"] $top
9408        return
9409    }
9410    if {[info exists headids($name)]} {
9411        if {![confirm_popup [mc \
9412                "Branch '%s' already exists. Overwrite?" $name] $top]} {
9413            return
9414        }
9415        set old_id $headids($name)
9416        lappend cmdargs -f
9417    }
9418    catch {destroy $top}
9419    lappend cmdargs $name $id
9420    nowbusy newbranch
9421    update
9422    if {[catch {
9423        eval exec git branch $cmdargs
9424    } err]} {
9425        notbusy newbranch
9426        error_popup $err
9427    } else {
9428        notbusy newbranch
9429        if {$old_id ne {}} {
9430            movehead $id $name
9431            movedhead $id $name
9432            redrawtags $old_id
9433            redrawtags $id
9434        } else {
9435            set headids($name) $id
9436            lappend idheads($id) $name
9437            addedhead $id $name
9438            redrawtags $id
9439        }
9440        dispneartags 0
9441        run refill_reflist
9442    }
9443}
9444
9445proc exec_citool {tool_args {baseid {}}} {
9446    global commitinfo env
9447
9448    set save_env [array get env GIT_AUTHOR_*]
9449
9450    if {$baseid ne {}} {
9451        if {![info exists commitinfo($baseid)]} {
9452            getcommit $baseid
9453        }
9454        set author [lindex $commitinfo($baseid) 1]
9455        set date [lindex $commitinfo($baseid) 2]
9456        if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9457                    $author author name email]
9458            && $date ne {}} {
9459            set env(GIT_AUTHOR_NAME) $name
9460            set env(GIT_AUTHOR_EMAIL) $email
9461            set env(GIT_AUTHOR_DATE) $date
9462        }
9463    }
9464
9465    eval exec git citool $tool_args &
9466
9467    array unset env GIT_AUTHOR_*
9468    array set env $save_env
9469}
9470
9471proc cherrypick {} {
9472    global rowmenuid curview
9473    global mainhead mainheadid
9474    global gitdir
9475
9476    set oldhead [exec git rev-parse HEAD]
9477    set dheads [descheads $rowmenuid]
9478    if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
9479        set ok [confirm_popup [mc "Commit %s is already\
9480                included in branch %s -- really re-apply it?" \
9481                                   [string range $rowmenuid 0 7] $mainhead]]
9482        if {!$ok} return
9483    }
9484    nowbusy cherrypick [mc "Cherry-picking"]
9485    update
9486    # Unfortunately git-cherry-pick writes stuff to stderr even when
9487    # no error occurs, and exec takes that as an indication of error...
9488    if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9489        notbusy cherrypick
9490        if {[regexp -line \
9491                 {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9492                 $err msg fname]} {
9493            error_popup [mc "Cherry-pick failed because of local changes\
9494                        to file '%s'.\nPlease commit, reset or stash\
9495                        your changes and try again." $fname]
9496        } elseif {[regexp -line \
9497                       {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
9498                       $err]} {
9499            if {[confirm_popup [mc "Cherry-pick failed because of merge\
9500                        conflict.\nDo you wish to run git citool to\
9501                        resolve it?"]]} {
9502                # Force citool to read MERGE_MSG
9503                file delete [file join $gitdir "GITGUI_MSG"]
9504                exec_citool {} $rowmenuid
9505            }
9506        } else {
9507            error_popup $err
9508        }
9509        run updatecommits
9510        return
9511    }
9512    set newhead [exec git rev-parse HEAD]
9513    if {$newhead eq $oldhead} {
9514        notbusy cherrypick
9515        error_popup [mc "No changes committed"]
9516        return
9517    }
9518    addnewchild $newhead $oldhead
9519    if {[commitinview $oldhead $curview]} {
9520        # XXX this isn't right if we have a path limit...
9521        insertrow $newhead $oldhead $curview
9522        if {$mainhead ne {}} {
9523            movehead $newhead $mainhead
9524            movedhead $newhead $mainhead
9525        }
9526        set mainheadid $newhead
9527        redrawtags $oldhead
9528        redrawtags $newhead
9529        selbyid $newhead
9530    }
9531    notbusy cherrypick
9532}
9533
9534proc revert {} {
9535    global rowmenuid curview
9536    global mainhead mainheadid
9537    global gitdir
9538
9539    set oldhead [exec git rev-parse HEAD]
9540    set dheads [descheads $rowmenuid]
9541    if { $dheads eq {} || [lsearch -exact $dheads $oldhead] == -1 } {
9542       set ok [confirm_popup [mc "Commit %s is not\
9543           included in branch %s -- really revert it?" \
9544                      [string range $rowmenuid 0 7] $mainhead]]
9545       if {!$ok} return
9546    }
9547    nowbusy revert [mc "Reverting"]
9548    update
9549
9550    if [catch {exec git revert --no-edit $rowmenuid} err] {
9551        notbusy revert
9552        if [regexp {files would be overwritten by merge:(\n(( |\t)+[^\n]+\n)+)}\
9553                $err match files] {
9554            regsub {\n( |\t)+} $files "\n" files
9555            error_popup [mc "Revert failed because of local changes to\
9556                the following files:%s Please commit, reset or stash \
9557                your changes and try again." $files]
9558        } elseif [regexp {error: could not revert} $err] {
9559            if [confirm_popup [mc "Revert failed because of merge conflict.\n\
9560                Do you wish to run git citool to resolve it?"]] {
9561                # Force citool to read MERGE_MSG
9562                file delete [file join $gitdir "GITGUI_MSG"]
9563                exec_citool {} $rowmenuid
9564            }
9565        } else { error_popup $err }
9566        run updatecommits
9567        return
9568    }
9569
9570    set newhead [exec git rev-parse HEAD]
9571    if { $newhead eq $oldhead } {
9572        notbusy revert
9573        error_popup [mc "No changes committed"]
9574        return
9575    }
9576
9577    addnewchild $newhead $oldhead
9578
9579    if [commitinview $oldhead $curview] {
9580        # XXX this isn't right if we have a path limit...
9581        insertrow $newhead $oldhead $curview
9582        if {$mainhead ne {}} {
9583            movehead $newhead $mainhead
9584            movedhead $newhead $mainhead
9585        }
9586        set mainheadid $newhead
9587        redrawtags $oldhead
9588        redrawtags $newhead
9589        selbyid $newhead
9590    }
9591
9592    notbusy revert
9593}
9594
9595proc resethead {} {
9596    global mainhead rowmenuid confirm_ok resettype NS
9597
9598    set confirm_ok 0
9599    set w ".confirmreset"
9600    ttk_toplevel $w
9601    make_transient $w .
9602    wm title $w [mc "Confirm reset"]
9603    ${NS}::label $w.m -text \
9604        [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
9605    pack $w.m -side top -fill x -padx 20 -pady 20
9606    ${NS}::labelframe $w.f -text [mc "Reset type:"]
9607    set resettype mixed
9608    ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
9609        -text [mc "Soft: Leave working tree and index untouched"]
9610    grid $w.f.soft -sticky w
9611    ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
9612        -text [mc "Mixed: Leave working tree untouched, reset index"]
9613    grid $w.f.mixed -sticky w
9614    ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
9615        -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
9616    grid $w.f.hard -sticky w
9617    pack $w.f -side top -fill x -padx 4
9618    ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
9619    pack $w.ok -side left -fill x -padx 20 -pady 20
9620    ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
9621    bind $w <Key-Escape> [list destroy $w]
9622    pack $w.cancel -side right -fill x -padx 20 -pady 20
9623    bind $w <Visibility> "grab $w; focus $w"
9624    tkwait window $w
9625    if {!$confirm_ok} return
9626    if {[catch {set fd [open \
9627            [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
9628        error_popup $err
9629    } else {
9630        dohidelocalchanges
9631        filerun $fd [list readresetstat $fd]
9632        nowbusy reset [mc "Resetting"]
9633        selbyid $rowmenuid
9634    }
9635}
9636
9637proc readresetstat {fd} {
9638    global mainhead mainheadid showlocalchanges rprogcoord
9639
9640    if {[gets $fd line] >= 0} {
9641        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9642            set rprogcoord [expr {1.0 * $m / $n}]
9643            adjustprogress
9644        }
9645        return 1
9646    }
9647    set rprogcoord 0
9648    adjustprogress
9649    notbusy reset
9650    if {[catch {close $fd} err]} {
9651        error_popup $err
9652    }
9653    set oldhead $mainheadid
9654    set newhead [exec git rev-parse HEAD]
9655    if {$newhead ne $oldhead} {
9656        movehead $newhead $mainhead
9657        movedhead $newhead $mainhead
9658        set mainheadid $newhead
9659        redrawtags $oldhead
9660        redrawtags $newhead
9661    }
9662    if {$showlocalchanges} {
9663        doshowlocalchanges
9664    }
9665    return 0
9666}
9667
9668# context menu for a head
9669proc headmenu {x y id head} {
9670    global headmenuid headmenuhead headctxmenu mainhead
9671
9672    stopfinding
9673    set headmenuid $id
9674    set headmenuhead $head
9675    set state normal
9676    if {[string match "remotes/*" $head]} {
9677        set state disabled
9678    }
9679    if {$head eq $mainhead} {
9680        set state disabled
9681    }
9682    $headctxmenu entryconfigure 0 -state $state
9683    $headctxmenu entryconfigure 1 -state $state
9684    tk_popup $headctxmenu $x $y
9685}
9686
9687proc cobranch {} {
9688    global headmenuid headmenuhead headids
9689    global showlocalchanges
9690
9691    # check the tree is clean first??
9692    nowbusy checkout [mc "Checking out"]
9693    update
9694    dohidelocalchanges
9695    if {[catch {
9696        set fd [open [list | git checkout $headmenuhead 2>@1] r]
9697    } err]} {
9698        notbusy checkout
9699        error_popup $err
9700        if {$showlocalchanges} {
9701            dodiffindex
9702        }
9703    } else {
9704        filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
9705    }
9706}
9707
9708proc readcheckoutstat {fd newhead newheadid} {
9709    global mainhead mainheadid headids showlocalchanges progresscoords
9710    global viewmainheadid curview
9711
9712    if {[gets $fd line] >= 0} {
9713        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9714            set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9715            adjustprogress
9716        }
9717        return 1
9718    }
9719    set progresscoords {0 0}
9720    adjustprogress
9721    notbusy checkout
9722    if {[catch {close $fd} err]} {
9723        error_popup $err
9724    }
9725    set oldmainid $mainheadid
9726    set mainhead $newhead
9727    set mainheadid $newheadid
9728    set viewmainheadid($curview) $newheadid
9729    redrawtags $oldmainid
9730    redrawtags $newheadid
9731    selbyid $newheadid
9732    if {$showlocalchanges} {
9733        dodiffindex
9734    }
9735}
9736
9737proc rmbranch {} {
9738    global headmenuid headmenuhead mainhead
9739    global idheads
9740
9741    set head $headmenuhead
9742    set id $headmenuid
9743    # this check shouldn't be needed any more...
9744    if {$head eq $mainhead} {
9745        error_popup [mc "Cannot delete the currently checked-out branch"]
9746        return
9747    }
9748    set dheads [descheads $id]
9749    if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
9750        # the stuff on this branch isn't on any other branch
9751        if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9752                        branch.\nReally delete branch %s?" $head $head]]} return
9753    }
9754    nowbusy rmbranch
9755    update
9756    if {[catch {exec git branch -D $head} err]} {
9757        notbusy rmbranch
9758        error_popup $err
9759        return
9760    }
9761    removehead $id $head
9762    removedhead $id $head
9763    redrawtags $id
9764    notbusy rmbranch
9765    dispneartags 0
9766    run refill_reflist
9767}
9768
9769# Display a list of tags and heads
9770proc showrefs {} {
9771    global showrefstop bgcolor fgcolor selectbgcolor NS
9772    global bglist fglist reflistfilter reflist maincursor
9773
9774    set top .showrefs
9775    set showrefstop $top
9776    if {[winfo exists $top]} {
9777        raise $top
9778        refill_reflist
9779        return
9780    }
9781    ttk_toplevel $top
9782    wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
9783    make_transient $top .
9784    text $top.list -background $bgcolor -foreground $fgcolor \
9785        -selectbackground $selectbgcolor -font mainfont \
9786        -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
9787        -width 30 -height 20 -cursor $maincursor \
9788        -spacing1 1 -spacing3 1 -state disabled
9789    $top.list tag configure highlight -background $selectbgcolor
9790    lappend bglist $top.list
9791    lappend fglist $top.list
9792    ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
9793    ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
9794    grid $top.list $top.ysb -sticky nsew
9795    grid $top.xsb x -sticky ew
9796    ${NS}::frame $top.f
9797    ${NS}::label $top.f.l -text "[mc "Filter"]: "
9798    ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
9799    set reflistfilter "*"
9800    trace add variable reflistfilter write reflistfilter_change
9801    pack $top.f.e -side right -fill x -expand 1
9802    pack $top.f.l -side left
9803    grid $top.f - -sticky ew -pady 2
9804    ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
9805    bind $top <Key-Escape> [list destroy $top]
9806    grid $top.close -
9807    grid columnconfigure $top 0 -weight 1
9808    grid rowconfigure $top 0 -weight 1
9809    bind $top.list <1> {break}
9810    bind $top.list <B1-Motion> {break}
9811    bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
9812    set reflist {}
9813    refill_reflist
9814}
9815
9816proc sel_reflist {w x y} {
9817    global showrefstop reflist headids tagids otherrefids
9818
9819    if {![winfo exists $showrefstop]} return
9820    set l [lindex [split [$w index "@$x,$y"] "."] 0]
9821    set ref [lindex $reflist [expr {$l-1}]]
9822    set n [lindex $ref 0]
9823    switch -- [lindex $ref 1] {
9824        "H" {selbyid $headids($n)}
9825        "T" {selbyid $tagids($n)}
9826        "o" {selbyid $otherrefids($n)}
9827    }
9828    $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
9829}
9830
9831proc unsel_reflist {} {
9832    global showrefstop
9833
9834    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9835    $showrefstop.list tag remove highlight 0.0 end
9836}
9837
9838proc reflistfilter_change {n1 n2 op} {
9839    global reflistfilter
9840
9841    after cancel refill_reflist
9842    after 200 refill_reflist
9843}
9844
9845proc refill_reflist {} {
9846    global reflist reflistfilter showrefstop headids tagids otherrefids
9847    global curview
9848
9849    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9850    set refs {}
9851    foreach n [array names headids] {
9852        if {[string match $reflistfilter $n]} {
9853            if {[commitinview $headids($n) $curview]} {
9854                lappend refs [list $n H]
9855            } else {
9856                interestedin $headids($n) {run refill_reflist}
9857            }
9858        }
9859    }
9860    foreach n [array names tagids] {
9861        if {[string match $reflistfilter $n]} {
9862            if {[commitinview $tagids($n) $curview]} {
9863                lappend refs [list $n T]
9864            } else {
9865                interestedin $tagids($n) {run refill_reflist}
9866            }
9867        }
9868    }
9869    foreach n [array names otherrefids] {
9870        if {[string match $reflistfilter $n]} {
9871            if {[commitinview $otherrefids($n) $curview]} {
9872                lappend refs [list $n o]
9873            } else {
9874                interestedin $otherrefids($n) {run refill_reflist}
9875            }
9876        }
9877    }
9878    set refs [lsort -index 0 $refs]
9879    if {$refs eq $reflist} return
9880
9881    # Update the contents of $showrefstop.list according to the
9882    # differences between $reflist (old) and $refs (new)
9883    $showrefstop.list conf -state normal
9884    $showrefstop.list insert end "\n"
9885    set i 0
9886    set j 0
9887    while {$i < [llength $reflist] || $j < [llength $refs]} {
9888        if {$i < [llength $reflist]} {
9889            if {$j < [llength $refs]} {
9890                set cmp [string compare [lindex $reflist $i 0] \
9891                             [lindex $refs $j 0]]
9892                if {$cmp == 0} {
9893                    set cmp [string compare [lindex $reflist $i 1] \
9894                                 [lindex $refs $j 1]]
9895                }
9896            } else {
9897                set cmp -1
9898            }
9899        } else {
9900            set cmp 1
9901        }
9902        switch -- $cmp {
9903            -1 {
9904                $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
9905                incr i
9906            }
9907            0 {
9908                incr i
9909                incr j
9910            }
9911            1 {
9912                set l [expr {$j + 1}]
9913                $showrefstop.list image create $l.0 -align baseline \
9914                    -image reficon-[lindex $refs $j 1] -padx 2
9915                $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
9916                incr j
9917            }
9918        }
9919    }
9920    set reflist $refs
9921    # delete last newline
9922    $showrefstop.list delete end-2c end-1c
9923    $showrefstop.list conf -state disabled
9924}
9925
9926# Stuff for finding nearby tags
9927proc getallcommits {} {
9928    global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
9929    global idheads idtags idotherrefs allparents tagobjid
9930    global gitdir
9931
9932    if {![info exists allcommits]} {
9933        set nextarc 0
9934        set allcommits 0
9935        set seeds {}
9936        set allcwait 0
9937        set cachedarcs 0
9938        set allccache [file join $gitdir "gitk.cache"]
9939        if {![catch {
9940            set f [open $allccache r]
9941            set allcwait 1
9942            getcache $f
9943        }]} return
9944    }
9945
9946    if {$allcwait} {
9947        return
9948    }
9949    set cmd [list | git rev-list --parents]
9950    set allcupdate [expr {$seeds ne {}}]
9951    if {!$allcupdate} {
9952        set ids "--all"
9953    } else {
9954        set refs [concat [array names idheads] [array names idtags] \
9955                      [array names idotherrefs]]
9956        set ids {}
9957        set tagobjs {}
9958        foreach name [array names tagobjid] {
9959            lappend tagobjs $tagobjid($name)
9960        }
9961        foreach id [lsort -unique $refs] {
9962            if {![info exists allparents($id)] &&
9963                [lsearch -exact $tagobjs $id] < 0} {
9964                lappend ids $id
9965            }
9966        }
9967        if {$ids ne {}} {
9968            foreach id $seeds {
9969                lappend ids "^$id"
9970            }
9971        }
9972    }
9973    if {$ids ne {}} {
9974        set fd [open [concat $cmd $ids] r]
9975        fconfigure $fd -blocking 0
9976        incr allcommits
9977        nowbusy allcommits
9978        filerun $fd [list getallclines $fd]
9979    } else {
9980        dispneartags 0
9981    }
9982}
9983
9984# Since most commits have 1 parent and 1 child, we group strings of
9985# such commits into "arcs" joining branch/merge points (BMPs), which
9986# are commits that either don't have 1 parent or don't have 1 child.
9987#
9988# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
9989# arcout(id) - outgoing arcs for BMP
9990# arcids(a) - list of IDs on arc including end but not start
9991# arcstart(a) - BMP ID at start of arc
9992# arcend(a) - BMP ID at end of arc
9993# growing(a) - arc a is still growing
9994# arctags(a) - IDs out of arcids (excluding end) that have tags
9995# archeads(a) - IDs out of arcids (excluding end) that have heads
9996# The start of an arc is at the descendent end, so "incoming" means
9997# coming from descendents, and "outgoing" means going towards ancestors.
9998
9999proc getallclines {fd} {
10000    global allparents allchildren idtags idheads nextarc
10001    global arcnos arcids arctags arcout arcend arcstart archeads growing
10002    global seeds allcommits cachedarcs allcupdate
10003
10004    set nid 0
10005    while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
10006        set id [lindex $line 0]
10007        if {[info exists allparents($id)]} {
10008            # seen it already
10009            continue
10010        }
10011        set cachedarcs 0
10012        set olds [lrange $line 1 end]
10013        set allparents($id) $olds
10014        if {![info exists allchildren($id)]} {
10015            set allchildren($id) {}
10016            set arcnos($id) {}
10017            lappend seeds $id
10018        } else {
10019            set a $arcnos($id)
10020            if {[llength $olds] == 1 && [llength $a] == 1} {
10021                lappend arcids($a) $id
10022                if {[info exists idtags($id)]} {
10023                    lappend arctags($a) $id
10024                }
10025                if {[info exists idheads($id)]} {
10026                    lappend archeads($a) $id
10027                }
10028                if {[info exists allparents($olds)]} {
10029                    # seen parent already
10030                    if {![info exists arcout($olds)]} {
10031                        splitarc $olds
10032                    }
10033                    lappend arcids($a) $olds
10034                    set arcend($a) $olds
10035                    unset growing($a)
10036                }
10037                lappend allchildren($olds) $id
10038                lappend arcnos($olds) $a
10039                continue
10040            }
10041        }
10042        foreach a $arcnos($id) {
10043            lappend arcids($a) $id
10044            set arcend($a) $id
10045            unset growing($a)
10046        }
10047
10048        set ao {}
10049        foreach p $olds {
10050            lappend allchildren($p) $id
10051            set a [incr nextarc]
10052            set arcstart($a) $id
10053            set archeads($a) {}
10054            set arctags($a) {}
10055            set archeads($a) {}
10056            set arcids($a) {}
10057            lappend ao $a
10058            set growing($a) 1
10059            if {[info exists allparents($p)]} {
10060                # seen it already, may need to make a new branch
10061                if {![info exists arcout($p)]} {
10062                    splitarc $p
10063                }
10064                lappend arcids($a) $p
10065                set arcend($a) $p
10066                unset growing($a)
10067            }
10068            lappend arcnos($p) $a
10069        }
10070        set arcout($id) $ao
10071    }
10072    if {$nid > 0} {
10073        global cached_dheads cached_dtags cached_atags
10074        catch {unset cached_dheads}
10075        catch {unset cached_dtags}
10076        catch {unset cached_atags}
10077    }
10078    if {![eof $fd]} {
10079        return [expr {$nid >= 1000? 2: 1}]
10080    }
10081    set cacheok 1
10082    if {[catch {
10083        fconfigure $fd -blocking 1
10084        close $fd
10085    } err]} {
10086        # got an error reading the list of commits
10087        # if we were updating, try rereading the whole thing again
10088        if {$allcupdate} {
10089            incr allcommits -1
10090            dropcache $err
10091            return
10092        }
10093        error_popup "[mc "Error reading commit topology information;\
10094                branch and preceding/following tag information\
10095                will be incomplete."]\n($err)"
10096        set cacheok 0
10097    }
10098    if {[incr allcommits -1] == 0} {
10099        notbusy allcommits
10100        if {$cacheok} {
10101            run savecache
10102        }
10103    }
10104    dispneartags 0
10105    return 0
10106}
10107
10108proc recalcarc {a} {
10109    global arctags archeads arcids idtags idheads
10110
10111    set at {}
10112    set ah {}
10113    foreach id [lrange $arcids($a) 0 end-1] {
10114        if {[info exists idtags($id)]} {
10115            lappend at $id
10116        }
10117        if {[info exists idheads($id)]} {
10118            lappend ah $id
10119        }
10120    }
10121    set arctags($a) $at
10122    set archeads($a) $ah
10123}
10124
10125proc splitarc {p} {
10126    global arcnos arcids nextarc arctags archeads idtags idheads
10127    global arcstart arcend arcout allparents growing
10128
10129    set a $arcnos($p)
10130    if {[llength $a] != 1} {
10131        puts "oops splitarc called but [llength $a] arcs already"
10132        return
10133    }
10134    set a [lindex $a 0]
10135    set i [lsearch -exact $arcids($a) $p]
10136    if {$i < 0} {
10137        puts "oops splitarc $p not in arc $a"
10138        return
10139    }
10140    set na [incr nextarc]
10141    if {[info exists arcend($a)]} {
10142        set arcend($na) $arcend($a)
10143    } else {
10144        set l [lindex $allparents([lindex $arcids($a) end]) 0]
10145        set j [lsearch -exact $arcnos($l) $a]
10146        set arcnos($l) [lreplace $arcnos($l) $j $j $na]
10147    }
10148    set tail [lrange $arcids($a) [expr {$i+1}] end]
10149    set arcids($a) [lrange $arcids($a) 0 $i]
10150    set arcend($a) $p
10151    set arcstart($na) $p
10152    set arcout($p) $na
10153    set arcids($na) $tail
10154    if {[info exists growing($a)]} {
10155        set growing($na) 1
10156        unset growing($a)
10157    }
10158
10159    foreach id $tail {
10160        if {[llength $arcnos($id)] == 1} {
10161            set arcnos($id) $na
10162        } else {
10163            set j [lsearch -exact $arcnos($id) $a]
10164            set arcnos($id) [lreplace $arcnos($id) $j $j $na]
10165        }
10166    }
10167
10168    # reconstruct tags and heads lists
10169    if {$arctags($a) ne {} || $archeads($a) ne {}} {
10170        recalcarc $a
10171        recalcarc $na
10172    } else {
10173        set arctags($na) {}
10174        set archeads($na) {}
10175    }
10176}
10177
10178# Update things for a new commit added that is a child of one
10179# existing commit.  Used when cherry-picking.
10180proc addnewchild {id p} {
10181    global allparents allchildren idtags nextarc
10182    global arcnos arcids arctags arcout arcend arcstart archeads growing
10183    global seeds allcommits
10184
10185    if {![info exists allcommits] || ![info exists arcnos($p)]} return
10186    set allparents($id) [list $p]
10187    set allchildren($id) {}
10188    set arcnos($id) {}
10189    lappend seeds $id
10190    lappend allchildren($p) $id
10191    set a [incr nextarc]
10192    set arcstart($a) $id
10193    set archeads($a) {}
10194    set arctags($a) {}
10195    set arcids($a) [list $p]
10196    set arcend($a) $p
10197    if {![info exists arcout($p)]} {
10198        splitarc $p
10199    }
10200    lappend arcnos($p) $a
10201    set arcout($id) [list $a]
10202}
10203
10204# This implements a cache for the topology information.
10205# The cache saves, for each arc, the start and end of the arc,
10206# the ids on the arc, and the outgoing arcs from the end.
10207proc readcache {f} {
10208    global arcnos arcids arcout arcstart arcend arctags archeads nextarc
10209    global idtags idheads allparents cachedarcs possible_seeds seeds growing
10210    global allcwait
10211
10212    set a $nextarc
10213    set lim $cachedarcs
10214    if {$lim - $a > 500} {
10215        set lim [expr {$a + 500}]
10216    }
10217    if {[catch {
10218        if {$a == $lim} {
10219            # finish reading the cache and setting up arctags, etc.
10220            set line [gets $f]
10221            if {$line ne "1"} {error "bad final version"}
10222            close $f
10223            foreach id [array names idtags] {
10224                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10225                    [llength $allparents($id)] == 1} {
10226                    set a [lindex $arcnos($id) 0]
10227                    if {$arctags($a) eq {}} {
10228                        recalcarc $a
10229                    }
10230                }
10231            }
10232            foreach id [array names idheads] {
10233                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10234                    [llength $allparents($id)] == 1} {
10235                    set a [lindex $arcnos($id) 0]
10236                    if {$archeads($a) eq {}} {
10237                        recalcarc $a
10238                    }
10239                }
10240            }
10241            foreach id [lsort -unique $possible_seeds] {
10242                if {$arcnos($id) eq {}} {
10243                    lappend seeds $id
10244                }
10245            }
10246            set allcwait 0
10247        } else {
10248            while {[incr a] <= $lim} {
10249                set line [gets $f]
10250                if {[llength $line] != 3} {error "bad line"}
10251                set s [lindex $line 0]
10252                set arcstart($a) $s
10253                lappend arcout($s) $a
10254                if {![info exists arcnos($s)]} {
10255                    lappend possible_seeds $s
10256                    set arcnos($s) {}
10257                }
10258                set e [lindex $line 1]
10259                if {$e eq {}} {
10260                    set growing($a) 1
10261                } else {
10262                    set arcend($a) $e
10263                    if {![info exists arcout($e)]} {
10264                        set arcout($e) {}
10265                    }
10266                }
10267                set arcids($a) [lindex $line 2]
10268                foreach id $arcids($a) {
10269                    lappend allparents($s) $id
10270                    set s $id
10271                    lappend arcnos($id) $a
10272                }
10273                if {![info exists allparents($s)]} {
10274                    set allparents($s) {}
10275                }
10276                set arctags($a) {}
10277                set archeads($a) {}
10278            }
10279            set nextarc [expr {$a - 1}]
10280        }
10281    } err]} {
10282        dropcache $err
10283        return 0
10284    }
10285    if {!$allcwait} {
10286        getallcommits
10287    }
10288    return $allcwait
10289}
10290
10291proc getcache {f} {
10292    global nextarc cachedarcs possible_seeds
10293
10294    if {[catch {
10295        set line [gets $f]
10296        if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
10297        # make sure it's an integer
10298        set cachedarcs [expr {int([lindex $line 1])}]
10299        if {$cachedarcs < 0} {error "bad number of arcs"}
10300        set nextarc 0
10301        set possible_seeds {}
10302        run readcache $f
10303    } err]} {
10304        dropcache $err
10305    }
10306    return 0
10307}
10308
10309proc dropcache {err} {
10310    global allcwait nextarc cachedarcs seeds
10311
10312    #puts "dropping cache ($err)"
10313    foreach v {arcnos arcout arcids arcstart arcend growing \
10314                   arctags archeads allparents allchildren} {
10315        global $v
10316        catch {unset $v}
10317    }
10318    set allcwait 0
10319    set nextarc 0
10320    set cachedarcs 0
10321    set seeds {}
10322    getallcommits
10323}
10324
10325proc writecache {f} {
10326    global cachearc cachedarcs allccache
10327    global arcstart arcend arcnos arcids arcout
10328
10329    set a $cachearc
10330    set lim $cachedarcs
10331    if {$lim - $a > 1000} {
10332        set lim [expr {$a + 1000}]
10333    }
10334    if {[catch {
10335        while {[incr a] <= $lim} {
10336            if {[info exists arcend($a)]} {
10337                puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
10338            } else {
10339                puts $f [list $arcstart($a) {} $arcids($a)]
10340            }
10341        }
10342    } err]} {
10343        catch {close $f}
10344        catch {file delete $allccache}
10345        #puts "writing cache failed ($err)"
10346        return 0
10347    }
10348    set cachearc [expr {$a - 1}]
10349    if {$a > $cachedarcs} {
10350        puts $f "1"
10351        close $f
10352        return 0
10353    }
10354    return 1
10355}
10356
10357proc savecache {} {
10358    global nextarc cachedarcs cachearc allccache
10359
10360    if {$nextarc == $cachedarcs} return
10361    set cachearc 0
10362    set cachedarcs $nextarc
10363    catch {
10364        set f [open $allccache w]
10365        puts $f [list 1 $cachedarcs]
10366        run writecache $f
10367    }
10368}
10369
10370# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
10371# or 0 if neither is true.
10372proc anc_or_desc {a b} {
10373    global arcout arcstart arcend arcnos cached_isanc
10374
10375    if {$arcnos($a) eq $arcnos($b)} {
10376        # Both are on the same arc(s); either both are the same BMP,
10377        # or if one is not a BMP, the other is also not a BMP or is
10378        # the BMP at end of the arc (and it only has 1 incoming arc).
10379        # Or both can be BMPs with no incoming arcs.
10380        if {$a eq $b || $arcnos($a) eq {}} {
10381            return 0
10382        }
10383        # assert {[llength $arcnos($a)] == 1}
10384        set arc [lindex $arcnos($a) 0]
10385        set i [lsearch -exact $arcids($arc) $a]
10386        set j [lsearch -exact $arcids($arc) $b]
10387        if {$i < 0 || $i > $j} {
10388            return 1
10389        } else {
10390            return -1
10391        }
10392    }
10393
10394    if {![info exists arcout($a)]} {
10395        set arc [lindex $arcnos($a) 0]
10396        if {[info exists arcend($arc)]} {
10397            set aend $arcend($arc)
10398        } else {
10399            set aend {}
10400        }
10401        set a $arcstart($arc)
10402    } else {
10403        set aend $a
10404    }
10405    if {![info exists arcout($b)]} {
10406        set arc [lindex $arcnos($b) 0]
10407        if {[info exists arcend($arc)]} {
10408            set bend $arcend($arc)
10409        } else {
10410            set bend {}
10411        }
10412        set b $arcstart($arc)
10413    } else {
10414        set bend $b
10415    }
10416    if {$a eq $bend} {
10417        return 1
10418    }
10419    if {$b eq $aend} {
10420        return -1
10421    }
10422    if {[info exists cached_isanc($a,$bend)]} {
10423        if {$cached_isanc($a,$bend)} {
10424            return 1
10425        }
10426    }
10427    if {[info exists cached_isanc($b,$aend)]} {
10428        if {$cached_isanc($b,$aend)} {
10429            return -1
10430        }
10431        if {[info exists cached_isanc($a,$bend)]} {
10432            return 0
10433        }
10434    }
10435
10436    set todo [list $a $b]
10437    set anc($a) a
10438    set anc($b) b
10439    for {set i 0} {$i < [llength $todo]} {incr i} {
10440        set x [lindex $todo $i]
10441        if {$anc($x) eq {}} {
10442            continue
10443        }
10444        foreach arc $arcnos($x) {
10445            set xd $arcstart($arc)
10446            if {$xd eq $bend} {
10447                set cached_isanc($a,$bend) 1
10448                set cached_isanc($b,$aend) 0
10449                return 1
10450            } elseif {$xd eq $aend} {
10451                set cached_isanc($b,$aend) 1
10452                set cached_isanc($a,$bend) 0
10453                return -1
10454            }
10455            if {![info exists anc($xd)]} {
10456                set anc($xd) $anc($x)
10457                lappend todo $xd
10458            } elseif {$anc($xd) ne $anc($x)} {
10459                set anc($xd) {}
10460            }
10461        }
10462    }
10463    set cached_isanc($a,$bend) 0
10464    set cached_isanc($b,$aend) 0
10465    return 0
10466}
10467
10468# This identifies whether $desc has an ancestor that is
10469# a growing tip of the graph and which is not an ancestor of $anc
10470# and returns 0 if so and 1 if not.
10471# If we subsequently discover a tag on such a growing tip, and that
10472# turns out to be a descendent of $anc (which it could, since we
10473# don't necessarily see children before parents), then $desc
10474# isn't a good choice to display as a descendent tag of
10475# $anc (since it is the descendent of another tag which is
10476# a descendent of $anc).  Similarly, $anc isn't a good choice to
10477# display as a ancestor tag of $desc.
10478#
10479proc is_certain {desc anc} {
10480    global arcnos arcout arcstart arcend growing problems
10481
10482    set certain {}
10483    if {[llength $arcnos($anc)] == 1} {
10484        # tags on the same arc are certain
10485        if {$arcnos($desc) eq $arcnos($anc)} {
10486            return 1
10487        }
10488        if {![info exists arcout($anc)]} {
10489            # if $anc is partway along an arc, use the start of the arc instead
10490            set a [lindex $arcnos($anc) 0]
10491            set anc $arcstart($a)
10492        }
10493    }
10494    if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
10495        set x $desc
10496    } else {
10497        set a [lindex $arcnos($desc) 0]
10498        set x $arcend($a)
10499    }
10500    if {$x == $anc} {
10501        return 1
10502    }
10503    set anclist [list $x]
10504    set dl($x) 1
10505    set nnh 1
10506    set ngrowanc 0
10507    for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
10508        set x [lindex $anclist $i]
10509        if {$dl($x)} {
10510            incr nnh -1
10511        }
10512        set done($x) 1
10513        foreach a $arcout($x) {
10514            if {[info exists growing($a)]} {
10515                if {![info exists growanc($x)] && $dl($x)} {
10516                    set growanc($x) 1
10517                    incr ngrowanc
10518                }
10519            } else {
10520                set y $arcend($a)
10521                if {[info exists dl($y)]} {
10522                    if {$dl($y)} {
10523                        if {!$dl($x)} {
10524                            set dl($y) 0
10525                            if {![info exists done($y)]} {
10526                                incr nnh -1
10527                            }
10528                            if {[info exists growanc($x)]} {
10529                                incr ngrowanc -1
10530                            }
10531                            set xl [list $y]
10532                            for {set k 0} {$k < [llength $xl]} {incr k} {
10533                                set z [lindex $xl $k]
10534                                foreach c $arcout($z) {
10535                                    if {[info exists arcend($c)]} {
10536                                        set v $arcend($c)
10537                                        if {[info exists dl($v)] && $dl($v)} {
10538                                            set dl($v) 0
10539                                            if {![info exists done($v)]} {
10540                                                incr nnh -1
10541                                            }
10542                                            if {[info exists growanc($v)]} {
10543                                                incr ngrowanc -1
10544                                            }
10545                                            lappend xl $v
10546                                        }
10547                                    }
10548                                }
10549                            }
10550                        }
10551                    }
10552                } elseif {$y eq $anc || !$dl($x)} {
10553                    set dl($y) 0
10554                    lappend anclist $y
10555                } else {
10556                    set dl($y) 1
10557                    lappend anclist $y
10558                    incr nnh
10559                }
10560            }
10561        }
10562    }
10563    foreach x [array names growanc] {
10564        if {$dl($x)} {
10565            return 0
10566        }
10567        return 0
10568    }
10569    return 1
10570}
10571
10572proc validate_arctags {a} {
10573    global arctags idtags
10574
10575    set i -1
10576    set na $arctags($a)
10577    foreach id $arctags($a) {
10578        incr i
10579        if {![info exists idtags($id)]} {
10580            set na [lreplace $na $i $i]
10581            incr i -1
10582        }
10583    }
10584    set arctags($a) $na
10585}
10586
10587proc validate_archeads {a} {
10588    global archeads idheads
10589
10590    set i -1
10591    set na $archeads($a)
10592    foreach id $archeads($a) {
10593        incr i
10594        if {![info exists idheads($id)]} {
10595            set na [lreplace $na $i $i]
10596            incr i -1
10597        }
10598    }
10599    set archeads($a) $na
10600}
10601
10602# Return the list of IDs that have tags that are descendents of id,
10603# ignoring IDs that are descendents of IDs already reported.
10604proc desctags {id} {
10605    global arcnos arcstart arcids arctags idtags allparents
10606    global growing cached_dtags
10607
10608    if {![info exists allparents($id)]} {
10609        return {}
10610    }
10611    set t1 [clock clicks -milliseconds]
10612    set argid $id
10613    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10614        # part-way along an arc; check that arc first
10615        set a [lindex $arcnos($id) 0]
10616        if {$arctags($a) ne {}} {
10617            validate_arctags $a
10618            set i [lsearch -exact $arcids($a) $id]
10619            set tid {}
10620            foreach t $arctags($a) {
10621                set j [lsearch -exact $arcids($a) $t]
10622                if {$j >= $i} break
10623                set tid $t
10624            }
10625            if {$tid ne {}} {
10626                return $tid
10627            }
10628        }
10629        set id $arcstart($a)
10630        if {[info exists idtags($id)]} {
10631            return $id
10632        }
10633    }
10634    if {[info exists cached_dtags($id)]} {
10635        return $cached_dtags($id)
10636    }
10637
10638    set origid $id
10639    set todo [list $id]
10640    set queued($id) 1
10641    set nc 1
10642    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10643        set id [lindex $todo $i]
10644        set done($id) 1
10645        set ta [info exists hastaggedancestor($id)]
10646        if {!$ta} {
10647            incr nc -1
10648        }
10649        # ignore tags on starting node
10650        if {!$ta && $i > 0} {
10651            if {[info exists idtags($id)]} {
10652                set tagloc($id) $id
10653                set ta 1
10654            } elseif {[info exists cached_dtags($id)]} {
10655                set tagloc($id) $cached_dtags($id)
10656                set ta 1
10657            }
10658        }
10659        foreach a $arcnos($id) {
10660            set d $arcstart($a)
10661            if {!$ta && $arctags($a) ne {}} {
10662                validate_arctags $a
10663                if {$arctags($a) ne {}} {
10664                    lappend tagloc($id) [lindex $arctags($a) end]
10665                }
10666            }
10667            if {$ta || $arctags($a) ne {}} {
10668                set tomark [list $d]
10669                for {set j 0} {$j < [llength $tomark]} {incr j} {
10670                    set dd [lindex $tomark $j]
10671                    if {![info exists hastaggedancestor($dd)]} {
10672                        if {[info exists done($dd)]} {
10673                            foreach b $arcnos($dd) {
10674                                lappend tomark $arcstart($b)
10675                            }
10676                            if {[info exists tagloc($dd)]} {
10677                                unset tagloc($dd)
10678                            }
10679                        } elseif {[info exists queued($dd)]} {
10680                            incr nc -1
10681                        }
10682                        set hastaggedancestor($dd) 1
10683                    }
10684                }
10685            }
10686            if {![info exists queued($d)]} {
10687                lappend todo $d
10688                set queued($d) 1
10689                if {![info exists hastaggedancestor($d)]} {
10690                    incr nc
10691                }
10692            }
10693        }
10694    }
10695    set tags {}
10696    foreach id [array names tagloc] {
10697        if {![info exists hastaggedancestor($id)]} {
10698            foreach t $tagloc($id) {
10699                if {[lsearch -exact $tags $t] < 0} {
10700                    lappend tags $t
10701                }
10702            }
10703        }
10704    }
10705    set t2 [clock clicks -milliseconds]
10706    set loopix $i
10707
10708    # remove tags that are descendents of other tags
10709    for {set i 0} {$i < [llength $tags]} {incr i} {
10710        set a [lindex $tags $i]
10711        for {set j 0} {$j < $i} {incr j} {
10712            set b [lindex $tags $j]
10713            set r [anc_or_desc $a $b]
10714            if {$r == 1} {
10715                set tags [lreplace $tags $j $j]
10716                incr j -1
10717                incr i -1
10718            } elseif {$r == -1} {
10719                set tags [lreplace $tags $i $i]
10720                incr i -1
10721                break
10722            }
10723        }
10724    }
10725
10726    if {[array names growing] ne {}} {
10727        # graph isn't finished, need to check if any tag could get
10728        # eclipsed by another tag coming later.  Simply ignore any
10729        # tags that could later get eclipsed.
10730        set ctags {}
10731        foreach t $tags {
10732            if {[is_certain $t $origid]} {
10733                lappend ctags $t
10734            }
10735        }
10736        if {$tags eq $ctags} {
10737            set cached_dtags($origid) $tags
10738        } else {
10739            set tags $ctags
10740        }
10741    } else {
10742        set cached_dtags($origid) $tags
10743    }
10744    set t3 [clock clicks -milliseconds]
10745    if {0 && $t3 - $t1 >= 100} {
10746        puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10747            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10748    }
10749    return $tags
10750}
10751
10752proc anctags {id} {
10753    global arcnos arcids arcout arcend arctags idtags allparents
10754    global growing cached_atags
10755
10756    if {![info exists allparents($id)]} {
10757        return {}
10758    }
10759    set t1 [clock clicks -milliseconds]
10760    set argid $id
10761    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10762        # part-way along an arc; check that arc first
10763        set a [lindex $arcnos($id) 0]
10764        if {$arctags($a) ne {}} {
10765            validate_arctags $a
10766            set i [lsearch -exact $arcids($a) $id]
10767            foreach t $arctags($a) {
10768                set j [lsearch -exact $arcids($a) $t]
10769                if {$j > $i} {
10770                    return $t
10771                }
10772            }
10773        }
10774        if {![info exists arcend($a)]} {
10775            return {}
10776        }
10777        set id $arcend($a)
10778        if {[info exists idtags($id)]} {
10779            return $id
10780        }
10781    }
10782    if {[info exists cached_atags($id)]} {
10783        return $cached_atags($id)
10784    }
10785
10786    set origid $id
10787    set todo [list $id]
10788    set queued($id) 1
10789    set taglist {}
10790    set nc 1
10791    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10792        set id [lindex $todo $i]
10793        set done($id) 1
10794        set td [info exists hastaggeddescendent($id)]
10795        if {!$td} {
10796            incr nc -1
10797        }
10798        # ignore tags on starting node
10799        if {!$td && $i > 0} {
10800            if {[info exists idtags($id)]} {
10801                set tagloc($id) $id
10802                set td 1
10803            } elseif {[info exists cached_atags($id)]} {
10804                set tagloc($id) $cached_atags($id)
10805                set td 1
10806            }
10807        }
10808        foreach a $arcout($id) {
10809            if {!$td && $arctags($a) ne {}} {
10810                validate_arctags $a
10811                if {$arctags($a) ne {}} {
10812                    lappend tagloc($id) [lindex $arctags($a) 0]
10813                }
10814            }
10815            if {![info exists arcend($a)]} continue
10816            set d $arcend($a)
10817            if {$td || $arctags($a) ne {}} {
10818                set tomark [list $d]
10819                for {set j 0} {$j < [llength $tomark]} {incr j} {
10820                    set dd [lindex $tomark $j]
10821                    if {![info exists hastaggeddescendent($dd)]} {
10822                        if {[info exists done($dd)]} {
10823                            foreach b $arcout($dd) {
10824                                if {[info exists arcend($b)]} {
10825                                    lappend tomark $arcend($b)
10826                                }
10827                            }
10828                            if {[info exists tagloc($dd)]} {
10829                                unset tagloc($dd)
10830                            }
10831                        } elseif {[info exists queued($dd)]} {
10832                            incr nc -1
10833                        }
10834                        set hastaggeddescendent($dd) 1
10835                    }
10836                }
10837            }
10838            if {![info exists queued($d)]} {
10839                lappend todo $d
10840                set queued($d) 1
10841                if {![info exists hastaggeddescendent($d)]} {
10842                    incr nc
10843                }
10844            }
10845        }
10846    }
10847    set t2 [clock clicks -milliseconds]
10848    set loopix $i
10849    set tags {}
10850    foreach id [array names tagloc] {
10851        if {![info exists hastaggeddescendent($id)]} {
10852            foreach t $tagloc($id) {
10853                if {[lsearch -exact $tags $t] < 0} {
10854                    lappend tags $t
10855                }
10856            }
10857        }
10858    }
10859
10860    # remove tags that are ancestors of other tags
10861    for {set i 0} {$i < [llength $tags]} {incr i} {
10862        set a [lindex $tags $i]
10863        for {set j 0} {$j < $i} {incr j} {
10864            set b [lindex $tags $j]
10865            set r [anc_or_desc $a $b]
10866            if {$r == -1} {
10867                set tags [lreplace $tags $j $j]
10868                incr j -1
10869                incr i -1
10870            } elseif {$r == 1} {
10871                set tags [lreplace $tags $i $i]
10872                incr i -1
10873                break
10874            }
10875        }
10876    }
10877
10878    if {[array names growing] ne {}} {
10879        # graph isn't finished, need to check if any tag could get
10880        # eclipsed by another tag coming later.  Simply ignore any
10881        # tags that could later get eclipsed.
10882        set ctags {}
10883        foreach t $tags {
10884            if {[is_certain $origid $t]} {
10885                lappend ctags $t
10886            }
10887        }
10888        if {$tags eq $ctags} {
10889            set cached_atags($origid) $tags
10890        } else {
10891            set tags $ctags
10892        }
10893    } else {
10894        set cached_atags($origid) $tags
10895    }
10896    set t3 [clock clicks -milliseconds]
10897    if {0 && $t3 - $t1 >= 100} {
10898        puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
10899            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10900    }
10901    return $tags
10902}
10903
10904# Return the list of IDs that have heads that are descendents of id,
10905# including id itself if it has a head.
10906proc descheads {id} {
10907    global arcnos arcstart arcids archeads idheads cached_dheads
10908    global allparents arcout
10909
10910    if {![info exists allparents($id)]} {
10911        return {}
10912    }
10913    set aret {}
10914    if {![info exists arcout($id)]} {
10915        # part-way along an arc; check it first
10916        set a [lindex $arcnos($id) 0]
10917        if {$archeads($a) ne {}} {
10918            validate_archeads $a
10919            set i [lsearch -exact $arcids($a) $id]
10920            foreach t $archeads($a) {
10921                set j [lsearch -exact $arcids($a) $t]
10922                if {$j > $i} break
10923                lappend aret $t
10924            }
10925        }
10926        set id $arcstart($a)
10927    }
10928    set origid $id
10929    set todo [list $id]
10930    set seen($id) 1
10931    set ret {}
10932    for {set i 0} {$i < [llength $todo]} {incr i} {
10933        set id [lindex $todo $i]
10934        if {[info exists cached_dheads($id)]} {
10935            set ret [concat $ret $cached_dheads($id)]
10936        } else {
10937            if {[info exists idheads($id)]} {
10938                lappend ret $id
10939            }
10940            foreach a $arcnos($id) {
10941                if {$archeads($a) ne {}} {
10942                    validate_archeads $a
10943                    if {$archeads($a) ne {}} {
10944                        set ret [concat $ret $archeads($a)]
10945                    }
10946                }
10947                set d $arcstart($a)
10948                if {![info exists seen($d)]} {
10949                    lappend todo $d
10950                    set seen($d) 1
10951                }
10952            }
10953        }
10954    }
10955    set ret [lsort -unique $ret]
10956    set cached_dheads($origid) $ret
10957    return [concat $ret $aret]
10958}
10959
10960proc addedtag {id} {
10961    global arcnos arcout cached_dtags cached_atags
10962
10963    if {![info exists arcnos($id)]} return
10964    if {![info exists arcout($id)]} {
10965        recalcarc [lindex $arcnos($id) 0]
10966    }
10967    catch {unset cached_dtags}
10968    catch {unset cached_atags}
10969}
10970
10971proc addedhead {hid head} {
10972    global arcnos arcout cached_dheads
10973
10974    if {![info exists arcnos($hid)]} return
10975    if {![info exists arcout($hid)]} {
10976        recalcarc [lindex $arcnos($hid) 0]
10977    }
10978    catch {unset cached_dheads}
10979}
10980
10981proc removedhead {hid head} {
10982    global cached_dheads
10983
10984    catch {unset cached_dheads}
10985}
10986
10987proc movedhead {hid head} {
10988    global arcnos arcout cached_dheads
10989
10990    if {![info exists arcnos($hid)]} return
10991    if {![info exists arcout($hid)]} {
10992        recalcarc [lindex $arcnos($hid) 0]
10993    }
10994    catch {unset cached_dheads}
10995}
10996
10997proc changedrefs {} {
10998    global cached_dheads cached_dtags cached_atags cached_tagcontent
10999    global arctags archeads arcnos arcout idheads idtags
11000
11001    foreach id [concat [array names idheads] [array names idtags]] {
11002        if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
11003            set a [lindex $arcnos($id) 0]
11004            if {![info exists donearc($a)]} {
11005                recalcarc $a
11006                set donearc($a) 1
11007            }
11008        }
11009    }
11010    catch {unset cached_tagcontent}
11011    catch {unset cached_dtags}
11012    catch {unset cached_atags}
11013    catch {unset cached_dheads}
11014}
11015
11016proc rereadrefs {} {
11017    global idtags idheads idotherrefs mainheadid
11018
11019    set refids [concat [array names idtags] \
11020                    [array names idheads] [array names idotherrefs]]
11021    foreach id $refids {
11022        if {![info exists ref($id)]} {
11023            set ref($id) [listrefs $id]
11024        }
11025    }
11026    set oldmainhead $mainheadid
11027    readrefs
11028    changedrefs
11029    set refids [lsort -unique [concat $refids [array names idtags] \
11030                        [array names idheads] [array names idotherrefs]]]
11031    foreach id $refids {
11032        set v [listrefs $id]
11033        if {![info exists ref($id)] || $ref($id) != $v} {
11034            redrawtags $id
11035        }
11036    }
11037    if {$oldmainhead ne $mainheadid} {
11038        redrawtags $oldmainhead
11039        redrawtags $mainheadid
11040    }
11041    run refill_reflist
11042}
11043
11044proc listrefs {id} {
11045    global idtags idheads idotherrefs
11046
11047    set x {}
11048    if {[info exists idtags($id)]} {
11049        set x $idtags($id)
11050    }
11051    set y {}
11052    if {[info exists idheads($id)]} {
11053        set y $idheads($id)
11054    }
11055    set z {}
11056    if {[info exists idotherrefs($id)]} {
11057        set z $idotherrefs($id)
11058    }
11059    return [list $x $y $z]
11060}
11061
11062proc add_tag_ctext {tag} {
11063    global ctext cached_tagcontent tagids
11064
11065    if {![info exists cached_tagcontent($tag)]} {
11066        catch {
11067            set cached_tagcontent($tag) [exec git cat-file -p $tag]
11068        }
11069    }
11070    $ctext insert end "[mc "Tag"]: $tag\n" bold
11071    if {[info exists cached_tagcontent($tag)]} {
11072        set text $cached_tagcontent($tag)
11073    } else {
11074        set text "[mc "Id"]:  $tagids($tag)"
11075    }
11076    appendwithlinks $text {}
11077}
11078
11079proc showtag {tag isnew} {
11080    global ctext cached_tagcontent tagids linknum tagobjid
11081
11082    if {$isnew} {
11083        addtohistory [list showtag $tag 0] savectextpos
11084    }
11085    $ctext conf -state normal
11086    clear_ctext
11087    settabs 0
11088    set linknum 0
11089    add_tag_ctext $tag
11090    maybe_scroll_ctext 1
11091    $ctext conf -state disabled
11092    init_flist {}
11093}
11094
11095proc showtags {id isnew} {
11096    global idtags ctext linknum
11097
11098    if {$isnew} {
11099        addtohistory [list showtags $id 0] savectextpos
11100    }
11101    $ctext conf -state normal
11102    clear_ctext
11103    settabs 0
11104    set linknum 0
11105    set sep {}
11106    foreach tag $idtags($id) {
11107        $ctext insert end $sep
11108        add_tag_ctext $tag
11109        set sep "\n\n"
11110    }
11111    maybe_scroll_ctext 1
11112    $ctext conf -state disabled
11113    init_flist {}
11114}
11115
11116proc doquit {} {
11117    global stopped
11118    global gitktmpdir
11119
11120    set stopped 100
11121    savestuff .
11122    destroy .
11123
11124    if {[info exists gitktmpdir]} {
11125        catch {file delete -force $gitktmpdir}
11126    }
11127}
11128
11129proc mkfontdisp {font top which} {
11130    global fontattr fontpref $font NS use_ttk
11131
11132    set fontpref($font) [set $font]
11133    ${NS}::button $top.${font}but -text $which \
11134        -command [list choosefont $font $which]
11135    ${NS}::label $top.$font -relief flat -font $font \
11136        -text $fontattr($font,family) -justify left
11137    grid x $top.${font}but $top.$font -sticky w
11138}
11139
11140proc choosefont {font which} {
11141    global fontparam fontlist fonttop fontattr
11142    global prefstop NS
11143
11144    set fontparam(which) $which
11145    set fontparam(font) $font
11146    set fontparam(family) [font actual $font -family]
11147    set fontparam(size) $fontattr($font,size)
11148    set fontparam(weight) $fontattr($font,weight)
11149    set fontparam(slant) $fontattr($font,slant)
11150    set top .gitkfont
11151    set fonttop $top
11152    if {![winfo exists $top]} {
11153        font create sample
11154        eval font config sample [font actual $font]
11155        ttk_toplevel $top
11156        make_transient $top $prefstop
11157        wm title $top [mc "Gitk font chooser"]
11158        ${NS}::label $top.l -textvariable fontparam(which)
11159        pack $top.l -side top
11160        set fontlist [lsort [font families]]
11161        ${NS}::frame $top.f
11162        listbox $top.f.fam -listvariable fontlist \
11163            -yscrollcommand [list $top.f.sb set]
11164        bind $top.f.fam <<ListboxSelect>> selfontfam
11165        ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
11166        pack $top.f.sb -side right -fill y
11167        pack $top.f.fam -side left -fill both -expand 1
11168        pack $top.f -side top -fill both -expand 1
11169        ${NS}::frame $top.g
11170        spinbox $top.g.size -from 4 -to 40 -width 4 \
11171            -textvariable fontparam(size) \
11172            -validatecommand {string is integer -strict %s}
11173        checkbutton $top.g.bold -padx 5 \
11174            -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
11175            -variable fontparam(weight) -onvalue bold -offvalue normal
11176        checkbutton $top.g.ital -padx 5 \
11177            -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
11178            -variable fontparam(slant) -onvalue italic -offvalue roman
11179        pack $top.g.size $top.g.bold $top.g.ital -side left
11180        pack $top.g -side top
11181        canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
11182            -background white
11183        $top.c create text 100 25 -anchor center -text $which -font sample \
11184            -fill black -tags text
11185        bind $top.c <Configure> [list centertext $top.c]
11186        pack $top.c -side top -fill x
11187        ${NS}::frame $top.buts
11188        ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
11189        ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
11190        bind $top <Key-Return> fontok
11191        bind $top <Key-Escape> fontcan
11192        grid $top.buts.ok $top.buts.can
11193        grid columnconfigure $top.buts 0 -weight 1 -uniform a
11194        grid columnconfigure $top.buts 1 -weight 1 -uniform a
11195        pack $top.buts -side bottom -fill x
11196        trace add variable fontparam write chg_fontparam
11197    } else {
11198        raise $top
11199        $top.c itemconf text -text $which
11200    }
11201    set i [lsearch -exact $fontlist $fontparam(family)]
11202    if {$i >= 0} {
11203        $top.f.fam selection set $i
11204        $top.f.fam see $i
11205    }
11206}
11207
11208proc centertext {w} {
11209    $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
11210}
11211
11212proc fontok {} {
11213    global fontparam fontpref prefstop
11214
11215    set f $fontparam(font)
11216    set fontpref($f) [list $fontparam(family) $fontparam(size)]
11217    if {$fontparam(weight) eq "bold"} {
11218        lappend fontpref($f) "bold"
11219    }
11220    if {$fontparam(slant) eq "italic"} {
11221        lappend fontpref($f) "italic"
11222    }
11223    set w $prefstop.notebook.fonts.$f
11224    $w conf -text $fontparam(family) -font $fontpref($f)
11225
11226    fontcan
11227}
11228
11229proc fontcan {} {
11230    global fonttop fontparam
11231
11232    if {[info exists fonttop]} {
11233        catch {destroy $fonttop}
11234        catch {font delete sample}
11235        unset fonttop
11236        unset fontparam
11237    }
11238}
11239
11240if {[package vsatisfies [package provide Tk] 8.6]} {
11241    # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
11242    # function to make use of it.
11243    proc choosefont {font which} {
11244        tk fontchooser configure -title $which -font $font \
11245            -command [list on_choosefont $font $which]
11246        tk fontchooser show
11247    }
11248    proc on_choosefont {font which newfont} {
11249        global fontparam
11250        puts stderr "$font $newfont"
11251        array set f [font actual $newfont]
11252        set fontparam(which) $which
11253        set fontparam(font) $font
11254        set fontparam(family) $f(-family)
11255        set fontparam(size) $f(-size)
11256        set fontparam(weight) $f(-weight)
11257        set fontparam(slant) $f(-slant)
11258        fontok
11259    }
11260}
11261
11262proc selfontfam {} {
11263    global fonttop fontparam
11264
11265    set i [$fonttop.f.fam curselection]
11266    if {$i ne {}} {
11267        set fontparam(family) [$fonttop.f.fam get $i]
11268    }
11269}
11270
11271proc chg_fontparam {v sub op} {
11272    global fontparam
11273
11274    font config sample -$sub $fontparam($sub)
11275}
11276
11277# Create a property sheet tab page
11278proc create_prefs_page {w} {
11279    global NS
11280    set parent [join [lrange [split $w .] 0 end-1] .]
11281    if {[winfo class $parent] eq "TNotebook"} {
11282        ${NS}::frame $w
11283    } else {
11284        ${NS}::labelframe $w
11285    }
11286}
11287
11288proc prefspage_general {notebook} {
11289    global NS maxwidth maxgraphpct showneartags showlocalchanges
11290    global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11291    global hideremotes want_ttk have_ttk maxrefs
11292
11293    set page [create_prefs_page $notebook.general]
11294
11295    ${NS}::label $page.ldisp -text [mc "Commit list display options"]
11296    grid $page.ldisp - -sticky w -pady 10
11297    ${NS}::label $page.spacer -text " "
11298    ${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
11299    spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
11300    grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w
11301    ${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
11302    spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
11303    grid x $page.maxpctl $page.maxpct -sticky w
11304    ${NS}::checkbutton $page.showlocal -text [mc "Show local changes"] \
11305        -variable showlocalchanges
11306    grid x $page.showlocal -sticky w
11307    ${NS}::checkbutton $page.autoselect -text [mc "Auto-select SHA1 (length)"] \
11308        -variable autoselect
11309    spinbox $page.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
11310    grid x $page.autoselect $page.autosellen -sticky w
11311    ${NS}::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \
11312        -variable hideremotes
11313    grid x $page.hideremotes -sticky w
11314
11315    ${NS}::label $page.ddisp -text [mc "Diff display options"]
11316    grid $page.ddisp - -sticky w -pady 10
11317    ${NS}::label $page.tabstopl -text [mc "Tab spacing"]
11318    spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
11319    grid x $page.tabstopl $page.tabstop -sticky w
11320    ${NS}::checkbutton $page.ntag -text [mc "Display nearby tags/heads"] \
11321        -variable showneartags
11322    grid x $page.ntag -sticky w
11323    ${NS}::label $page.maxrefsl -text [mc "Maximum # tags/heads to show"]
11324    spinbox $page.maxrefs -from 1 -to 1000 -width 4 -textvariable maxrefs
11325    grid x $page.maxrefsl $page.maxrefs -sticky w
11326    ${NS}::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \
11327        -variable limitdiffs
11328    grid x $page.ldiff -sticky w
11329    ${NS}::checkbutton $page.lattr -text [mc "Support per-file encodings"] \
11330        -variable perfile_attrs
11331    grid x $page.lattr -sticky w
11332
11333    ${NS}::entry $page.extdifft -textvariable extdifftool
11334    ${NS}::frame $page.extdifff
11335    ${NS}::label $page.extdifff.l -text [mc "External diff tool" ]
11336    ${NS}::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff
11337    pack $page.extdifff.l $page.extdifff.b -side left
11338    pack configure $page.extdifff.l -padx 10
11339    grid x $page.extdifff $page.extdifft -sticky ew
11340
11341    ${NS}::label $page.lgen -text [mc "General options"]
11342    grid $page.lgen - -sticky w -pady 10
11343    ${NS}::checkbutton $page.want_ttk -variable want_ttk \
11344        -text [mc "Use themed widgets"]
11345    if {$have_ttk} {
11346        ${NS}::label $page.ttk_note -text [mc "(change requires restart)"]
11347    } else {
11348        ${NS}::label $page.ttk_note -text [mc "(currently unavailable)"]
11349    }
11350    grid x $page.want_ttk $page.ttk_note -sticky w
11351    return $page
11352}
11353
11354proc prefspage_colors {notebook} {
11355    global NS uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11356
11357    set page [create_prefs_page $notebook.colors]
11358
11359    ${NS}::label $page.cdisp -text [mc "Colors: press to choose"]
11360    grid $page.cdisp - -sticky w -pady 10
11361    label $page.ui -padx 40 -relief sunk -background $uicolor
11362    ${NS}::button $page.uibut -text [mc "Interface"] \
11363       -command [list choosecolor uicolor {} $page.ui [mc "interface"] setui]
11364    grid x $page.uibut $page.ui -sticky w
11365    label $page.bg -padx 40 -relief sunk -background $bgcolor
11366    ${NS}::button $page.bgbut -text [mc "Background"] \
11367        -command [list choosecolor bgcolor {} $page.bg [mc "background"] setbg]
11368    grid x $page.bgbut $page.bg -sticky w
11369    label $page.fg -padx 40 -relief sunk -background $fgcolor
11370    ${NS}::button $page.fgbut -text [mc "Foreground"] \
11371        -command [list choosecolor fgcolor {} $page.fg [mc "foreground"] setfg]
11372    grid x $page.fgbut $page.fg -sticky w
11373    label $page.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
11374    ${NS}::button $page.diffoldbut -text [mc "Diff: old lines"] \
11375        -command [list choosecolor diffcolors 0 $page.diffold [mc "diff old lines"] \
11376                      [list $ctext tag conf d0 -foreground]]
11377    grid x $page.diffoldbut $page.diffold -sticky w
11378    label $page.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
11379    ${NS}::button $page.diffnewbut -text [mc "Diff: new lines"] \
11380        -command [list choosecolor diffcolors 1 $page.diffnew [mc "diff new lines"] \
11381                      [list $ctext tag conf dresult -foreground]]
11382    grid x $page.diffnewbut $page.diffnew -sticky w
11383    label $page.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
11384    ${NS}::button $page.hunksepbut -text [mc "Diff: hunk header"] \
11385        -command [list choosecolor diffcolors 2 $page.hunksep \
11386                      [mc "diff hunk header"] \
11387                      [list $ctext tag conf hunksep -foreground]]
11388    grid x $page.hunksepbut $page.hunksep -sticky w
11389    label $page.markbgsep -padx 40 -relief sunk -background $markbgcolor
11390    ${NS}::button $page.markbgbut -text [mc "Marked line bg"] \
11391        -command [list choosecolor markbgcolor {} $page.markbgsep \
11392                      [mc "marked line background"] \
11393                      [list $ctext tag conf omark -background]]
11394    grid x $page.markbgbut $page.markbgsep -sticky w
11395    label $page.selbgsep -padx 40 -relief sunk -background $selectbgcolor
11396    ${NS}::button $page.selbgbut -text [mc "Select bg"] \
11397        -command [list choosecolor selectbgcolor {} $page.selbgsep [mc "background"] setselbg]
11398    grid x $page.selbgbut $page.selbgsep -sticky w
11399    return $page
11400}
11401
11402proc prefspage_fonts {notebook} {
11403    global NS
11404    set page [create_prefs_page $notebook.fonts]
11405    ${NS}::label $page.cfont -text [mc "Fonts: press to choose"]
11406    grid $page.cfont - -sticky w -pady 10
11407    mkfontdisp mainfont $page [mc "Main font"]
11408    mkfontdisp textfont $page [mc "Diff display font"]
11409    mkfontdisp uifont $page [mc "User interface font"]
11410    return $page
11411}
11412
11413proc doprefs {} {
11414    global maxwidth maxgraphpct use_ttk NS
11415    global oldprefs prefstop showneartags showlocalchanges
11416    global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11417    global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11418    global hideremotes want_ttk have_ttk
11419
11420    set top .gitkprefs
11421    set prefstop $top
11422    if {[winfo exists $top]} {
11423        raise $top
11424        return
11425    }
11426    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11427                   limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11428        set oldprefs($v) [set $v]
11429    }
11430    ttk_toplevel $top
11431    wm title $top [mc "Gitk preferences"]
11432    make_transient $top .
11433
11434    if {[set use_notebook [expr {$use_ttk && [info command ::ttk::notebook] ne ""}]]} {
11435        set notebook [ttk::notebook $top.notebook]
11436    } else {
11437        set notebook [${NS}::frame $top.notebook -borderwidth 0 -relief flat]
11438    }
11439
11440    lappend pages [prefspage_general $notebook] [mc "General"]
11441    lappend pages [prefspage_colors $notebook] [mc "Colors"]
11442    lappend pages [prefspage_fonts $notebook] [mc "Fonts"]
11443    set col 0
11444    foreach {page title} $pages {
11445        if {$use_notebook} {
11446            $notebook add $page -text $title
11447        } else {
11448            set btn [${NS}::button $notebook.b_[string map {. X} $page] \
11449                         -text $title -command [list raise $page]]
11450            $page configure -text $title
11451            grid $btn -row 0 -column [incr col] -sticky w
11452            grid $page -row 1 -column 0 -sticky news -columnspan 100
11453        }
11454    }
11455
11456    if {!$use_notebook} {
11457        grid columnconfigure $notebook 0 -weight 1
11458        grid rowconfigure $notebook 1 -weight 1
11459        raise [lindex $pages 0]
11460    }
11461
11462    grid $notebook -sticky news -padx 2 -pady 2
11463    grid rowconfigure $top 0 -weight 1
11464    grid columnconfigure $top 0 -weight 1
11465
11466    ${NS}::frame $top.buts
11467    ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
11468    ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
11469    bind $top <Key-Return> prefsok
11470    bind $top <Key-Escape> prefscan
11471    grid $top.buts.ok $top.buts.can
11472    grid columnconfigure $top.buts 0 -weight 1 -uniform a
11473    grid columnconfigure $top.buts 1 -weight 1 -uniform a
11474    grid $top.buts - - -pady 10 -sticky ew
11475    grid columnconfigure $top 2 -weight 1
11476    bind $top <Visibility> [list focus $top.buts.ok]
11477}
11478
11479proc choose_extdiff {} {
11480    global extdifftool
11481
11482    set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
11483    if {$prog ne {}} {
11484        set extdifftool $prog
11485    }
11486}
11487
11488proc choosecolor {v vi w x cmd} {
11489    global $v
11490
11491    set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
11492               -title [mc "Gitk: choose color for %s" $x]]
11493    if {$c eq {}} return
11494    $w conf -background $c
11495    lset $v $vi $c
11496    eval $cmd $c
11497}
11498
11499proc setselbg {c} {
11500    global bglist cflist
11501    foreach w $bglist {
11502        $w configure -selectbackground $c
11503    }
11504    $cflist tag configure highlight \
11505        -background [$cflist cget -selectbackground]
11506    allcanvs itemconf secsel -fill $c
11507}
11508
11509# This sets the background color and the color scheme for the whole UI.
11510# For some reason, tk_setPalette chooses a nasty dark red for selectColor
11511# if we don't specify one ourselves, which makes the checkbuttons and
11512# radiobuttons look bad.  This chooses white for selectColor if the
11513# background color is light, or black if it is dark.
11514proc setui {c} {
11515    if {[tk windowingsystem] eq "win32"} { return }
11516    set bg [winfo rgb . $c]
11517    set selc black
11518    if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
11519        set selc white
11520    }
11521    tk_setPalette background $c selectColor $selc
11522}
11523
11524proc setbg {c} {
11525    global bglist
11526
11527    foreach w $bglist {
11528        $w conf -background $c
11529    }
11530}
11531
11532proc setfg {c} {
11533    global fglist canv
11534
11535    foreach w $fglist {
11536        $w conf -foreground $c
11537    }
11538    allcanvs itemconf text -fill $c
11539    $canv itemconf circle -outline $c
11540    $canv itemconf markid -outline $c
11541}
11542
11543proc prefscan {} {
11544    global oldprefs prefstop
11545
11546    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11547                   limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11548        global $v
11549        set $v $oldprefs($v)
11550    }
11551    catch {destroy $prefstop}
11552    unset prefstop
11553    fontcan
11554}
11555
11556proc prefsok {} {
11557    global maxwidth maxgraphpct
11558    global oldprefs prefstop showneartags showlocalchanges
11559    global fontpref mainfont textfont uifont
11560    global limitdiffs treediffs perfile_attrs
11561    global hideremotes
11562
11563    catch {destroy $prefstop}
11564    unset prefstop
11565    fontcan
11566    set fontchanged 0
11567    if {$mainfont ne $fontpref(mainfont)} {
11568        set mainfont $fontpref(mainfont)
11569        parsefont mainfont $mainfont
11570        eval font configure mainfont [fontflags mainfont]
11571        eval font configure mainfontbold [fontflags mainfont 1]
11572        setcoords
11573        set fontchanged 1
11574    }
11575    if {$textfont ne $fontpref(textfont)} {
11576        set textfont $fontpref(textfont)
11577        parsefont textfont $textfont
11578        eval font configure textfont [fontflags textfont]
11579        eval font configure textfontbold [fontflags textfont 1]
11580    }
11581    if {$uifont ne $fontpref(uifont)} {
11582        set uifont $fontpref(uifont)
11583        parsefont uifont $uifont
11584        eval font configure uifont [fontflags uifont]
11585    }
11586    settabs
11587    if {$showlocalchanges != $oldprefs(showlocalchanges)} {
11588        if {$showlocalchanges} {
11589            doshowlocalchanges
11590        } else {
11591            dohidelocalchanges
11592        }
11593    }
11594    if {$limitdiffs != $oldprefs(limitdiffs) ||
11595        ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11596        # treediffs elements are limited by path;
11597        # won't have encodings cached if perfile_attrs was just turned on
11598        catch {unset treediffs}
11599    }
11600    if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
11601        || $maxgraphpct != $oldprefs(maxgraphpct)} {
11602        redisplay
11603    } elseif {$showneartags != $oldprefs(showneartags) ||
11604          $limitdiffs != $oldprefs(limitdiffs)} {
11605        reselectline
11606    }
11607    if {$hideremotes != $oldprefs(hideremotes)} {
11608        rereadrefs
11609    }
11610}
11611
11612proc formatdate {d} {
11613    global datetimeformat
11614    if {$d ne {}} {
11615        # If $datetimeformat includes a timezone, display in the
11616        # timezone of the argument.  Otherwise, display in local time.
11617        if {[string match {*%[zZ]*} $datetimeformat]} {
11618            if {[catch {set d [clock format [lindex $d 0] -timezone [lindex $d 1] -format $datetimeformat]}]} {
11619                # Tcl < 8.5 does not support -timezone.  Emulate it by
11620                # setting TZ (e.g. TZ=<-0430>+04:30).
11621                global env
11622                if {[info exists env(TZ)]} {
11623                    set savedTZ $env(TZ)
11624                }
11625                set zone [lindex $d 1]
11626                set sign [string map {+ - - +} [string index $zone 0]]
11627                set env(TZ) <$zone>$sign[string range $zone 1 2]:[string range $zone 3 4]
11628                set d [clock format [lindex $d 0] -format $datetimeformat]
11629                if {[info exists savedTZ]} {
11630                    set env(TZ) $savedTZ
11631                } else {
11632                    unset env(TZ)
11633                }
11634            }
11635        } else {
11636            set d [clock format [lindex $d 0] -format $datetimeformat]
11637        }
11638    }
11639    return $d
11640}
11641
11642# This list of encoding names and aliases is distilled from
11643# http://www.iana.org/assignments/character-sets.
11644# Not all of them are supported by Tcl.
11645set encoding_aliases {
11646    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11647      ISO646-US US-ASCII us IBM367 cp367 csASCII }
11648    { ISO-10646-UTF-1 csISO10646UTF1 }
11649    { ISO_646.basic:1983 ref csISO646basic1983 }
11650    { INVARIANT csINVARIANT }
11651    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11652    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11653    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11654    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11655    { NATS-DANO iso-ir-9-1 csNATSDANO }
11656    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11657    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11658    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11659    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11660    { ISO-2022-KR csISO2022KR }
11661    { EUC-KR csEUCKR }
11662    { ISO-2022-JP csISO2022JP }
11663    { ISO-2022-JP-2 csISO2022JP2 }
11664    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11665      csISO13JISC6220jp }
11666    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11667    { IT iso-ir-15 ISO646-IT csISO15Italian }
11668    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11669    { ES iso-ir-17 ISO646-ES csISO17Spanish }
11670    { greek7-old iso-ir-18 csISO18Greek7Old }
11671    { latin-greek iso-ir-19 csISO19LatinGreek }
11672    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11673    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11674    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11675    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11676    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11677    { BS_viewdata iso-ir-47 csISO47BSViewdata }
11678    { INIS iso-ir-49 csISO49INIS }
11679    { INIS-8 iso-ir-50 csISO50INIS8 }
11680    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11681    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11682    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11683    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11684    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11685    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11686      csISO60Norwegian1 }
11687    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11688    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11689    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11690    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11691    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11692    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11693    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11694    { greek7 iso-ir-88 csISO88Greek7 }
11695    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11696    { iso-ir-90 csISO90 }
11697    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11698    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11699      csISO92JISC62991984b }
11700    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11701    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11702    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11703      csISO95JIS62291984handadd }
11704    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11705    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11706    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11707    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11708      CP819 csISOLatin1 }
11709    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11710    { T.61-7bit iso-ir-102 csISO102T617bit }
11711    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11712    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
11713    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
11714    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
11715    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
11716    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
11717    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
11718    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
11719      arabic csISOLatinArabic }
11720    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
11721    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
11722    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
11723      greek greek8 csISOLatinGreek }
11724    { T.101-G2 iso-ir-128 csISO128T101G2 }
11725    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
11726      csISOLatinHebrew }
11727    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
11728    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
11729    { CSN_369103 iso-ir-139 csISO139CSN369103 }
11730    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
11731    { ISO_6937-2-add iso-ir-142 csISOTextComm }
11732    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
11733    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
11734      csISOLatinCyrillic }
11735    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
11736    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
11737    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
11738    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
11739    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
11740    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
11741    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
11742    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
11743    { ISO_10367-box iso-ir-155 csISO10367Box }
11744    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
11745    { latin-lap lap iso-ir-158 csISO158Lap }
11746    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
11747    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
11748    { us-dk csUSDK }
11749    { dk-us csDKUS }
11750    { JIS_X0201 X0201 csHalfWidthKatakana }
11751    { KSC5636 ISO646-KR csKSC5636 }
11752    { ISO-10646-UCS-2 csUnicode }
11753    { ISO-10646-UCS-4 csUCS4 }
11754    { DEC-MCS dec csDECMCS }
11755    { hp-roman8 roman8 r8 csHPRoman8 }
11756    { macintosh mac csMacintosh }
11757    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
11758      csIBM037 }
11759    { IBM038 EBCDIC-INT cp038 csIBM038 }
11760    { IBM273 CP273 csIBM273 }
11761    { IBM274 EBCDIC-BE CP274 csIBM274 }
11762    { IBM275 EBCDIC-BR cp275 csIBM275 }
11763    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
11764    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
11765    { IBM280 CP280 ebcdic-cp-it csIBM280 }
11766    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
11767    { IBM284 CP284 ebcdic-cp-es csIBM284 }
11768    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
11769    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
11770    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
11771    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
11772    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
11773    { IBM424 cp424 ebcdic-cp-he csIBM424 }
11774    { IBM437 cp437 437 csPC8CodePage437 }
11775    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
11776    { IBM775 cp775 csPC775Baltic }
11777    { IBM850 cp850 850 csPC850Multilingual }
11778    { IBM851 cp851 851 csIBM851 }
11779    { IBM852 cp852 852 csPCp852 }
11780    { IBM855 cp855 855 csIBM855 }
11781    { IBM857 cp857 857 csIBM857 }
11782    { IBM860 cp860 860 csIBM860 }
11783    { IBM861 cp861 861 cp-is csIBM861 }
11784    { IBM862 cp862 862 csPC862LatinHebrew }
11785    { IBM863 cp863 863 csIBM863 }
11786    { IBM864 cp864 csIBM864 }
11787    { IBM865 cp865 865 csIBM865 }
11788    { IBM866 cp866 866 csIBM866 }
11789    { IBM868 CP868 cp-ar csIBM868 }
11790    { IBM869 cp869 869 cp-gr csIBM869 }
11791    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
11792    { IBM871 CP871 ebcdic-cp-is csIBM871 }
11793    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
11794    { IBM891 cp891 csIBM891 }
11795    { IBM903 cp903 csIBM903 }
11796    { IBM904 cp904 904 csIBBM904 }
11797    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
11798    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
11799    { IBM1026 CP1026 csIBM1026 }
11800    { EBCDIC-AT-DE csIBMEBCDICATDE }
11801    { EBCDIC-AT-DE-A csEBCDICATDEA }
11802    { EBCDIC-CA-FR csEBCDICCAFR }
11803    { EBCDIC-DK-NO csEBCDICDKNO }
11804    { EBCDIC-DK-NO-A csEBCDICDKNOA }
11805    { EBCDIC-FI-SE csEBCDICFISE }
11806    { EBCDIC-FI-SE-A csEBCDICFISEA }
11807    { EBCDIC-FR csEBCDICFR }
11808    { EBCDIC-IT csEBCDICIT }
11809    { EBCDIC-PT csEBCDICPT }
11810    { EBCDIC-ES csEBCDICES }
11811    { EBCDIC-ES-A csEBCDICESA }
11812    { EBCDIC-ES-S csEBCDICESS }
11813    { EBCDIC-UK csEBCDICUK }
11814    { EBCDIC-US csEBCDICUS }
11815    { UNKNOWN-8BIT csUnknown8BiT }
11816    { MNEMONIC csMnemonic }
11817    { MNEM csMnem }
11818    { VISCII csVISCII }
11819    { VIQR csVIQR }
11820    { KOI8-R csKOI8R }
11821    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
11822    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
11823    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
11824    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
11825    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
11826    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
11827    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
11828    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
11829    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
11830    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
11831    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
11832    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
11833    { IBM1047 IBM-1047 }
11834    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
11835    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
11836    { UNICODE-1-1 csUnicode11 }
11837    { CESU-8 csCESU-8 }
11838    { BOCU-1 csBOCU-1 }
11839    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
11840    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
11841      l8 }
11842    { ISO-8859-15 ISO_8859-15 Latin-9 }
11843    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
11844    { GBK CP936 MS936 windows-936 }
11845    { JIS_Encoding csJISEncoding }
11846    { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
11847    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
11848      EUC-JP }
11849    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
11850    { ISO-10646-UCS-Basic csUnicodeASCII }
11851    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
11852    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
11853    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
11854    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
11855    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
11856    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
11857    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
11858    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
11859    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
11860    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
11861    { Adobe-Standard-Encoding csAdobeStandardEncoding }
11862    { Ventura-US csVenturaUS }
11863    { Ventura-International csVenturaInternational }
11864    { PC8-Danish-Norwegian csPC8DanishNorwegian }
11865    { PC8-Turkish csPC8Turkish }
11866    { IBM-Symbols csIBMSymbols }
11867    { IBM-Thai csIBMThai }
11868    { HP-Legal csHPLegal }
11869    { HP-Pi-font csHPPiFont }
11870    { HP-Math8 csHPMath8 }
11871    { Adobe-Symbol-Encoding csHPPSMath }
11872    { HP-DeskTop csHPDesktop }
11873    { Ventura-Math csVenturaMath }
11874    { Microsoft-Publishing csMicrosoftPublishing }
11875    { Windows-31J csWindows31J }
11876    { GB2312 csGB2312 }
11877    { Big5 csBig5 }
11878}
11879
11880proc tcl_encoding {enc} {
11881    global encoding_aliases tcl_encoding_cache
11882    if {[info exists tcl_encoding_cache($enc)]} {
11883        return $tcl_encoding_cache($enc)
11884    }
11885    set names [encoding names]
11886    set lcnames [string tolower $names]
11887    set enc [string tolower $enc]
11888    set i [lsearch -exact $lcnames $enc]
11889    if {$i < 0} {
11890        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
11891        if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
11892            set i [lsearch -exact $lcnames $encx]
11893        }
11894    }
11895    if {$i < 0} {
11896        foreach l $encoding_aliases {
11897            set ll [string tolower $l]
11898            if {[lsearch -exact $ll $enc] < 0} continue
11899            # look through the aliases for one that tcl knows about
11900            foreach e $ll {
11901                set i [lsearch -exact $lcnames $e]
11902                if {$i < 0} {
11903                    if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
11904                        set i [lsearch -exact $lcnames $ex]
11905                    }
11906                }
11907                if {$i >= 0} break
11908            }
11909            break
11910        }
11911    }
11912    set tclenc {}
11913    if {$i >= 0} {
11914        set tclenc [lindex $names $i]
11915    }
11916    set tcl_encoding_cache($enc) $tclenc
11917    return $tclenc
11918}
11919
11920proc gitattr {path attr default} {
11921    global path_attr_cache
11922    if {[info exists path_attr_cache($attr,$path)]} {
11923        set r $path_attr_cache($attr,$path)
11924    } else {
11925        set r "unspecified"
11926        if {![catch {set line [exec git check-attr $attr -- $path]}]} {
11927            regexp "(.*): $attr: (.*)" $line m f r
11928        }
11929        set path_attr_cache($attr,$path) $r
11930    }
11931    if {$r eq "unspecified"} {
11932        return $default
11933    }
11934    return $r
11935}
11936
11937proc cache_gitattr {attr pathlist} {
11938    global path_attr_cache
11939    set newlist {}
11940    foreach path $pathlist {
11941        if {![info exists path_attr_cache($attr,$path)]} {
11942            lappend newlist $path
11943        }
11944    }
11945    set lim 1000
11946    if {[tk windowingsystem] == "win32"} {
11947        # windows has a 32k limit on the arguments to a command...
11948        set lim 30
11949    }
11950    while {$newlist ne {}} {
11951        set head [lrange $newlist 0 [expr {$lim - 1}]]
11952        set newlist [lrange $newlist $lim end]
11953        if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
11954            foreach row [split $rlist "\n"] {
11955                if {[regexp "(.*): $attr: (.*)" $row m path value]} {
11956                    if {[string index $path 0] eq "\""} {
11957                        set path [encoding convertfrom [lindex $path 0]]
11958                    }
11959                    set path_attr_cache($attr,$path) $value
11960                }
11961            }
11962        }
11963    }
11964}
11965
11966proc get_path_encoding {path} {
11967    global gui_encoding perfile_attrs
11968    set tcl_enc $gui_encoding
11969    if {$path ne {} && $perfile_attrs} {
11970        set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
11971        if {$enc2 ne {}} {
11972            set tcl_enc $enc2
11973        }
11974    }
11975    return $tcl_enc
11976}
11977
11978# First check that Tcl/Tk is recent enough
11979if {[catch {package require Tk 8.4} err]} {
11980    show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
11981                     Gitk requires at least Tcl/Tk 8.4." list
11982    exit 1
11983}
11984
11985# on OSX bring the current Wish process window to front
11986if {[tk windowingsystem] eq "aqua"} {
11987    exec osascript -e [format {
11988        tell application "System Events"
11989            set frontmost of processes whose unix id is %d to true
11990        end tell
11991    } [pid] ]
11992}
11993
11994# Unset GIT_TRACE var if set
11995if { [info exists ::env(GIT_TRACE)] } {
11996    unset ::env(GIT_TRACE)
11997}
11998
11999# defaults...
12000set wrcomcmd "git diff-tree --stdin -p --pretty"
12001
12002set gitencoding {}
12003catch {
12004    set gitencoding [exec git config --get i18n.commitencoding]
12005}
12006catch {
12007    set gitencoding [exec git config --get i18n.logoutputencoding]
12008}
12009if {$gitencoding == ""} {
12010    set gitencoding "utf-8"
12011}
12012set tclencoding [tcl_encoding $gitencoding]
12013if {$tclencoding == {}} {
12014    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
12015}
12016
12017set gui_encoding [encoding system]
12018catch {
12019    set enc [exec git config --get gui.encoding]
12020    if {$enc ne {}} {
12021        set tclenc [tcl_encoding $enc]
12022        if {$tclenc ne {}} {
12023            set gui_encoding $tclenc
12024        } else {
12025            puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
12026        }
12027    }
12028}
12029
12030set log_showroot true
12031catch {
12032    set log_showroot [exec git config --bool --get log.showroot]
12033}
12034
12035if {[tk windowingsystem] eq "aqua"} {
12036    set mainfont {{Lucida Grande} 9}
12037    set textfont {Monaco 9}
12038    set uifont {{Lucida Grande} 9 bold}
12039} elseif {![catch {::tk::pkgconfig get fontsystem} xft] && $xft eq "xft"} {
12040    # fontconfig!
12041    set mainfont {sans 9}
12042    set textfont {monospace 9}
12043    set uifont {sans 9 bold}
12044} else {
12045    set mainfont {Helvetica 9}
12046    set textfont {Courier 9}
12047    set uifont {Helvetica 9 bold}
12048}
12049set tabstop 8
12050set findmergefiles 0
12051set maxgraphpct 50
12052set maxwidth 16
12053set revlistorder 0
12054set fastdate 0
12055set uparrowlen 5
12056set downarrowlen 5
12057set mingaplen 100
12058set cmitmode "patch"
12059set wrapcomment "none"
12060set showneartags 1
12061set hideremotes 0
12062set maxrefs 20
12063set visiblerefs {"master"}
12064set maxlinelen 200
12065set showlocalchanges 1
12066set limitdiffs 1
12067set datetimeformat "%Y-%m-%d %H:%M:%S"
12068set autoselect 1
12069set autosellen 40
12070set perfile_attrs 0
12071set want_ttk 1
12072
12073if {[tk windowingsystem] eq "aqua"} {
12074    set extdifftool "opendiff"
12075} else {
12076    set extdifftool "meld"
12077}
12078
12079set colors {green red blue magenta darkgrey brown orange}
12080if {[tk windowingsystem] eq "win32"} {
12081    set uicolor SystemButtonFace
12082    set uifgcolor SystemButtonText
12083    set uifgdisabledcolor SystemDisabledText
12084    set bgcolor SystemWindow
12085    set fgcolor SystemWindowText
12086    set selectbgcolor SystemHighlight
12087} else {
12088    set uicolor grey85
12089    set uifgcolor black
12090    set uifgdisabledcolor "#999"
12091    set bgcolor white
12092    set fgcolor black
12093    set selectbgcolor gray85
12094}
12095set diffcolors {red "#00a000" blue}
12096set diffcontext 3
12097set mergecolors {red blue green purple brown "#009090" magenta "#808000" "#009000" "#ff0080" cyan "#b07070" "#70b0f0" "#70f0b0" "#f0b070" "#ff70b0"}
12098set ignorespace 0
12099set worddiff ""
12100set markbgcolor "#e0e0ff"
12101
12102set headbgcolor green
12103set headfgcolor black
12104set headoutlinecolor black
12105set remotebgcolor #ffddaa
12106set tagbgcolor yellow
12107set tagfgcolor black
12108set tagoutlinecolor black
12109set reflinecolor black
12110set filesepbgcolor #aaaaaa
12111set filesepfgcolor black
12112set linehoverbgcolor #ffff80
12113set linehoverfgcolor black
12114set linehoveroutlinecolor black
12115set mainheadcirclecolor yellow
12116set workingfilescirclecolor red
12117set indexcirclecolor green
12118set circlecolors {white blue gray blue blue}
12119set linkfgcolor blue
12120set circleoutlinecolor $fgcolor
12121set foundbgcolor yellow
12122set currentsearchhitbgcolor orange
12123
12124# button for popping up context menus
12125if {[tk windowingsystem] eq "aqua"} {
12126    set ctxbut <Button-2>
12127} else {
12128    set ctxbut <Button-3>
12129}
12130
12131## For msgcat loading, first locate the installation location.
12132if { [info exists ::env(GITK_MSGSDIR)] } {
12133    ## Msgsdir was manually set in the environment.
12134    set gitk_msgsdir $::env(GITK_MSGSDIR)
12135} else {
12136    ## Let's guess the prefix from argv0.
12137    set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
12138    set gitk_libdir [file join $gitk_prefix share gitk lib]
12139    set gitk_msgsdir [file join $gitk_libdir msgs]
12140    unset gitk_prefix
12141}
12142
12143## Internationalization (i18n) through msgcat and gettext. See
12144## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
12145package require msgcat
12146namespace import ::msgcat::mc
12147## And eventually load the actual message catalog
12148::msgcat::mcload $gitk_msgsdir
12149
12150catch {
12151    # follow the XDG base directory specification by default. See
12152    # http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html
12153    if {[info exists env(XDG_CONFIG_HOME)] && $env(XDG_CONFIG_HOME) ne ""} {
12154        # XDG_CONFIG_HOME environment variable is set
12155        set config_file [file join $env(XDG_CONFIG_HOME) git gitk]
12156        set config_file_tmp [file join $env(XDG_CONFIG_HOME) git gitk-tmp]
12157    } else {
12158        # default XDG_CONFIG_HOME
12159        set config_file "~/.config/git/gitk"
12160        set config_file_tmp "~/.config/git/gitk-tmp"
12161    }
12162    if {![file exists $config_file]} {
12163        # for backward compatibility use the old config file if it exists
12164        if {[file exists "~/.gitk"]} {
12165            set config_file "~/.gitk"
12166            set config_file_tmp "~/.gitk-tmp"
12167        } elseif {![file exists [file dirname $config_file]]} {
12168            file mkdir [file dirname $config_file]
12169        }
12170    }
12171    source $config_file
12172}
12173
12174parsefont mainfont $mainfont
12175eval font create mainfont [fontflags mainfont]
12176eval font create mainfontbold [fontflags mainfont 1]
12177
12178parsefont textfont $textfont
12179eval font create textfont [fontflags textfont]
12180eval font create textfontbold [fontflags textfont 1]
12181
12182parsefont uifont $uifont
12183eval font create uifont [fontflags uifont]
12184
12185setui $uicolor
12186
12187setoptions
12188
12189# check that we can find a .git directory somewhere...
12190if {[catch {set gitdir [exec git rev-parse --git-dir]}]} {
12191    show_error {} . [mc "Cannot find a git repository here."]
12192    exit 1
12193}
12194
12195set selecthead {}
12196set selectheadid {}
12197
12198set revtreeargs {}
12199set cmdline_files {}
12200set i 0
12201set revtreeargscmd {}
12202foreach arg $argv {
12203    switch -glob -- $arg {
12204        "" { }
12205        "--" {
12206            set cmdline_files [lrange $argv [expr {$i + 1}] end]
12207            break
12208        }
12209        "--select-commit=*" {
12210            set selecthead [string range $arg 16 end]
12211        }
12212        "--argscmd=*" {
12213            set revtreeargscmd [string range $arg 10 end]
12214        }
12215        default {
12216            lappend revtreeargs $arg
12217        }
12218    }
12219    incr i
12220}
12221
12222if {$selecthead eq "HEAD"} {
12223    set selecthead {}
12224}
12225
12226if {$i >= [llength $argv] && $revtreeargs ne {}} {
12227    # no -- on command line, but some arguments (other than --argscmd)
12228    if {[catch {
12229        set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
12230        set cmdline_files [split $f "\n"]
12231        set n [llength $cmdline_files]
12232        set revtreeargs [lrange $revtreeargs 0 end-$n]
12233        # Unfortunately git rev-parse doesn't produce an error when
12234        # something is both a revision and a filename.  To be consistent
12235        # with git log and git rev-list, check revtreeargs for filenames.
12236        foreach arg $revtreeargs {
12237            if {[file exists $arg]} {
12238                show_error {} . [mc "Ambiguous argument '%s': both revision\
12239                                 and filename" $arg]
12240                exit 1
12241            }
12242        }
12243    } err]} {
12244        # unfortunately we get both stdout and stderr in $err,
12245        # so look for "fatal:".
12246        set i [string first "fatal:" $err]
12247        if {$i > 0} {
12248            set err [string range $err [expr {$i + 6}] end]
12249        }
12250        show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
12251        exit 1
12252    }
12253}
12254
12255set nullid "0000000000000000000000000000000000000000"
12256set nullid2 "0000000000000000000000000000000000000001"
12257set nullfile "/dev/null"
12258
12259set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
12260if {![info exists have_ttk]} {
12261    set have_ttk [llength [info commands ::ttk::style]]
12262}
12263set use_ttk [expr {$have_ttk && $want_ttk}]
12264set NS [expr {$use_ttk ? "ttk" : ""}]
12265
12266regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
12267
12268set show_notes {}
12269if {[package vcompare $git_version "1.6.6.2"] >= 0} {
12270    set show_notes "--show-notes"
12271}
12272
12273set appname "gitk"
12274
12275set runq {}
12276set history {}
12277set historyindex 0
12278set fh_serial 0
12279set nhl_names {}
12280set highlight_paths {}
12281set findpattern {}
12282set searchdirn -forwards
12283set boldids {}
12284set boldnameids {}
12285set diffelide {0 0}
12286set markingmatches 0
12287set linkentercount 0
12288set need_redisplay 0
12289set nrows_drawn 0
12290set firsttabstop 0
12291
12292set nextviewnum 1
12293set curview 0
12294set selectedview 0
12295set selectedhlview [mc "None"]
12296set highlight_related [mc "None"]
12297set highlight_files {}
12298set viewfiles(0) {}
12299set viewperm(0) 0
12300set viewargs(0) {}
12301set viewargscmd(0) {}
12302
12303set selectedline {}
12304set numcommits 0
12305set loginstance 0
12306set cmdlineok 0
12307set stopped 0
12308set stuffsaved 0
12309set patchnum 0
12310set lserial 0
12311set hasworktree [hasworktree]
12312set cdup {}
12313if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} {
12314    set cdup [exec git rev-parse --show-cdup]
12315}
12316set worktree [exec git rev-parse --show-toplevel]
12317setcoords
12318makewindow
12319catch {
12320    image create photo gitlogo      -width 16 -height 16
12321
12322    image create photo gitlogominus -width  4 -height  2
12323    gitlogominus put #C00000 -to 0 0 4 2
12324    gitlogo copy gitlogominus -to  1 5
12325    gitlogo copy gitlogominus -to  6 5
12326    gitlogo copy gitlogominus -to 11 5
12327    image delete gitlogominus
12328
12329    image create photo gitlogoplus  -width  4 -height  4
12330    gitlogoplus  put #008000 -to 1 0 3 4
12331    gitlogoplus  put #008000 -to 0 1 4 3
12332    gitlogo copy gitlogoplus  -to  1 9
12333    gitlogo copy gitlogoplus  -to  6 9
12334    gitlogo copy gitlogoplus  -to 11 9
12335    image delete gitlogoplus
12336
12337    image create photo gitlogo32    -width 32 -height 32
12338    gitlogo32 copy gitlogo -zoom 2 2
12339
12340    wm iconphoto . -default gitlogo gitlogo32
12341}
12342# wait for the window to become visible
12343tkwait visibility .
12344wm title . "$appname: [reponame]"
12345update
12346readrefs
12347
12348if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
12349    # create a view for the files/dirs specified on the command line
12350    set curview 1
12351    set selectedview 1
12352    set nextviewnum 2
12353    set viewname(1) [mc "Command line"]
12354    set viewfiles(1) $cmdline_files
12355    set viewargs(1) $revtreeargs
12356    set viewargscmd(1) $revtreeargscmd
12357    set viewperm(1) 0
12358    set vdatemode(1) 0
12359    addviewmenu 1
12360    .bar.view entryconf [mca "Edit view..."] -state normal
12361    .bar.view entryconf [mca "Delete view"] -state normal
12362}
12363
12364if {[info exists permviews]} {
12365    foreach v $permviews {
12366        set n $nextviewnum
12367        incr nextviewnum
12368        set viewname($n) [lindex $v 0]
12369        set viewfiles($n) [lindex $v 1]
12370        set viewargs($n) [lindex $v 2]
12371        set viewargscmd($n) [lindex $v 3]
12372        set viewperm($n) 1
12373        addviewmenu $n
12374    }
12375}
12376
12377if {[tk windowingsystem] eq "win32"} {
12378    focus -force .
12379}
12380
12381getcommits {}
12382
12383# Local variables:
12384# mode: tcl
12385# indent-tabs-mode: t
12386# tab-width: 8
12387# End: