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