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