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