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