gitkon commit gitk: Show local changes properly when we have a path limit (cdc8429)
   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"} {
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    bind $top.name <Key-Return> "[list mkbrgo $top]"
8274    grid $top.nlab $top.name -sticky w
8275    frame $top.buts
8276    button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
8277    button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
8278    bind $top <Key-Return> [list mkbrgo $top]
8279    bind $top <Key-Escape> "catch {destroy $top}"
8280    grid $top.buts.go $top.buts.can
8281    grid columnconfigure $top.buts 0 -weight 1 -uniform a
8282    grid columnconfigure $top.buts 1 -weight 1 -uniform a
8283    grid $top.buts - -pady 10 -sticky ew
8284    focus $top.name
8285}
8286
8287proc mkbrgo {top} {
8288    global headids idheads
8289
8290    set name [$top.name get]
8291    set id [$top.sha1 get]
8292    set cmdargs {}
8293    set old_id {}
8294    if {$name eq {}} {
8295        error_popup [mc "Please specify a name for the new branch"] $top
8296        return
8297    }
8298    if {[info exists headids($name)]} {
8299        if {![confirm_popup [mc \
8300                "Branch '%s' already exists. Overwrite?" $name] $top]} {
8301            return
8302        }
8303        set old_id $headids($name)
8304        lappend cmdargs -f
8305    }
8306    catch {destroy $top}
8307    lappend cmdargs $name $id
8308    nowbusy newbranch
8309    update
8310    if {[catch {
8311        eval exec git branch $cmdargs
8312    } err]} {
8313        notbusy newbranch
8314        error_popup $err
8315    } else {
8316        notbusy newbranch
8317        if {$old_id ne {}} {
8318            movehead $id $name
8319            movedhead $id $name
8320            redrawtags $old_id
8321            redrawtags $id
8322        } else {
8323            set headids($name) $id
8324            lappend idheads($id) $name
8325            addedhead $id $name
8326            redrawtags $id
8327        }
8328        dispneartags 0
8329        run refill_reflist
8330    }
8331}
8332
8333proc exec_citool {tool_args {baseid {}}} {
8334    global commitinfo env
8335
8336    set save_env [array get env GIT_AUTHOR_*]
8337
8338    if {$baseid ne {}} {
8339        if {![info exists commitinfo($baseid)]} {
8340            getcommit $baseid
8341        }
8342        set author [lindex $commitinfo($baseid) 1]
8343        set date [lindex $commitinfo($baseid) 2]
8344        if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
8345                    $author author name email]
8346            && $date ne {}} {
8347            set env(GIT_AUTHOR_NAME) $name
8348            set env(GIT_AUTHOR_EMAIL) $email
8349            set env(GIT_AUTHOR_DATE) $date
8350        }
8351    }
8352
8353    eval exec git citool $tool_args &
8354
8355    array unset env GIT_AUTHOR_*
8356    array set env $save_env
8357}
8358
8359proc cherrypick {} {
8360    global rowmenuid curview
8361    global mainhead mainheadid
8362
8363    set oldhead [exec git rev-parse HEAD]
8364    set dheads [descheads $rowmenuid]
8365    if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
8366        set ok [confirm_popup [mc "Commit %s is already\
8367                included in branch %s -- really re-apply it?" \
8368                                   [string range $rowmenuid 0 7] $mainhead]]
8369        if {!$ok} return
8370    }
8371    nowbusy cherrypick [mc "Cherry-picking"]
8372    update
8373    # Unfortunately git-cherry-pick writes stuff to stderr even when
8374    # no error occurs, and exec takes that as an indication of error...
8375    if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
8376        notbusy cherrypick
8377        if {[regexp -line \
8378                 {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
8379                 $err msg fname]} {
8380            error_popup [mc "Cherry-pick failed because of local changes\
8381                        to file '%s'.\nPlease commit, reset or stash\
8382                        your changes and try again." $fname]
8383        } elseif {[regexp -line \
8384                       {^(CONFLICT \(.*\):|Automatic cherry-pick failed)} \
8385                       $err]} {
8386            if {[confirm_popup [mc "Cherry-pick failed because of merge\
8387                        conflict.\nDo you wish to run git citool to\
8388                        resolve it?"]]} {
8389                # Force citool to read MERGE_MSG
8390                file delete [file join [gitdir] "GITGUI_MSG"]
8391                exec_citool {} $rowmenuid
8392            }
8393        } else {
8394            error_popup $err
8395        }
8396        run updatecommits
8397        return
8398    }
8399    set newhead [exec git rev-parse HEAD]
8400    if {$newhead eq $oldhead} {
8401        notbusy cherrypick
8402        error_popup [mc "No changes committed"]
8403        return
8404    }
8405    addnewchild $newhead $oldhead
8406    if {[commitinview $oldhead $curview]} {
8407        # XXX this isn't right if we have a path limit...
8408        insertrow $newhead $oldhead $curview
8409        if {$mainhead ne {}} {
8410            movehead $newhead $mainhead
8411            movedhead $newhead $mainhead
8412        }
8413        set mainheadid $newhead
8414        redrawtags $oldhead
8415        redrawtags $newhead
8416        selbyid $newhead
8417    }
8418    notbusy cherrypick
8419}
8420
8421proc resethead {} {
8422    global mainhead rowmenuid confirm_ok resettype
8423
8424    set confirm_ok 0
8425    set w ".confirmreset"
8426    toplevel $w
8427    make_transient $w .
8428    wm title $w [mc "Confirm reset"]
8429    message $w.m -text \
8430        [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
8431        -justify center -aspect 1000
8432    pack $w.m -side top -fill x -padx 20 -pady 20
8433    frame $w.f -relief sunken -border 2
8434    message $w.f.rt -text [mc "Reset type:"] -aspect 1000
8435    grid $w.f.rt -sticky w
8436    set resettype mixed
8437    radiobutton $w.f.soft -value soft -variable resettype -justify left \
8438        -text [mc "Soft: Leave working tree and index untouched"]
8439    grid $w.f.soft -sticky w
8440    radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
8441        -text [mc "Mixed: Leave working tree untouched, reset index"]
8442    grid $w.f.mixed -sticky w
8443    radiobutton $w.f.hard -value hard -variable resettype -justify left \
8444        -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
8445    grid $w.f.hard -sticky w
8446    pack $w.f -side top -fill x
8447    button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
8448    pack $w.ok -side left -fill x -padx 20 -pady 20
8449    button $w.cancel -text [mc Cancel] -command "destroy $w"
8450    bind $w <Key-Escape> [list destroy $w]
8451    pack $w.cancel -side right -fill x -padx 20 -pady 20
8452    bind $w <Visibility> "grab $w; focus $w"
8453    tkwait window $w
8454    if {!$confirm_ok} return
8455    if {[catch {set fd [open \
8456            [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
8457        error_popup $err
8458    } else {
8459        dohidelocalchanges
8460        filerun $fd [list readresetstat $fd]
8461        nowbusy reset [mc "Resetting"]
8462        selbyid $rowmenuid
8463    }
8464}
8465
8466proc readresetstat {fd} {
8467    global mainhead mainheadid showlocalchanges rprogcoord
8468
8469    if {[gets $fd line] >= 0} {
8470        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
8471            set rprogcoord [expr {1.0 * $m / $n}]
8472            adjustprogress
8473        }
8474        return 1
8475    }
8476    set rprogcoord 0
8477    adjustprogress
8478    notbusy reset
8479    if {[catch {close $fd} err]} {
8480        error_popup $err
8481    }
8482    set oldhead $mainheadid
8483    set newhead [exec git rev-parse HEAD]
8484    if {$newhead ne $oldhead} {
8485        movehead $newhead $mainhead
8486        movedhead $newhead $mainhead
8487        set mainheadid $newhead
8488        redrawtags $oldhead
8489        redrawtags $newhead
8490    }
8491    if {$showlocalchanges} {
8492        doshowlocalchanges
8493    }
8494    return 0
8495}
8496
8497# context menu for a head
8498proc headmenu {x y id head} {
8499    global headmenuid headmenuhead headctxmenu mainhead
8500
8501    stopfinding
8502    set headmenuid $id
8503    set headmenuhead $head
8504    set state normal
8505    if {$head eq $mainhead} {
8506        set state disabled
8507    }
8508    $headctxmenu entryconfigure 0 -state $state
8509    $headctxmenu entryconfigure 1 -state $state
8510    tk_popup $headctxmenu $x $y
8511}
8512
8513proc cobranch {} {
8514    global headmenuid headmenuhead headids
8515    global showlocalchanges
8516
8517    # check the tree is clean first??
8518    nowbusy checkout [mc "Checking out"]
8519    update
8520    dohidelocalchanges
8521    if {[catch {
8522        set fd [open [list | git checkout $headmenuhead 2>@1] r]
8523    } err]} {
8524        notbusy checkout
8525        error_popup $err
8526        if {$showlocalchanges} {
8527            dodiffindex
8528        }
8529    } else {
8530        filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
8531    }
8532}
8533
8534proc readcheckoutstat {fd newhead newheadid} {
8535    global mainhead mainheadid headids showlocalchanges progresscoords
8536    global viewmainheadid curview
8537
8538    if {[gets $fd line] >= 0} {
8539        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
8540            set progresscoords [list 0 [expr {1.0 * $m / $n}]]
8541            adjustprogress
8542        }
8543        return 1
8544    }
8545    set progresscoords {0 0}
8546    adjustprogress
8547    notbusy checkout
8548    if {[catch {close $fd} err]} {
8549        error_popup $err
8550    }
8551    set oldmainid $mainheadid
8552    set mainhead $newhead
8553    set mainheadid $newheadid
8554    set viewmainheadid($curview) $newheadid
8555    redrawtags $oldmainid
8556    redrawtags $newheadid
8557    selbyid $newheadid
8558    if {$showlocalchanges} {
8559        dodiffindex
8560    }
8561}
8562
8563proc rmbranch {} {
8564    global headmenuid headmenuhead mainhead
8565    global idheads
8566
8567    set head $headmenuhead
8568    set id $headmenuid
8569    # this check shouldn't be needed any more...
8570    if {$head eq $mainhead} {
8571        error_popup [mc "Cannot delete the currently checked-out branch"]
8572        return
8573    }
8574    set dheads [descheads $id]
8575    if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
8576        # the stuff on this branch isn't on any other branch
8577        if {![confirm_popup [mc "The commits on branch %s aren't on any other\
8578                        branch.\nReally delete branch %s?" $head $head]]} return
8579    }
8580    nowbusy rmbranch
8581    update
8582    if {[catch {exec git branch -D $head} err]} {
8583        notbusy rmbranch
8584        error_popup $err
8585        return
8586    }
8587    removehead $id $head
8588    removedhead $id $head
8589    redrawtags $id
8590    notbusy rmbranch
8591    dispneartags 0
8592    run refill_reflist
8593}
8594
8595# Display a list of tags and heads
8596proc showrefs {} {
8597    global showrefstop bgcolor fgcolor selectbgcolor
8598    global bglist fglist reflistfilter reflist maincursor
8599
8600    set top .showrefs
8601    set showrefstop $top
8602    if {[winfo exists $top]} {
8603        raise $top
8604        refill_reflist
8605        return
8606    }
8607    toplevel $top
8608    wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
8609    make_transient $top .
8610    text $top.list -background $bgcolor -foreground $fgcolor \
8611        -selectbackground $selectbgcolor -font mainfont \
8612        -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
8613        -width 30 -height 20 -cursor $maincursor \
8614        -spacing1 1 -spacing3 1 -state disabled
8615    $top.list tag configure highlight -background $selectbgcolor
8616    lappend bglist $top.list
8617    lappend fglist $top.list
8618    scrollbar $top.ysb -command "$top.list yview" -orient vertical
8619    scrollbar $top.xsb -command "$top.list xview" -orient horizontal
8620    grid $top.list $top.ysb -sticky nsew
8621    grid $top.xsb x -sticky ew
8622    frame $top.f
8623    label $top.f.l -text "[mc "Filter"]: "
8624    entry $top.f.e -width 20 -textvariable reflistfilter
8625    set reflistfilter "*"
8626    trace add variable reflistfilter write reflistfilter_change
8627    pack $top.f.e -side right -fill x -expand 1
8628    pack $top.f.l -side left
8629    grid $top.f - -sticky ew -pady 2
8630    button $top.close -command [list destroy $top] -text [mc "Close"]
8631    bind $top <Key-Escape> [list destroy $top]
8632    grid $top.close -
8633    grid columnconfigure $top 0 -weight 1
8634    grid rowconfigure $top 0 -weight 1
8635    bind $top.list <1> {break}
8636    bind $top.list <B1-Motion> {break}
8637    bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
8638    set reflist {}
8639    refill_reflist
8640}
8641
8642proc sel_reflist {w x y} {
8643    global showrefstop reflist headids tagids otherrefids
8644
8645    if {![winfo exists $showrefstop]} return
8646    set l [lindex [split [$w index "@$x,$y"] "."] 0]
8647    set ref [lindex $reflist [expr {$l-1}]]
8648    set n [lindex $ref 0]
8649    switch -- [lindex $ref 1] {
8650        "H" {selbyid $headids($n)}
8651        "T" {selbyid $tagids($n)}
8652        "o" {selbyid $otherrefids($n)}
8653    }
8654    $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
8655}
8656
8657proc unsel_reflist {} {
8658    global showrefstop
8659
8660    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
8661    $showrefstop.list tag remove highlight 0.0 end
8662}
8663
8664proc reflistfilter_change {n1 n2 op} {
8665    global reflistfilter
8666
8667    after cancel refill_reflist
8668    after 200 refill_reflist
8669}
8670
8671proc refill_reflist {} {
8672    global reflist reflistfilter showrefstop headids tagids otherrefids
8673    global curview
8674
8675    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
8676    set refs {}
8677    foreach n [array names headids] {
8678        if {[string match $reflistfilter $n]} {
8679            if {[commitinview $headids($n) $curview]} {
8680                lappend refs [list $n H]
8681            } else {
8682                interestedin $headids($n) {run refill_reflist}
8683            }
8684        }
8685    }
8686    foreach n [array names tagids] {
8687        if {[string match $reflistfilter $n]} {
8688            if {[commitinview $tagids($n) $curview]} {
8689                lappend refs [list $n T]
8690            } else {
8691                interestedin $tagids($n) {run refill_reflist}
8692            }
8693        }
8694    }
8695    foreach n [array names otherrefids] {
8696        if {[string match $reflistfilter $n]} {
8697            if {[commitinview $otherrefids($n) $curview]} {
8698                lappend refs [list $n o]
8699            } else {
8700                interestedin $otherrefids($n) {run refill_reflist}
8701            }
8702        }
8703    }
8704    set refs [lsort -index 0 $refs]
8705    if {$refs eq $reflist} return
8706
8707    # Update the contents of $showrefstop.list according to the
8708    # differences between $reflist (old) and $refs (new)
8709    $showrefstop.list conf -state normal
8710    $showrefstop.list insert end "\n"
8711    set i 0
8712    set j 0
8713    while {$i < [llength $reflist] || $j < [llength $refs]} {
8714        if {$i < [llength $reflist]} {
8715            if {$j < [llength $refs]} {
8716                set cmp [string compare [lindex $reflist $i 0] \
8717                             [lindex $refs $j 0]]
8718                if {$cmp == 0} {
8719                    set cmp [string compare [lindex $reflist $i 1] \
8720                                 [lindex $refs $j 1]]
8721                }
8722            } else {
8723                set cmp -1
8724            }
8725        } else {
8726            set cmp 1
8727        }
8728        switch -- $cmp {
8729            -1 {
8730                $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
8731                incr i
8732            }
8733            0 {
8734                incr i
8735                incr j
8736            }
8737            1 {
8738                set l [expr {$j + 1}]
8739                $showrefstop.list image create $l.0 -align baseline \
8740                    -image reficon-[lindex $refs $j 1] -padx 2
8741                $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
8742                incr j
8743            }
8744        }
8745    }
8746    set reflist $refs
8747    # delete last newline
8748    $showrefstop.list delete end-2c end-1c
8749    $showrefstop.list conf -state disabled
8750}
8751
8752# Stuff for finding nearby tags
8753proc getallcommits {} {
8754    global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
8755    global idheads idtags idotherrefs allparents tagobjid
8756
8757    if {![info exists allcommits]} {
8758        set nextarc 0
8759        set allcommits 0
8760        set seeds {}
8761        set allcwait 0
8762        set cachedarcs 0
8763        set allccache [file join [gitdir] "gitk.cache"]
8764        if {![catch {
8765            set f [open $allccache r]
8766            set allcwait 1
8767            getcache $f
8768        }]} return
8769    }
8770
8771    if {$allcwait} {
8772        return
8773    }
8774    set cmd [list | git rev-list --parents]
8775    set allcupdate [expr {$seeds ne {}}]
8776    if {!$allcupdate} {
8777        set ids "--all"
8778    } else {
8779        set refs [concat [array names idheads] [array names idtags] \
8780                      [array names idotherrefs]]
8781        set ids {}
8782        set tagobjs {}
8783        foreach name [array names tagobjid] {
8784            lappend tagobjs $tagobjid($name)
8785        }
8786        foreach id [lsort -unique $refs] {
8787            if {![info exists allparents($id)] &&
8788                [lsearch -exact $tagobjs $id] < 0} {
8789                lappend ids $id
8790            }
8791        }
8792        if {$ids ne {}} {
8793            foreach id $seeds {
8794                lappend ids "^$id"
8795            }
8796        }
8797    }
8798    if {$ids ne {}} {
8799        set fd [open [concat $cmd $ids] r]
8800        fconfigure $fd -blocking 0
8801        incr allcommits
8802        nowbusy allcommits
8803        filerun $fd [list getallclines $fd]
8804    } else {
8805        dispneartags 0
8806    }
8807}
8808
8809# Since most commits have 1 parent and 1 child, we group strings of
8810# such commits into "arcs" joining branch/merge points (BMPs), which
8811# are commits that either don't have 1 parent or don't have 1 child.
8812#
8813# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
8814# arcout(id) - outgoing arcs for BMP
8815# arcids(a) - list of IDs on arc including end but not start
8816# arcstart(a) - BMP ID at start of arc
8817# arcend(a) - BMP ID at end of arc
8818# growing(a) - arc a is still growing
8819# arctags(a) - IDs out of arcids (excluding end) that have tags
8820# archeads(a) - IDs out of arcids (excluding end) that have heads
8821# The start of an arc is at the descendent end, so "incoming" means
8822# coming from descendents, and "outgoing" means going towards ancestors.
8823
8824proc getallclines {fd} {
8825    global allparents allchildren idtags idheads nextarc
8826    global arcnos arcids arctags arcout arcend arcstart archeads growing
8827    global seeds allcommits cachedarcs allcupdate
8828    
8829    set nid 0
8830    while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
8831        set id [lindex $line 0]
8832        if {[info exists allparents($id)]} {
8833            # seen it already
8834            continue
8835        }
8836        set cachedarcs 0
8837        set olds [lrange $line 1 end]
8838        set allparents($id) $olds
8839        if {![info exists allchildren($id)]} {
8840            set allchildren($id) {}
8841            set arcnos($id) {}
8842            lappend seeds $id
8843        } else {
8844            set a $arcnos($id)
8845            if {[llength $olds] == 1 && [llength $a] == 1} {
8846                lappend arcids($a) $id
8847                if {[info exists idtags($id)]} {
8848                    lappend arctags($a) $id
8849                }
8850                if {[info exists idheads($id)]} {
8851                    lappend archeads($a) $id
8852                }
8853                if {[info exists allparents($olds)]} {
8854                    # seen parent already
8855                    if {![info exists arcout($olds)]} {
8856                        splitarc $olds
8857                    }
8858                    lappend arcids($a) $olds
8859                    set arcend($a) $olds
8860                    unset growing($a)
8861                }
8862                lappend allchildren($olds) $id
8863                lappend arcnos($olds) $a
8864                continue
8865            }
8866        }
8867        foreach a $arcnos($id) {
8868            lappend arcids($a) $id
8869            set arcend($a) $id
8870            unset growing($a)
8871        }
8872
8873        set ao {}
8874        foreach p $olds {
8875            lappend allchildren($p) $id
8876            set a [incr nextarc]
8877            set arcstart($a) $id
8878            set archeads($a) {}
8879            set arctags($a) {}
8880            set archeads($a) {}
8881            set arcids($a) {}
8882            lappend ao $a
8883            set growing($a) 1
8884            if {[info exists allparents($p)]} {
8885                # seen it already, may need to make a new branch
8886                if {![info exists arcout($p)]} {
8887                    splitarc $p
8888                }
8889                lappend arcids($a) $p
8890                set arcend($a) $p
8891                unset growing($a)
8892            }
8893            lappend arcnos($p) $a
8894        }
8895        set arcout($id) $ao
8896    }
8897    if {$nid > 0} {
8898        global cached_dheads cached_dtags cached_atags
8899        catch {unset cached_dheads}
8900        catch {unset cached_dtags}
8901        catch {unset cached_atags}
8902    }
8903    if {![eof $fd]} {
8904        return [expr {$nid >= 1000? 2: 1}]
8905    }
8906    set cacheok 1
8907    if {[catch {
8908        fconfigure $fd -blocking 1
8909        close $fd
8910    } err]} {
8911        # got an error reading the list of commits
8912        # if we were updating, try rereading the whole thing again
8913        if {$allcupdate} {
8914            incr allcommits -1
8915            dropcache $err
8916            return
8917        }
8918        error_popup "[mc "Error reading commit topology information;\
8919                branch and preceding/following tag information\
8920                will be incomplete."]\n($err)"
8921        set cacheok 0
8922    }
8923    if {[incr allcommits -1] == 0} {
8924        notbusy allcommits
8925        if {$cacheok} {
8926            run savecache
8927        }
8928    }
8929    dispneartags 0
8930    return 0
8931}
8932
8933proc recalcarc {a} {
8934    global arctags archeads arcids idtags idheads
8935
8936    set at {}
8937    set ah {}
8938    foreach id [lrange $arcids($a) 0 end-1] {
8939        if {[info exists idtags($id)]} {
8940            lappend at $id
8941        }
8942        if {[info exists idheads($id)]} {
8943            lappend ah $id
8944        }
8945    }
8946    set arctags($a) $at
8947    set archeads($a) $ah
8948}
8949
8950proc splitarc {p} {
8951    global arcnos arcids nextarc arctags archeads idtags idheads
8952    global arcstart arcend arcout allparents growing
8953
8954    set a $arcnos($p)
8955    if {[llength $a] != 1} {
8956        puts "oops splitarc called but [llength $a] arcs already"
8957        return
8958    }
8959    set a [lindex $a 0]
8960    set i [lsearch -exact $arcids($a) $p]
8961    if {$i < 0} {
8962        puts "oops splitarc $p not in arc $a"
8963        return
8964    }
8965    set na [incr nextarc]
8966    if {[info exists arcend($a)]} {
8967        set arcend($na) $arcend($a)
8968    } else {
8969        set l [lindex $allparents([lindex $arcids($a) end]) 0]
8970        set j [lsearch -exact $arcnos($l) $a]
8971        set arcnos($l) [lreplace $arcnos($l) $j $j $na]
8972    }
8973    set tail [lrange $arcids($a) [expr {$i+1}] end]
8974    set arcids($a) [lrange $arcids($a) 0 $i]
8975    set arcend($a) $p
8976    set arcstart($na) $p
8977    set arcout($p) $na
8978    set arcids($na) $tail
8979    if {[info exists growing($a)]} {
8980        set growing($na) 1
8981        unset growing($a)
8982    }
8983
8984    foreach id $tail {
8985        if {[llength $arcnos($id)] == 1} {
8986            set arcnos($id) $na
8987        } else {
8988            set j [lsearch -exact $arcnos($id) $a]
8989            set arcnos($id) [lreplace $arcnos($id) $j $j $na]
8990        }
8991    }
8992
8993    # reconstruct tags and heads lists
8994    if {$arctags($a) ne {} || $archeads($a) ne {}} {
8995        recalcarc $a
8996        recalcarc $na
8997    } else {
8998        set arctags($na) {}
8999        set archeads($na) {}
9000    }
9001}
9002
9003# Update things for a new commit added that is a child of one
9004# existing commit.  Used when cherry-picking.
9005proc addnewchild {id p} {
9006    global allparents allchildren idtags nextarc
9007    global arcnos arcids arctags arcout arcend arcstart archeads growing
9008    global seeds allcommits
9009
9010    if {![info exists allcommits] || ![info exists arcnos($p)]} return
9011    set allparents($id) [list $p]
9012    set allchildren($id) {}
9013    set arcnos($id) {}
9014    lappend seeds $id
9015    lappend allchildren($p) $id
9016    set a [incr nextarc]
9017    set arcstart($a) $id
9018    set archeads($a) {}
9019    set arctags($a) {}
9020    set arcids($a) [list $p]
9021    set arcend($a) $p
9022    if {![info exists arcout($p)]} {
9023        splitarc $p
9024    }
9025    lappend arcnos($p) $a
9026    set arcout($id) [list $a]
9027}
9028
9029# This implements a cache for the topology information.
9030# The cache saves, for each arc, the start and end of the arc,
9031# the ids on the arc, and the outgoing arcs from the end.
9032proc readcache {f} {
9033    global arcnos arcids arcout arcstart arcend arctags archeads nextarc
9034    global idtags idheads allparents cachedarcs possible_seeds seeds growing
9035    global allcwait
9036
9037    set a $nextarc
9038    set lim $cachedarcs
9039    if {$lim - $a > 500} {
9040        set lim [expr {$a + 500}]
9041    }
9042    if {[catch {
9043        if {$a == $lim} {
9044            # finish reading the cache and setting up arctags, etc.
9045            set line [gets $f]
9046            if {$line ne "1"} {error "bad final version"}
9047            close $f
9048            foreach id [array names idtags] {
9049                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9050                    [llength $allparents($id)] == 1} {
9051                    set a [lindex $arcnos($id) 0]
9052                    if {$arctags($a) eq {}} {
9053                        recalcarc $a
9054                    }
9055                }
9056            }
9057            foreach id [array names idheads] {
9058                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9059                    [llength $allparents($id)] == 1} {
9060                    set a [lindex $arcnos($id) 0]
9061                    if {$archeads($a) eq {}} {
9062                        recalcarc $a
9063                    }
9064                }
9065            }
9066            foreach id [lsort -unique $possible_seeds] {
9067                if {$arcnos($id) eq {}} {
9068                    lappend seeds $id
9069                }
9070            }
9071            set allcwait 0
9072        } else {
9073            while {[incr a] <= $lim} {
9074                set line [gets $f]
9075                if {[llength $line] != 3} {error "bad line"}
9076                set s [lindex $line 0]
9077                set arcstart($a) $s
9078                lappend arcout($s) $a
9079                if {![info exists arcnos($s)]} {
9080                    lappend possible_seeds $s
9081                    set arcnos($s) {}
9082                }
9083                set e [lindex $line 1]
9084                if {$e eq {}} {
9085                    set growing($a) 1
9086                } else {
9087                    set arcend($a) $e
9088                    if {![info exists arcout($e)]} {
9089                        set arcout($e) {}
9090                    }
9091                }
9092                set arcids($a) [lindex $line 2]
9093                foreach id $arcids($a) {
9094                    lappend allparents($s) $id
9095                    set s $id
9096                    lappend arcnos($id) $a
9097                }
9098                if {![info exists allparents($s)]} {
9099                    set allparents($s) {}
9100                }
9101                set arctags($a) {}
9102                set archeads($a) {}
9103            }
9104            set nextarc [expr {$a - 1}]
9105        }
9106    } err]} {
9107        dropcache $err
9108        return 0
9109    }
9110    if {!$allcwait} {
9111        getallcommits
9112    }
9113    return $allcwait
9114}
9115
9116proc getcache {f} {
9117    global nextarc cachedarcs possible_seeds
9118
9119    if {[catch {
9120        set line [gets $f]
9121        if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
9122        # make sure it's an integer
9123        set cachedarcs [expr {int([lindex $line 1])}]
9124        if {$cachedarcs < 0} {error "bad number of arcs"}
9125        set nextarc 0
9126        set possible_seeds {}
9127        run readcache $f
9128    } err]} {
9129        dropcache $err
9130    }
9131    return 0
9132}
9133
9134proc dropcache {err} {
9135    global allcwait nextarc cachedarcs seeds
9136
9137    #puts "dropping cache ($err)"
9138    foreach v {arcnos arcout arcids arcstart arcend growing \
9139                   arctags archeads allparents allchildren} {
9140        global $v
9141        catch {unset $v}
9142    }
9143    set allcwait 0
9144    set nextarc 0
9145    set cachedarcs 0
9146    set seeds {}
9147    getallcommits
9148}
9149
9150proc writecache {f} {
9151    global cachearc cachedarcs allccache
9152    global arcstart arcend arcnos arcids arcout
9153
9154    set a $cachearc
9155    set lim $cachedarcs
9156    if {$lim - $a > 1000} {
9157        set lim [expr {$a + 1000}]
9158    }
9159    if {[catch {
9160        while {[incr a] <= $lim} {
9161            if {[info exists arcend($a)]} {
9162                puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
9163            } else {
9164                puts $f [list $arcstart($a) {} $arcids($a)]
9165            }
9166        }
9167    } err]} {
9168        catch {close $f}
9169        catch {file delete $allccache}
9170        #puts "writing cache failed ($err)"
9171        return 0
9172    }
9173    set cachearc [expr {$a - 1}]
9174    if {$a > $cachedarcs} {
9175        puts $f "1"
9176        close $f
9177        return 0
9178    }
9179    return 1
9180}
9181
9182proc savecache {} {
9183    global nextarc cachedarcs cachearc allccache
9184
9185    if {$nextarc == $cachedarcs} return
9186    set cachearc 0
9187    set cachedarcs $nextarc
9188    catch {
9189        set f [open $allccache w]
9190        puts $f [list 1 $cachedarcs]
9191        run writecache $f
9192    }
9193}
9194
9195# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
9196# or 0 if neither is true.
9197proc anc_or_desc {a b} {
9198    global arcout arcstart arcend arcnos cached_isanc
9199
9200    if {$arcnos($a) eq $arcnos($b)} {
9201        # Both are on the same arc(s); either both are the same BMP,
9202        # or if one is not a BMP, the other is also not a BMP or is
9203        # the BMP at end of the arc (and it only has 1 incoming arc).
9204        # Or both can be BMPs with no incoming arcs.
9205        if {$a eq $b || $arcnos($a) eq {}} {
9206            return 0
9207        }
9208        # assert {[llength $arcnos($a)] == 1}
9209        set arc [lindex $arcnos($a) 0]
9210        set i [lsearch -exact $arcids($arc) $a]
9211        set j [lsearch -exact $arcids($arc) $b]
9212        if {$i < 0 || $i > $j} {
9213            return 1
9214        } else {
9215            return -1
9216        }
9217    }
9218
9219    if {![info exists arcout($a)]} {
9220        set arc [lindex $arcnos($a) 0]
9221        if {[info exists arcend($arc)]} {
9222            set aend $arcend($arc)
9223        } else {
9224            set aend {}
9225        }
9226        set a $arcstart($arc)
9227    } else {
9228        set aend $a
9229    }
9230    if {![info exists arcout($b)]} {
9231        set arc [lindex $arcnos($b) 0]
9232        if {[info exists arcend($arc)]} {
9233            set bend $arcend($arc)
9234        } else {
9235            set bend {}
9236        }
9237        set b $arcstart($arc)
9238    } else {
9239        set bend $b
9240    }
9241    if {$a eq $bend} {
9242        return 1
9243    }
9244    if {$b eq $aend} {
9245        return -1
9246    }
9247    if {[info exists cached_isanc($a,$bend)]} {
9248        if {$cached_isanc($a,$bend)} {
9249            return 1
9250        }
9251    }
9252    if {[info exists cached_isanc($b,$aend)]} {
9253        if {$cached_isanc($b,$aend)} {
9254            return -1
9255        }
9256        if {[info exists cached_isanc($a,$bend)]} {
9257            return 0
9258        }
9259    }
9260
9261    set todo [list $a $b]
9262    set anc($a) a
9263    set anc($b) b
9264    for {set i 0} {$i < [llength $todo]} {incr i} {
9265        set x [lindex $todo $i]
9266        if {$anc($x) eq {}} {
9267            continue
9268        }
9269        foreach arc $arcnos($x) {
9270            set xd $arcstart($arc)
9271            if {$xd eq $bend} {
9272                set cached_isanc($a,$bend) 1
9273                set cached_isanc($b,$aend) 0
9274                return 1
9275            } elseif {$xd eq $aend} {
9276                set cached_isanc($b,$aend) 1
9277                set cached_isanc($a,$bend) 0
9278                return -1
9279            }
9280            if {![info exists anc($xd)]} {
9281                set anc($xd) $anc($x)
9282                lappend todo $xd
9283            } elseif {$anc($xd) ne $anc($x)} {
9284                set anc($xd) {}
9285            }
9286        }
9287    }
9288    set cached_isanc($a,$bend) 0
9289    set cached_isanc($b,$aend) 0
9290    return 0
9291}
9292
9293# This identifies whether $desc has an ancestor that is
9294# a growing tip of the graph and which is not an ancestor of $anc
9295# and returns 0 if so and 1 if not.
9296# If we subsequently discover a tag on such a growing tip, and that
9297# turns out to be a descendent of $anc (which it could, since we
9298# don't necessarily see children before parents), then $desc
9299# isn't a good choice to display as a descendent tag of
9300# $anc (since it is the descendent of another tag which is
9301# a descendent of $anc).  Similarly, $anc isn't a good choice to
9302# display as a ancestor tag of $desc.
9303#
9304proc is_certain {desc anc} {
9305    global arcnos arcout arcstart arcend growing problems
9306
9307    set certain {}
9308    if {[llength $arcnos($anc)] == 1} {
9309        # tags on the same arc are certain
9310        if {$arcnos($desc) eq $arcnos($anc)} {
9311            return 1
9312        }
9313        if {![info exists arcout($anc)]} {
9314            # if $anc is partway along an arc, use the start of the arc instead
9315            set a [lindex $arcnos($anc) 0]
9316            set anc $arcstart($a)
9317        }
9318    }
9319    if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
9320        set x $desc
9321    } else {
9322        set a [lindex $arcnos($desc) 0]
9323        set x $arcend($a)
9324    }
9325    if {$x == $anc} {
9326        return 1
9327    }
9328    set anclist [list $x]
9329    set dl($x) 1
9330    set nnh 1
9331    set ngrowanc 0
9332    for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
9333        set x [lindex $anclist $i]
9334        if {$dl($x)} {
9335            incr nnh -1
9336        }
9337        set done($x) 1
9338        foreach a $arcout($x) {
9339            if {[info exists growing($a)]} {
9340                if {![info exists growanc($x)] && $dl($x)} {
9341                    set growanc($x) 1
9342                    incr ngrowanc
9343                }
9344            } else {
9345                set y $arcend($a)
9346                if {[info exists dl($y)]} {
9347                    if {$dl($y)} {
9348                        if {!$dl($x)} {
9349                            set dl($y) 0
9350                            if {![info exists done($y)]} {
9351                                incr nnh -1
9352                            }
9353                            if {[info exists growanc($x)]} {
9354                                incr ngrowanc -1
9355                            }
9356                            set xl [list $y]
9357                            for {set k 0} {$k < [llength $xl]} {incr k} {
9358                                set z [lindex $xl $k]
9359                                foreach c $arcout($z) {
9360                                    if {[info exists arcend($c)]} {
9361                                        set v $arcend($c)
9362                                        if {[info exists dl($v)] && $dl($v)} {
9363                                            set dl($v) 0
9364                                            if {![info exists done($v)]} {
9365                                                incr nnh -1
9366                                            }
9367                                            if {[info exists growanc($v)]} {
9368                                                incr ngrowanc -1
9369                                            }
9370                                            lappend xl $v
9371                                        }
9372                                    }
9373                                }
9374                            }
9375                        }
9376                    }
9377                } elseif {$y eq $anc || !$dl($x)} {
9378                    set dl($y) 0
9379                    lappend anclist $y
9380                } else {
9381                    set dl($y) 1
9382                    lappend anclist $y
9383                    incr nnh
9384                }
9385            }
9386        }
9387    }
9388    foreach x [array names growanc] {
9389        if {$dl($x)} {
9390            return 0
9391        }
9392        return 0
9393    }
9394    return 1
9395}
9396
9397proc validate_arctags {a} {
9398    global arctags idtags
9399
9400    set i -1
9401    set na $arctags($a)
9402    foreach id $arctags($a) {
9403        incr i
9404        if {![info exists idtags($id)]} {
9405            set na [lreplace $na $i $i]
9406            incr i -1
9407        }
9408    }
9409    set arctags($a) $na
9410}
9411
9412proc validate_archeads {a} {
9413    global archeads idheads
9414
9415    set i -1
9416    set na $archeads($a)
9417    foreach id $archeads($a) {
9418        incr i
9419        if {![info exists idheads($id)]} {
9420            set na [lreplace $na $i $i]
9421            incr i -1
9422        }
9423    }
9424    set archeads($a) $na
9425}
9426
9427# Return the list of IDs that have tags that are descendents of id,
9428# ignoring IDs that are descendents of IDs already reported.
9429proc desctags {id} {
9430    global arcnos arcstart arcids arctags idtags allparents
9431    global growing cached_dtags
9432
9433    if {![info exists allparents($id)]} {
9434        return {}
9435    }
9436    set t1 [clock clicks -milliseconds]
9437    set argid $id
9438    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9439        # part-way along an arc; check that arc first
9440        set a [lindex $arcnos($id) 0]
9441        if {$arctags($a) ne {}} {
9442            validate_arctags $a
9443            set i [lsearch -exact $arcids($a) $id]
9444            set tid {}
9445            foreach t $arctags($a) {
9446                set j [lsearch -exact $arcids($a) $t]
9447                if {$j >= $i} break
9448                set tid $t
9449            }
9450            if {$tid ne {}} {
9451                return $tid
9452            }
9453        }
9454        set id $arcstart($a)
9455        if {[info exists idtags($id)]} {
9456            return $id
9457        }
9458    }
9459    if {[info exists cached_dtags($id)]} {
9460        return $cached_dtags($id)
9461    }
9462
9463    set origid $id
9464    set todo [list $id]
9465    set queued($id) 1
9466    set nc 1
9467    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
9468        set id [lindex $todo $i]
9469        set done($id) 1
9470        set ta [info exists hastaggedancestor($id)]
9471        if {!$ta} {
9472            incr nc -1
9473        }
9474        # ignore tags on starting node
9475        if {!$ta && $i > 0} {
9476            if {[info exists idtags($id)]} {
9477                set tagloc($id) $id
9478                set ta 1
9479            } elseif {[info exists cached_dtags($id)]} {
9480                set tagloc($id) $cached_dtags($id)
9481                set ta 1
9482            }
9483        }
9484        foreach a $arcnos($id) {
9485            set d $arcstart($a)
9486            if {!$ta && $arctags($a) ne {}} {
9487                validate_arctags $a
9488                if {$arctags($a) ne {}} {
9489                    lappend tagloc($id) [lindex $arctags($a) end]
9490                }
9491            }
9492            if {$ta || $arctags($a) ne {}} {
9493                set tomark [list $d]
9494                for {set j 0} {$j < [llength $tomark]} {incr j} {
9495                    set dd [lindex $tomark $j]
9496                    if {![info exists hastaggedancestor($dd)]} {
9497                        if {[info exists done($dd)]} {
9498                            foreach b $arcnos($dd) {
9499                                lappend tomark $arcstart($b)
9500                            }
9501                            if {[info exists tagloc($dd)]} {
9502                                unset tagloc($dd)
9503                            }
9504                        } elseif {[info exists queued($dd)]} {
9505                            incr nc -1
9506                        }
9507                        set hastaggedancestor($dd) 1
9508                    }
9509                }
9510            }
9511            if {![info exists queued($d)]} {
9512                lappend todo $d
9513                set queued($d) 1
9514                if {![info exists hastaggedancestor($d)]} {
9515                    incr nc
9516                }
9517            }
9518        }
9519    }
9520    set tags {}
9521    foreach id [array names tagloc] {
9522        if {![info exists hastaggedancestor($id)]} {
9523            foreach t $tagloc($id) {
9524                if {[lsearch -exact $tags $t] < 0} {
9525                    lappend tags $t
9526                }
9527            }
9528        }
9529    }
9530    set t2 [clock clicks -milliseconds]
9531    set loopix $i
9532
9533    # remove tags that are descendents of other tags
9534    for {set i 0} {$i < [llength $tags]} {incr i} {
9535        set a [lindex $tags $i]
9536        for {set j 0} {$j < $i} {incr j} {
9537            set b [lindex $tags $j]
9538            set r [anc_or_desc $a $b]
9539            if {$r == 1} {
9540                set tags [lreplace $tags $j $j]
9541                incr j -1
9542                incr i -1
9543            } elseif {$r == -1} {
9544                set tags [lreplace $tags $i $i]
9545                incr i -1
9546                break
9547            }
9548        }
9549    }
9550
9551    if {[array names growing] ne {}} {
9552        # graph isn't finished, need to check if any tag could get
9553        # eclipsed by another tag coming later.  Simply ignore any
9554        # tags that could later get eclipsed.
9555        set ctags {}
9556        foreach t $tags {
9557            if {[is_certain $t $origid]} {
9558                lappend ctags $t
9559            }
9560        }
9561        if {$tags eq $ctags} {
9562            set cached_dtags($origid) $tags
9563        } else {
9564            set tags $ctags
9565        }
9566    } else {
9567        set cached_dtags($origid) $tags
9568    }
9569    set t3 [clock clicks -milliseconds]
9570    if {0 && $t3 - $t1 >= 100} {
9571        puts "iterating descendents ($loopix/[llength $todo] nodes) took\
9572            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
9573    }
9574    return $tags
9575}
9576
9577proc anctags {id} {
9578    global arcnos arcids arcout arcend arctags idtags allparents
9579    global growing cached_atags
9580
9581    if {![info exists allparents($id)]} {
9582        return {}
9583    }
9584    set t1 [clock clicks -milliseconds]
9585    set argid $id
9586    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9587        # part-way along an arc; check that arc first
9588        set a [lindex $arcnos($id) 0]
9589        if {$arctags($a) ne {}} {
9590            validate_arctags $a
9591            set i [lsearch -exact $arcids($a) $id]
9592            foreach t $arctags($a) {
9593                set j [lsearch -exact $arcids($a) $t]
9594                if {$j > $i} {
9595                    return $t
9596                }
9597            }
9598        }
9599        if {![info exists arcend($a)]} {
9600            return {}
9601        }
9602        set id $arcend($a)
9603        if {[info exists idtags($id)]} {
9604            return $id
9605        }
9606    }
9607    if {[info exists cached_atags($id)]} {
9608        return $cached_atags($id)
9609    }
9610
9611    set origid $id
9612    set todo [list $id]
9613    set queued($id) 1
9614    set taglist {}
9615    set nc 1
9616    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
9617        set id [lindex $todo $i]
9618        set done($id) 1
9619        set td [info exists hastaggeddescendent($id)]
9620        if {!$td} {
9621            incr nc -1
9622        }
9623        # ignore tags on starting node
9624        if {!$td && $i > 0} {
9625            if {[info exists idtags($id)]} {
9626                set tagloc($id) $id
9627                set td 1
9628            } elseif {[info exists cached_atags($id)]} {
9629                set tagloc($id) $cached_atags($id)
9630                set td 1
9631            }
9632        }
9633        foreach a $arcout($id) {
9634            if {!$td && $arctags($a) ne {}} {
9635                validate_arctags $a
9636                if {$arctags($a) ne {}} {
9637                    lappend tagloc($id) [lindex $arctags($a) 0]
9638                }
9639            }
9640            if {![info exists arcend($a)]} continue
9641            set d $arcend($a)
9642            if {$td || $arctags($a) ne {}} {
9643                set tomark [list $d]
9644                for {set j 0} {$j < [llength $tomark]} {incr j} {
9645                    set dd [lindex $tomark $j]
9646                    if {![info exists hastaggeddescendent($dd)]} {
9647                        if {[info exists done($dd)]} {
9648                            foreach b $arcout($dd) {
9649                                if {[info exists arcend($b)]} {
9650                                    lappend tomark $arcend($b)
9651                                }
9652                            }
9653                            if {[info exists tagloc($dd)]} {
9654                                unset tagloc($dd)
9655                            }
9656                        } elseif {[info exists queued($dd)]} {
9657                            incr nc -1
9658                        }
9659                        set hastaggeddescendent($dd) 1
9660                    }
9661                }
9662            }
9663            if {![info exists queued($d)]} {
9664                lappend todo $d
9665                set queued($d) 1
9666                if {![info exists hastaggeddescendent($d)]} {
9667                    incr nc
9668                }
9669            }
9670        }
9671    }
9672    set t2 [clock clicks -milliseconds]
9673    set loopix $i
9674    set tags {}
9675    foreach id [array names tagloc] {
9676        if {![info exists hastaggeddescendent($id)]} {
9677            foreach t $tagloc($id) {
9678                if {[lsearch -exact $tags $t] < 0} {
9679                    lappend tags $t
9680                }
9681            }
9682        }
9683    }
9684
9685    # remove tags that are ancestors of other tags
9686    for {set i 0} {$i < [llength $tags]} {incr i} {
9687        set a [lindex $tags $i]
9688        for {set j 0} {$j < $i} {incr j} {
9689            set b [lindex $tags $j]
9690            set r [anc_or_desc $a $b]
9691            if {$r == -1} {
9692                set tags [lreplace $tags $j $j]
9693                incr j -1
9694                incr i -1
9695            } elseif {$r == 1} {
9696                set tags [lreplace $tags $i $i]
9697                incr i -1
9698                break
9699            }
9700        }
9701    }
9702
9703    if {[array names growing] ne {}} {
9704        # graph isn't finished, need to check if any tag could get
9705        # eclipsed by another tag coming later.  Simply ignore any
9706        # tags that could later get eclipsed.
9707        set ctags {}
9708        foreach t $tags {
9709            if {[is_certain $origid $t]} {
9710                lappend ctags $t
9711            }
9712        }
9713        if {$tags eq $ctags} {
9714            set cached_atags($origid) $tags
9715        } else {
9716            set tags $ctags
9717        }
9718    } else {
9719        set cached_atags($origid) $tags
9720    }
9721    set t3 [clock clicks -milliseconds]
9722    if {0 && $t3 - $t1 >= 100} {
9723        puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
9724            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
9725    }
9726    return $tags
9727}
9728
9729# Return the list of IDs that have heads that are descendents of id,
9730# including id itself if it has a head.
9731proc descheads {id} {
9732    global arcnos arcstart arcids archeads idheads cached_dheads
9733    global allparents
9734
9735    if {![info exists allparents($id)]} {
9736        return {}
9737    }
9738    set aret {}
9739    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
9740        # part-way along an arc; check it first
9741        set a [lindex $arcnos($id) 0]
9742        if {$archeads($a) ne {}} {
9743            validate_archeads $a
9744            set i [lsearch -exact $arcids($a) $id]
9745            foreach t $archeads($a) {
9746                set j [lsearch -exact $arcids($a) $t]
9747                if {$j > $i} break
9748                lappend aret $t
9749            }
9750        }
9751        set id $arcstart($a)
9752    }
9753    set origid $id
9754    set todo [list $id]
9755    set seen($id) 1
9756    set ret {}
9757    for {set i 0} {$i < [llength $todo]} {incr i} {
9758        set id [lindex $todo $i]
9759        if {[info exists cached_dheads($id)]} {
9760            set ret [concat $ret $cached_dheads($id)]
9761        } else {
9762            if {[info exists idheads($id)]} {
9763                lappend ret $id
9764            }
9765            foreach a $arcnos($id) {
9766                if {$archeads($a) ne {}} {
9767                    validate_archeads $a
9768                    if {$archeads($a) ne {}} {
9769                        set ret [concat $ret $archeads($a)]
9770                    }
9771                }
9772                set d $arcstart($a)
9773                if {![info exists seen($d)]} {
9774                    lappend todo $d
9775                    set seen($d) 1
9776                }
9777            }
9778        }
9779    }
9780    set ret [lsort -unique $ret]
9781    set cached_dheads($origid) $ret
9782    return [concat $ret $aret]
9783}
9784
9785proc addedtag {id} {
9786    global arcnos arcout cached_dtags cached_atags
9787
9788    if {![info exists arcnos($id)]} return
9789    if {![info exists arcout($id)]} {
9790        recalcarc [lindex $arcnos($id) 0]
9791    }
9792    catch {unset cached_dtags}
9793    catch {unset cached_atags}
9794}
9795
9796proc addedhead {hid head} {
9797    global arcnos arcout cached_dheads
9798
9799    if {![info exists arcnos($hid)]} return
9800    if {![info exists arcout($hid)]} {
9801        recalcarc [lindex $arcnos($hid) 0]
9802    }
9803    catch {unset cached_dheads}
9804}
9805
9806proc removedhead {hid head} {
9807    global cached_dheads
9808
9809    catch {unset cached_dheads}
9810}
9811
9812proc movedhead {hid head} {
9813    global arcnos arcout cached_dheads
9814
9815    if {![info exists arcnos($hid)]} return
9816    if {![info exists arcout($hid)]} {
9817        recalcarc [lindex $arcnos($hid) 0]
9818    }
9819    catch {unset cached_dheads}
9820}
9821
9822proc changedrefs {} {
9823    global cached_dheads cached_dtags cached_atags
9824    global arctags archeads arcnos arcout idheads idtags
9825
9826    foreach id [concat [array names idheads] [array names idtags]] {
9827        if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
9828            set a [lindex $arcnos($id) 0]
9829            if {![info exists donearc($a)]} {
9830                recalcarc $a
9831                set donearc($a) 1
9832            }
9833        }
9834    }
9835    catch {unset cached_dtags}
9836    catch {unset cached_atags}
9837    catch {unset cached_dheads}
9838}
9839
9840proc rereadrefs {} {
9841    global idtags idheads idotherrefs mainheadid
9842
9843    set refids [concat [array names idtags] \
9844                    [array names idheads] [array names idotherrefs]]
9845    foreach id $refids {
9846        if {![info exists ref($id)]} {
9847            set ref($id) [listrefs $id]
9848        }
9849    }
9850    set oldmainhead $mainheadid
9851    readrefs
9852    changedrefs
9853    set refids [lsort -unique [concat $refids [array names idtags] \
9854                        [array names idheads] [array names idotherrefs]]]
9855    foreach id $refids {
9856        set v [listrefs $id]
9857        if {![info exists ref($id)] || $ref($id) != $v} {
9858            redrawtags $id
9859        }
9860    }
9861    if {$oldmainhead ne $mainheadid} {
9862        redrawtags $oldmainhead
9863        redrawtags $mainheadid
9864    }
9865    run refill_reflist
9866}
9867
9868proc listrefs {id} {
9869    global idtags idheads idotherrefs
9870
9871    set x {}
9872    if {[info exists idtags($id)]} {
9873        set x $idtags($id)
9874    }
9875    set y {}
9876    if {[info exists idheads($id)]} {
9877        set y $idheads($id)
9878    }
9879    set z {}
9880    if {[info exists idotherrefs($id)]} {
9881        set z $idotherrefs($id)
9882    }
9883    return [list $x $y $z]
9884}
9885
9886proc showtag {tag isnew} {
9887    global ctext tagcontents tagids linknum tagobjid
9888
9889    if {$isnew} {
9890        addtohistory [list showtag $tag 0]
9891    }
9892    $ctext conf -state normal
9893    clear_ctext
9894    settabs 0
9895    set linknum 0
9896    if {![info exists tagcontents($tag)]} {
9897        catch {
9898            set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
9899        }
9900    }
9901    if {[info exists tagcontents($tag)]} {
9902        set text $tagcontents($tag)
9903    } else {
9904        set text "[mc "Tag"]: $tag\n[mc "Id"]:  $tagids($tag)"
9905    }
9906    appendwithlinks $text {}
9907    $ctext conf -state disabled
9908    init_flist {}
9909}
9910
9911proc doquit {} {
9912    global stopped
9913    global gitktmpdir
9914
9915    set stopped 100
9916    savestuff .
9917    destroy .
9918
9919    if {[info exists gitktmpdir]} {
9920        catch {file delete -force $gitktmpdir}
9921    }
9922}
9923
9924proc mkfontdisp {font top which} {
9925    global fontattr fontpref $font
9926
9927    set fontpref($font) [set $font]
9928    button $top.${font}but -text $which -font optionfont \
9929        -command [list choosefont $font $which]
9930    label $top.$font -relief flat -font $font \
9931        -text $fontattr($font,family) -justify left
9932    grid x $top.${font}but $top.$font -sticky w
9933}
9934
9935proc choosefont {font which} {
9936    global fontparam fontlist fonttop fontattr
9937    global prefstop
9938
9939    set fontparam(which) $which
9940    set fontparam(font) $font
9941    set fontparam(family) [font actual $font -family]
9942    set fontparam(size) $fontattr($font,size)
9943    set fontparam(weight) $fontattr($font,weight)
9944    set fontparam(slant) $fontattr($font,slant)
9945    set top .gitkfont
9946    set fonttop $top
9947    if {![winfo exists $top]} {
9948        font create sample
9949        eval font config sample [font actual $font]
9950        toplevel $top
9951        make_transient $top $prefstop
9952        wm title $top [mc "Gitk font chooser"]
9953        label $top.l -textvariable fontparam(which)
9954        pack $top.l -side top
9955        set fontlist [lsort [font families]]
9956        frame $top.f
9957        listbox $top.f.fam -listvariable fontlist \
9958            -yscrollcommand [list $top.f.sb set]
9959        bind $top.f.fam <<ListboxSelect>> selfontfam
9960        scrollbar $top.f.sb -command [list $top.f.fam yview]
9961        pack $top.f.sb -side right -fill y
9962        pack $top.f.fam -side left -fill both -expand 1
9963        pack $top.f -side top -fill both -expand 1
9964        frame $top.g
9965        spinbox $top.g.size -from 4 -to 40 -width 4 \
9966            -textvariable fontparam(size) \
9967            -validatecommand {string is integer -strict %s}
9968        checkbutton $top.g.bold -padx 5 \
9969            -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
9970            -variable fontparam(weight) -onvalue bold -offvalue normal
9971        checkbutton $top.g.ital -padx 5 \
9972            -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
9973            -variable fontparam(slant) -onvalue italic -offvalue roman
9974        pack $top.g.size $top.g.bold $top.g.ital -side left
9975        pack $top.g -side top
9976        canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
9977            -background white
9978        $top.c create text 100 25 -anchor center -text $which -font sample \
9979            -fill black -tags text
9980        bind $top.c <Configure> [list centertext $top.c]
9981        pack $top.c -side top -fill x
9982        frame $top.buts
9983        button $top.buts.ok -text [mc "OK"] -command fontok -default active
9984        button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
9985        bind $top <Key-Return> fontok
9986        bind $top <Key-Escape> fontcan
9987        grid $top.buts.ok $top.buts.can
9988        grid columnconfigure $top.buts 0 -weight 1 -uniform a
9989        grid columnconfigure $top.buts 1 -weight 1 -uniform a
9990        pack $top.buts -side bottom -fill x
9991        trace add variable fontparam write chg_fontparam
9992    } else {
9993        raise $top
9994        $top.c itemconf text -text $which
9995    }
9996    set i [lsearch -exact $fontlist $fontparam(family)]
9997    if {$i >= 0} {
9998        $top.f.fam selection set $i
9999        $top.f.fam see $i
10000    }
10001}
10002
10003proc centertext {w} {
10004    $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
10005}
10006
10007proc fontok {} {
10008    global fontparam fontpref prefstop
10009
10010    set f $fontparam(font)
10011    set fontpref($f) [list $fontparam(family) $fontparam(size)]
10012    if {$fontparam(weight) eq "bold"} {
10013        lappend fontpref($f) "bold"
10014    }
10015    if {$fontparam(slant) eq "italic"} {
10016        lappend fontpref($f) "italic"
10017    }
10018    set w $prefstop.$f
10019    $w conf -text $fontparam(family) -font $fontpref($f)
10020        
10021    fontcan
10022}
10023
10024proc fontcan {} {
10025    global fonttop fontparam
10026
10027    if {[info exists fonttop]} {
10028        catch {destroy $fonttop}
10029        catch {font delete sample}
10030        unset fonttop
10031        unset fontparam
10032    }
10033}
10034
10035proc selfontfam {} {
10036    global fonttop fontparam
10037
10038    set i [$fonttop.f.fam curselection]
10039    if {$i ne {}} {
10040        set fontparam(family) [$fonttop.f.fam get $i]
10041    }
10042}
10043
10044proc chg_fontparam {v sub op} {
10045    global fontparam
10046
10047    font config sample -$sub $fontparam($sub)
10048}
10049
10050proc doprefs {} {
10051    global maxwidth maxgraphpct
10052    global oldprefs prefstop showneartags showlocalchanges
10053    global bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
10054    global tabstop limitdiffs autoselect extdifftool perfile_attrs
10055
10056    set top .gitkprefs
10057    set prefstop $top
10058    if {[winfo exists $top]} {
10059        raise $top
10060        return
10061    }
10062    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
10063                   limitdiffs tabstop perfile_attrs} {
10064        set oldprefs($v) [set $v]
10065    }
10066    toplevel $top
10067    wm title $top [mc "Gitk preferences"]
10068    make_transient $top .
10069    label $top.ldisp -text [mc "Commit list display options"]
10070    grid $top.ldisp - -sticky w -pady 10
10071    label $top.spacer -text " "
10072    label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
10073        -font optionfont
10074    spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
10075    grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
10076    label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
10077        -font optionfont
10078    spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
10079    grid x $top.maxpctl $top.maxpct -sticky w
10080    frame $top.showlocal
10081    label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
10082    checkbutton $top.showlocal.b -variable showlocalchanges
10083    pack $top.showlocal.b $top.showlocal.l -side left
10084    grid x $top.showlocal -sticky w
10085    frame $top.autoselect
10086    label $top.autoselect.l -text [mc "Auto-select SHA1"] -font optionfont
10087    checkbutton $top.autoselect.b -variable autoselect
10088    pack $top.autoselect.b $top.autoselect.l -side left
10089    grid x $top.autoselect -sticky w
10090
10091    label $top.ddisp -text [mc "Diff display options"]
10092    grid $top.ddisp - -sticky w -pady 10
10093    label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
10094    spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
10095    grid x $top.tabstopl $top.tabstop -sticky w
10096    frame $top.ntag
10097    label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
10098    checkbutton $top.ntag.b -variable showneartags
10099    pack $top.ntag.b $top.ntag.l -side left
10100    grid x $top.ntag -sticky w
10101    frame $top.ldiff
10102    label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
10103    checkbutton $top.ldiff.b -variable limitdiffs
10104    pack $top.ldiff.b $top.ldiff.l -side left
10105    grid x $top.ldiff -sticky w
10106    frame $top.lattr
10107    label $top.lattr.l -text [mc "Support per-file encodings"] -font optionfont
10108    checkbutton $top.lattr.b -variable perfile_attrs
10109    pack $top.lattr.b $top.lattr.l -side left
10110    grid x $top.lattr -sticky w
10111
10112    entry $top.extdifft -textvariable extdifftool
10113    frame $top.extdifff
10114    label $top.extdifff.l -text [mc "External diff tool" ] -font optionfont \
10115        -padx 10
10116    button $top.extdifff.b -text [mc "Choose..."] -font optionfont \
10117        -command choose_extdiff
10118    pack $top.extdifff.l $top.extdifff.b -side left
10119    grid x $top.extdifff $top.extdifft -sticky w
10120
10121    label $top.cdisp -text [mc "Colors: press to choose"]
10122    grid $top.cdisp - -sticky w -pady 10
10123    label $top.bg -padx 40 -relief sunk -background $bgcolor
10124    button $top.bgbut -text [mc "Background"] -font optionfont \
10125        -command [list choosecolor bgcolor {} $top.bg background setbg]
10126    grid x $top.bgbut $top.bg -sticky w
10127    label $top.fg -padx 40 -relief sunk -background $fgcolor
10128    button $top.fgbut -text [mc "Foreground"] -font optionfont \
10129        -command [list choosecolor fgcolor {} $top.fg foreground setfg]
10130    grid x $top.fgbut $top.fg -sticky w
10131    label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
10132    button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
10133        -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
10134                      [list $ctext tag conf d0 -foreground]]
10135    grid x $top.diffoldbut $top.diffold -sticky w
10136    label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
10137    button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
10138        -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
10139                      [list $ctext tag conf dresult -foreground]]
10140    grid x $top.diffnewbut $top.diffnew -sticky w
10141    label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
10142    button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
10143        -command [list choosecolor diffcolors 2 $top.hunksep \
10144                      "diff hunk header" \
10145                      [list $ctext tag conf hunksep -foreground]]
10146    grid x $top.hunksepbut $top.hunksep -sticky w
10147    label $top.markbgsep -padx 40 -relief sunk -background $markbgcolor
10148    button $top.markbgbut -text [mc "Marked line bg"] -font optionfont \
10149        -command [list choosecolor markbgcolor {} $top.markbgsep \
10150                      [mc "marked line background"] \
10151                      [list $ctext tag conf omark -background]]
10152    grid x $top.markbgbut $top.markbgsep -sticky w
10153    label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
10154    button $top.selbgbut -text [mc "Select bg"] -font optionfont \
10155        -command [list choosecolor selectbgcolor {} $top.selbgsep background setselbg]
10156    grid x $top.selbgbut $top.selbgsep -sticky w
10157
10158    label $top.cfont -text [mc "Fonts: press to choose"]
10159    grid $top.cfont - -sticky w -pady 10
10160    mkfontdisp mainfont $top [mc "Main font"]
10161    mkfontdisp textfont $top [mc "Diff display font"]
10162    mkfontdisp uifont $top [mc "User interface font"]
10163
10164    frame $top.buts
10165    button $top.buts.ok -text [mc "OK"] -command prefsok -default active
10166    button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
10167    bind $top <Key-Return> prefsok
10168    bind $top <Key-Escape> prefscan
10169    grid $top.buts.ok $top.buts.can
10170    grid columnconfigure $top.buts 0 -weight 1 -uniform a
10171    grid columnconfigure $top.buts 1 -weight 1 -uniform a
10172    grid $top.buts - - -pady 10 -sticky ew
10173    bind $top <Visibility> "focus $top.buts.ok"
10174}
10175
10176proc choose_extdiff {} {
10177    global extdifftool
10178
10179    set prog [tk_getOpenFile -title "External diff tool" -multiple false]
10180    if {$prog ne {}} {
10181        set extdifftool $prog
10182    }
10183}
10184
10185proc choosecolor {v vi w x cmd} {
10186    global $v
10187
10188    set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
10189               -title [mc "Gitk: choose color for %s" $x]]
10190    if {$c eq {}} return
10191    $w conf -background $c
10192    lset $v $vi $c
10193    eval $cmd $c
10194}
10195
10196proc setselbg {c} {
10197    global bglist cflist
10198    foreach w $bglist {
10199        $w configure -selectbackground $c
10200    }
10201    $cflist tag configure highlight \
10202        -background [$cflist cget -selectbackground]
10203    allcanvs itemconf secsel -fill $c
10204}
10205
10206proc setbg {c} {
10207    global bglist
10208
10209    foreach w $bglist {
10210        $w conf -background $c
10211    }
10212}
10213
10214proc setfg {c} {
10215    global fglist canv
10216
10217    foreach w $fglist {
10218        $w conf -foreground $c
10219    }
10220    allcanvs itemconf text -fill $c
10221    $canv itemconf circle -outline $c
10222}
10223
10224proc prefscan {} {
10225    global oldprefs prefstop
10226
10227    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
10228                   limitdiffs tabstop perfile_attrs} {
10229        global $v
10230        set $v $oldprefs($v)
10231    }
10232    catch {destroy $prefstop}
10233    unset prefstop
10234    fontcan
10235}
10236
10237proc prefsok {} {
10238    global maxwidth maxgraphpct
10239    global oldprefs prefstop showneartags showlocalchanges
10240    global fontpref mainfont textfont uifont
10241    global limitdiffs treediffs perfile_attrs
10242
10243    catch {destroy $prefstop}
10244    unset prefstop
10245    fontcan
10246    set fontchanged 0
10247    if {$mainfont ne $fontpref(mainfont)} {
10248        set mainfont $fontpref(mainfont)
10249        parsefont mainfont $mainfont
10250        eval font configure mainfont [fontflags mainfont]
10251        eval font configure mainfontbold [fontflags mainfont 1]
10252        setcoords
10253        set fontchanged 1
10254    }
10255    if {$textfont ne $fontpref(textfont)} {
10256        set textfont $fontpref(textfont)
10257        parsefont textfont $textfont
10258        eval font configure textfont [fontflags textfont]
10259        eval font configure textfontbold [fontflags textfont 1]
10260    }
10261    if {$uifont ne $fontpref(uifont)} {
10262        set uifont $fontpref(uifont)
10263        parsefont uifont $uifont
10264        eval font configure uifont [fontflags uifont]
10265    }
10266    settabs
10267    if {$showlocalchanges != $oldprefs(showlocalchanges)} {
10268        if {$showlocalchanges} {
10269            doshowlocalchanges
10270        } else {
10271            dohidelocalchanges
10272        }
10273    }
10274    if {$limitdiffs != $oldprefs(limitdiffs) ||
10275        ($perfile_attrs && !$oldprefs(perfile_attrs))} {
10276        # treediffs elements are limited by path;
10277        # won't have encodings cached if perfile_attrs was just turned on
10278        catch {unset treediffs}
10279    }
10280    if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
10281        || $maxgraphpct != $oldprefs(maxgraphpct)} {
10282        redisplay
10283    } elseif {$showneartags != $oldprefs(showneartags) ||
10284          $limitdiffs != $oldprefs(limitdiffs)} {
10285        reselectline
10286    }
10287}
10288
10289proc formatdate {d} {
10290    global datetimeformat
10291    if {$d ne {}} {
10292        set d [clock format $d -format $datetimeformat]
10293    }
10294    return $d
10295}
10296
10297# This list of encoding names and aliases is distilled from
10298# http://www.iana.org/assignments/character-sets.
10299# Not all of them are supported by Tcl.
10300set encoding_aliases {
10301    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
10302      ISO646-US US-ASCII us IBM367 cp367 csASCII }
10303    { ISO-10646-UTF-1 csISO10646UTF1 }
10304    { ISO_646.basic:1983 ref csISO646basic1983 }
10305    { INVARIANT csINVARIANT }
10306    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
10307    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
10308    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
10309    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
10310    { NATS-DANO iso-ir-9-1 csNATSDANO }
10311    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
10312    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
10313    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
10314    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
10315    { ISO-2022-KR csISO2022KR }
10316    { EUC-KR csEUCKR }
10317    { ISO-2022-JP csISO2022JP }
10318    { ISO-2022-JP-2 csISO2022JP2 }
10319    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
10320      csISO13JISC6220jp }
10321    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
10322    { IT iso-ir-15 ISO646-IT csISO15Italian }
10323    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
10324    { ES iso-ir-17 ISO646-ES csISO17Spanish }
10325    { greek7-old iso-ir-18 csISO18Greek7Old }
10326    { latin-greek iso-ir-19 csISO19LatinGreek }
10327    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
10328    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
10329    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
10330    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
10331    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
10332    { BS_viewdata iso-ir-47 csISO47BSViewdata }
10333    { INIS iso-ir-49 csISO49INIS }
10334    { INIS-8 iso-ir-50 csISO50INIS8 }
10335    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
10336    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
10337    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
10338    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
10339    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
10340    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
10341      csISO60Norwegian1 }
10342    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
10343    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
10344    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
10345    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
10346    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
10347    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
10348    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
10349    { greek7 iso-ir-88 csISO88Greek7 }
10350    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
10351    { iso-ir-90 csISO90 }
10352    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
10353    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
10354      csISO92JISC62991984b }
10355    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
10356    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
10357    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
10358      csISO95JIS62291984handadd }
10359    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
10360    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
10361    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
10362    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
10363      CP819 csISOLatin1 }
10364    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
10365    { T.61-7bit iso-ir-102 csISO102T617bit }
10366    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
10367    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
10368    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
10369    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
10370    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
10371    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
10372    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
10373    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
10374      arabic csISOLatinArabic }
10375    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
10376    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
10377    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
10378      greek greek8 csISOLatinGreek }
10379    { T.101-G2 iso-ir-128 csISO128T101G2 }
10380    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
10381      csISOLatinHebrew }
10382    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
10383    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
10384    { CSN_369103 iso-ir-139 csISO139CSN369103 }
10385    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
10386    { ISO_6937-2-add iso-ir-142 csISOTextComm }
10387    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
10388    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
10389      csISOLatinCyrillic }
10390    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
10391    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
10392    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
10393    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
10394    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
10395    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
10396    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
10397    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
10398    { ISO_10367-box iso-ir-155 csISO10367Box }
10399    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
10400    { latin-lap lap iso-ir-158 csISO158Lap }
10401    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
10402    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
10403    { us-dk csUSDK }
10404    { dk-us csDKUS }
10405    { JIS_X0201 X0201 csHalfWidthKatakana }
10406    { KSC5636 ISO646-KR csKSC5636 }
10407    { ISO-10646-UCS-2 csUnicode }
10408    { ISO-10646-UCS-4 csUCS4 }
10409    { DEC-MCS dec csDECMCS }
10410    { hp-roman8 roman8 r8 csHPRoman8 }
10411    { macintosh mac csMacintosh }
10412    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
10413      csIBM037 }
10414    { IBM038 EBCDIC-INT cp038 csIBM038 }
10415    { IBM273 CP273 csIBM273 }
10416    { IBM274 EBCDIC-BE CP274 csIBM274 }
10417    { IBM275 EBCDIC-BR cp275 csIBM275 }
10418    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
10419    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
10420    { IBM280 CP280 ebcdic-cp-it csIBM280 }
10421    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
10422    { IBM284 CP284 ebcdic-cp-es csIBM284 }
10423    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
10424    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
10425    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
10426    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
10427    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
10428    { IBM424 cp424 ebcdic-cp-he csIBM424 }
10429    { IBM437 cp437 437 csPC8CodePage437 }
10430    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
10431    { IBM775 cp775 csPC775Baltic }
10432    { IBM850 cp850 850 csPC850Multilingual }
10433    { IBM851 cp851 851 csIBM851 }
10434    { IBM852 cp852 852 csPCp852 }
10435    { IBM855 cp855 855 csIBM855 }
10436    { IBM857 cp857 857 csIBM857 }
10437    { IBM860 cp860 860 csIBM860 }
10438    { IBM861 cp861 861 cp-is csIBM861 }
10439    { IBM862 cp862 862 csPC862LatinHebrew }
10440    { IBM863 cp863 863 csIBM863 }
10441    { IBM864 cp864 csIBM864 }
10442    { IBM865 cp865 865 csIBM865 }
10443    { IBM866 cp866 866 csIBM866 }
10444    { IBM868 CP868 cp-ar csIBM868 }
10445    { IBM869 cp869 869 cp-gr csIBM869 }
10446    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
10447    { IBM871 CP871 ebcdic-cp-is csIBM871 }
10448    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
10449    { IBM891 cp891 csIBM891 }
10450    { IBM903 cp903 csIBM903 }
10451    { IBM904 cp904 904 csIBBM904 }
10452    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
10453    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
10454    { IBM1026 CP1026 csIBM1026 }
10455    { EBCDIC-AT-DE csIBMEBCDICATDE }
10456    { EBCDIC-AT-DE-A csEBCDICATDEA }
10457    { EBCDIC-CA-FR csEBCDICCAFR }
10458    { EBCDIC-DK-NO csEBCDICDKNO }
10459    { EBCDIC-DK-NO-A csEBCDICDKNOA }
10460    { EBCDIC-FI-SE csEBCDICFISE }
10461    { EBCDIC-FI-SE-A csEBCDICFISEA }
10462    { EBCDIC-FR csEBCDICFR }
10463    { EBCDIC-IT csEBCDICIT }
10464    { EBCDIC-PT csEBCDICPT }
10465    { EBCDIC-ES csEBCDICES }
10466    { EBCDIC-ES-A csEBCDICESA }
10467    { EBCDIC-ES-S csEBCDICESS }
10468    { EBCDIC-UK csEBCDICUK }
10469    { EBCDIC-US csEBCDICUS }
10470    { UNKNOWN-8BIT csUnknown8BiT }
10471    { MNEMONIC csMnemonic }
10472    { MNEM csMnem }
10473    { VISCII csVISCII }
10474    { VIQR csVIQR }
10475    { KOI8-R csKOI8R }
10476    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
10477    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
10478    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
10479    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
10480    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
10481    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
10482    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
10483    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
10484    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
10485    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
10486    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
10487    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
10488    { IBM1047 IBM-1047 }
10489    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
10490    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
10491    { UNICODE-1-1 csUnicode11 }
10492    { CESU-8 csCESU-8 }
10493    { BOCU-1 csBOCU-1 }
10494    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
10495    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
10496      l8 }
10497    { ISO-8859-15 ISO_8859-15 Latin-9 }
10498    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
10499    { GBK CP936 MS936 windows-936 }
10500    { JIS_Encoding csJISEncoding }
10501    { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
10502    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
10503      EUC-JP }
10504    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
10505    { ISO-10646-UCS-Basic csUnicodeASCII }
10506    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
10507    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
10508    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
10509    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
10510    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
10511    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
10512    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
10513    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
10514    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
10515    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
10516    { Adobe-Standard-Encoding csAdobeStandardEncoding }
10517    { Ventura-US csVenturaUS }
10518    { Ventura-International csVenturaInternational }
10519    { PC8-Danish-Norwegian csPC8DanishNorwegian }
10520    { PC8-Turkish csPC8Turkish }
10521    { IBM-Symbols csIBMSymbols }
10522    { IBM-Thai csIBMThai }
10523    { HP-Legal csHPLegal }
10524    { HP-Pi-font csHPPiFont }
10525    { HP-Math8 csHPMath8 }
10526    { Adobe-Symbol-Encoding csHPPSMath }
10527    { HP-DeskTop csHPDesktop }
10528    { Ventura-Math csVenturaMath }
10529    { Microsoft-Publishing csMicrosoftPublishing }
10530    { Windows-31J csWindows31J }
10531    { GB2312 csGB2312 }
10532    { Big5 csBig5 }
10533}
10534
10535proc tcl_encoding {enc} {
10536    global encoding_aliases tcl_encoding_cache
10537    if {[info exists tcl_encoding_cache($enc)]} {
10538        return $tcl_encoding_cache($enc)
10539    }
10540    set names [encoding names]
10541    set lcnames [string tolower $names]
10542    set enc [string tolower $enc]
10543    set i [lsearch -exact $lcnames $enc]
10544    if {$i < 0} {
10545        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
10546        if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
10547            set i [lsearch -exact $lcnames $encx]
10548        }
10549    }
10550    if {$i < 0} {
10551        foreach l $encoding_aliases {
10552            set ll [string tolower $l]
10553            if {[lsearch -exact $ll $enc] < 0} continue
10554            # look through the aliases for one that tcl knows about
10555            foreach e $ll {
10556                set i [lsearch -exact $lcnames $e]
10557                if {$i < 0} {
10558                    if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
10559                        set i [lsearch -exact $lcnames $ex]
10560                    }
10561                }
10562                if {$i >= 0} break
10563            }
10564            break
10565        }
10566    }
10567    set tclenc {}
10568    if {$i >= 0} {
10569        set tclenc [lindex $names $i]
10570    }
10571    set tcl_encoding_cache($enc) $tclenc
10572    return $tclenc
10573}
10574
10575proc gitattr {path attr default} {
10576    global path_attr_cache
10577    if {[info exists path_attr_cache($attr,$path)]} {
10578        set r $path_attr_cache($attr,$path)
10579    } else {
10580        set r "unspecified"
10581        if {![catch {set line [exec git check-attr $attr -- $path]}]} {
10582            regexp "(.*): encoding: (.*)" $line m f r
10583        }
10584        set path_attr_cache($attr,$path) $r
10585    }
10586    if {$r eq "unspecified"} {
10587        return $default
10588    }
10589    return $r
10590}
10591
10592proc cache_gitattr {attr pathlist} {
10593    global path_attr_cache
10594    set newlist {}
10595    foreach path $pathlist {
10596        if {![info exists path_attr_cache($attr,$path)]} {
10597            lappend newlist $path
10598        }
10599    }
10600    set lim 1000
10601    if {[tk windowingsystem] == "win32"} {
10602        # windows has a 32k limit on the arguments to a command...
10603        set lim 30
10604    }
10605    while {$newlist ne {}} {
10606        set head [lrange $newlist 0 [expr {$lim - 1}]]
10607        set newlist [lrange $newlist $lim end]
10608        if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
10609            foreach row [split $rlist "\n"] {
10610                if {[regexp "(.*): encoding: (.*)" $row m path value]} {
10611                    if {[string index $path 0] eq "\""} {
10612                        set path [encoding convertfrom [lindex $path 0]]
10613                    }
10614                    set path_attr_cache($attr,$path) $value
10615                }
10616            }
10617        }
10618    }
10619}
10620
10621proc get_path_encoding {path} {
10622    global gui_encoding perfile_attrs
10623    set tcl_enc $gui_encoding
10624    if {$path ne {} && $perfile_attrs} {
10625        set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
10626        if {$enc2 ne {}} {
10627            set tcl_enc $enc2
10628        }
10629    }
10630    return $tcl_enc
10631}
10632
10633# First check that Tcl/Tk is recent enough
10634if {[catch {package require Tk 8.4} err]} {
10635    show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
10636                     Gitk requires at least Tcl/Tk 8.4."]
10637    exit 1
10638}
10639
10640# defaults...
10641set wrcomcmd "git diff-tree --stdin -p --pretty"
10642
10643set gitencoding {}
10644catch {
10645    set gitencoding [exec git config --get i18n.commitencoding]
10646}
10647catch {
10648    set gitencoding [exec git config --get i18n.logoutputencoding]
10649}
10650if {$gitencoding == ""} {
10651    set gitencoding "utf-8"
10652}
10653set tclencoding [tcl_encoding $gitencoding]
10654if {$tclencoding == {}} {
10655    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
10656}
10657
10658set gui_encoding [encoding system]
10659catch {
10660    set enc [exec git config --get gui.encoding]
10661    if {$enc ne {}} {
10662        set tclenc [tcl_encoding $enc]
10663        if {$tclenc ne {}} {
10664            set gui_encoding $tclenc
10665        } else {
10666            puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
10667        }
10668    }
10669}
10670
10671set mainfont {Helvetica 9}
10672set textfont {Courier 9}
10673set uifont {Helvetica 9 bold}
10674set tabstop 8
10675set findmergefiles 0
10676set maxgraphpct 50
10677set maxwidth 16
10678set revlistorder 0
10679set fastdate 0
10680set uparrowlen 5
10681set downarrowlen 5
10682set mingaplen 100
10683set cmitmode "patch"
10684set wrapcomment "none"
10685set showneartags 1
10686set maxrefs 20
10687set maxlinelen 200
10688set showlocalchanges 1
10689set limitdiffs 1
10690set datetimeformat "%Y-%m-%d %H:%M:%S"
10691set autoselect 1
10692set perfile_attrs 0
10693
10694set extdifftool "meld"
10695
10696set colors {green red blue magenta darkgrey brown orange}
10697set bgcolor white
10698set fgcolor black
10699set diffcolors {red "#00a000" blue}
10700set diffcontext 3
10701set ignorespace 0
10702set selectbgcolor gray85
10703set markbgcolor "#e0e0ff"
10704
10705set circlecolors {white blue gray blue blue}
10706
10707# button for popping up context menus
10708if {[tk windowingsystem] eq "aqua"} {
10709    set ctxbut <Button-2>
10710} else {
10711    set ctxbut <Button-3>
10712}
10713
10714## For msgcat loading, first locate the installation location.
10715if { [info exists ::env(GITK_MSGSDIR)] } {
10716    ## Msgsdir was manually set in the environment.
10717    set gitk_msgsdir $::env(GITK_MSGSDIR)
10718} else {
10719    ## Let's guess the prefix from argv0.
10720    set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
10721    set gitk_libdir [file join $gitk_prefix share gitk lib]
10722    set gitk_msgsdir [file join $gitk_libdir msgs]
10723    unset gitk_prefix
10724}
10725
10726## Internationalization (i18n) through msgcat and gettext. See
10727## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
10728package require msgcat
10729namespace import ::msgcat::mc
10730## And eventually load the actual message catalog
10731::msgcat::mcload $gitk_msgsdir
10732
10733catch {source ~/.gitk}
10734
10735font create optionfont -family sans-serif -size -12
10736
10737parsefont mainfont $mainfont
10738eval font create mainfont [fontflags mainfont]
10739eval font create mainfontbold [fontflags mainfont 1]
10740
10741parsefont textfont $textfont
10742eval font create textfont [fontflags textfont]
10743eval font create textfontbold [fontflags textfont 1]
10744
10745parsefont uifont $uifont
10746eval font create uifont [fontflags uifont]
10747
10748setoptions
10749
10750# check that we can find a .git directory somewhere...
10751if {[catch {set gitdir [gitdir]}]} {
10752    show_error {} . [mc "Cannot find a git repository here."]
10753    exit 1
10754}
10755if {![file isdirectory $gitdir]} {
10756    show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
10757    exit 1
10758}
10759
10760set selecthead {}
10761set selectheadid {}
10762
10763set revtreeargs {}
10764set cmdline_files {}
10765set i 0
10766set revtreeargscmd {}
10767foreach arg $argv {
10768    switch -glob -- $arg {
10769        "" { }
10770        "--" {
10771            set cmdline_files [lrange $argv [expr {$i + 1}] end]
10772            break
10773        }
10774        "--select-commit=*" {
10775            set selecthead [string range $arg 16 end]
10776        }
10777        "--argscmd=*" {
10778            set revtreeargscmd [string range $arg 10 end]
10779        }
10780        default {
10781            lappend revtreeargs $arg
10782        }
10783    }
10784    incr i
10785}
10786
10787if {$selecthead eq "HEAD"} {
10788    set selecthead {}
10789}
10790
10791if {$i >= [llength $argv] && $revtreeargs ne {}} {
10792    # no -- on command line, but some arguments (other than --argscmd)
10793    if {[catch {
10794        set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
10795        set cmdline_files [split $f "\n"]
10796        set n [llength $cmdline_files]
10797        set revtreeargs [lrange $revtreeargs 0 end-$n]
10798        # Unfortunately git rev-parse doesn't produce an error when
10799        # something is both a revision and a filename.  To be consistent
10800        # with git log and git rev-list, check revtreeargs for filenames.
10801        foreach arg $revtreeargs {
10802            if {[file exists $arg]} {
10803                show_error {} . [mc "Ambiguous argument '%s': both revision\
10804                                 and filename" $arg]
10805                exit 1
10806            }
10807        }
10808    } err]} {
10809        # unfortunately we get both stdout and stderr in $err,
10810        # so look for "fatal:".
10811        set i [string first "fatal:" $err]
10812        if {$i > 0} {
10813            set err [string range $err [expr {$i + 6}] end]
10814        }
10815        show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
10816        exit 1
10817    }
10818}
10819
10820set nullid "0000000000000000000000000000000000000000"
10821set nullid2 "0000000000000000000000000000000000000001"
10822set nullfile "/dev/null"
10823
10824set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
10825
10826set runq {}
10827set history {}
10828set historyindex 0
10829set fh_serial 0
10830set nhl_names {}
10831set highlight_paths {}
10832set findpattern {}
10833set searchdirn -forwards
10834set boldids {}
10835set boldnameids {}
10836set diffelide {0 0}
10837set markingmatches 0
10838set linkentercount 0
10839set need_redisplay 0
10840set nrows_drawn 0
10841set firsttabstop 0
10842
10843set nextviewnum 1
10844set curview 0
10845set selectedview 0
10846set selectedhlview [mc "None"]
10847set highlight_related [mc "None"]
10848set highlight_files {}
10849set viewfiles(0) {}
10850set viewperm(0) 0
10851set viewargs(0) {}
10852set viewargscmd(0) {}
10853
10854set selectedline {}
10855set numcommits 0
10856set loginstance 0
10857set cmdlineok 0
10858set stopped 0
10859set stuffsaved 0
10860set patchnum 0
10861set lserial 0
10862set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
10863setcoords
10864makewindow
10865# wait for the window to become visible
10866tkwait visibility .
10867wm title . "[file tail $argv0]: [file tail [pwd]]"
10868readrefs
10869
10870if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
10871    # create a view for the files/dirs specified on the command line
10872    set curview 1
10873    set selectedview 1
10874    set nextviewnum 2
10875    set viewname(1) [mc "Command line"]
10876    set viewfiles(1) $cmdline_files
10877    set viewargs(1) $revtreeargs
10878    set viewargscmd(1) $revtreeargscmd
10879    set viewperm(1) 0
10880    set vdatemode(1) 0
10881    addviewmenu 1
10882    .bar.view entryconf [mca "Edit view..."] -state normal
10883    .bar.view entryconf [mca "Delete view"] -state normal
10884}
10885
10886if {[info exists permviews]} {
10887    foreach v $permviews {
10888        set n $nextviewnum
10889        incr nextviewnum
10890        set viewname($n) [lindex $v 0]
10891        set viewfiles($n) [lindex $v 1]
10892        set viewargs($n) [lindex $v 2]
10893        set viewargscmd($n) [lindex $v 3]
10894        set viewperm($n) 1
10895        addviewmenu $n
10896    }
10897}
10898getcommits {}