5ba2ce6ebcb3295bffaf6a4a4be65a6a89302cc7
   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
7622
7623    if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
7624
7625    set treepending $ids
7626    set treediff {}
7627    fconfigure $gdtf -blocking 0 -encoding binary
7628    filerun $gdtf [list gettreediffline $gdtf $ids]
7629}
7630
7631proc gettreediffline {gdtf ids} {
7632    global treediff treediffs treepending diffids diffmergeid
7633    global cmitmode vfilelimit curview limitdiffs perfile_attrs
7634
7635    set nr 0
7636    set sublist {}
7637    set max 1000
7638    if {$perfile_attrs} {
7639        # cache_gitattr is slow, and even slower on win32 where we
7640        # have to invoke it for only about 30 paths at a time
7641        set max 500
7642        if {[tk windowingsystem] == "win32"} {
7643            set max 120
7644        }
7645    }
7646    while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7647        set i [string first "\t" $line]
7648        if {$i >= 0} {
7649            set file [string range $line [expr {$i+1}] end]
7650            if {[string index $file 0] eq "\""} {
7651                set file [lindex $file 0]
7652            }
7653            set file [encoding convertfrom $file]
7654            if {$file ne [lindex $treediff end]} {
7655                lappend treediff $file
7656                lappend sublist $file
7657            }
7658        }
7659    }
7660    if {$perfile_attrs} {
7661        cache_gitattr encoding $sublist
7662    }
7663    if {![eof $gdtf]} {
7664        return [expr {$nr >= $max? 2: 1}]
7665    }
7666    close $gdtf
7667    if {$limitdiffs && $vfilelimit($curview) ne {}} {
7668        set flist {}
7669        foreach f $treediff {
7670            if {[path_filter $vfilelimit($curview) $f]} {
7671                lappend flist $f
7672            }
7673        }
7674        set treediffs($ids) $flist
7675    } else {
7676        set treediffs($ids) $treediff
7677    }
7678    unset treepending
7679    if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7680        gettree $diffids
7681    } elseif {$ids != $diffids} {
7682        if {![info exists diffmergeid]} {
7683            gettreediffs $diffids
7684        }
7685    } else {
7686        addtocflist $ids
7687    }
7688    return 0
7689}
7690
7691# empty string or positive integer
7692proc diffcontextvalidate {v} {
7693    return [regexp {^(|[1-9][0-9]*)$} $v]
7694}
7695
7696proc diffcontextchange {n1 n2 op} {
7697    global diffcontextstring diffcontext
7698
7699    if {[string is integer -strict $diffcontextstring]} {
7700        if {$diffcontextstring >= 0} {
7701            set diffcontext $diffcontextstring
7702            reselectline
7703        }
7704    }
7705}
7706
7707proc changeignorespace {} {
7708    reselectline
7709}
7710
7711proc changeworddiff {name ix op} {
7712    reselectline
7713}
7714
7715proc getblobdiffs {ids} {
7716    global blobdifffd diffids env
7717    global diffinhdr treediffs
7718    global diffcontext
7719    global ignorespace
7720    global worddiff
7721    global limitdiffs vfilelimit curview
7722    global diffencoding targetline diffnparents
7723    global git_version currdiffsubmod
7724
7725    set textconv {}
7726    if {[package vcompare $git_version "1.6.1"] >= 0} {
7727        set textconv "--textconv"
7728    }
7729    set submodule {}
7730    if {[package vcompare $git_version "1.6.6"] >= 0} {
7731        set submodule "--submodule"
7732    }
7733    set cmd [diffcmd $ids "-p $textconv $submodule  -C --cc --no-commit-id -U$diffcontext"]
7734    if {$ignorespace} {
7735        append cmd " -w"
7736    }
7737    if {$worddiff ne [mc "Line diff"]} {
7738        append cmd " --word-diff=porcelain"
7739    }
7740    if {$limitdiffs && $vfilelimit($curview) ne {}} {
7741        set cmd [concat $cmd -- $vfilelimit($curview)]
7742    }
7743    if {[catch {set bdf [open $cmd r]} err]} {
7744        error_popup [mc "Error getting diffs: %s" $err]
7745        return
7746    }
7747    set targetline {}
7748    set diffnparents 0
7749    set diffinhdr 0
7750    set diffencoding [get_path_encoding {}]
7751    fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
7752    set blobdifffd($ids) $bdf
7753    set currdiffsubmod ""
7754    filerun $bdf [list getblobdiffline $bdf $diffids]
7755}
7756
7757proc savecmitpos {} {
7758    global ctext cmitmode
7759
7760    if {$cmitmode eq "tree"} {
7761        return {}
7762    }
7763    return [list target_scrollpos [$ctext index @0,0]]
7764}
7765
7766proc savectextpos {} {
7767    global ctext
7768
7769    return [list target_scrollpos [$ctext index @0,0]]
7770}
7771
7772proc maybe_scroll_ctext {ateof} {
7773    global ctext target_scrollpos
7774
7775    if {![info exists target_scrollpos]} return
7776    if {!$ateof} {
7777        set nlines [expr {[winfo height $ctext]
7778                          / [font metrics textfont -linespace]}]
7779        if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
7780    }
7781    $ctext yview $target_scrollpos
7782    unset target_scrollpos
7783}
7784
7785proc setinlist {var i val} {
7786    global $var
7787
7788    while {[llength [set $var]] < $i} {
7789        lappend $var {}
7790    }
7791    if {[llength [set $var]] == $i} {
7792        lappend $var $val
7793    } else {
7794        lset $var $i $val
7795    }
7796}
7797
7798proc makediffhdr {fname ids} {
7799    global ctext curdiffstart treediffs diffencoding
7800    global ctext_file_names jump_to_here targetline diffline
7801
7802    set fname [encoding convertfrom $fname]
7803    set diffencoding [get_path_encoding $fname]
7804    set i [lsearch -exact $treediffs($ids) $fname]
7805    if {$i >= 0} {
7806        setinlist difffilestart $i $curdiffstart
7807    }
7808    lset ctext_file_names end $fname
7809    set l [expr {(78 - [string length $fname]) / 2}]
7810    set pad [string range "----------------------------------------" 1 $l]
7811    $ctext insert $curdiffstart "$pad $fname $pad" filesep
7812    set targetline {}
7813    if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
7814        set targetline [lindex $jump_to_here 1]
7815    }
7816    set diffline 0
7817}
7818
7819proc getblobdiffline {bdf ids} {
7820    global diffids blobdifffd ctext curdiffstart
7821    global diffnexthead diffnextnote difffilestart
7822    global ctext_file_names ctext_file_lines
7823    global diffinhdr treediffs mergemax diffnparents
7824    global diffencoding jump_to_here targetline diffline currdiffsubmod
7825    global worddiff
7826
7827    set nr 0
7828    $ctext conf -state normal
7829    while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
7830        if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
7831            catch {close $bdf}
7832            return 0
7833        }
7834        if {![string compare -length 5 "diff " $line]} {
7835            if {![regexp {^diff (--cc|--git) } $line m type]} {
7836                set line [encoding convertfrom $line]
7837                $ctext insert end "$line\n" hunksep
7838                continue
7839            }
7840            # start of a new file
7841            set diffinhdr 1
7842            $ctext insert end "\n"
7843            set curdiffstart [$ctext index "end - 1c"]
7844            lappend ctext_file_names ""
7845            lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7846            $ctext insert end "\n" filesep
7847
7848            if {$type eq "--cc"} {
7849                # start of a new file in a merge diff
7850                set fname [string range $line 10 end]
7851                if {[lsearch -exact $treediffs($ids) $fname] < 0} {
7852                    lappend treediffs($ids) $fname
7853                    add_flist [list $fname]
7854                }
7855
7856            } else {
7857                set line [string range $line 11 end]
7858                # If the name hasn't changed the length will be odd,
7859                # the middle char will be a space, and the two bits either
7860                # side will be a/name and b/name, or "a/name" and "b/name".
7861                # If the name has changed we'll get "rename from" and
7862                # "rename to" or "copy from" and "copy to" lines following
7863                # this, and we'll use them to get the filenames.
7864                # This complexity is necessary because spaces in the
7865                # filename(s) don't get escaped.
7866                set l [string length $line]
7867                set i [expr {$l / 2}]
7868                if {!(($l & 1) && [string index $line $i] eq " " &&
7869                      [string range $line 2 [expr {$i - 1}]] eq \
7870                          [string range $line [expr {$i + 3}] end])} {
7871                    continue
7872                }
7873                # unescape if quoted and chop off the a/ from the front
7874                if {[string index $line 0] eq "\""} {
7875                    set fname [string range [lindex $line 0] 2 end]
7876                } else {
7877                    set fname [string range $line 2 [expr {$i - 1}]]
7878                }
7879            }
7880            makediffhdr $fname $ids
7881
7882        } elseif {![string compare -length 16 "* Unmerged path " $line]} {
7883            set fname [encoding convertfrom [string range $line 16 end]]
7884            $ctext insert end "\n"
7885            set curdiffstart [$ctext index "end - 1c"]
7886            lappend ctext_file_names $fname
7887            lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7888            $ctext insert end "$line\n" filesep
7889            set i [lsearch -exact $treediffs($ids) $fname]
7890            if {$i >= 0} {
7891                setinlist difffilestart $i $curdiffstart
7892            }
7893
7894        } elseif {![string compare -length 2 "@@" $line]} {
7895            regexp {^@@+} $line ats
7896            set line [encoding convertfrom $diffencoding $line]
7897            $ctext insert end "$line\n" hunksep
7898            if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
7899                set diffline $nl
7900            }
7901            set diffnparents [expr {[string length $ats] - 1}]
7902            set diffinhdr 0
7903
7904        } elseif {![string compare -length 10 "Submodule " $line]} {
7905            # start of a new submodule
7906            if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
7907                set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
7908            } else {
7909                set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
7910            }
7911            if {$currdiffsubmod != $fname} {
7912                $ctext insert end "\n";     # Add newline after commit message
7913            }
7914            set curdiffstart [$ctext index "end - 1c"]
7915            lappend ctext_file_names ""
7916            if {$currdiffsubmod != $fname} {
7917                lappend ctext_file_lines $fname
7918                makediffhdr $fname $ids
7919                set currdiffsubmod $fname
7920                $ctext insert end "\n$line\n" filesep
7921            } else {
7922                $ctext insert end "$line\n" filesep
7923            }
7924        } elseif {![string compare -length 3 "  >" $line]} {
7925            set $currdiffsubmod ""
7926            set line [encoding convertfrom $diffencoding $line]
7927            $ctext insert end "$line\n" dresult
7928        } elseif {![string compare -length 3 "  <" $line]} {
7929            set $currdiffsubmod ""
7930            set line [encoding convertfrom $diffencoding $line]
7931            $ctext insert end "$line\n" d0
7932        } elseif {$diffinhdr} {
7933            if {![string compare -length 12 "rename from " $line]} {
7934                set fname [string range $line [expr 6 + [string first " from " $line] ] end]
7935                if {[string index $fname 0] eq "\""} {
7936                    set fname [lindex $fname 0]
7937                }
7938                set fname [encoding convertfrom $fname]
7939                set i [lsearch -exact $treediffs($ids) $fname]
7940                if {$i >= 0} {
7941                    setinlist difffilestart $i $curdiffstart
7942                }
7943            } elseif {![string compare -length 10 $line "rename to "] ||
7944                      ![string compare -length 8 $line "copy to "]} {
7945                set fname [string range $line [expr 4 + [string first " to " $line] ] end]
7946                if {[string index $fname 0] eq "\""} {
7947                    set fname [lindex $fname 0]
7948                }
7949                makediffhdr $fname $ids
7950            } elseif {[string compare -length 3 $line "---"] == 0} {
7951                # do nothing
7952                continue
7953            } elseif {[string compare -length 3 $line "+++"] == 0} {
7954                set diffinhdr 0
7955                continue
7956            }
7957            $ctext insert end "$line\n" filesep
7958
7959        } else {
7960            set line [string map {\x1A ^Z} \
7961                          [encoding convertfrom $diffencoding $line]]
7962            # parse the prefix - one ' ', '-' or '+' for each parent
7963            set prefix [string range $line 0 [expr {$diffnparents - 1}]]
7964            set tag [expr {$diffnparents > 1? "m": "d"}]
7965            set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
7966            set words_pre_markup ""
7967            set words_post_markup ""
7968            if {[string trim $prefix " -+"] eq {}} {
7969                # prefix only has " ", "-" and "+" in it: normal diff line
7970                set num [string first "-" $prefix]
7971                if {$dowords} {
7972                    set line [string range $line 1 end]
7973                }
7974                if {$num >= 0} {
7975                    # removed line, first parent with line is $num
7976                    if {$num >= $mergemax} {
7977                        set num "max"
7978                    }
7979                    if {$dowords && $worddiff eq [mc "Markup words"]} {
7980                        $ctext insert end "\[-$line-\]" $tag$num
7981                    } else {
7982                        $ctext insert end "$line" $tag$num
7983                    }
7984                    if {!$dowords} {
7985                        $ctext insert end "\n" $tag$num
7986                    }
7987                } else {
7988                    set tags {}
7989                    if {[string first "+" $prefix] >= 0} {
7990                        # added line
7991                        lappend tags ${tag}result
7992                        if {$diffnparents > 1} {
7993                            set num [string first " " $prefix]
7994                            if {$num >= 0} {
7995                                if {$num >= $mergemax} {
7996                                    set num "max"
7997                                }
7998                                lappend tags m$num
7999                            }
8000                        }
8001                        set words_pre_markup "{+"
8002                        set words_post_markup "+}"
8003                    }
8004                    if {$targetline ne {}} {
8005                        if {$diffline == $targetline} {
8006                            set seehere [$ctext index "end - 1 chars"]
8007                            set targetline {}
8008                        } else {
8009                            incr diffline
8010                        }
8011                    }
8012                    if {$dowords && $worddiff eq [mc "Markup words"]} {
8013                        $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
8014                    } else {
8015                        $ctext insert end "$line" $tags
8016                    }
8017                    if {!$dowords} {
8018                        $ctext insert end "\n" $tags
8019                    }
8020                }
8021            } elseif {$dowords && $prefix eq "~"} {
8022                $ctext insert end "\n" {}
8023            } else {
8024                # "\ No newline at end of file",
8025                # or something else we don't recognize
8026                $ctext insert end "$line\n" hunksep
8027            }
8028        }
8029    }
8030    if {[info exists seehere]} {
8031        mark_ctext_line [lindex [split $seehere .] 0]
8032    }
8033    maybe_scroll_ctext [eof $bdf]
8034    $ctext conf -state disabled
8035    if {[eof $bdf]} {
8036        catch {close $bdf}
8037        return 0
8038    }
8039    return [expr {$nr >= 1000? 2: 1}]
8040}
8041
8042proc changediffdisp {} {
8043    global ctext diffelide
8044
8045    $ctext tag conf d0 -elide [lindex $diffelide 0]
8046    $ctext tag conf dresult -elide [lindex $diffelide 1]
8047}
8048
8049proc highlightfile {cline} {
8050    global cflist cflist_top
8051
8052    if {![info exists cflist_top]} return
8053
8054    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
8055    $cflist tag add highlight $cline.0 "$cline.0 lineend"
8056    $cflist see $cline.0
8057    set cflist_top $cline
8058}
8059
8060proc highlightfile_for_scrollpos {topidx} {
8061    global cmitmode difffilestart
8062
8063    if {$cmitmode eq "tree"} return
8064    if {![info exists difffilestart]} return
8065
8066    set top [lindex [split $topidx .] 0]
8067    if {$difffilestart eq {} || $top < [lindex $difffilestart 0]} {
8068        highlightfile 0
8069    } else {
8070        highlightfile [expr {[bsearch $difffilestart $top] + 2}]
8071    }
8072}
8073
8074proc prevfile {} {
8075    global difffilestart ctext cmitmode
8076
8077    if {$cmitmode eq "tree"} return
8078    set prev 0.0
8079    set here [$ctext index @0,0]
8080    foreach loc $difffilestart {
8081        if {[$ctext compare $loc >= $here]} {
8082            $ctext yview $prev
8083            return
8084        }
8085        set prev $loc
8086    }
8087    $ctext yview $prev
8088}
8089
8090proc nextfile {} {
8091    global difffilestart ctext cmitmode
8092
8093    if {$cmitmode eq "tree"} return
8094    set here [$ctext index @0,0]
8095    foreach loc $difffilestart {
8096        if {[$ctext compare $loc > $here]} {
8097            $ctext yview $loc
8098            return
8099        }
8100    }
8101}
8102
8103proc clear_ctext {{first 1.0}} {
8104    global ctext smarktop smarkbot
8105    global ctext_file_names ctext_file_lines
8106    global pendinglinks
8107
8108    set l [lindex [split $first .] 0]
8109    if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
8110        set smarktop $l
8111    }
8112    if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
8113        set smarkbot $l
8114    }
8115    $ctext delete $first end
8116    if {$first eq "1.0"} {
8117        catch {unset pendinglinks}
8118    }
8119    set ctext_file_names {}
8120    set ctext_file_lines {}
8121}
8122
8123proc settabs {{firstab {}}} {
8124    global firsttabstop tabstop ctext have_tk85
8125
8126    if {$firstab ne {} && $have_tk85} {
8127        set firsttabstop $firstab
8128    }
8129    set w [font measure textfont "0"]
8130    if {$firsttabstop != 0} {
8131        $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
8132                               [expr {($firsttabstop + 2 * $tabstop) * $w}]]
8133    } elseif {$have_tk85 || $tabstop != 8} {
8134        $ctext conf -tabs [expr {$tabstop * $w}]
8135    } else {
8136        $ctext conf -tabs {}
8137    }
8138}
8139
8140proc incrsearch {name ix op} {
8141    global ctext searchstring searchdirn
8142
8143    if {[catch {$ctext index anchor}]} {
8144        # no anchor set, use start of selection, or of visible area
8145        set sel [$ctext tag ranges sel]
8146        if {$sel ne {}} {
8147            $ctext mark set anchor [lindex $sel 0]
8148        } elseif {$searchdirn eq "-forwards"} {
8149            $ctext mark set anchor @0,0
8150        } else {
8151            $ctext mark set anchor @0,[winfo height $ctext]
8152        }
8153    }
8154    if {$searchstring ne {}} {
8155        set here [$ctext search -count mlen $searchdirn -- $searchstring anchor]
8156        if {$here ne {}} {
8157            $ctext see $here
8158            set mend "$here + $mlen c"
8159            $ctext tag remove sel 1.0 end
8160            $ctext tag add sel $here $mend
8161            suppress_highlighting_file_for_current_scrollpos
8162            highlightfile_for_scrollpos $here
8163        }
8164    }
8165    rehighlight_search_results
8166}
8167
8168proc dosearch {} {
8169    global sstring ctext searchstring searchdirn
8170
8171    focus $sstring
8172    $sstring icursor end
8173    set searchdirn -forwards
8174    if {$searchstring ne {}} {
8175        set sel [$ctext tag ranges sel]
8176        if {$sel ne {}} {
8177            set start "[lindex $sel 0] + 1c"
8178        } elseif {[catch {set start [$ctext index anchor]}]} {
8179            set start "@0,0"
8180        }
8181        set match [$ctext search -count mlen -- $searchstring $start]
8182        $ctext tag remove sel 1.0 end
8183        if {$match eq {}} {
8184            bell
8185            return
8186        }
8187        $ctext see $match
8188        suppress_highlighting_file_for_current_scrollpos
8189        highlightfile_for_scrollpos $match
8190        set mend "$match + $mlen c"
8191        $ctext tag add sel $match $mend
8192        $ctext mark unset anchor
8193        rehighlight_search_results
8194    }
8195}
8196
8197proc dosearchback {} {
8198    global sstring ctext searchstring searchdirn
8199
8200    focus $sstring
8201    $sstring icursor end
8202    set searchdirn -backwards
8203    if {$searchstring ne {}} {
8204        set sel [$ctext tag ranges sel]
8205        if {$sel ne {}} {
8206            set start [lindex $sel 0]
8207        } elseif {[catch {set start [$ctext index anchor]}]} {
8208            set start @0,[winfo height $ctext]
8209        }
8210        set match [$ctext search -backwards -count ml -- $searchstring $start]
8211        $ctext tag remove sel 1.0 end
8212        if {$match eq {}} {
8213            bell
8214            return
8215        }
8216        $ctext see $match
8217        suppress_highlighting_file_for_current_scrollpos
8218        highlightfile_for_scrollpos $match
8219        set mend "$match + $ml c"
8220        $ctext tag add sel $match $mend
8221        $ctext mark unset anchor
8222        rehighlight_search_results
8223    }
8224}
8225
8226proc rehighlight_search_results {} {
8227    global ctext searchstring
8228
8229    $ctext tag remove found 1.0 end
8230    $ctext tag remove currentsearchhit 1.0 end
8231
8232    if {$searchstring ne {}} {
8233        searchmarkvisible 1
8234    }
8235}
8236
8237proc searchmark {first last} {
8238    global ctext searchstring
8239
8240    set sel [$ctext tag ranges sel]
8241
8242    set mend $first.0
8243    while {1} {
8244        set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8245        if {$match eq {}} break
8246        set mend "$match + $mlen c"
8247        if {$sel ne {} && [$ctext compare $match == [lindex $sel 0]]} {
8248            $ctext tag add currentsearchhit $match $mend
8249        } else {
8250            $ctext tag add found $match $mend
8251        }
8252    }
8253}
8254
8255proc searchmarkvisible {doall} {
8256    global ctext smarktop smarkbot
8257
8258    set topline [lindex [split [$ctext index @0,0] .] 0]
8259    set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8260    if {$doall || $botline < $smarktop || $topline > $smarkbot} {
8261        # no overlap with previous
8262        searchmark $topline $botline
8263        set smarktop $topline
8264        set smarkbot $botline
8265    } else {
8266        if {$topline < $smarktop} {
8267            searchmark $topline [expr {$smarktop-1}]
8268            set smarktop $topline
8269        }
8270        if {$botline > $smarkbot} {
8271            searchmark [expr {$smarkbot+1}] $botline
8272            set smarkbot $botline
8273        }
8274    }
8275}
8276
8277proc suppress_highlighting_file_for_current_scrollpos {} {
8278    global ctext suppress_highlighting_file_for_this_scrollpos
8279
8280    set suppress_highlighting_file_for_this_scrollpos [$ctext index @0,0]
8281}
8282
8283proc scrolltext {f0 f1} {
8284    global searchstring cmitmode ctext
8285    global suppress_highlighting_file_for_this_scrollpos
8286
8287    set topidx [$ctext index @0,0]
8288    if {![info exists suppress_highlighting_file_for_this_scrollpos]
8289        || $topidx ne $suppress_highlighting_file_for_this_scrollpos} {
8290        highlightfile_for_scrollpos $topidx
8291    }
8292
8293    catch {unset suppress_highlighting_file_for_this_scrollpos}
8294
8295    .bleft.bottom.sb set $f0 $f1
8296    if {$searchstring ne {}} {
8297        searchmarkvisible 0
8298    }
8299}
8300
8301proc setcoords {} {
8302    global linespc charspc canvx0 canvy0
8303    global xspc1 xspc2 lthickness
8304
8305    set linespc [font metrics mainfont -linespace]
8306    set charspc [font measure mainfont "m"]
8307    set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8308    set canvx0 [expr {int(3 + 0.5 * $linespc)}]
8309    set lthickness [expr {int($linespc / 9) + 1}]
8310    set xspc1(0) $linespc
8311    set xspc2 $linespc
8312}
8313
8314proc redisplay {} {
8315    global canv
8316    global selectedline
8317
8318    set ymax [lindex [$canv cget -scrollregion] 3]
8319    if {$ymax eq {} || $ymax == 0} return
8320    set span [$canv yview]
8321    clear_display
8322    setcanvscroll
8323    allcanvs yview moveto [lindex $span 0]
8324    drawvisible
8325    if {$selectedline ne {}} {
8326        selectline $selectedline 0
8327        allcanvs yview moveto [lindex $span 0]
8328    }
8329}
8330
8331proc parsefont {f n} {
8332    global fontattr
8333
8334    set fontattr($f,family) [lindex $n 0]
8335    set s [lindex $n 1]
8336    if {$s eq {} || $s == 0} {
8337        set s 10
8338    } elseif {$s < 0} {
8339        set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
8340    }
8341    set fontattr($f,size) $s
8342    set fontattr($f,weight) normal
8343    set fontattr($f,slant) roman
8344    foreach style [lrange $n 2 end] {
8345        switch -- $style {
8346            "normal" -
8347            "bold"   {set fontattr($f,weight) $style}
8348            "roman" -
8349            "italic" {set fontattr($f,slant) $style}
8350        }
8351    }
8352}
8353
8354proc fontflags {f {isbold 0}} {
8355    global fontattr
8356
8357    return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8358                -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8359                -slant $fontattr($f,slant)]
8360}
8361
8362proc fontname {f} {
8363    global fontattr
8364
8365    set n [list $fontattr($f,family) $fontattr($f,size)]
8366    if {$fontattr($f,weight) eq "bold"} {
8367        lappend n "bold"
8368    }
8369    if {$fontattr($f,slant) eq "italic"} {
8370        lappend n "italic"
8371    }
8372    return $n
8373}
8374
8375proc incrfont {inc} {
8376    global mainfont textfont ctext canv cflist showrefstop
8377    global stopped entries fontattr
8378
8379    unmarkmatches
8380    set s $fontattr(mainfont,size)
8381    incr s $inc
8382    if {$s < 1} {
8383        set s 1
8384    }
8385    set fontattr(mainfont,size) $s
8386    font config mainfont -size $s
8387    font config mainfontbold -size $s
8388    set mainfont [fontname mainfont]
8389    set s $fontattr(textfont,size)
8390    incr s $inc
8391    if {$s < 1} {
8392        set s 1
8393    }
8394    set fontattr(textfont,size) $s
8395    font config textfont -size $s
8396    font config textfontbold -size $s
8397    set textfont [fontname textfont]
8398    setcoords
8399    settabs
8400    redisplay
8401}
8402
8403proc clearsha1 {} {
8404    global sha1entry sha1string
8405    if {[string length $sha1string] == 40} {
8406        $sha1entry delete 0 end
8407    }
8408}
8409
8410proc sha1change {n1 n2 op} {
8411    global sha1string currentid sha1but
8412    if {$sha1string == {}
8413        || ([info exists currentid] && $sha1string == $currentid)} {
8414        set state disabled
8415    } else {
8416        set state normal
8417    }
8418    if {[$sha1but cget -state] == $state} return
8419    if {$state == "normal"} {
8420        $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
8421    } else {
8422        $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
8423    }
8424}
8425
8426proc gotocommit {} {
8427    global sha1string tagids headids curview varcid
8428
8429    if {$sha1string == {}
8430        || ([info exists currentid] && $sha1string == $currentid)} return
8431    if {[info exists tagids($sha1string)]} {
8432        set id $tagids($sha1string)
8433    } elseif {[info exists headids($sha1string)]} {
8434        set id $headids($sha1string)
8435    } else {
8436        set id [string tolower $sha1string]
8437        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
8438            set matches [longid $id]
8439            if {$matches ne {}} {
8440                if {[llength $matches] > 1} {
8441                    error_popup [mc "Short SHA1 id %s is ambiguous" $id]
8442                    return
8443                }
8444                set id [lindex $matches 0]
8445            }
8446        } else {
8447            if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8448                error_popup [mc "Revision %s is not known" $sha1string]
8449                return
8450            }
8451        }
8452    }
8453    if {[commitinview $id $curview]} {
8454        selectline [rowofcommit $id] 1
8455        return
8456    }
8457    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
8458        set msg [mc "SHA1 id %s is not known" $sha1string]
8459    } else {
8460        set msg [mc "Revision %s is not in the current view" $sha1string]
8461    }
8462    error_popup $msg
8463}
8464
8465proc lineenter {x y id} {
8466    global hoverx hovery hoverid hovertimer
8467    global commitinfo canv
8468
8469    if {![info exists commitinfo($id)] && ![getcommit $id]} return
8470    set hoverx $x
8471    set hovery $y
8472    set hoverid $id
8473    if {[info exists hovertimer]} {
8474        after cancel $hovertimer
8475    }
8476    set hovertimer [after 500 linehover]
8477    $canv delete hover
8478}
8479
8480proc linemotion {x y id} {
8481    global hoverx hovery hoverid hovertimer
8482
8483    if {[info exists hoverid] && $id == $hoverid} {
8484        set hoverx $x
8485        set hovery $y
8486        if {[info exists hovertimer]} {
8487            after cancel $hovertimer
8488        }
8489        set hovertimer [after 500 linehover]
8490    }
8491}
8492
8493proc lineleave {id} {
8494    global hoverid hovertimer canv
8495
8496    if {[info exists hoverid] && $id == $hoverid} {
8497        $canv delete hover
8498        if {[info exists hovertimer]} {
8499            after cancel $hovertimer
8500            unset hovertimer
8501        }
8502        unset hoverid
8503    }
8504}
8505
8506proc linehover {} {
8507    global hoverx hovery hoverid hovertimer
8508    global canv linespc lthickness
8509    global linehoverbgcolor linehoverfgcolor linehoveroutlinecolor
8510
8511    global commitinfo
8512
8513    set text [lindex $commitinfo($hoverid) 0]
8514    set ymax [lindex [$canv cget -scrollregion] 3]
8515    if {$ymax == {}} return
8516    set yfrac [lindex [$canv yview] 0]
8517    set x [expr {$hoverx + 2 * $linespc}]
8518    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8519    set x0 [expr {$x - 2 * $lthickness}]
8520    set y0 [expr {$y - 2 * $lthickness}]
8521    set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
8522    set y1 [expr {$y + $linespc + 2 * $lthickness}]
8523    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8524               -fill $linehoverbgcolor -outline $linehoveroutlinecolor \
8525               -width 1 -tags hover]
8526    $canv raise $t
8527    set t [$canv create text $x $y -anchor nw -text $text -tags hover \
8528               -font mainfont -fill $linehoverfgcolor]
8529    $canv raise $t
8530}
8531
8532proc clickisonarrow {id y} {
8533    global lthickness
8534
8535    set ranges [rowranges $id]
8536    set thresh [expr {2 * $lthickness + 6}]
8537    set n [expr {[llength $ranges] - 1}]
8538    for {set i 1} {$i < $n} {incr i} {
8539        set row [lindex $ranges $i]
8540        if {abs([yc $row] - $y) < $thresh} {
8541            return $i
8542        }
8543    }
8544    return {}
8545}
8546
8547proc arrowjump {id n y} {
8548    global canv
8549
8550    # 1 <-> 2, 3 <-> 4, etc...
8551    set n [expr {(($n - 1) ^ 1) + 1}]
8552    set row [lindex [rowranges $id] $n]
8553    set yt [yc $row]
8554    set ymax [lindex [$canv cget -scrollregion] 3]
8555    if {$ymax eq {} || $ymax <= 0} return
8556    set view [$canv yview]
8557    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8558    set yfrac [expr {$yt / $ymax - $yspan / 2}]
8559    if {$yfrac < 0} {
8560        set yfrac 0
8561    }
8562    allcanvs yview moveto $yfrac
8563}
8564
8565proc lineclick {x y id isnew} {
8566    global ctext commitinfo children canv thickerline curview
8567
8568    if {![info exists commitinfo($id)] && ![getcommit $id]} return
8569    unmarkmatches
8570    unselectline
8571    normalline
8572    $canv delete hover
8573    # draw this line thicker than normal
8574    set thickerline $id
8575    drawlines $id
8576    if {$isnew} {
8577        set ymax [lindex [$canv cget -scrollregion] 3]
8578        if {$ymax eq {}} return
8579        set yfrac [lindex [$canv yview] 0]
8580        set y [expr {$y + $yfrac * $ymax}]
8581    }
8582    set dirn [clickisonarrow $id $y]
8583    if {$dirn ne {}} {
8584        arrowjump $id $dirn $y
8585        return
8586    }
8587
8588    if {$isnew} {
8589        addtohistory [list lineclick $x $y $id 0] savectextpos
8590    }
8591    # fill the details pane with info about this line
8592    $ctext conf -state normal
8593    clear_ctext
8594    settabs 0
8595    $ctext insert end "[mc "Parent"]:\t"
8596    $ctext insert end $id link0
8597    setlink $id link0
8598    set info $commitinfo($id)
8599    $ctext insert end "\n\t[lindex $info 0]\n"
8600    $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8601    set date [formatdate [lindex $info 2]]
8602    $ctext insert end "\t[mc "Date"]:\t$date\n"
8603    set kids $children($curview,$id)
8604    if {$kids ne {}} {
8605        $ctext insert end "\n[mc "Children"]:"
8606        set i 0
8607        foreach child $kids {
8608            incr i
8609            if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8610            set info $commitinfo($child)
8611            $ctext insert end "\n\t"
8612            $ctext insert end $child link$i
8613            setlink $child link$i
8614            $ctext insert end "\n\t[lindex $info 0]"
8615            $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8616            set date [formatdate [lindex $info 2]]
8617            $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8618        }
8619    }
8620    maybe_scroll_ctext 1
8621    $ctext conf -state disabled
8622    init_flist {}
8623}
8624
8625proc normalline {} {
8626    global thickerline
8627    if {[info exists thickerline]} {
8628        set id $thickerline
8629        unset thickerline
8630        drawlines $id
8631    }
8632}
8633
8634proc selbyid {id {isnew 1}} {
8635    global curview
8636    if {[commitinview $id $curview]} {
8637        selectline [rowofcommit $id] $isnew
8638    }
8639}
8640
8641proc mstime {} {
8642    global startmstime
8643    if {![info exists startmstime]} {
8644        set startmstime [clock clicks -milliseconds]
8645    }
8646    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8647}
8648
8649proc rowmenu {x y id} {
8650    global rowctxmenu selectedline rowmenuid curview
8651    global nullid nullid2 fakerowmenu mainhead markedid
8652
8653    stopfinding
8654    set rowmenuid $id
8655    if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8656        set state disabled
8657    } else {
8658        set state normal
8659    }
8660    if {[info exists markedid] && $markedid ne $id} {
8661        set mstate normal
8662    } else {
8663        set mstate disabled
8664    }
8665    if {$id ne $nullid && $id ne $nullid2} {
8666        set menu $rowctxmenu
8667        if {$mainhead ne {}} {
8668            $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead] -state normal
8669        } else {
8670            $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8671        }
8672        $menu entryconfigure 9 -state $mstate
8673        $menu entryconfigure 10 -state $mstate
8674        $menu entryconfigure 11 -state $mstate
8675    } else {
8676        set menu $fakerowmenu
8677    }
8678    $menu entryconfigure [mca "Diff this -> selected"] -state $state
8679    $menu entryconfigure [mca "Diff selected -> this"] -state $state
8680    $menu entryconfigure [mca "Make patch"] -state $state
8681    $menu entryconfigure [mca "Diff this -> marked commit"] -state $mstate
8682    $menu entryconfigure [mca "Diff marked commit -> this"] -state $mstate
8683    tk_popup $menu $x $y
8684}
8685
8686proc markhere {} {
8687    global rowmenuid markedid canv
8688
8689    set markedid $rowmenuid
8690    make_idmark $markedid
8691}
8692
8693proc gotomark {} {
8694    global markedid
8695
8696    if {[info exists markedid]} {
8697        selbyid $markedid
8698    }
8699}
8700
8701proc replace_by_kids {l r} {
8702    global curview children
8703
8704    set id [commitonrow $r]
8705    set l [lreplace $l 0 0]
8706    foreach kid $children($curview,$id) {
8707        lappend l [rowofcommit $kid]
8708    }
8709    return [lsort -integer -decreasing -unique $l]
8710}
8711
8712proc find_common_desc {} {
8713    global markedid rowmenuid curview children
8714
8715    if {![info exists markedid]} return
8716    if {![commitinview $markedid $curview] ||
8717        ![commitinview $rowmenuid $curview]} return
8718    #set t1 [clock clicks -milliseconds]
8719    set l1 [list [rowofcommit $markedid]]
8720    set l2 [list [rowofcommit $rowmenuid]]
8721    while 1 {
8722        set r1 [lindex $l1 0]
8723        set r2 [lindex $l2 0]
8724        if {$r1 eq {} || $r2 eq {}} break
8725        if {$r1 == $r2} {
8726            selectline $r1 1
8727            break
8728        }
8729        if {$r1 > $r2} {
8730            set l1 [replace_by_kids $l1 $r1]
8731        } else {
8732            set l2 [replace_by_kids $l2 $r2]
8733        }
8734    }
8735    #set t2 [clock clicks -milliseconds]
8736    #puts "took [expr {$t2-$t1}]ms"
8737}
8738
8739proc compare_commits {} {
8740    global markedid rowmenuid curview children
8741
8742    if {![info exists markedid]} return
8743    if {![commitinview $markedid $curview]} return
8744    addtohistory [list do_cmp_commits $markedid $rowmenuid]
8745    do_cmp_commits $markedid $rowmenuid
8746}
8747
8748proc getpatchid {id} {
8749    global patchids
8750
8751    if {![info exists patchids($id)]} {
8752        set cmd [diffcmd [list $id] {-p --root}]
8753        # trim off the initial "|"
8754        set cmd [lrange $cmd 1 end]
8755        if {[catch {
8756            set x [eval exec $cmd | git patch-id]
8757            set patchids($id) [lindex $x 0]
8758        }]} {
8759            set patchids($id) "error"
8760        }
8761    }
8762    return $patchids($id)
8763}
8764
8765proc do_cmp_commits {a b} {
8766    global ctext curview parents children patchids commitinfo
8767
8768    $ctext conf -state normal
8769    clear_ctext
8770    init_flist {}
8771    for {set i 0} {$i < 100} {incr i} {
8772        set skipa 0
8773        set skipb 0
8774        if {[llength $parents($curview,$a)] > 1} {
8775            appendshortlink $a [mc "Skipping merge commit "] "\n"
8776            set skipa 1
8777        } else {
8778            set patcha [getpatchid $a]
8779        }
8780        if {[llength $parents($curview,$b)] > 1} {
8781            appendshortlink $b [mc "Skipping merge commit "] "\n"
8782            set skipb 1
8783        } else {
8784            set patchb [getpatchid $b]
8785        }
8786        if {!$skipa && !$skipb} {
8787            set heada [lindex $commitinfo($a) 0]
8788            set headb [lindex $commitinfo($b) 0]
8789            if {$patcha eq "error"} {
8790                appendshortlink $a [mc "Error getting patch ID for "] \
8791                    [mc " - stopping\n"]
8792                break
8793            }
8794            if {$patchb eq "error"} {
8795                appendshortlink $b [mc "Error getting patch ID for "] \
8796                    [mc " - stopping\n"]
8797                break
8798            }
8799            if {$patcha eq $patchb} {
8800                if {$heada eq $headb} {
8801                    appendshortlink $a [mc "Commit "]
8802                    appendshortlink $b " == " "  $heada\n"
8803                } else {
8804                    appendshortlink $a [mc "Commit "] "  $heada\n"
8805                    appendshortlink $b [mc " is the same patch as\n       "] \
8806                        "  $headb\n"
8807                }
8808                set skipa 1
8809                set skipb 1
8810            } else {
8811                $ctext insert end "\n"
8812                appendshortlink $a [mc "Commit "] "  $heada\n"
8813                appendshortlink $b [mc " differs from\n       "] \
8814                    "  $headb\n"
8815                $ctext insert end [mc "Diff of commits:\n\n"]
8816                $ctext conf -state disabled
8817                update
8818                diffcommits $a $b
8819                return
8820            }
8821        }
8822        if {$skipa} {
8823            set kids [real_children $curview,$a]
8824            if {[llength $kids] != 1} {
8825                $ctext insert end "\n"
8826                appendshortlink $a [mc "Commit "] \
8827                    [mc " has %s children - stopping\n" [llength $kids]]
8828                break
8829            }
8830            set a [lindex $kids 0]
8831        }
8832        if {$skipb} {
8833            set kids [real_children $curview,$b]
8834            if {[llength $kids] != 1} {
8835                appendshortlink $b [mc "Commit "] \
8836                    [mc " has %s children - stopping\n" [llength $kids]]
8837                break
8838            }
8839            set b [lindex $kids 0]
8840        }
8841    }
8842    $ctext conf -state disabled
8843}
8844
8845proc diffcommits {a b} {
8846    global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
8847
8848    set tmpdir [gitknewtmpdir]
8849    set fna [file join $tmpdir "commit-[string range $a 0 7]"]
8850    set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
8851    if {[catch {
8852        exec git diff-tree -p --pretty $a >$fna
8853        exec git diff-tree -p --pretty $b >$fnb
8854    } err]} {
8855        error_popup [mc "Error writing commit to file: %s" $err]
8856        return
8857    }
8858    if {[catch {
8859        set fd [open "| diff -U$diffcontext $fna $fnb" r]
8860    } err]} {
8861        error_popup [mc "Error diffing commits: %s" $err]
8862        return
8863    }
8864    set diffids [list commits $a $b]
8865    set blobdifffd($diffids) $fd
8866    set diffinhdr 0
8867    set currdiffsubmod ""
8868    filerun $fd [list getblobdiffline $fd $diffids]
8869}
8870
8871proc diffvssel {dirn} {
8872    global rowmenuid selectedline
8873
8874    if {$selectedline eq {}} return
8875    if {$dirn} {
8876        set oldid [commitonrow $selectedline]
8877        set newid $rowmenuid
8878    } else {
8879        set oldid $rowmenuid
8880        set newid [commitonrow $selectedline]
8881    }
8882    addtohistory [list doseldiff $oldid $newid] savectextpos
8883    doseldiff $oldid $newid
8884}
8885
8886proc diffvsmark {dirn} {
8887    global rowmenuid markedid
8888
8889    if {![info exists markedid]} return
8890    if {$dirn} {
8891        set oldid $markedid
8892        set newid $rowmenuid
8893    } else {
8894        set oldid $rowmenuid
8895        set newid $markedid
8896    }
8897    addtohistory [list doseldiff $oldid $newid] savectextpos
8898    doseldiff $oldid $newid
8899}
8900
8901proc doseldiff {oldid newid} {
8902    global ctext
8903    global commitinfo
8904
8905    $ctext conf -state normal
8906    clear_ctext
8907    init_flist [mc "Top"]
8908    $ctext insert end "[mc "From"] "
8909    $ctext insert end $oldid link0
8910    setlink $oldid link0
8911    $ctext insert end "\n     "
8912    $ctext insert end [lindex $commitinfo($oldid) 0]
8913    $ctext insert end "\n\n[mc "To"]   "
8914    $ctext insert end $newid link1
8915    setlink $newid link1
8916    $ctext insert end "\n     "
8917    $ctext insert end [lindex $commitinfo($newid) 0]
8918    $ctext insert end "\n"
8919    $ctext conf -state disabled
8920    $ctext tag remove found 1.0 end
8921    startdiff [list $oldid $newid]
8922}
8923
8924proc mkpatch {} {
8925    global rowmenuid currentid commitinfo patchtop patchnum NS
8926
8927    if {![info exists currentid]} return
8928    set oldid $currentid
8929    set oldhead [lindex $commitinfo($oldid) 0]
8930    set newid $rowmenuid
8931    set newhead [lindex $commitinfo($newid) 0]
8932    set top .patch
8933    set patchtop $top
8934    catch {destroy $top}
8935    ttk_toplevel $top
8936    make_transient $top .
8937    ${NS}::label $top.title -text [mc "Generate patch"]
8938    grid $top.title - -pady 10
8939    ${NS}::label $top.from -text [mc "From:"]
8940    ${NS}::entry $top.fromsha1 -width 40
8941    $top.fromsha1 insert 0 $oldid
8942    $top.fromsha1 conf -state readonly
8943    grid $top.from $top.fromsha1 -sticky w
8944    ${NS}::entry $top.fromhead -width 60
8945    $top.fromhead insert 0 $oldhead
8946    $top.fromhead conf -state readonly
8947    grid x $top.fromhead -sticky w
8948    ${NS}::label $top.to -text [mc "To:"]
8949    ${NS}::entry $top.tosha1 -width 40
8950    $top.tosha1 insert 0 $newid
8951    $top.tosha1 conf -state readonly
8952    grid $top.to $top.tosha1 -sticky w
8953    ${NS}::entry $top.tohead -width 60
8954    $top.tohead insert 0 $newhead
8955    $top.tohead conf -state readonly
8956    grid x $top.tohead -sticky w
8957    ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
8958    grid $top.rev x -pady 10 -padx 5
8959    ${NS}::label $top.flab -text [mc "Output file:"]
8960    ${NS}::entry $top.fname -width 60
8961    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
8962    incr patchnum
8963    grid $top.flab $top.fname -sticky w
8964    ${NS}::frame $top.buts
8965    ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
8966    ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
8967    bind $top <Key-Return> mkpatchgo
8968    bind $top <Key-Escape> mkpatchcan
8969    grid $top.buts.gen $top.buts.can
8970    grid columnconfigure $top.buts 0 -weight 1 -uniform a
8971    grid columnconfigure $top.buts 1 -weight 1 -uniform a
8972    grid $top.buts - -pady 10 -sticky ew
8973    focus $top.fname
8974}
8975
8976proc mkpatchrev {} {
8977    global patchtop
8978
8979    set oldid [$patchtop.fromsha1 get]
8980    set oldhead [$patchtop.fromhead get]
8981    set newid [$patchtop.tosha1 get]
8982    set newhead [$patchtop.tohead get]
8983    foreach e [list fromsha1 fromhead tosha1 tohead] \
8984            v [list $newid $newhead $oldid $oldhead] {
8985        $patchtop.$e conf -state normal
8986        $patchtop.$e delete 0 end
8987        $patchtop.$e insert 0 $v
8988        $patchtop.$e conf -state readonly
8989    }
8990}
8991
8992proc mkpatchgo {} {
8993    global patchtop nullid nullid2
8994
8995    set oldid [$patchtop.fromsha1 get]
8996    set newid [$patchtop.tosha1 get]
8997    set fname [$patchtop.fname get]
8998    set cmd [diffcmd [list $oldid $newid] -p]
8999    # trim off the initial "|"
9000    set cmd [lrange $cmd 1 end]
9001    lappend cmd >$fname &
9002    if {[catch {eval exec $cmd} err]} {
9003        error_popup "[mc "Error creating patch:"] $err" $patchtop
9004    }
9005    catch {destroy $patchtop}
9006    unset patchtop
9007}
9008
9009proc mkpatchcan {} {
9010    global patchtop
9011
9012    catch {destroy $patchtop}
9013    unset patchtop
9014}
9015
9016proc mktag {} {
9017    global rowmenuid mktagtop commitinfo NS
9018
9019    set top .maketag
9020    set mktagtop $top
9021    catch {destroy $top}
9022    ttk_toplevel $top
9023    make_transient $top .
9024    ${NS}::label $top.title -text [mc "Create tag"]
9025    grid $top.title - -pady 10
9026    ${NS}::label $top.id -text [mc "ID:"]
9027    ${NS}::entry $top.sha1 -width 40
9028    $top.sha1 insert 0 $rowmenuid
9029    $top.sha1 conf -state readonly
9030    grid $top.id $top.sha1 -sticky w
9031    ${NS}::entry $top.head -width 60
9032    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9033    $top.head conf -state readonly
9034    grid x $top.head -sticky w
9035    ${NS}::label $top.tlab -text [mc "Tag name:"]
9036    ${NS}::entry $top.tag -width 60
9037    grid $top.tlab $top.tag -sticky w
9038    ${NS}::label $top.op -text [mc "Tag message is optional"]
9039    grid $top.op -columnspan 2 -sticky we
9040    ${NS}::label $top.mlab -text [mc "Tag message:"]
9041    ${NS}::entry $top.msg -width 60
9042    grid $top.mlab $top.msg -sticky w
9043    ${NS}::frame $top.buts
9044    ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
9045    ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
9046    bind $top <Key-Return> mktaggo
9047    bind $top <Key-Escape> mktagcan
9048    grid $top.buts.gen $top.buts.can
9049    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9050    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9051    grid $top.buts - -pady 10 -sticky ew
9052    focus $top.tag
9053}
9054
9055proc domktag {} {
9056    global mktagtop env tagids idtags
9057
9058    set id [$mktagtop.sha1 get]
9059    set tag [$mktagtop.tag get]
9060    set msg [$mktagtop.msg get]
9061    if {$tag == {}} {
9062        error_popup [mc "No tag name specified"] $mktagtop
9063        return 0
9064    }
9065    if {[info exists tagids($tag)]} {
9066        error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
9067        return 0
9068    }
9069    if {[catch {
9070        if {$msg != {}} {
9071            exec git tag -a -m $msg $tag $id
9072        } else {
9073            exec git tag $tag $id
9074        }
9075    } err]} {
9076        error_popup "[mc "Error creating tag:"] $err" $mktagtop
9077        return 0
9078    }
9079
9080    set tagids($tag) $id
9081    lappend idtags($id) $tag
9082    redrawtags $id
9083    addedtag $id
9084    dispneartags 0
9085    run refill_reflist
9086    return 1
9087}
9088
9089proc redrawtags {id} {
9090    global canv linehtag idpos currentid curview cmitlisted markedid
9091    global canvxmax iddrawn circleitem mainheadid circlecolors
9092    global mainheadcirclecolor
9093
9094    if {![commitinview $id $curview]} return
9095    if {![info exists iddrawn($id)]} return
9096    set row [rowofcommit $id]
9097    if {$id eq $mainheadid} {
9098        set ofill $mainheadcirclecolor
9099    } else {
9100        set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
9101    }
9102    $canv itemconf $circleitem($row) -fill $ofill
9103    $canv delete tag.$id
9104    set xt [eval drawtags $id $idpos($id)]
9105    $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
9106    set text [$canv itemcget $linehtag($id) -text]
9107    set font [$canv itemcget $linehtag($id) -font]
9108    set xr [expr {$xt + [font measure $font $text]}]
9109    if {$xr > $canvxmax} {
9110        set canvxmax $xr
9111        setcanvscroll
9112    }
9113    if {[info exists currentid] && $currentid == $id} {
9114        make_secsel $id
9115    }
9116    if {[info exists markedid] && $markedid eq $id} {
9117        make_idmark $id
9118    }
9119}
9120
9121proc mktagcan {} {
9122    global mktagtop
9123
9124    catch {destroy $mktagtop}
9125    unset mktagtop
9126}
9127
9128proc mktaggo {} {
9129    if {![domktag]} return
9130    mktagcan
9131}
9132
9133proc writecommit {} {
9134    global rowmenuid wrcomtop commitinfo wrcomcmd NS
9135
9136    set top .writecommit
9137    set wrcomtop $top
9138    catch {destroy $top}
9139    ttk_toplevel $top
9140    make_transient $top .
9141    ${NS}::label $top.title -text [mc "Write commit to file"]
9142    grid $top.title - -pady 10
9143    ${NS}::label $top.id -text [mc "ID:"]
9144    ${NS}::entry $top.sha1 -width 40
9145    $top.sha1 insert 0 $rowmenuid
9146    $top.sha1 conf -state readonly
9147    grid $top.id $top.sha1 -sticky w
9148    ${NS}::entry $top.head -width 60
9149    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9150    $top.head conf -state readonly
9151    grid x $top.head -sticky w
9152    ${NS}::label $top.clab -text [mc "Command:"]
9153    ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
9154    grid $top.clab $top.cmd -sticky w -pady 10
9155    ${NS}::label $top.flab -text [mc "Output file:"]
9156    ${NS}::entry $top.fname -width 60
9157    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
9158    grid $top.flab $top.fname -sticky w
9159    ${NS}::frame $top.buts
9160    ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
9161    ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
9162    bind $top <Key-Return> wrcomgo
9163    bind $top <Key-Escape> wrcomcan
9164    grid $top.buts.gen $top.buts.can
9165    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9166    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9167    grid $top.buts - -pady 10 -sticky ew
9168    focus $top.fname
9169}
9170
9171proc wrcomgo {} {
9172    global wrcomtop
9173
9174    set id [$wrcomtop.sha1 get]
9175    set cmd "echo $id | [$wrcomtop.cmd get]"
9176    set fname [$wrcomtop.fname get]
9177    if {[catch {exec sh -c $cmd >$fname &} err]} {
9178        error_popup "[mc "Error writing commit:"] $err" $wrcomtop
9179    }
9180    catch {destroy $wrcomtop}
9181    unset wrcomtop
9182}
9183
9184proc wrcomcan {} {
9185    global wrcomtop
9186
9187    catch {destroy $wrcomtop}
9188    unset wrcomtop
9189}
9190
9191proc mkbranch {} {
9192    global rowmenuid mkbrtop NS
9193
9194    set top .makebranch
9195    catch {destroy $top}
9196    ttk_toplevel $top
9197    make_transient $top .
9198    ${NS}::label $top.title -text [mc "Create new branch"]
9199    grid $top.title - -pady 10
9200    ${NS}::label $top.id -text [mc "ID:"]
9201    ${NS}::entry $top.sha1 -width 40
9202    $top.sha1 insert 0 $rowmenuid
9203    $top.sha1 conf -state readonly
9204    grid $top.id $top.sha1 -sticky w
9205    ${NS}::label $top.nlab -text [mc "Name:"]
9206    ${NS}::entry $top.name -width 40
9207    grid $top.nlab $top.name -sticky w
9208    ${NS}::frame $top.buts
9209    ${NS}::button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
9210    ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
9211    bind $top <Key-Return> [list mkbrgo $top]
9212    bind $top <Key-Escape> "catch {destroy $top}"
9213    grid $top.buts.go $top.buts.can
9214    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9215    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9216    grid $top.buts - -pady 10 -sticky ew
9217    focus $top.name
9218}
9219
9220proc mkbrgo {top} {
9221    global headids idheads
9222
9223    set name [$top.name get]
9224    set id [$top.sha1 get]
9225    set cmdargs {}
9226    set old_id {}
9227    if {$name eq {}} {
9228        error_popup [mc "Please specify a name for the new branch"] $top
9229        return
9230    }
9231    if {[info exists headids($name)]} {
9232        if {![confirm_popup [mc \
9233                "Branch '%s' already exists. Overwrite?" $name] $top]} {
9234            return
9235        }
9236        set old_id $headids($name)
9237        lappend cmdargs -f
9238    }
9239    catch {destroy $top}
9240    lappend cmdargs $name $id
9241    nowbusy newbranch
9242    update
9243    if {[catch {
9244        eval exec git branch $cmdargs
9245    } err]} {
9246        notbusy newbranch
9247        error_popup $err
9248    } else {
9249        notbusy newbranch
9250        if {$old_id ne {}} {
9251            movehead $id $name
9252            movedhead $id $name
9253            redrawtags $old_id
9254            redrawtags $id
9255        } else {
9256            set headids($name) $id
9257            lappend idheads($id) $name
9258            addedhead $id $name
9259            redrawtags $id
9260        }
9261        dispneartags 0
9262        run refill_reflist
9263    }
9264}
9265
9266proc exec_citool {tool_args {baseid {}}} {
9267    global commitinfo env
9268
9269    set save_env [array get env GIT_AUTHOR_*]
9270
9271    if {$baseid ne {}} {
9272        if {![info exists commitinfo($baseid)]} {
9273            getcommit $baseid
9274        }
9275        set author [lindex $commitinfo($baseid) 1]
9276        set date [lindex $commitinfo($baseid) 2]
9277        if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9278                    $author author name email]
9279            && $date ne {}} {
9280            set env(GIT_AUTHOR_NAME) $name
9281            set env(GIT_AUTHOR_EMAIL) $email
9282            set env(GIT_AUTHOR_DATE) $date
9283        }
9284    }
9285
9286    eval exec git citool $tool_args &
9287
9288    array unset env GIT_AUTHOR_*
9289    array set env $save_env
9290}
9291
9292proc cherrypick {} {
9293    global rowmenuid curview
9294    global mainhead mainheadid
9295    global gitdir
9296
9297    set oldhead [exec git rev-parse HEAD]
9298    set dheads [descheads $rowmenuid]
9299    if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
9300        set ok [confirm_popup [mc "Commit %s is already\
9301                included in branch %s -- really re-apply it?" \
9302                                   [string range $rowmenuid 0 7] $mainhead]]
9303        if {!$ok} return
9304    }
9305    nowbusy cherrypick [mc "Cherry-picking"]
9306    update
9307    # Unfortunately git-cherry-pick writes stuff to stderr even when
9308    # no error occurs, and exec takes that as an indication of error...
9309    if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9310        notbusy cherrypick
9311        if {[regexp -line \
9312                 {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9313                 $err msg fname]} {
9314            error_popup [mc "Cherry-pick failed because of local changes\
9315                        to file '%s'.\nPlease commit, reset or stash\
9316                        your changes and try again." $fname]
9317        } elseif {[regexp -line \
9318                       {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
9319                       $err]} {
9320            if {[confirm_popup [mc "Cherry-pick failed because of merge\
9321                        conflict.\nDo you wish to run git citool to\
9322                        resolve it?"]]} {
9323                # Force citool to read MERGE_MSG
9324                file delete [file join $gitdir "GITGUI_MSG"]
9325                exec_citool {} $rowmenuid
9326            }
9327        } else {
9328            error_popup $err
9329        }
9330        run updatecommits
9331        return
9332    }
9333    set newhead [exec git rev-parse HEAD]
9334    if {$newhead eq $oldhead} {
9335        notbusy cherrypick
9336        error_popup [mc "No changes committed"]
9337        return
9338    }
9339    addnewchild $newhead $oldhead
9340    if {[commitinview $oldhead $curview]} {
9341        # XXX this isn't right if we have a path limit...
9342        insertrow $newhead $oldhead $curview
9343        if {$mainhead ne {}} {
9344            movehead $newhead $mainhead
9345            movedhead $newhead $mainhead
9346        }
9347        set mainheadid $newhead
9348        redrawtags $oldhead
9349        redrawtags $newhead
9350        selbyid $newhead
9351    }
9352    notbusy cherrypick
9353}
9354
9355proc resethead {} {
9356    global mainhead rowmenuid confirm_ok resettype NS
9357
9358    set confirm_ok 0
9359    set w ".confirmreset"
9360    ttk_toplevel $w
9361    make_transient $w .
9362    wm title $w [mc "Confirm reset"]
9363    ${NS}::label $w.m -text \
9364        [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
9365    pack $w.m -side top -fill x -padx 20 -pady 20
9366    ${NS}::labelframe $w.f -text [mc "Reset type:"]
9367    set resettype mixed
9368    ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
9369        -text [mc "Soft: Leave working tree and index untouched"]
9370    grid $w.f.soft -sticky w
9371    ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
9372        -text [mc "Mixed: Leave working tree untouched, reset index"]
9373    grid $w.f.mixed -sticky w
9374    ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
9375        -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
9376    grid $w.f.hard -sticky w
9377    pack $w.f -side top -fill x -padx 4
9378    ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
9379    pack $w.ok -side left -fill x -padx 20 -pady 20
9380    ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
9381    bind $w <Key-Escape> [list destroy $w]
9382    pack $w.cancel -side right -fill x -padx 20 -pady 20
9383    bind $w <Visibility> "grab $w; focus $w"
9384    tkwait window $w
9385    if {!$confirm_ok} return
9386    if {[catch {set fd [open \
9387            [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
9388        error_popup $err
9389    } else {
9390        dohidelocalchanges
9391        filerun $fd [list readresetstat $fd]
9392        nowbusy reset [mc "Resetting"]
9393        selbyid $rowmenuid
9394    }
9395}
9396
9397proc readresetstat {fd} {
9398    global mainhead mainheadid showlocalchanges rprogcoord
9399
9400    if {[gets $fd line] >= 0} {
9401        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9402            set rprogcoord [expr {1.0 * $m / $n}]
9403            adjustprogress
9404        }
9405        return 1
9406    }
9407    set rprogcoord 0
9408    adjustprogress
9409    notbusy reset
9410    if {[catch {close $fd} err]} {
9411        error_popup $err
9412    }
9413    set oldhead $mainheadid
9414    set newhead [exec git rev-parse HEAD]
9415    if {$newhead ne $oldhead} {
9416        movehead $newhead $mainhead
9417        movedhead $newhead $mainhead
9418        set mainheadid $newhead
9419        redrawtags $oldhead
9420        redrawtags $newhead
9421    }
9422    if {$showlocalchanges} {
9423        doshowlocalchanges
9424    }
9425    return 0
9426}
9427
9428# context menu for a head
9429proc headmenu {x y id head} {
9430    global headmenuid headmenuhead headctxmenu mainhead
9431
9432    stopfinding
9433    set headmenuid $id
9434    set headmenuhead $head
9435    set state normal
9436    if {[string match "remotes/*" $head]} {
9437        set state disabled
9438    }
9439    if {$head eq $mainhead} {
9440        set state disabled
9441    }
9442    $headctxmenu entryconfigure 0 -state $state
9443    $headctxmenu entryconfigure 1 -state $state
9444    tk_popup $headctxmenu $x $y
9445}
9446
9447proc cobranch {} {
9448    global headmenuid headmenuhead headids
9449    global showlocalchanges
9450
9451    # check the tree is clean first??
9452    nowbusy checkout [mc "Checking out"]
9453    update
9454    dohidelocalchanges
9455    if {[catch {
9456        set fd [open [list | git checkout $headmenuhead 2>@1] r]
9457    } err]} {
9458        notbusy checkout
9459        error_popup $err
9460        if {$showlocalchanges} {
9461            dodiffindex
9462        }
9463    } else {
9464        filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
9465    }
9466}
9467
9468proc readcheckoutstat {fd newhead newheadid} {
9469    global mainhead mainheadid headids showlocalchanges progresscoords
9470    global viewmainheadid curview
9471
9472    if {[gets $fd line] >= 0} {
9473        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9474            set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9475            adjustprogress
9476        }
9477        return 1
9478    }
9479    set progresscoords {0 0}
9480    adjustprogress
9481    notbusy checkout
9482    if {[catch {close $fd} err]} {
9483        error_popup $err
9484    }
9485    set oldmainid $mainheadid
9486    set mainhead $newhead
9487    set mainheadid $newheadid
9488    set viewmainheadid($curview) $newheadid
9489    redrawtags $oldmainid
9490    redrawtags $newheadid
9491    selbyid $newheadid
9492    if {$showlocalchanges} {
9493        dodiffindex
9494    }
9495}
9496
9497proc rmbranch {} {
9498    global headmenuid headmenuhead mainhead
9499    global idheads
9500
9501    set head $headmenuhead
9502    set id $headmenuid
9503    # this check shouldn't be needed any more...
9504    if {$head eq $mainhead} {
9505        error_popup [mc "Cannot delete the currently checked-out branch"]
9506        return
9507    }
9508    set dheads [descheads $id]
9509    if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
9510        # the stuff on this branch isn't on any other branch
9511        if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9512                        branch.\nReally delete branch %s?" $head $head]]} return
9513    }
9514    nowbusy rmbranch
9515    update
9516    if {[catch {exec git branch -D $head} err]} {
9517        notbusy rmbranch
9518        error_popup $err
9519        return
9520    }
9521    removehead $id $head
9522    removedhead $id $head
9523    redrawtags $id
9524    notbusy rmbranch
9525    dispneartags 0
9526    run refill_reflist
9527}
9528
9529# Display a list of tags and heads
9530proc showrefs {} {
9531    global showrefstop bgcolor fgcolor selectbgcolor NS
9532    global bglist fglist reflistfilter reflist maincursor
9533
9534    set top .showrefs
9535    set showrefstop $top
9536    if {[winfo exists $top]} {
9537        raise $top
9538        refill_reflist
9539        return
9540    }
9541    ttk_toplevel $top
9542    wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
9543    make_transient $top .
9544    text $top.list -background $bgcolor -foreground $fgcolor \
9545        -selectbackground $selectbgcolor -font mainfont \
9546        -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
9547        -width 30 -height 20 -cursor $maincursor \
9548        -spacing1 1 -spacing3 1 -state disabled
9549    $top.list tag configure highlight -background $selectbgcolor
9550    lappend bglist $top.list
9551    lappend fglist $top.list
9552    ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
9553    ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
9554    grid $top.list $top.ysb -sticky nsew
9555    grid $top.xsb x -sticky ew
9556    ${NS}::frame $top.f
9557    ${NS}::label $top.f.l -text "[mc "Filter"]: "
9558    ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
9559    set reflistfilter "*"
9560    trace add variable reflistfilter write reflistfilter_change
9561    pack $top.f.e -side right -fill x -expand 1
9562    pack $top.f.l -side left
9563    grid $top.f - -sticky ew -pady 2
9564    ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
9565    bind $top <Key-Escape> [list destroy $top]
9566    grid $top.close -
9567    grid columnconfigure $top 0 -weight 1
9568    grid rowconfigure $top 0 -weight 1
9569    bind $top.list <1> {break}
9570    bind $top.list <B1-Motion> {break}
9571    bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
9572    set reflist {}
9573    refill_reflist
9574}
9575
9576proc sel_reflist {w x y} {
9577    global showrefstop reflist headids tagids otherrefids
9578
9579    if {![winfo exists $showrefstop]} return
9580    set l [lindex [split [$w index "@$x,$y"] "."] 0]
9581    set ref [lindex $reflist [expr {$l-1}]]
9582    set n [lindex $ref 0]
9583    switch -- [lindex $ref 1] {
9584        "H" {selbyid $headids($n)}
9585        "T" {selbyid $tagids($n)}
9586        "o" {selbyid $otherrefids($n)}
9587    }
9588    $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
9589}
9590
9591proc unsel_reflist {} {
9592    global showrefstop
9593
9594    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9595    $showrefstop.list tag remove highlight 0.0 end
9596}
9597
9598proc reflistfilter_change {n1 n2 op} {
9599    global reflistfilter
9600
9601    after cancel refill_reflist
9602    after 200 refill_reflist
9603}
9604
9605proc refill_reflist {} {
9606    global reflist reflistfilter showrefstop headids tagids otherrefids
9607    global curview
9608
9609    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9610    set refs {}
9611    foreach n [array names headids] {
9612        if {[string match $reflistfilter $n]} {
9613            if {[commitinview $headids($n) $curview]} {
9614                lappend refs [list $n H]
9615            } else {
9616                interestedin $headids($n) {run refill_reflist}
9617            }
9618        }
9619    }
9620    foreach n [array names tagids] {
9621        if {[string match $reflistfilter $n]} {
9622            if {[commitinview $tagids($n) $curview]} {
9623                lappend refs [list $n T]
9624            } else {
9625                interestedin $tagids($n) {run refill_reflist}
9626            }
9627        }
9628    }
9629    foreach n [array names otherrefids] {
9630        if {[string match $reflistfilter $n]} {
9631            if {[commitinview $otherrefids($n) $curview]} {
9632                lappend refs [list $n o]
9633            } else {
9634                interestedin $otherrefids($n) {run refill_reflist}
9635            }
9636        }
9637    }
9638    set refs [lsort -index 0 $refs]
9639    if {$refs eq $reflist} return
9640
9641    # Update the contents of $showrefstop.list according to the
9642    # differences between $reflist (old) and $refs (new)
9643    $showrefstop.list conf -state normal
9644    $showrefstop.list insert end "\n"
9645    set i 0
9646    set j 0
9647    while {$i < [llength $reflist] || $j < [llength $refs]} {
9648        if {$i < [llength $reflist]} {
9649            if {$j < [llength $refs]} {
9650                set cmp [string compare [lindex $reflist $i 0] \
9651                             [lindex $refs $j 0]]
9652                if {$cmp == 0} {
9653                    set cmp [string compare [lindex $reflist $i 1] \
9654                                 [lindex $refs $j 1]]
9655                }
9656            } else {
9657                set cmp -1
9658            }
9659        } else {
9660            set cmp 1
9661        }
9662        switch -- $cmp {
9663            -1 {
9664                $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
9665                incr i
9666            }
9667            0 {
9668                incr i
9669                incr j
9670            }
9671            1 {
9672                set l [expr {$j + 1}]
9673                $showrefstop.list image create $l.0 -align baseline \
9674                    -image reficon-[lindex $refs $j 1] -padx 2
9675                $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
9676                incr j
9677            }
9678        }
9679    }
9680    set reflist $refs
9681    # delete last newline
9682    $showrefstop.list delete end-2c end-1c
9683    $showrefstop.list conf -state disabled
9684}
9685
9686# Stuff for finding nearby tags
9687proc getallcommits {} {
9688    global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
9689    global idheads idtags idotherrefs allparents tagobjid
9690    global gitdir
9691
9692    if {![info exists allcommits]} {
9693        set nextarc 0
9694        set allcommits 0
9695        set seeds {}
9696        set allcwait 0
9697        set cachedarcs 0
9698        set allccache [file join $gitdir "gitk.cache"]
9699        if {![catch {
9700            set f [open $allccache r]
9701            set allcwait 1
9702            getcache $f
9703        }]} return
9704    }
9705
9706    if {$allcwait} {
9707        return
9708    }
9709    set cmd [list | git rev-list --parents]
9710    set allcupdate [expr {$seeds ne {}}]
9711    if {!$allcupdate} {
9712        set ids "--all"
9713    } else {
9714        set refs [concat [array names idheads] [array names idtags] \
9715                      [array names idotherrefs]]
9716        set ids {}
9717        set tagobjs {}
9718        foreach name [array names tagobjid] {
9719            lappend tagobjs $tagobjid($name)
9720        }
9721        foreach id [lsort -unique $refs] {
9722            if {![info exists allparents($id)] &&
9723                [lsearch -exact $tagobjs $id] < 0} {
9724                lappend ids $id
9725            }
9726        }
9727        if {$ids ne {}} {
9728            foreach id $seeds {
9729                lappend ids "^$id"
9730            }
9731        }
9732    }
9733    if {$ids ne {}} {
9734        set fd [open [concat $cmd $ids] r]
9735        fconfigure $fd -blocking 0
9736        incr allcommits
9737        nowbusy allcommits
9738        filerun $fd [list getallclines $fd]
9739    } else {
9740        dispneartags 0
9741    }
9742}
9743
9744# Since most commits have 1 parent and 1 child, we group strings of
9745# such commits into "arcs" joining branch/merge points (BMPs), which
9746# are commits that either don't have 1 parent or don't have 1 child.
9747#
9748# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
9749# arcout(id) - outgoing arcs for BMP
9750# arcids(a) - list of IDs on arc including end but not start
9751# arcstart(a) - BMP ID at start of arc
9752# arcend(a) - BMP ID at end of arc
9753# growing(a) - arc a is still growing
9754# arctags(a) - IDs out of arcids (excluding end) that have tags
9755# archeads(a) - IDs out of arcids (excluding end) that have heads
9756# The start of an arc is at the descendent end, so "incoming" means
9757# coming from descendents, and "outgoing" means going towards ancestors.
9758
9759proc getallclines {fd} {
9760    global allparents allchildren idtags idheads nextarc
9761    global arcnos arcids arctags arcout arcend arcstart archeads growing
9762    global seeds allcommits cachedarcs allcupdate
9763
9764    set nid 0
9765    while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
9766        set id [lindex $line 0]
9767        if {[info exists allparents($id)]} {
9768            # seen it already
9769            continue
9770        }
9771        set cachedarcs 0
9772        set olds [lrange $line 1 end]
9773        set allparents($id) $olds
9774        if {![info exists allchildren($id)]} {
9775            set allchildren($id) {}
9776            set arcnos($id) {}
9777            lappend seeds $id
9778        } else {
9779            set a $arcnos($id)
9780            if {[llength $olds] == 1 && [llength $a] == 1} {
9781                lappend arcids($a) $id
9782                if {[info exists idtags($id)]} {
9783                    lappend arctags($a) $id
9784                }
9785                if {[info exists idheads($id)]} {
9786                    lappend archeads($a) $id
9787                }
9788                if {[info exists allparents($olds)]} {
9789                    # seen parent already
9790                    if {![info exists arcout($olds)]} {
9791                        splitarc $olds
9792                    }
9793                    lappend arcids($a) $olds
9794                    set arcend($a) $olds
9795                    unset growing($a)
9796                }
9797                lappend allchildren($olds) $id
9798                lappend arcnos($olds) $a
9799                continue
9800            }
9801        }
9802        foreach a $arcnos($id) {
9803            lappend arcids($a) $id
9804            set arcend($a) $id
9805            unset growing($a)
9806        }
9807
9808        set ao {}
9809        foreach p $olds {
9810            lappend allchildren($p) $id
9811            set a [incr nextarc]
9812            set arcstart($a) $id
9813            set archeads($a) {}
9814            set arctags($a) {}
9815            set archeads($a) {}
9816            set arcids($a) {}
9817            lappend ao $a
9818            set growing($a) 1
9819            if {[info exists allparents($p)]} {
9820                # seen it already, may need to make a new branch
9821                if {![info exists arcout($p)]} {
9822                    splitarc $p
9823                }
9824                lappend arcids($a) $p
9825                set arcend($a) $p
9826                unset growing($a)
9827            }
9828            lappend arcnos($p) $a
9829        }
9830        set arcout($id) $ao
9831    }
9832    if {$nid > 0} {
9833        global cached_dheads cached_dtags cached_atags
9834        catch {unset cached_dheads}
9835        catch {unset cached_dtags}
9836        catch {unset cached_atags}
9837    }
9838    if {![eof $fd]} {
9839        return [expr {$nid >= 1000? 2: 1}]
9840    }
9841    set cacheok 1
9842    if {[catch {
9843        fconfigure $fd -blocking 1
9844        close $fd
9845    } err]} {
9846        # got an error reading the list of commits
9847        # if we were updating, try rereading the whole thing again
9848        if {$allcupdate} {
9849            incr allcommits -1
9850            dropcache $err
9851            return
9852        }
9853        error_popup "[mc "Error reading commit topology information;\
9854                branch and preceding/following tag information\
9855                will be incomplete."]\n($err)"
9856        set cacheok 0
9857    }
9858    if {[incr allcommits -1] == 0} {
9859        notbusy allcommits
9860        if {$cacheok} {
9861            run savecache
9862        }
9863    }
9864    dispneartags 0
9865    return 0
9866}
9867
9868proc recalcarc {a} {
9869    global arctags archeads arcids idtags idheads
9870
9871    set at {}
9872    set ah {}
9873    foreach id [lrange $arcids($a) 0 end-1] {
9874        if {[info exists idtags($id)]} {
9875            lappend at $id
9876        }
9877        if {[info exists idheads($id)]} {
9878            lappend ah $id
9879        }
9880    }
9881    set arctags($a) $at
9882    set archeads($a) $ah
9883}
9884
9885proc splitarc {p} {
9886    global arcnos arcids nextarc arctags archeads idtags idheads
9887    global arcstart arcend arcout allparents growing
9888
9889    set a $arcnos($p)
9890    if {[llength $a] != 1} {
9891        puts "oops splitarc called but [llength $a] arcs already"
9892        return
9893    }
9894    set a [lindex $a 0]
9895    set i [lsearch -exact $arcids($a) $p]
9896    if {$i < 0} {
9897        puts "oops splitarc $p not in arc $a"
9898        return
9899    }
9900    set na [incr nextarc]
9901    if {[info exists arcend($a)]} {
9902        set arcend($na) $arcend($a)
9903    } else {
9904        set l [lindex $allparents([lindex $arcids($a) end]) 0]
9905        set j [lsearch -exact $arcnos($l) $a]
9906        set arcnos($l) [lreplace $arcnos($l) $j $j $na]
9907    }
9908    set tail [lrange $arcids($a) [expr {$i+1}] end]
9909    set arcids($a) [lrange $arcids($a) 0 $i]
9910    set arcend($a) $p
9911    set arcstart($na) $p
9912    set arcout($p) $na
9913    set arcids($na) $tail
9914    if {[info exists growing($a)]} {
9915        set growing($na) 1
9916        unset growing($a)
9917    }
9918
9919    foreach id $tail {
9920        if {[llength $arcnos($id)] == 1} {
9921            set arcnos($id) $na
9922        } else {
9923            set j [lsearch -exact $arcnos($id) $a]
9924            set arcnos($id) [lreplace $arcnos($id) $j $j $na]
9925        }
9926    }
9927
9928    # reconstruct tags and heads lists
9929    if {$arctags($a) ne {} || $archeads($a) ne {}} {
9930        recalcarc $a
9931        recalcarc $na
9932    } else {
9933        set arctags($na) {}
9934        set archeads($na) {}
9935    }
9936}
9937
9938# Update things for a new commit added that is a child of one
9939# existing commit.  Used when cherry-picking.
9940proc addnewchild {id p} {
9941    global allparents allchildren idtags nextarc
9942    global arcnos arcids arctags arcout arcend arcstart archeads growing
9943    global seeds allcommits
9944
9945    if {![info exists allcommits] || ![info exists arcnos($p)]} return
9946    set allparents($id) [list $p]
9947    set allchildren($id) {}
9948    set arcnos($id) {}
9949    lappend seeds $id
9950    lappend allchildren($p) $id
9951    set a [incr nextarc]
9952    set arcstart($a) $id
9953    set archeads($a) {}
9954    set arctags($a) {}
9955    set arcids($a) [list $p]
9956    set arcend($a) $p
9957    if {![info exists arcout($p)]} {
9958        splitarc $p
9959    }
9960    lappend arcnos($p) $a
9961    set arcout($id) [list $a]
9962}
9963
9964# This implements a cache for the topology information.
9965# The cache saves, for each arc, the start and end of the arc,
9966# the ids on the arc, and the outgoing arcs from the end.
9967proc readcache {f} {
9968    global arcnos arcids arcout arcstart arcend arctags archeads nextarc
9969    global idtags idheads allparents cachedarcs possible_seeds seeds growing
9970    global allcwait
9971
9972    set a $nextarc
9973    set lim $cachedarcs
9974    if {$lim - $a > 500} {
9975        set lim [expr {$a + 500}]
9976    }
9977    if {[catch {
9978        if {$a == $lim} {
9979            # finish reading the cache and setting up arctags, etc.
9980            set line [gets $f]
9981            if {$line ne "1"} {error "bad final version"}
9982            close $f
9983            foreach id [array names idtags] {
9984                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9985                    [llength $allparents($id)] == 1} {
9986                    set a [lindex $arcnos($id) 0]
9987                    if {$arctags($a) eq {}} {
9988                        recalcarc $a
9989                    }
9990                }
9991            }
9992            foreach id [array names idheads] {
9993                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9994                    [llength $allparents($id)] == 1} {
9995                    set a [lindex $arcnos($id) 0]
9996                    if {$archeads($a) eq {}} {
9997                        recalcarc $a
9998                    }
9999                }
10000            }
10001            foreach id [lsort -unique $possible_seeds] {
10002                if {$arcnos($id) eq {}} {
10003                    lappend seeds $id
10004                }
10005            }
10006            set allcwait 0
10007        } else {
10008            while {[incr a] <= $lim} {
10009                set line [gets $f]
10010                if {[llength $line] != 3} {error "bad line"}
10011                set s [lindex $line 0]
10012                set arcstart($a) $s
10013                lappend arcout($s) $a
10014                if {![info exists arcnos($s)]} {
10015                    lappend possible_seeds $s
10016                    set arcnos($s) {}
10017                }
10018                set e [lindex $line 1]
10019                if {$e eq {}} {
10020                    set growing($a) 1
10021                } else {
10022                    set arcend($a) $e
10023                    if {![info exists arcout($e)]} {
10024                        set arcout($e) {}
10025                    }
10026                }
10027                set arcids($a) [lindex $line 2]
10028                foreach id $arcids($a) {
10029                    lappend allparents($s) $id
10030                    set s $id
10031                    lappend arcnos($id) $a
10032                }
10033                if {![info exists allparents($s)]} {
10034                    set allparents($s) {}
10035                }
10036                set arctags($a) {}
10037                set archeads($a) {}
10038            }
10039            set nextarc [expr {$a - 1}]
10040        }
10041    } err]} {
10042        dropcache $err
10043        return 0
10044    }
10045    if {!$allcwait} {
10046        getallcommits
10047    }
10048    return $allcwait
10049}
10050
10051proc getcache {f} {
10052    global nextarc cachedarcs possible_seeds
10053
10054    if {[catch {
10055        set line [gets $f]
10056        if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
10057        # make sure it's an integer
10058        set cachedarcs [expr {int([lindex $line 1])}]
10059        if {$cachedarcs < 0} {error "bad number of arcs"}
10060        set nextarc 0
10061        set possible_seeds {}
10062        run readcache $f
10063    } err]} {
10064        dropcache $err
10065    }
10066    return 0
10067}
10068
10069proc dropcache {err} {
10070    global allcwait nextarc cachedarcs seeds
10071
10072    #puts "dropping cache ($err)"
10073    foreach v {arcnos arcout arcids arcstart arcend growing \
10074                   arctags archeads allparents allchildren} {
10075        global $v
10076        catch {unset $v}
10077    }
10078    set allcwait 0
10079    set nextarc 0
10080    set cachedarcs 0
10081    set seeds {}
10082    getallcommits
10083}
10084
10085proc writecache {f} {
10086    global cachearc cachedarcs allccache
10087    global arcstart arcend arcnos arcids arcout
10088
10089    set a $cachearc
10090    set lim $cachedarcs
10091    if {$lim - $a > 1000} {
10092        set lim [expr {$a + 1000}]
10093    }
10094    if {[catch {
10095        while {[incr a] <= $lim} {
10096            if {[info exists arcend($a)]} {
10097                puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
10098            } else {
10099                puts $f [list $arcstart($a) {} $arcids($a)]
10100            }
10101        }
10102    } err]} {
10103        catch {close $f}
10104        catch {file delete $allccache}
10105        #puts "writing cache failed ($err)"
10106        return 0
10107    }
10108    set cachearc [expr {$a - 1}]
10109    if {$a > $cachedarcs} {
10110        puts $f "1"
10111        close $f
10112        return 0
10113    }
10114    return 1
10115}
10116
10117proc savecache {} {
10118    global nextarc cachedarcs cachearc allccache
10119
10120    if {$nextarc == $cachedarcs} return
10121    set cachearc 0
10122    set cachedarcs $nextarc
10123    catch {
10124        set f [open $allccache w]
10125        puts $f [list 1 $cachedarcs]
10126        run writecache $f
10127    }
10128}
10129
10130# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
10131# or 0 if neither is true.
10132proc anc_or_desc {a b} {
10133    global arcout arcstart arcend arcnos cached_isanc
10134
10135    if {$arcnos($a) eq $arcnos($b)} {
10136        # Both are on the same arc(s); either both are the same BMP,
10137        # or if one is not a BMP, the other is also not a BMP or is
10138        # the BMP at end of the arc (and it only has 1 incoming arc).
10139        # Or both can be BMPs with no incoming arcs.
10140        if {$a eq $b || $arcnos($a) eq {}} {
10141            return 0
10142        }
10143        # assert {[llength $arcnos($a)] == 1}
10144        set arc [lindex $arcnos($a) 0]
10145        set i [lsearch -exact $arcids($arc) $a]
10146        set j [lsearch -exact $arcids($arc) $b]
10147        if {$i < 0 || $i > $j} {
10148            return 1
10149        } else {
10150            return -1
10151        }
10152    }
10153
10154    if {![info exists arcout($a)]} {
10155        set arc [lindex $arcnos($a) 0]
10156        if {[info exists arcend($arc)]} {
10157            set aend $arcend($arc)
10158        } else {
10159            set aend {}
10160        }
10161        set a $arcstart($arc)
10162    } else {
10163        set aend $a
10164    }
10165    if {![info exists arcout($b)]} {
10166        set arc [lindex $arcnos($b) 0]
10167        if {[info exists arcend($arc)]} {
10168            set bend $arcend($arc)
10169        } else {
10170            set bend {}
10171        }
10172        set b $arcstart($arc)
10173    } else {
10174        set bend $b
10175    }
10176    if {$a eq $bend} {
10177        return 1
10178    }
10179    if {$b eq $aend} {
10180        return -1
10181    }
10182    if {[info exists cached_isanc($a,$bend)]} {
10183        if {$cached_isanc($a,$bend)} {
10184            return 1
10185        }
10186    }
10187    if {[info exists cached_isanc($b,$aend)]} {
10188        if {$cached_isanc($b,$aend)} {
10189            return -1
10190        }
10191        if {[info exists cached_isanc($a,$bend)]} {
10192            return 0
10193        }
10194    }
10195
10196    set todo [list $a $b]
10197    set anc($a) a
10198    set anc($b) b
10199    for {set i 0} {$i < [llength $todo]} {incr i} {
10200        set x [lindex $todo $i]
10201        if {$anc($x) eq {}} {
10202            continue
10203        }
10204        foreach arc $arcnos($x) {
10205            set xd $arcstart($arc)
10206            if {$xd eq $bend} {
10207                set cached_isanc($a,$bend) 1
10208                set cached_isanc($b,$aend) 0
10209                return 1
10210            } elseif {$xd eq $aend} {
10211                set cached_isanc($b,$aend) 1
10212                set cached_isanc($a,$bend) 0
10213                return -1
10214            }
10215            if {![info exists anc($xd)]} {
10216                set anc($xd) $anc($x)
10217                lappend todo $xd
10218            } elseif {$anc($xd) ne $anc($x)} {
10219                set anc($xd) {}
10220            }
10221        }
10222    }
10223    set cached_isanc($a,$bend) 0
10224    set cached_isanc($b,$aend) 0
10225    return 0
10226}
10227
10228# This identifies whether $desc has an ancestor that is
10229# a growing tip of the graph and which is not an ancestor of $anc
10230# and returns 0 if so and 1 if not.
10231# If we subsequently discover a tag on such a growing tip, and that
10232# turns out to be a descendent of $anc (which it could, since we
10233# don't necessarily see children before parents), then $desc
10234# isn't a good choice to display as a descendent tag of
10235# $anc (since it is the descendent of another tag which is
10236# a descendent of $anc).  Similarly, $anc isn't a good choice to
10237# display as a ancestor tag of $desc.
10238#
10239proc is_certain {desc anc} {
10240    global arcnos arcout arcstart arcend growing problems
10241
10242    set certain {}
10243    if {[llength $arcnos($anc)] == 1} {
10244        # tags on the same arc are certain
10245        if {$arcnos($desc) eq $arcnos($anc)} {
10246            return 1
10247        }
10248        if {![info exists arcout($anc)]} {
10249            # if $anc is partway along an arc, use the start of the arc instead
10250            set a [lindex $arcnos($anc) 0]
10251            set anc $arcstart($a)
10252        }
10253    }
10254    if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
10255        set x $desc
10256    } else {
10257        set a [lindex $arcnos($desc) 0]
10258        set x $arcend($a)
10259    }
10260    if {$x == $anc} {
10261        return 1
10262    }
10263    set anclist [list $x]
10264    set dl($x) 1
10265    set nnh 1
10266    set ngrowanc 0
10267    for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
10268        set x [lindex $anclist $i]
10269        if {$dl($x)} {
10270            incr nnh -1
10271        }
10272        set done($x) 1
10273        foreach a $arcout($x) {
10274            if {[info exists growing($a)]} {
10275                if {![info exists growanc($x)] && $dl($x)} {
10276                    set growanc($x) 1
10277                    incr ngrowanc
10278                }
10279            } else {
10280                set y $arcend($a)
10281                if {[info exists dl($y)]} {
10282                    if {$dl($y)} {
10283                        if {!$dl($x)} {
10284                            set dl($y) 0
10285                            if {![info exists done($y)]} {
10286                                incr nnh -1
10287                            }
10288                            if {[info exists growanc($x)]} {
10289                                incr ngrowanc -1
10290                            }
10291                            set xl [list $y]
10292                            for {set k 0} {$k < [llength $xl]} {incr k} {
10293                                set z [lindex $xl $k]
10294                                foreach c $arcout($z) {
10295                                    if {[info exists arcend($c)]} {
10296                                        set v $arcend($c)
10297                                        if {[info exists dl($v)] && $dl($v)} {
10298                                            set dl($v) 0
10299                                            if {![info exists done($v)]} {
10300                                                incr nnh -1
10301                                            }
10302                                            if {[info exists growanc($v)]} {
10303                                                incr ngrowanc -1
10304                                            }
10305                                            lappend xl $v
10306                                        }
10307                                    }
10308                                }
10309                            }
10310                        }
10311                    }
10312                } elseif {$y eq $anc || !$dl($x)} {
10313                    set dl($y) 0
10314                    lappend anclist $y
10315                } else {
10316                    set dl($y) 1
10317                    lappend anclist $y
10318                    incr nnh
10319                }
10320            }
10321        }
10322    }
10323    foreach x [array names growanc] {
10324        if {$dl($x)} {
10325            return 0
10326        }
10327        return 0
10328    }
10329    return 1
10330}
10331
10332proc validate_arctags {a} {
10333    global arctags idtags
10334
10335    set i -1
10336    set na $arctags($a)
10337    foreach id $arctags($a) {
10338        incr i
10339        if {![info exists idtags($id)]} {
10340            set na [lreplace $na $i $i]
10341            incr i -1
10342        }
10343    }
10344    set arctags($a) $na
10345}
10346
10347proc validate_archeads {a} {
10348    global archeads idheads
10349
10350    set i -1
10351    set na $archeads($a)
10352    foreach id $archeads($a) {
10353        incr i
10354        if {![info exists idheads($id)]} {
10355            set na [lreplace $na $i $i]
10356            incr i -1
10357        }
10358    }
10359    set archeads($a) $na
10360}
10361
10362# Return the list of IDs that have tags that are descendents of id,
10363# ignoring IDs that are descendents of IDs already reported.
10364proc desctags {id} {
10365    global arcnos arcstart arcids arctags idtags allparents
10366    global growing cached_dtags
10367
10368    if {![info exists allparents($id)]} {
10369        return {}
10370    }
10371    set t1 [clock clicks -milliseconds]
10372    set argid $id
10373    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10374        # part-way along an arc; check that arc first
10375        set a [lindex $arcnos($id) 0]
10376        if {$arctags($a) ne {}} {
10377            validate_arctags $a
10378            set i [lsearch -exact $arcids($a) $id]
10379            set tid {}
10380            foreach t $arctags($a) {
10381                set j [lsearch -exact $arcids($a) $t]
10382                if {$j >= $i} break
10383                set tid $t
10384            }
10385            if {$tid ne {}} {
10386                return $tid
10387            }
10388        }
10389        set id $arcstart($a)
10390        if {[info exists idtags($id)]} {
10391            return $id
10392        }
10393    }
10394    if {[info exists cached_dtags($id)]} {
10395        return $cached_dtags($id)
10396    }
10397
10398    set origid $id
10399    set todo [list $id]
10400    set queued($id) 1
10401    set nc 1
10402    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10403        set id [lindex $todo $i]
10404        set done($id) 1
10405        set ta [info exists hastaggedancestor($id)]
10406        if {!$ta} {
10407            incr nc -1
10408        }
10409        # ignore tags on starting node
10410        if {!$ta && $i > 0} {
10411            if {[info exists idtags($id)]} {
10412                set tagloc($id) $id
10413                set ta 1
10414            } elseif {[info exists cached_dtags($id)]} {
10415                set tagloc($id) $cached_dtags($id)
10416                set ta 1
10417            }
10418        }
10419        foreach a $arcnos($id) {
10420            set d $arcstart($a)
10421            if {!$ta && $arctags($a) ne {}} {
10422                validate_arctags $a
10423                if {$arctags($a) ne {}} {
10424                    lappend tagloc($id) [lindex $arctags($a) end]
10425                }
10426            }
10427            if {$ta || $arctags($a) ne {}} {
10428                set tomark [list $d]
10429                for {set j 0} {$j < [llength $tomark]} {incr j} {
10430                    set dd [lindex $tomark $j]
10431                    if {![info exists hastaggedancestor($dd)]} {
10432                        if {[info exists done($dd)]} {
10433                            foreach b $arcnos($dd) {
10434                                lappend tomark $arcstart($b)
10435                            }
10436                            if {[info exists tagloc($dd)]} {
10437                                unset tagloc($dd)
10438                            }
10439                        } elseif {[info exists queued($dd)]} {
10440                            incr nc -1
10441                        }
10442                        set hastaggedancestor($dd) 1
10443                    }
10444                }
10445            }
10446            if {![info exists queued($d)]} {
10447                lappend todo $d
10448                set queued($d) 1
10449                if {![info exists hastaggedancestor($d)]} {
10450                    incr nc
10451                }
10452            }
10453        }
10454    }
10455    set tags {}
10456    foreach id [array names tagloc] {
10457        if {![info exists hastaggedancestor($id)]} {
10458            foreach t $tagloc($id) {
10459                if {[lsearch -exact $tags $t] < 0} {
10460                    lappend tags $t
10461                }
10462            }
10463        }
10464    }
10465    set t2 [clock clicks -milliseconds]
10466    set loopix $i
10467
10468    # remove tags that are descendents of other tags
10469    for {set i 0} {$i < [llength $tags]} {incr i} {
10470        set a [lindex $tags $i]
10471        for {set j 0} {$j < $i} {incr j} {
10472            set b [lindex $tags $j]
10473            set r [anc_or_desc $a $b]
10474            if {$r == 1} {
10475                set tags [lreplace $tags $j $j]
10476                incr j -1
10477                incr i -1
10478            } elseif {$r == -1} {
10479                set tags [lreplace $tags $i $i]
10480                incr i -1
10481                break
10482            }
10483        }
10484    }
10485
10486    if {[array names growing] ne {}} {
10487        # graph isn't finished, need to check if any tag could get
10488        # eclipsed by another tag coming later.  Simply ignore any
10489        # tags that could later get eclipsed.
10490        set ctags {}
10491        foreach t $tags {
10492            if {[is_certain $t $origid]} {
10493                lappend ctags $t
10494            }
10495        }
10496        if {$tags eq $ctags} {
10497            set cached_dtags($origid) $tags
10498        } else {
10499            set tags $ctags
10500        }
10501    } else {
10502        set cached_dtags($origid) $tags
10503    }
10504    set t3 [clock clicks -milliseconds]
10505    if {0 && $t3 - $t1 >= 100} {
10506        puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10507            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10508    }
10509    return $tags
10510}
10511
10512proc anctags {id} {
10513    global arcnos arcids arcout arcend arctags idtags allparents
10514    global growing cached_atags
10515
10516    if {![info exists allparents($id)]} {
10517        return {}
10518    }
10519    set t1 [clock clicks -milliseconds]
10520    set argid $id
10521    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10522        # part-way along an arc; check that arc first
10523        set a [lindex $arcnos($id) 0]
10524        if {$arctags($a) ne {}} {
10525            validate_arctags $a
10526            set i [lsearch -exact $arcids($a) $id]
10527            foreach t $arctags($a) {
10528                set j [lsearch -exact $arcids($a) $t]
10529                if {$j > $i} {
10530                    return $t
10531                }
10532            }
10533        }
10534        if {![info exists arcend($a)]} {
10535            return {}
10536        }
10537        set id $arcend($a)
10538        if {[info exists idtags($id)]} {
10539            return $id
10540        }
10541    }
10542    if {[info exists cached_atags($id)]} {
10543        return $cached_atags($id)
10544    }
10545
10546    set origid $id
10547    set todo [list $id]
10548    set queued($id) 1
10549    set taglist {}
10550    set nc 1
10551    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10552        set id [lindex $todo $i]
10553        set done($id) 1
10554        set td [info exists hastaggeddescendent($id)]
10555        if {!$td} {
10556            incr nc -1
10557        }
10558        # ignore tags on starting node
10559        if {!$td && $i > 0} {
10560            if {[info exists idtags($id)]} {
10561                set tagloc($id) $id
10562                set td 1
10563            } elseif {[info exists cached_atags($id)]} {
10564                set tagloc($id) $cached_atags($id)
10565                set td 1
10566            }
10567        }
10568        foreach a $arcout($id) {
10569            if {!$td && $arctags($a) ne {}} {
10570                validate_arctags $a
10571                if {$arctags($a) ne {}} {
10572                    lappend tagloc($id) [lindex $arctags($a) 0]
10573                }
10574            }
10575            if {![info exists arcend($a)]} continue
10576            set d $arcend($a)
10577            if {$td || $arctags($a) ne {}} {
10578                set tomark [list $d]
10579                for {set j 0} {$j < [llength $tomark]} {incr j} {
10580                    set dd [lindex $tomark $j]
10581                    if {![info exists hastaggeddescendent($dd)]} {
10582                        if {[info exists done($dd)]} {
10583                            foreach b $arcout($dd) {
10584                                if {[info exists arcend($b)]} {
10585                                    lappend tomark $arcend($b)
10586                                }
10587                            }
10588                            if {[info exists tagloc($dd)]} {
10589                                unset tagloc($dd)
10590                            }
10591                        } elseif {[info exists queued($dd)]} {
10592                            incr nc -1
10593                        }
10594                        set hastaggeddescendent($dd) 1
10595                    }
10596                }
10597            }
10598            if {![info exists queued($d)]} {
10599                lappend todo $d
10600                set queued($d) 1
10601                if {![info exists hastaggeddescendent($d)]} {
10602                    incr nc
10603                }
10604            }
10605        }
10606    }
10607    set t2 [clock clicks -milliseconds]
10608    set loopix $i
10609    set tags {}
10610    foreach id [array names tagloc] {
10611        if {![info exists hastaggeddescendent($id)]} {
10612            foreach t $tagloc($id) {
10613                if {[lsearch -exact $tags $t] < 0} {
10614                    lappend tags $t
10615                }
10616            }
10617        }
10618    }
10619
10620    # remove tags that are ancestors of other tags
10621    for {set i 0} {$i < [llength $tags]} {incr i} {
10622        set a [lindex $tags $i]
10623        for {set j 0} {$j < $i} {incr j} {
10624            set b [lindex $tags $j]
10625            set r [anc_or_desc $a $b]
10626            if {$r == -1} {
10627                set tags [lreplace $tags $j $j]
10628                incr j -1
10629                incr i -1
10630            } elseif {$r == 1} {
10631                set tags [lreplace $tags $i $i]
10632                incr i -1
10633                break
10634            }
10635        }
10636    }
10637
10638    if {[array names growing] ne {}} {
10639        # graph isn't finished, need to check if any tag could get
10640        # eclipsed by another tag coming later.  Simply ignore any
10641        # tags that could later get eclipsed.
10642        set ctags {}
10643        foreach t $tags {
10644            if {[is_certain $origid $t]} {
10645                lappend ctags $t
10646            }
10647        }
10648        if {$tags eq $ctags} {
10649            set cached_atags($origid) $tags
10650        } else {
10651            set tags $ctags
10652        }
10653    } else {
10654        set cached_atags($origid) $tags
10655    }
10656    set t3 [clock clicks -milliseconds]
10657    if {0 && $t3 - $t1 >= 100} {
10658        puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
10659            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10660    }
10661    return $tags
10662}
10663
10664# Return the list of IDs that have heads that are descendents of id,
10665# including id itself if it has a head.
10666proc descheads {id} {
10667    global arcnos arcstart arcids archeads idheads cached_dheads
10668    global allparents arcout
10669
10670    if {![info exists allparents($id)]} {
10671        return {}
10672    }
10673    set aret {}
10674    if {![info exists arcout($id)]} {
10675        # part-way along an arc; check it first
10676        set a [lindex $arcnos($id) 0]
10677        if {$archeads($a) ne {}} {
10678            validate_archeads $a
10679            set i [lsearch -exact $arcids($a) $id]
10680            foreach t $archeads($a) {
10681                set j [lsearch -exact $arcids($a) $t]
10682                if {$j > $i} break
10683                lappend aret $t
10684            }
10685        }
10686        set id $arcstart($a)
10687    }
10688    set origid $id
10689    set todo [list $id]
10690    set seen($id) 1
10691    set ret {}
10692    for {set i 0} {$i < [llength $todo]} {incr i} {
10693        set id [lindex $todo $i]
10694        if {[info exists cached_dheads($id)]} {
10695            set ret [concat $ret $cached_dheads($id)]
10696        } else {
10697            if {[info exists idheads($id)]} {
10698                lappend ret $id
10699            }
10700            foreach a $arcnos($id) {
10701                if {$archeads($a) ne {}} {
10702                    validate_archeads $a
10703                    if {$archeads($a) ne {}} {
10704                        set ret [concat $ret $archeads($a)]
10705                    }
10706                }
10707                set d $arcstart($a)
10708                if {![info exists seen($d)]} {
10709                    lappend todo $d
10710                    set seen($d) 1
10711                }
10712            }
10713        }
10714    }
10715    set ret [lsort -unique $ret]
10716    set cached_dheads($origid) $ret
10717    return [concat $ret $aret]
10718}
10719
10720proc addedtag {id} {
10721    global arcnos arcout cached_dtags cached_atags
10722
10723    if {![info exists arcnos($id)]} return
10724    if {![info exists arcout($id)]} {
10725        recalcarc [lindex $arcnos($id) 0]
10726    }
10727    catch {unset cached_dtags}
10728    catch {unset cached_atags}
10729}
10730
10731proc addedhead {hid head} {
10732    global arcnos arcout cached_dheads
10733
10734    if {![info exists arcnos($hid)]} return
10735    if {![info exists arcout($hid)]} {
10736        recalcarc [lindex $arcnos($hid) 0]
10737    }
10738    catch {unset cached_dheads}
10739}
10740
10741proc removedhead {hid head} {
10742    global cached_dheads
10743
10744    catch {unset cached_dheads}
10745}
10746
10747proc movedhead {hid head} {
10748    global arcnos arcout cached_dheads
10749
10750    if {![info exists arcnos($hid)]} return
10751    if {![info exists arcout($hid)]} {
10752        recalcarc [lindex $arcnos($hid) 0]
10753    }
10754    catch {unset cached_dheads}
10755}
10756
10757proc changedrefs {} {
10758    global cached_dheads cached_dtags cached_atags cached_tagcontent
10759    global arctags archeads arcnos arcout idheads idtags
10760
10761    foreach id [concat [array names idheads] [array names idtags]] {
10762        if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
10763            set a [lindex $arcnos($id) 0]
10764            if {![info exists donearc($a)]} {
10765                recalcarc $a
10766                set donearc($a) 1
10767            }
10768        }
10769    }
10770    catch {unset cached_tagcontent}
10771    catch {unset cached_dtags}
10772    catch {unset cached_atags}
10773    catch {unset cached_dheads}
10774}
10775
10776proc rereadrefs {} {
10777    global idtags idheads idotherrefs mainheadid
10778
10779    set refids [concat [array names idtags] \
10780                    [array names idheads] [array names idotherrefs]]
10781    foreach id $refids {
10782        if {![info exists ref($id)]} {
10783            set ref($id) [listrefs $id]
10784        }
10785    }
10786    set oldmainhead $mainheadid
10787    readrefs
10788    changedrefs
10789    set refids [lsort -unique [concat $refids [array names idtags] \
10790                        [array names idheads] [array names idotherrefs]]]
10791    foreach id $refids {
10792        set v [listrefs $id]
10793        if {![info exists ref($id)] || $ref($id) != $v} {
10794            redrawtags $id
10795        }
10796    }
10797    if {$oldmainhead ne $mainheadid} {
10798        redrawtags $oldmainhead
10799        redrawtags $mainheadid
10800    }
10801    run refill_reflist
10802}
10803
10804proc listrefs {id} {
10805    global idtags idheads idotherrefs
10806
10807    set x {}
10808    if {[info exists idtags($id)]} {
10809        set x $idtags($id)
10810    }
10811    set y {}
10812    if {[info exists idheads($id)]} {
10813        set y $idheads($id)
10814    }
10815    set z {}
10816    if {[info exists idotherrefs($id)]} {
10817        set z $idotherrefs($id)
10818    }
10819    return [list $x $y $z]
10820}
10821
10822proc showtag {tag isnew} {
10823    global ctext cached_tagcontent tagids linknum tagobjid
10824
10825    if {$isnew} {
10826        addtohistory [list showtag $tag 0] savectextpos
10827    }
10828    $ctext conf -state normal
10829    clear_ctext
10830    settabs 0
10831    set linknum 0
10832    if {![info exists cached_tagcontent($tag)]} {
10833        catch {
10834           set cached_tagcontent($tag) [exec git cat-file tag $tag]
10835        }
10836    }
10837    if {[info exists cached_tagcontent($tag)]} {
10838        set text $cached_tagcontent($tag)
10839    } else {
10840        set text "[mc "Tag"]: $tag\n[mc "Id"]:  $tagids($tag)"
10841    }
10842    appendwithlinks $text {}
10843    maybe_scroll_ctext 1
10844    $ctext conf -state disabled
10845    init_flist {}
10846}
10847
10848proc doquit {} {
10849    global stopped
10850    global gitktmpdir
10851
10852    set stopped 100
10853    savestuff .
10854    destroy .
10855
10856    if {[info exists gitktmpdir]} {
10857        catch {file delete -force $gitktmpdir}
10858    }
10859}
10860
10861proc mkfontdisp {font top which} {
10862    global fontattr fontpref $font NS use_ttk
10863
10864    set fontpref($font) [set $font]
10865    ${NS}::button $top.${font}but -text $which \
10866        -command [list choosefont $font $which]
10867    ${NS}::label $top.$font -relief flat -font $font \
10868        -text $fontattr($font,family) -justify left
10869    grid x $top.${font}but $top.$font -sticky w
10870}
10871
10872proc choosefont {font which} {
10873    global fontparam fontlist fonttop fontattr
10874    global prefstop NS
10875
10876    set fontparam(which) $which
10877    set fontparam(font) $font
10878    set fontparam(family) [font actual $font -family]
10879    set fontparam(size) $fontattr($font,size)
10880    set fontparam(weight) $fontattr($font,weight)
10881    set fontparam(slant) $fontattr($font,slant)
10882    set top .gitkfont
10883    set fonttop $top
10884    if {![winfo exists $top]} {
10885        font create sample
10886        eval font config sample [font actual $font]
10887        ttk_toplevel $top
10888        make_transient $top $prefstop
10889        wm title $top [mc "Gitk font chooser"]
10890        ${NS}::label $top.l -textvariable fontparam(which)
10891        pack $top.l -side top
10892        set fontlist [lsort [font families]]
10893        ${NS}::frame $top.f
10894        listbox $top.f.fam -listvariable fontlist \
10895            -yscrollcommand [list $top.f.sb set]
10896        bind $top.f.fam <<ListboxSelect>> selfontfam
10897        ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
10898        pack $top.f.sb -side right -fill y
10899        pack $top.f.fam -side left -fill both -expand 1
10900        pack $top.f -side top -fill both -expand 1
10901        ${NS}::frame $top.g
10902        spinbox $top.g.size -from 4 -to 40 -width 4 \
10903            -textvariable fontparam(size) \
10904            -validatecommand {string is integer -strict %s}
10905        checkbutton $top.g.bold -padx 5 \
10906            -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
10907            -variable fontparam(weight) -onvalue bold -offvalue normal
10908        checkbutton $top.g.ital -padx 5 \
10909            -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
10910            -variable fontparam(slant) -onvalue italic -offvalue roman
10911        pack $top.g.size $top.g.bold $top.g.ital -side left
10912        pack $top.g -side top
10913        canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
10914            -background white
10915        $top.c create text 100 25 -anchor center -text $which -font sample \
10916            -fill black -tags text
10917        bind $top.c <Configure> [list centertext $top.c]
10918        pack $top.c -side top -fill x
10919        ${NS}::frame $top.buts
10920        ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
10921        ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
10922        bind $top <Key-Return> fontok
10923        bind $top <Key-Escape> fontcan
10924        grid $top.buts.ok $top.buts.can
10925        grid columnconfigure $top.buts 0 -weight 1 -uniform a
10926        grid columnconfigure $top.buts 1 -weight 1 -uniform a
10927        pack $top.buts -side bottom -fill x
10928        trace add variable fontparam write chg_fontparam
10929    } else {
10930        raise $top
10931        $top.c itemconf text -text $which
10932    }
10933    set i [lsearch -exact $fontlist $fontparam(family)]
10934    if {$i >= 0} {
10935        $top.f.fam selection set $i
10936        $top.f.fam see $i
10937    }
10938}
10939
10940proc centertext {w} {
10941    $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
10942}
10943
10944proc fontok {} {
10945    global fontparam fontpref prefstop
10946
10947    set f $fontparam(font)
10948    set fontpref($f) [list $fontparam(family) $fontparam(size)]
10949    if {$fontparam(weight) eq "bold"} {
10950        lappend fontpref($f) "bold"
10951    }
10952    if {$fontparam(slant) eq "italic"} {
10953        lappend fontpref($f) "italic"
10954    }
10955    set w $prefstop.notebook.fonts.$f
10956    $w conf -text $fontparam(family) -font $fontpref($f)
10957
10958    fontcan
10959}
10960
10961proc fontcan {} {
10962    global fonttop fontparam
10963
10964    if {[info exists fonttop]} {
10965        catch {destroy $fonttop}
10966        catch {font delete sample}
10967        unset fonttop
10968        unset fontparam
10969    }
10970}
10971
10972if {[package vsatisfies [package provide Tk] 8.6]} {
10973    # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
10974    # function to make use of it.
10975    proc choosefont {font which} {
10976        tk fontchooser configure -title $which -font $font \
10977            -command [list on_choosefont $font $which]
10978        tk fontchooser show
10979    }
10980    proc on_choosefont {font which newfont} {
10981        global fontparam
10982        puts stderr "$font $newfont"
10983        array set f [font actual $newfont]
10984        set fontparam(which) $which
10985        set fontparam(font) $font
10986        set fontparam(family) $f(-family)
10987        set fontparam(size) $f(-size)
10988        set fontparam(weight) $f(-weight)
10989        set fontparam(slant) $f(-slant)
10990        fontok
10991    }
10992}
10993
10994proc selfontfam {} {
10995    global fonttop fontparam
10996
10997    set i [$fonttop.f.fam curselection]
10998    if {$i ne {}} {
10999        set fontparam(family) [$fonttop.f.fam get $i]
11000    }
11001}
11002
11003proc chg_fontparam {v sub op} {
11004    global fontparam
11005
11006    font config sample -$sub $fontparam($sub)
11007}
11008
11009# Create a property sheet tab page
11010proc create_prefs_page {w} {
11011    global NS
11012    set parent [join [lrange [split $w .] 0 end-1] .]
11013    if {[winfo class $parent] eq "TNotebook"} {
11014        ${NS}::frame $w
11015    } else {
11016        ${NS}::labelframe $w
11017    }
11018}
11019
11020proc prefspage_general {notebook} {
11021    global NS maxwidth maxgraphpct showneartags showlocalchanges
11022    global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11023    global hideremotes want_ttk have_ttk maxrefs
11024
11025    set page [create_prefs_page $notebook.general]
11026
11027    ${NS}::label $page.ldisp -text [mc "Commit list display options"]
11028    grid $page.ldisp - -sticky w -pady 10
11029    ${NS}::label $page.spacer -text " "
11030    ${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
11031    spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
11032    grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w
11033    ${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
11034    spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
11035    grid x $page.maxpctl $page.maxpct -sticky w
11036    ${NS}::checkbutton $page.showlocal -text [mc "Show local changes"] \
11037        -variable showlocalchanges
11038    grid x $page.showlocal -sticky w
11039    ${NS}::checkbutton $page.autoselect -text [mc "Auto-select SHA1 (length)"] \
11040        -variable autoselect
11041    spinbox $page.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
11042    grid x $page.autoselect $page.autosellen -sticky w
11043    ${NS}::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \
11044        -variable hideremotes
11045    grid x $page.hideremotes -sticky w
11046
11047    ${NS}::label $page.ddisp -text [mc "Diff display options"]
11048    grid $page.ddisp - -sticky w -pady 10
11049    ${NS}::label $page.tabstopl -text [mc "Tab spacing"]
11050    spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
11051    grid x $page.tabstopl $page.tabstop -sticky w
11052    ${NS}::checkbutton $page.ntag -text [mc "Display nearby tags/heads"] \
11053        -variable showneartags
11054    grid x $page.ntag -sticky w
11055    ${NS}::label $page.maxrefsl -text [mc "Maximum # tags/heads to show"]
11056    spinbox $page.maxrefs -from 1 -to 1000 -width 4 -textvariable maxrefs
11057    grid x $page.maxrefsl $page.maxrefs -sticky w
11058    ${NS}::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \
11059        -variable limitdiffs
11060    grid x $page.ldiff -sticky w
11061    ${NS}::checkbutton $page.lattr -text [mc "Support per-file encodings"] \
11062        -variable perfile_attrs
11063    grid x $page.lattr -sticky w
11064
11065    ${NS}::entry $page.extdifft -textvariable extdifftool
11066    ${NS}::frame $page.extdifff
11067    ${NS}::label $page.extdifff.l -text [mc "External diff tool" ]
11068    ${NS}::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff
11069    pack $page.extdifff.l $page.extdifff.b -side left
11070    pack configure $page.extdifff.l -padx 10
11071    grid x $page.extdifff $page.extdifft -sticky ew
11072
11073    ${NS}::label $page.lgen -text [mc "General options"]
11074    grid $page.lgen - -sticky w -pady 10
11075    ${NS}::checkbutton $page.want_ttk -variable want_ttk \
11076        -text [mc "Use themed widgets"]
11077    if {$have_ttk} {
11078        ${NS}::label $page.ttk_note -text [mc "(change requires restart)"]
11079    } else {
11080        ${NS}::label $page.ttk_note -text [mc "(currently unavailable)"]
11081    }
11082    grid x $page.want_ttk $page.ttk_note -sticky w
11083    return $page
11084}
11085
11086proc prefspage_colors {notebook} {
11087    global NS uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11088
11089    set page [create_prefs_page $notebook.colors]
11090
11091    ${NS}::label $page.cdisp -text [mc "Colors: press to choose"]
11092    grid $page.cdisp - -sticky w -pady 10
11093    label $page.ui -padx 40 -relief sunk -background $uicolor
11094    ${NS}::button $page.uibut -text [mc "Interface"] \
11095       -command [list choosecolor uicolor {} $page.ui [mc "interface"] setui]
11096    grid x $page.uibut $page.ui -sticky w
11097    label $page.bg -padx 40 -relief sunk -background $bgcolor
11098    ${NS}::button $page.bgbut -text [mc "Background"] \
11099        -command [list choosecolor bgcolor {} $page.bg [mc "background"] setbg]
11100    grid x $page.bgbut $page.bg -sticky w
11101    label $page.fg -padx 40 -relief sunk -background $fgcolor
11102    ${NS}::button $page.fgbut -text [mc "Foreground"] \
11103        -command [list choosecolor fgcolor {} $page.fg [mc "foreground"] setfg]
11104    grid x $page.fgbut $page.fg -sticky w
11105    label $page.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
11106    ${NS}::button $page.diffoldbut -text [mc "Diff: old lines"] \
11107        -command [list choosecolor diffcolors 0 $page.diffold [mc "diff old lines"] \
11108                      [list $ctext tag conf d0 -foreground]]
11109    grid x $page.diffoldbut $page.diffold -sticky w
11110    label $page.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
11111    ${NS}::button $page.diffnewbut -text [mc "Diff: new lines"] \
11112        -command [list choosecolor diffcolors 1 $page.diffnew [mc "diff new lines"] \
11113                      [list $ctext tag conf dresult -foreground]]
11114    grid x $page.diffnewbut $page.diffnew -sticky w
11115    label $page.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
11116    ${NS}::button $page.hunksepbut -text [mc "Diff: hunk header"] \
11117        -command [list choosecolor diffcolors 2 $page.hunksep \
11118                      [mc "diff hunk header"] \
11119                      [list $ctext tag conf hunksep -foreground]]
11120    grid x $page.hunksepbut $page.hunksep -sticky w
11121    label $page.markbgsep -padx 40 -relief sunk -background $markbgcolor
11122    ${NS}::button $page.markbgbut -text [mc "Marked line bg"] \
11123        -command [list choosecolor markbgcolor {} $page.markbgsep \
11124                      [mc "marked line background"] \
11125                      [list $ctext tag conf omark -background]]
11126    grid x $page.markbgbut $page.markbgsep -sticky w
11127    label $page.selbgsep -padx 40 -relief sunk -background $selectbgcolor
11128    ${NS}::button $page.selbgbut -text [mc "Select bg"] \
11129        -command [list choosecolor selectbgcolor {} $page.selbgsep [mc "background"] setselbg]
11130    grid x $page.selbgbut $page.selbgsep -sticky w
11131    return $page
11132}
11133
11134proc prefspage_fonts {notebook} {
11135    global NS
11136    set page [create_prefs_page $notebook.fonts]
11137    ${NS}::label $page.cfont -text [mc "Fonts: press to choose"]
11138    grid $page.cfont - -sticky w -pady 10
11139    mkfontdisp mainfont $page [mc "Main font"]
11140    mkfontdisp textfont $page [mc "Diff display font"]
11141    mkfontdisp uifont $page [mc "User interface font"]
11142    return $page
11143}
11144
11145proc doprefs {} {
11146    global maxwidth maxgraphpct use_ttk NS
11147    global oldprefs prefstop showneartags showlocalchanges
11148    global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11149    global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11150    global hideremotes want_ttk have_ttk
11151
11152    set top .gitkprefs
11153    set prefstop $top
11154    if {[winfo exists $top]} {
11155        raise $top
11156        return
11157    }
11158    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11159                   limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11160        set oldprefs($v) [set $v]
11161    }
11162    ttk_toplevel $top
11163    wm title $top [mc "Gitk preferences"]
11164    make_transient $top .
11165
11166    if {[set use_notebook [expr {$use_ttk && [info command ::ttk::notebook] ne ""}]]} {
11167        set notebook [ttk::notebook $top.notebook]
11168    } else {
11169        set notebook [${NS}::frame $top.notebook -borderwidth 0 -relief flat]
11170    }
11171
11172    lappend pages [prefspage_general $notebook] [mc "General"]
11173    lappend pages [prefspage_colors $notebook] [mc "Colors"]
11174    lappend pages [prefspage_fonts $notebook] [mc "Fonts"]
11175    set col 0
11176    foreach {page title} $pages {
11177        if {$use_notebook} {
11178            $notebook add $page -text $title
11179        } else {
11180            set btn [${NS}::button $notebook.b_[string map {. X} $page] \
11181                         -text $title -command [list raise $page]]
11182            $page configure -text $title
11183            grid $btn -row 0 -column [incr col] -sticky w
11184            grid $page -row 1 -column 0 -sticky news -columnspan 100
11185        }
11186    }
11187
11188    if {!$use_notebook} {
11189        grid columnconfigure $notebook 0 -weight 1
11190        grid rowconfigure $notebook 1 -weight 1
11191        raise [lindex $pages 0]
11192    }
11193
11194    grid $notebook -sticky news -padx 2 -pady 2
11195    grid rowconfigure $top 0 -weight 1
11196    grid columnconfigure $top 0 -weight 1
11197
11198    ${NS}::frame $top.buts
11199    ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
11200    ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
11201    bind $top <Key-Return> prefsok
11202    bind $top <Key-Escape> prefscan
11203    grid $top.buts.ok $top.buts.can
11204    grid columnconfigure $top.buts 0 -weight 1 -uniform a
11205    grid columnconfigure $top.buts 1 -weight 1 -uniform a
11206    grid $top.buts - - -pady 10 -sticky ew
11207    grid columnconfigure $top 2 -weight 1
11208    bind $top <Visibility> [list focus $top.buts.ok]
11209}
11210
11211proc choose_extdiff {} {
11212    global extdifftool
11213
11214    set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
11215    if {$prog ne {}} {
11216        set extdifftool $prog
11217    }
11218}
11219
11220proc choosecolor {v vi w x cmd} {
11221    global $v
11222
11223    set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
11224               -title [mc "Gitk: choose color for %s" $x]]
11225    if {$c eq {}} return
11226    $w conf -background $c
11227    lset $v $vi $c
11228    eval $cmd $c
11229}
11230
11231proc setselbg {c} {
11232    global bglist cflist
11233    foreach w $bglist {
11234        $w configure -selectbackground $c
11235    }
11236    $cflist tag configure highlight \
11237        -background [$cflist cget -selectbackground]
11238    allcanvs itemconf secsel -fill $c
11239}
11240
11241# This sets the background color and the color scheme for the whole UI.
11242# For some reason, tk_setPalette chooses a nasty dark red for selectColor
11243# if we don't specify one ourselves, which makes the checkbuttons and
11244# radiobuttons look bad.  This chooses white for selectColor if the
11245# background color is light, or black if it is dark.
11246proc setui {c} {
11247    if {[tk windowingsystem] eq "win32"} { return }
11248    set bg [winfo rgb . $c]
11249    set selc black
11250    if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
11251        set selc white
11252    }
11253    tk_setPalette background $c selectColor $selc
11254}
11255
11256proc setbg {c} {
11257    global bglist
11258
11259    foreach w $bglist {
11260        $w conf -background $c
11261    }
11262}
11263
11264proc setfg {c} {
11265    global fglist canv
11266
11267    foreach w $fglist {
11268        $w conf -foreground $c
11269    }
11270    allcanvs itemconf text -fill $c
11271    $canv itemconf circle -outline $c
11272    $canv itemconf markid -outline $c
11273}
11274
11275proc prefscan {} {
11276    global oldprefs prefstop
11277
11278    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11279                   limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11280        global $v
11281        set $v $oldprefs($v)
11282    }
11283    catch {destroy $prefstop}
11284    unset prefstop
11285    fontcan
11286}
11287
11288proc prefsok {} {
11289    global maxwidth maxgraphpct
11290    global oldprefs prefstop showneartags showlocalchanges
11291    global fontpref mainfont textfont uifont
11292    global limitdiffs treediffs perfile_attrs
11293    global hideremotes
11294
11295    catch {destroy $prefstop}
11296    unset prefstop
11297    fontcan
11298    set fontchanged 0
11299    if {$mainfont ne $fontpref(mainfont)} {
11300        set mainfont $fontpref(mainfont)
11301        parsefont mainfont $mainfont
11302        eval font configure mainfont [fontflags mainfont]
11303        eval font configure mainfontbold [fontflags mainfont 1]
11304        setcoords
11305        set fontchanged 1
11306    }
11307    if {$textfont ne $fontpref(textfont)} {
11308        set textfont $fontpref(textfont)
11309        parsefont textfont $textfont
11310        eval font configure textfont [fontflags textfont]
11311        eval font configure textfontbold [fontflags textfont 1]
11312    }
11313    if {$uifont ne $fontpref(uifont)} {
11314        set uifont $fontpref(uifont)
11315        parsefont uifont $uifont
11316        eval font configure uifont [fontflags uifont]
11317    }
11318    settabs
11319    if {$showlocalchanges != $oldprefs(showlocalchanges)} {
11320        if {$showlocalchanges} {
11321            doshowlocalchanges
11322        } else {
11323            dohidelocalchanges
11324        }
11325    }
11326    if {$limitdiffs != $oldprefs(limitdiffs) ||
11327        ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11328        # treediffs elements are limited by path;
11329        # won't have encodings cached if perfile_attrs was just turned on
11330        catch {unset treediffs}
11331    }
11332    if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
11333        || $maxgraphpct != $oldprefs(maxgraphpct)} {
11334        redisplay
11335    } elseif {$showneartags != $oldprefs(showneartags) ||
11336          $limitdiffs != $oldprefs(limitdiffs)} {
11337        reselectline
11338    }
11339    if {$hideremotes != $oldprefs(hideremotes)} {
11340        rereadrefs
11341    }
11342}
11343
11344proc formatdate {d} {
11345    global datetimeformat
11346    if {$d ne {}} {
11347        set d [clock format [lindex $d 0] -format $datetimeformat]
11348    }
11349    return $d
11350}
11351
11352# This list of encoding names and aliases is distilled from
11353# http://www.iana.org/assignments/character-sets.
11354# Not all of them are supported by Tcl.
11355set encoding_aliases {
11356    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11357      ISO646-US US-ASCII us IBM367 cp367 csASCII }
11358    { ISO-10646-UTF-1 csISO10646UTF1 }
11359    { ISO_646.basic:1983 ref csISO646basic1983 }
11360    { INVARIANT csINVARIANT }
11361    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11362    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11363    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11364    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11365    { NATS-DANO iso-ir-9-1 csNATSDANO }
11366    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11367    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11368    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11369    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11370    { ISO-2022-KR csISO2022KR }
11371    { EUC-KR csEUCKR }
11372    { ISO-2022-JP csISO2022JP }
11373    { ISO-2022-JP-2 csISO2022JP2 }
11374    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11375      csISO13JISC6220jp }
11376    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11377    { IT iso-ir-15 ISO646-IT csISO15Italian }
11378    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11379    { ES iso-ir-17 ISO646-ES csISO17Spanish }
11380    { greek7-old iso-ir-18 csISO18Greek7Old }
11381    { latin-greek iso-ir-19 csISO19LatinGreek }
11382    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11383    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11384    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11385    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11386    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11387    { BS_viewdata iso-ir-47 csISO47BSViewdata }
11388    { INIS iso-ir-49 csISO49INIS }
11389    { INIS-8 iso-ir-50 csISO50INIS8 }
11390    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11391    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11392    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11393    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11394    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11395    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11396      csISO60Norwegian1 }
11397    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11398    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11399    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11400    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11401    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11402    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11403    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11404    { greek7 iso-ir-88 csISO88Greek7 }
11405    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11406    { iso-ir-90 csISO90 }
11407    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11408    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11409      csISO92JISC62991984b }
11410    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11411    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11412    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11413      csISO95JIS62291984handadd }
11414    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11415    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11416    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11417    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11418      CP819 csISOLatin1 }
11419    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11420    { T.61-7bit iso-ir-102 csISO102T617bit }
11421    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11422    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
11423    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
11424    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
11425    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
11426    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
11427    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
11428    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
11429      arabic csISOLatinArabic }
11430    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
11431    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
11432    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
11433      greek greek8 csISOLatinGreek }
11434    { T.101-G2 iso-ir-128 csISO128T101G2 }
11435    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
11436      csISOLatinHebrew }
11437    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
11438    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
11439    { CSN_369103 iso-ir-139 csISO139CSN369103 }
11440    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
11441    { ISO_6937-2-add iso-ir-142 csISOTextComm }
11442    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
11443    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
11444      csISOLatinCyrillic }
11445    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
11446    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
11447    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
11448    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
11449    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
11450    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
11451    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
11452    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
11453    { ISO_10367-box iso-ir-155 csISO10367Box }
11454    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
11455    { latin-lap lap iso-ir-158 csISO158Lap }
11456    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
11457    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
11458    { us-dk csUSDK }
11459    { dk-us csDKUS }
11460    { JIS_X0201 X0201 csHalfWidthKatakana }
11461    { KSC5636 ISO646-KR csKSC5636 }
11462    { ISO-10646-UCS-2 csUnicode }
11463    { ISO-10646-UCS-4 csUCS4 }
11464    { DEC-MCS dec csDECMCS }
11465    { hp-roman8 roman8 r8 csHPRoman8 }
11466    { macintosh mac csMacintosh }
11467    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
11468      csIBM037 }
11469    { IBM038 EBCDIC-INT cp038 csIBM038 }
11470    { IBM273 CP273 csIBM273 }
11471    { IBM274 EBCDIC-BE CP274 csIBM274 }
11472    { IBM275 EBCDIC-BR cp275 csIBM275 }
11473    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
11474    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
11475    { IBM280 CP280 ebcdic-cp-it csIBM280 }
11476    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
11477    { IBM284 CP284 ebcdic-cp-es csIBM284 }
11478    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
11479    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
11480    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
11481    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
11482    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
11483    { IBM424 cp424 ebcdic-cp-he csIBM424 }
11484    { IBM437 cp437 437 csPC8CodePage437 }
11485    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
11486    { IBM775 cp775 csPC775Baltic }
11487    { IBM850 cp850 850 csPC850Multilingual }
11488    { IBM851 cp851 851 csIBM851 }
11489    { IBM852 cp852 852 csPCp852 }
11490    { IBM855 cp855 855 csIBM855 }
11491    { IBM857 cp857 857 csIBM857 }
11492    { IBM860 cp860 860 csIBM860 }
11493    { IBM861 cp861 861 cp-is csIBM861 }
11494    { IBM862 cp862 862 csPC862LatinHebrew }
11495    { IBM863 cp863 863 csIBM863 }
11496    { IBM864 cp864 csIBM864 }
11497    { IBM865 cp865 865 csIBM865 }
11498    { IBM866 cp866 866 csIBM866 }
11499    { IBM868 CP868 cp-ar csIBM868 }
11500    { IBM869 cp869 869 cp-gr csIBM869 }
11501    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
11502    { IBM871 CP871 ebcdic-cp-is csIBM871 }
11503    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
11504    { IBM891 cp891 csIBM891 }
11505    { IBM903 cp903 csIBM903 }
11506    { IBM904 cp904 904 csIBBM904 }
11507    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
11508    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
11509    { IBM1026 CP1026 csIBM1026 }
11510    { EBCDIC-AT-DE csIBMEBCDICATDE }
11511    { EBCDIC-AT-DE-A csEBCDICATDEA }
11512    { EBCDIC-CA-FR csEBCDICCAFR }
11513    { EBCDIC-DK-NO csEBCDICDKNO }
11514    { EBCDIC-DK-NO-A csEBCDICDKNOA }
11515    { EBCDIC-FI-SE csEBCDICFISE }
11516    { EBCDIC-FI-SE-A csEBCDICFISEA }
11517    { EBCDIC-FR csEBCDICFR }
11518    { EBCDIC-IT csEBCDICIT }
11519    { EBCDIC-PT csEBCDICPT }
11520    { EBCDIC-ES csEBCDICES }
11521    { EBCDIC-ES-A csEBCDICESA }
11522    { EBCDIC-ES-S csEBCDICESS }
11523    { EBCDIC-UK csEBCDICUK }
11524    { EBCDIC-US csEBCDICUS }
11525    { UNKNOWN-8BIT csUnknown8BiT }
11526    { MNEMONIC csMnemonic }
11527    { MNEM csMnem }
11528    { VISCII csVISCII }
11529    { VIQR csVIQR }
11530    { KOI8-R csKOI8R }
11531    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
11532    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
11533    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
11534    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
11535    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
11536    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
11537    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
11538    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
11539    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
11540    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
11541    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
11542    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
11543    { IBM1047 IBM-1047 }
11544    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
11545    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
11546    { UNICODE-1-1 csUnicode11 }
11547    { CESU-8 csCESU-8 }
11548    { BOCU-1 csBOCU-1 }
11549    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
11550    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
11551      l8 }
11552    { ISO-8859-15 ISO_8859-15 Latin-9 }
11553    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
11554    { GBK CP936 MS936 windows-936 }
11555    { JIS_Encoding csJISEncoding }
11556    { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
11557    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
11558      EUC-JP }
11559    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
11560    { ISO-10646-UCS-Basic csUnicodeASCII }
11561    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
11562    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
11563    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
11564    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
11565    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
11566    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
11567    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
11568    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
11569    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
11570    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
11571    { Adobe-Standard-Encoding csAdobeStandardEncoding }
11572    { Ventura-US csVenturaUS }
11573    { Ventura-International csVenturaInternational }
11574    { PC8-Danish-Norwegian csPC8DanishNorwegian }
11575    { PC8-Turkish csPC8Turkish }
11576    { IBM-Symbols csIBMSymbols }
11577    { IBM-Thai csIBMThai }
11578    { HP-Legal csHPLegal }
11579    { HP-Pi-font csHPPiFont }
11580    { HP-Math8 csHPMath8 }
11581    { Adobe-Symbol-Encoding csHPPSMath }
11582    { HP-DeskTop csHPDesktop }
11583    { Ventura-Math csVenturaMath }
11584    { Microsoft-Publishing csMicrosoftPublishing }
11585    { Windows-31J csWindows31J }
11586    { GB2312 csGB2312 }
11587    { Big5 csBig5 }
11588}
11589
11590proc tcl_encoding {enc} {
11591    global encoding_aliases tcl_encoding_cache
11592    if {[info exists tcl_encoding_cache($enc)]} {
11593        return $tcl_encoding_cache($enc)
11594    }
11595    set names [encoding names]
11596    set lcnames [string tolower $names]
11597    set enc [string tolower $enc]
11598    set i [lsearch -exact $lcnames $enc]
11599    if {$i < 0} {
11600        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
11601        if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
11602            set i [lsearch -exact $lcnames $encx]
11603        }
11604    }
11605    if {$i < 0} {
11606        foreach l $encoding_aliases {
11607            set ll [string tolower $l]
11608            if {[lsearch -exact $ll $enc] < 0} continue
11609            # look through the aliases for one that tcl knows about
11610            foreach e $ll {
11611                set i [lsearch -exact $lcnames $e]
11612                if {$i < 0} {
11613                    if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
11614                        set i [lsearch -exact $lcnames $ex]
11615                    }
11616                }
11617                if {$i >= 0} break
11618            }
11619            break
11620        }
11621    }
11622    set tclenc {}
11623    if {$i >= 0} {
11624        set tclenc [lindex $names $i]
11625    }
11626    set tcl_encoding_cache($enc) $tclenc
11627    return $tclenc
11628}
11629
11630proc gitattr {path attr default} {
11631    global path_attr_cache
11632    if {[info exists path_attr_cache($attr,$path)]} {
11633        set r $path_attr_cache($attr,$path)
11634    } else {
11635        set r "unspecified"
11636        if {![catch {set line [exec git check-attr $attr -- $path]}]} {
11637            regexp "(.*): $attr: (.*)" $line m f r
11638        }
11639        set path_attr_cache($attr,$path) $r
11640    }
11641    if {$r eq "unspecified"} {
11642        return $default
11643    }
11644    return $r
11645}
11646
11647proc cache_gitattr {attr pathlist} {
11648    global path_attr_cache
11649    set newlist {}
11650    foreach path $pathlist {
11651        if {![info exists path_attr_cache($attr,$path)]} {
11652            lappend newlist $path
11653        }
11654    }
11655    set lim 1000
11656    if {[tk windowingsystem] == "win32"} {
11657        # windows has a 32k limit on the arguments to a command...
11658        set lim 30
11659    }
11660    while {$newlist ne {}} {
11661        set head [lrange $newlist 0 [expr {$lim - 1}]]
11662        set newlist [lrange $newlist $lim end]
11663        if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
11664            foreach row [split $rlist "\n"] {
11665                if {[regexp "(.*): $attr: (.*)" $row m path value]} {
11666                    if {[string index $path 0] eq "\""} {
11667                        set path [encoding convertfrom [lindex $path 0]]
11668                    }
11669                    set path_attr_cache($attr,$path) $value
11670                }
11671            }
11672        }
11673    }
11674}
11675
11676proc get_path_encoding {path} {
11677    global gui_encoding perfile_attrs
11678    set tcl_enc $gui_encoding
11679    if {$path ne {} && $perfile_attrs} {
11680        set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
11681        if {$enc2 ne {}} {
11682            set tcl_enc $enc2
11683        }
11684    }
11685    return $tcl_enc
11686}
11687
11688# First check that Tcl/Tk is recent enough
11689if {[catch {package require Tk 8.4} err]} {
11690    show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
11691                     Gitk requires at least Tcl/Tk 8.4." list
11692    exit 1
11693}
11694
11695# Unset GIT_TRACE var if set
11696if { [info exists ::env(GIT_TRACE)] } {
11697    unset ::env(GIT_TRACE)
11698}
11699
11700# defaults...
11701set wrcomcmd "git diff-tree --stdin -p --pretty"
11702
11703set gitencoding {}
11704catch {
11705    set gitencoding [exec git config --get i18n.commitencoding]
11706}
11707catch {
11708    set gitencoding [exec git config --get i18n.logoutputencoding]
11709}
11710if {$gitencoding == ""} {
11711    set gitencoding "utf-8"
11712}
11713set tclencoding [tcl_encoding $gitencoding]
11714if {$tclencoding == {}} {
11715    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
11716}
11717
11718set gui_encoding [encoding system]
11719catch {
11720    set enc [exec git config --get gui.encoding]
11721    if {$enc ne {}} {
11722        set tclenc [tcl_encoding $enc]
11723        if {$tclenc ne {}} {
11724            set gui_encoding $tclenc
11725        } else {
11726            puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
11727        }
11728    }
11729}
11730
11731set log_showroot true
11732catch {
11733    set log_showroot [exec git config --bool --get log.showroot]
11734}
11735
11736if {[tk windowingsystem] eq "aqua"} {
11737    set mainfont {{Lucida Grande} 9}
11738    set textfont {Monaco 9}
11739    set uifont {{Lucida Grande} 9 bold}
11740} elseif {![catch {::tk::pkgconfig get fontsystem} xft] && $xft eq "xft"} {
11741    # fontconfig!
11742    set mainfont {sans 9}
11743    set textfont {monospace 9}
11744    set uifont {sans 9 bold}
11745} else {
11746    set mainfont {Helvetica 9}
11747    set textfont {Courier 9}
11748    set uifont {Helvetica 9 bold}
11749}
11750set tabstop 8
11751set findmergefiles 0
11752set maxgraphpct 50
11753set maxwidth 16
11754set revlistorder 0
11755set fastdate 0
11756set uparrowlen 5
11757set downarrowlen 5
11758set mingaplen 100
11759set cmitmode "patch"
11760set wrapcomment "none"
11761set showneartags 1
11762set hideremotes 0
11763set maxrefs 20
11764set maxlinelen 200
11765set showlocalchanges 1
11766set limitdiffs 1
11767set datetimeformat "%Y-%m-%d %H:%M:%S"
11768set autoselect 1
11769set autosellen 40
11770set perfile_attrs 0
11771set want_ttk 1
11772
11773if {[tk windowingsystem] eq "aqua"} {
11774    set extdifftool "opendiff"
11775} else {
11776    set extdifftool "meld"
11777}
11778
11779set colors {green red blue magenta darkgrey brown orange}
11780if {[tk windowingsystem] eq "win32"} {
11781    set uicolor SystemButtonFace
11782    set uifgcolor SystemButtonText
11783    set uifgdisabledcolor SystemDisabledText
11784    set bgcolor SystemWindow
11785    set fgcolor SystemWindowText
11786    set selectbgcolor SystemHighlight
11787} else {
11788    set uicolor grey85
11789    set uifgcolor black
11790    set uifgdisabledcolor "#999"
11791    set bgcolor white
11792    set fgcolor black
11793    set selectbgcolor gray85
11794}
11795set diffcolors {red "#00a000" blue}
11796set diffcontext 3
11797set mergecolors {red blue green purple brown "#009090" magenta "#808000" "#009000" "#ff0080" cyan "#b07070" "#70b0f0" "#70f0b0" "#f0b070" "#ff70b0"}
11798set ignorespace 0
11799set worddiff ""
11800set markbgcolor "#e0e0ff"
11801
11802set headbgcolor green
11803set headfgcolor black
11804set headoutlinecolor black
11805set remotebgcolor #ffddaa
11806set tagbgcolor yellow
11807set tagfgcolor black
11808set tagoutlinecolor black
11809set reflinecolor black
11810set filesepbgcolor #aaaaaa
11811set filesepfgcolor black
11812set linehoverbgcolor #ffff80
11813set linehoverfgcolor black
11814set linehoveroutlinecolor black
11815set mainheadcirclecolor yellow
11816set workingfilescirclecolor red
11817set indexcirclecolor green
11818set circlecolors {white blue gray blue blue}
11819set linkfgcolor blue
11820set circleoutlinecolor $fgcolor
11821set foundbgcolor yellow
11822set currentsearchhitbgcolor orange
11823
11824# button for popping up context menus
11825if {[tk windowingsystem] eq "aqua"} {
11826    set ctxbut <Button-2>
11827} else {
11828    set ctxbut <Button-3>
11829}
11830
11831## For msgcat loading, first locate the installation location.
11832if { [info exists ::env(GITK_MSGSDIR)] } {
11833    ## Msgsdir was manually set in the environment.
11834    set gitk_msgsdir $::env(GITK_MSGSDIR)
11835} else {
11836    ## Let's guess the prefix from argv0.
11837    set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
11838    set gitk_libdir [file join $gitk_prefix share gitk lib]
11839    set gitk_msgsdir [file join $gitk_libdir msgs]
11840    unset gitk_prefix
11841}
11842
11843## Internationalization (i18n) through msgcat and gettext. See
11844## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
11845package require msgcat
11846namespace import ::msgcat::mc
11847## And eventually load the actual message catalog
11848::msgcat::mcload $gitk_msgsdir
11849
11850catch {source ~/.gitk}
11851
11852parsefont mainfont $mainfont
11853eval font create mainfont [fontflags mainfont]
11854eval font create mainfontbold [fontflags mainfont 1]
11855
11856parsefont textfont $textfont
11857eval font create textfont [fontflags textfont]
11858eval font create textfontbold [fontflags textfont 1]
11859
11860parsefont uifont $uifont
11861eval font create uifont [fontflags uifont]
11862
11863setui $uicolor
11864
11865setoptions
11866
11867# check that we can find a .git directory somewhere...
11868if {[catch {set gitdir [exec git rev-parse --git-dir]}]} {
11869    show_error {} . [mc "Cannot find a git repository here."]
11870    exit 1
11871}
11872
11873set selecthead {}
11874set selectheadid {}
11875
11876set revtreeargs {}
11877set cmdline_files {}
11878set i 0
11879set revtreeargscmd {}
11880foreach arg $argv {
11881    switch -glob -- $arg {
11882        "" { }
11883        "--" {
11884            set cmdline_files [lrange $argv [expr {$i + 1}] end]
11885            break
11886        }
11887        "--select-commit=*" {
11888            set selecthead [string range $arg 16 end]
11889        }
11890        "--argscmd=*" {
11891            set revtreeargscmd [string range $arg 10 end]
11892        }
11893        default {
11894            lappend revtreeargs $arg
11895        }
11896    }
11897    incr i
11898}
11899
11900if {$selecthead eq "HEAD"} {
11901    set selecthead {}
11902}
11903
11904if {$i >= [llength $argv] && $revtreeargs ne {}} {
11905    # no -- on command line, but some arguments (other than --argscmd)
11906    if {[catch {
11907        set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
11908        set cmdline_files [split $f "\n"]
11909        set n [llength $cmdline_files]
11910        set revtreeargs [lrange $revtreeargs 0 end-$n]
11911        # Unfortunately git rev-parse doesn't produce an error when
11912        # something is both a revision and a filename.  To be consistent
11913        # with git log and git rev-list, check revtreeargs for filenames.
11914        foreach arg $revtreeargs {
11915            if {[file exists $arg]} {
11916                show_error {} . [mc "Ambiguous argument '%s': both revision\
11917                                 and filename" $arg]
11918                exit 1
11919            }
11920        }
11921    } err]} {
11922        # unfortunately we get both stdout and stderr in $err,
11923        # so look for "fatal:".
11924        set i [string first "fatal:" $err]
11925        if {$i > 0} {
11926            set err [string range $err [expr {$i + 6}] end]
11927        }
11928        show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
11929        exit 1
11930    }
11931}
11932
11933set nullid "0000000000000000000000000000000000000000"
11934set nullid2 "0000000000000000000000000000000000000001"
11935set nullfile "/dev/null"
11936
11937set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
11938if {![info exists have_ttk]} {
11939    set have_ttk [llength [info commands ::ttk::style]]
11940}
11941set use_ttk [expr {$have_ttk && $want_ttk}]
11942set NS [expr {$use_ttk ? "ttk" : ""}]
11943
11944regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
11945
11946set show_notes {}
11947if {[package vcompare $git_version "1.6.6.2"] >= 0} {
11948    set show_notes "--show-notes"
11949}
11950
11951set appname "gitk"
11952
11953set runq {}
11954set history {}
11955set historyindex 0
11956set fh_serial 0
11957set nhl_names {}
11958set highlight_paths {}
11959set findpattern {}
11960set searchdirn -forwards
11961set boldids {}
11962set boldnameids {}
11963set diffelide {0 0}
11964set markingmatches 0
11965set linkentercount 0
11966set need_redisplay 0
11967set nrows_drawn 0
11968set firsttabstop 0
11969
11970set nextviewnum 1
11971set curview 0
11972set selectedview 0
11973set selectedhlview [mc "None"]
11974set highlight_related [mc "None"]
11975set highlight_files {}
11976set viewfiles(0) {}
11977set viewperm(0) 0
11978set viewargs(0) {}
11979set viewargscmd(0) {}
11980
11981set selectedline {}
11982set numcommits 0
11983set loginstance 0
11984set cmdlineok 0
11985set stopped 0
11986set stuffsaved 0
11987set patchnum 0
11988set lserial 0
11989set hasworktree [hasworktree]
11990set cdup {}
11991if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} {
11992    set cdup [exec git rev-parse --show-cdup]
11993}
11994set worktree [exec git rev-parse --show-toplevel]
11995setcoords
11996makewindow
11997catch {
11998    image create photo gitlogo      -width 16 -height 16
11999
12000    image create photo gitlogominus -width  4 -height  2
12001    gitlogominus put #C00000 -to 0 0 4 2
12002    gitlogo copy gitlogominus -to  1 5
12003    gitlogo copy gitlogominus -to  6 5
12004    gitlogo copy gitlogominus -to 11 5
12005    image delete gitlogominus
12006
12007    image create photo gitlogoplus  -width  4 -height  4
12008    gitlogoplus  put #008000 -to 1 0 3 4
12009    gitlogoplus  put #008000 -to 0 1 4 3
12010    gitlogo copy gitlogoplus  -to  1 9
12011    gitlogo copy gitlogoplus  -to  6 9
12012    gitlogo copy gitlogoplus  -to 11 9
12013    image delete gitlogoplus
12014
12015    image create photo gitlogo32    -width 32 -height 32
12016    gitlogo32 copy gitlogo -zoom 2 2
12017
12018    wm iconphoto . -default gitlogo gitlogo32
12019}
12020# wait for the window to become visible
12021tkwait visibility .
12022wm title . "$appname: [reponame]"
12023update
12024readrefs
12025
12026if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
12027    # create a view for the files/dirs specified on the command line
12028    set curview 1
12029    set selectedview 1
12030    set nextviewnum 2
12031    set viewname(1) [mc "Command line"]
12032    set viewfiles(1) $cmdline_files
12033    set viewargs(1) $revtreeargs
12034    set viewargscmd(1) $revtreeargscmd
12035    set viewperm(1) 0
12036    set vdatemode(1) 0
12037    addviewmenu 1
12038    .bar.view entryconf [mca "Edit view..."] -state normal
12039    .bar.view entryconf [mca "Delete view"] -state normal
12040}
12041
12042if {[info exists permviews]} {
12043    foreach v $permviews {
12044        set n $nextviewnum
12045        incr nextviewnum
12046        set viewname($n) [lindex $v 0]
12047        set viewfiles($n) [lindex $v 1]
12048        set viewargs($n) [lindex $v 2]
12049        set viewargscmd($n) [lindex $v 3]
12050        set viewperm($n) 1
12051        addviewmenu $n
12052    }
12053}
12054
12055if {[tk windowingsystem] eq "win32"} {
12056    focus -force .
12057}
12058
12059getcommits {}
12060
12061# Local variables:
12062# mode: tcl
12063# indent-tabs-mode: t
12064# tab-width: 8
12065# End: