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