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