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