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