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