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