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