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