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