gitkon commit gitk: Highlight only when search type is "containing:". (8b39e04)
   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
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 [expr {$gdttype eq [mc "containing:"]}]
6290    set findcurline $l
6291    selectline $l 1
6292    if {$markingmatches &&
6293        ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
6294        # highlight the matches in the comments
6295        set f [$ctext get 1.0 $commentend]
6296        set matches [findmatches $f]
6297        foreach match $matches {
6298            set start [lindex $match 0]
6299            set end [expr {[lindex $match 1] + 1}]
6300            $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6301        }
6302    }
6303    drawvisible
6304}
6305
6306# mark the bits of a headline or author that match a find string
6307proc markmatches {canv l str tag matches font row} {
6308    global selectedline
6309
6310    set bbox [$canv bbox $tag]
6311    set x0 [lindex $bbox 0]
6312    set y0 [lindex $bbox 1]
6313    set y1 [lindex $bbox 3]
6314    foreach match $matches {
6315        set start [lindex $match 0]
6316        set end [lindex $match 1]
6317        if {$start > $end} continue
6318        set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6319        set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6320        set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6321                   [expr {$x0+$xlen+2}] $y1 \
6322                   -outline {} -tags [list match$l matches] -fill yellow]
6323        $canv lower $t
6324        if {$row == $selectedline} {
6325            $canv raise $t secsel
6326        }
6327    }
6328}
6329
6330proc unmarkmatches {} {
6331    global markingmatches
6332
6333    allcanvs delete matches
6334    set markingmatches 0
6335    stopfinding
6336}
6337
6338proc selcanvline {w x y} {
6339    global canv canvy0 ctext linespc
6340    global rowtextx
6341    set ymax [lindex [$canv cget -scrollregion] 3]
6342    if {$ymax == {}} return
6343    set yfrac [lindex [$canv yview] 0]
6344    set y [expr {$y + $yfrac * $ymax}]
6345    set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6346    if {$l < 0} {
6347        set l 0
6348    }
6349    if {$w eq $canv} {
6350        set xmax [lindex [$canv cget -scrollregion] 2]
6351        set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6352        if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
6353    }
6354    unmarkmatches
6355    selectline $l 1
6356}
6357
6358proc commit_descriptor {p} {
6359    global commitinfo
6360    if {![info exists commitinfo($p)]} {
6361        getcommit $p
6362    }
6363    set l "..."
6364    if {[llength $commitinfo($p)] > 1} {
6365        set l [lindex $commitinfo($p) 0]
6366    }
6367    return "$p ($l)\n"
6368}
6369
6370# append some text to the ctext widget, and make any SHA1 ID
6371# that we know about be a clickable link.
6372proc appendwithlinks {text tags} {
6373    global ctext linknum curview
6374
6375    set start [$ctext index "end - 1c"]
6376    $ctext insert end $text $tags
6377    set links [regexp -indices -all -inline {\m[0-9a-f]{6,40}\M} $text]
6378    foreach l $links {
6379        set s [lindex $l 0]
6380        set e [lindex $l 1]
6381        set linkid [string range $text $s $e]
6382        incr e
6383        $ctext tag delete link$linknum
6384        $ctext tag add link$linknum "$start + $s c" "$start + $e c"
6385        setlink $linkid link$linknum
6386        incr linknum
6387    }
6388}
6389
6390proc setlink {id lk} {
6391    global curview ctext pendinglinks
6392
6393    set known 0
6394    if {[string length $id] < 40} {
6395        set matches [longid $id]
6396        if {[llength $matches] > 0} {
6397            if {[llength $matches] > 1} return
6398            set known 1
6399            set id [lindex $matches 0]
6400        }
6401    } else {
6402        set known [commitinview $id $curview]
6403    }
6404    if {$known} {
6405        $ctext tag conf $lk -foreground blue -underline 1
6406        $ctext tag bind $lk <1> [list selbyid $id]
6407        $ctext tag bind $lk <Enter> {linkcursor %W 1}
6408        $ctext tag bind $lk <Leave> {linkcursor %W -1}
6409    } else {
6410        lappend pendinglinks($id) $lk
6411        interestedin $id {makelink %P}
6412    }
6413}
6414
6415proc makelink {id} {
6416    global pendinglinks
6417
6418    if {![info exists pendinglinks($id)]} return
6419    foreach lk $pendinglinks($id) {
6420        setlink $id $lk
6421    }
6422    unset pendinglinks($id)
6423}
6424
6425proc linkcursor {w inc} {
6426    global linkentercount curtextcursor
6427
6428    if {[incr linkentercount $inc] > 0} {
6429        $w configure -cursor hand2
6430    } else {
6431        $w configure -cursor $curtextcursor
6432        if {$linkentercount < 0} {
6433            set linkentercount 0
6434        }
6435    }
6436}
6437
6438proc viewnextline {dir} {
6439    global canv linespc
6440
6441    $canv delete hover
6442    set ymax [lindex [$canv cget -scrollregion] 3]
6443    set wnow [$canv yview]
6444    set wtop [expr {[lindex $wnow 0] * $ymax}]
6445    set newtop [expr {$wtop + $dir * $linespc}]
6446    if {$newtop < 0} {
6447        set newtop 0
6448    } elseif {$newtop > $ymax} {
6449        set newtop $ymax
6450    }
6451    allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6452}
6453
6454# add a list of tag or branch names at position pos
6455# returns the number of names inserted
6456proc appendrefs {pos ids var} {
6457    global ctext linknum curview $var maxrefs
6458
6459    if {[catch {$ctext index $pos}]} {
6460        return 0
6461    }
6462    $ctext conf -state normal
6463    $ctext delete $pos "$pos lineend"
6464    set tags {}
6465    foreach id $ids {
6466        foreach tag [set $var\($id\)] {
6467            lappend tags [list $tag $id]
6468        }
6469    }
6470    if {[llength $tags] > $maxrefs} {
6471        $ctext insert $pos "many ([llength $tags])"
6472    } else {
6473        set tags [lsort -index 0 -decreasing $tags]
6474        set sep {}
6475        foreach ti $tags {
6476            set id [lindex $ti 1]
6477            set lk link$linknum
6478            incr linknum
6479            $ctext tag delete $lk
6480            $ctext insert $pos $sep
6481            $ctext insert $pos [lindex $ti 0] $lk
6482            setlink $id $lk
6483            set sep ", "
6484        }
6485    }
6486    $ctext conf -state disabled
6487    return [llength $tags]
6488}
6489
6490# called when we have finished computing the nearby tags
6491proc dispneartags {delay} {
6492    global selectedline currentid showneartags tagphase
6493
6494    if {$selectedline eq {} || !$showneartags} return
6495    after cancel dispnexttag
6496    if {$delay} {
6497        after 200 dispnexttag
6498        set tagphase -1
6499    } else {
6500        after idle dispnexttag
6501        set tagphase 0
6502    }
6503}
6504
6505proc dispnexttag {} {
6506    global selectedline currentid showneartags tagphase ctext
6507
6508    if {$selectedline eq {} || !$showneartags} return
6509    switch -- $tagphase {
6510        0 {
6511            set dtags [desctags $currentid]
6512            if {$dtags ne {}} {
6513                appendrefs precedes $dtags idtags
6514            }
6515        }
6516        1 {
6517            set atags [anctags $currentid]
6518            if {$atags ne {}} {
6519                appendrefs follows $atags idtags
6520            }
6521        }
6522        2 {
6523            set dheads [descheads $currentid]
6524            if {$dheads ne {}} {
6525                if {[appendrefs branch $dheads idheads] > 1
6526                    && [$ctext get "branch -3c"] eq "h"} {
6527                    # turn "Branch" into "Branches"
6528                    $ctext conf -state normal
6529                    $ctext insert "branch -2c" "es"
6530                    $ctext conf -state disabled
6531                }
6532            }
6533        }
6534    }
6535    if {[incr tagphase] <= 2} {
6536        after idle dispnexttag
6537    }
6538}
6539
6540proc make_secsel {id} {
6541    global linehtag linentag linedtag canv canv2 canv3
6542
6543    if {![info exists linehtag($id)]} return
6544    $canv delete secsel
6545    set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
6546               -tags secsel -fill [$canv cget -selectbackground]]
6547    $canv lower $t
6548    $canv2 delete secsel
6549    set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
6550               -tags secsel -fill [$canv2 cget -selectbackground]]
6551    $canv2 lower $t
6552    $canv3 delete secsel
6553    set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
6554               -tags secsel -fill [$canv3 cget -selectbackground]]
6555    $canv3 lower $t
6556}
6557
6558proc selectline {l isnew {desired_loc {}}} {
6559    global canv ctext commitinfo selectedline
6560    global canvy0 linespc parents children curview
6561    global currentid sha1entry
6562    global commentend idtags linknum
6563    global mergemax numcommits pending_select
6564    global cmitmode showneartags allcommits
6565    global targetrow targetid lastscrollrows
6566    global autoselect jump_to_here
6567
6568    catch {unset pending_select}
6569    $canv delete hover
6570    normalline
6571    unsel_reflist
6572    stopfinding
6573    if {$l < 0 || $l >= $numcommits} return
6574    set id [commitonrow $l]
6575    set targetid $id
6576    set targetrow $l
6577    set selectedline $l
6578    set currentid $id
6579    if {$lastscrollrows < $numcommits} {
6580        setcanvscroll
6581    }
6582
6583    set y [expr {$canvy0 + $l * $linespc}]
6584    set ymax [lindex [$canv cget -scrollregion] 3]
6585    set ytop [expr {$y - $linespc - 1}]
6586    set ybot [expr {$y + $linespc + 1}]
6587    set wnow [$canv yview]
6588    set wtop [expr {[lindex $wnow 0] * $ymax}]
6589    set wbot [expr {[lindex $wnow 1] * $ymax}]
6590    set wh [expr {$wbot - $wtop}]
6591    set newtop $wtop
6592    if {$ytop < $wtop} {
6593        if {$ybot < $wtop} {
6594            set newtop [expr {$y - $wh / 2.0}]
6595        } else {
6596            set newtop $ytop
6597            if {$newtop > $wtop - $linespc} {
6598                set newtop [expr {$wtop - $linespc}]
6599            }
6600        }
6601    } elseif {$ybot > $wbot} {
6602        if {$ytop > $wbot} {
6603            set newtop [expr {$y - $wh / 2.0}]
6604        } else {
6605            set newtop [expr {$ybot - $wh}]
6606            if {$newtop < $wtop + $linespc} {
6607                set newtop [expr {$wtop + $linespc}]
6608            }
6609        }
6610    }
6611    if {$newtop != $wtop} {
6612        if {$newtop < 0} {
6613            set newtop 0
6614        }
6615        allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6616        drawvisible
6617    }
6618
6619    make_secsel $id
6620
6621    if {$isnew} {
6622        addtohistory [list selbyid $id]
6623    }
6624
6625    $sha1entry delete 0 end
6626    $sha1entry insert 0 $id
6627    if {$autoselect} {
6628        $sha1entry selection from 0
6629        $sha1entry selection to end
6630    }
6631    rhighlight_sel $id
6632
6633    $ctext conf -state normal
6634    clear_ctext
6635    set linknum 0
6636    if {![info exists commitinfo($id)]} {
6637        getcommit $id
6638    }
6639    set info $commitinfo($id)
6640    set date [formatdate [lindex $info 2]]
6641    $ctext insert end "[mc "Author"]: [lindex $info 1]  $date\n"
6642    set date [formatdate [lindex $info 4]]
6643    $ctext insert end "[mc "Committer"]: [lindex $info 3]  $date\n"
6644    if {[info exists idtags($id)]} {
6645        $ctext insert end [mc "Tags:"]
6646        foreach tag $idtags($id) {
6647            $ctext insert end " $tag"
6648        }
6649        $ctext insert end "\n"
6650    }
6651
6652    set headers {}
6653    set olds $parents($curview,$id)
6654    if {[llength $olds] > 1} {
6655        set np 0
6656        foreach p $olds {
6657            if {$np >= $mergemax} {
6658                set tag mmax
6659            } else {
6660                set tag m$np
6661            }
6662            $ctext insert end "[mc "Parent"]: " $tag
6663            appendwithlinks [commit_descriptor $p] {}
6664            incr np
6665        }
6666    } else {
6667        foreach p $olds {
6668            append headers "[mc "Parent"]: [commit_descriptor $p]"
6669        }
6670    }
6671
6672    foreach c $children($curview,$id) {
6673        append headers "[mc "Child"]:  [commit_descriptor $c]"
6674    }
6675
6676    # make anything that looks like a SHA1 ID be a clickable link
6677    appendwithlinks $headers {}
6678    if {$showneartags} {
6679        if {![info exists allcommits]} {
6680            getallcommits
6681        }
6682        $ctext insert end "[mc "Branch"]: "
6683        $ctext mark set branch "end -1c"
6684        $ctext mark gravity branch left
6685        $ctext insert end "\n[mc "Follows"]: "
6686        $ctext mark set follows "end -1c"
6687        $ctext mark gravity follows left
6688        $ctext insert end "\n[mc "Precedes"]: "
6689        $ctext mark set precedes "end -1c"
6690        $ctext mark gravity precedes left
6691        $ctext insert end "\n"
6692        dispneartags 1
6693    }
6694    $ctext insert end "\n"
6695    set comment [lindex $info 5]
6696    if {[string first "\r" $comment] >= 0} {
6697        set comment [string map {"\r" "\n    "} $comment]
6698    }
6699    appendwithlinks $comment {comment}
6700
6701    $ctext tag remove found 1.0 end
6702    $ctext conf -state disabled
6703    set commentend [$ctext index "end - 1c"]
6704
6705    set jump_to_here $desired_loc
6706    init_flist [mc "Comments"]
6707    if {$cmitmode eq "tree"} {
6708        gettree $id
6709    } elseif {[llength $olds] <= 1} {
6710        startdiff $id
6711    } else {
6712        mergediff $id
6713    }
6714}
6715
6716proc selfirstline {} {
6717    unmarkmatches
6718    selectline 0 1
6719}
6720
6721proc sellastline {} {
6722    global numcommits
6723    unmarkmatches
6724    set l [expr {$numcommits - 1}]
6725    selectline $l 1
6726}
6727
6728proc selnextline {dir} {
6729    global selectedline
6730    focus .
6731    if {$selectedline eq {}} return
6732    set l [expr {$selectedline + $dir}]
6733    unmarkmatches
6734    selectline $l 1
6735}
6736
6737proc selnextpage {dir} {
6738    global canv linespc selectedline numcommits
6739
6740    set lpp [expr {([winfo height $canv] - 2) / $linespc}]
6741    if {$lpp < 1} {
6742        set lpp 1
6743    }
6744    allcanvs yview scroll [expr {$dir * $lpp}] units
6745    drawvisible
6746    if {$selectedline eq {}} return
6747    set l [expr {$selectedline + $dir * $lpp}]
6748    if {$l < 0} {
6749        set l 0
6750    } elseif {$l >= $numcommits} {
6751        set l [expr $numcommits - 1]
6752    }
6753    unmarkmatches
6754    selectline $l 1
6755}
6756
6757proc unselectline {} {
6758    global selectedline currentid
6759
6760    set selectedline {}
6761    catch {unset currentid}
6762    allcanvs delete secsel
6763    rhighlight_none
6764}
6765
6766proc reselectline {} {
6767    global selectedline
6768
6769    if {$selectedline ne {}} {
6770        selectline $selectedline 0
6771    }
6772}
6773
6774proc addtohistory {cmd} {
6775    global history historyindex curview
6776
6777    set elt [list $curview $cmd]
6778    if {$historyindex > 0
6779        && [lindex $history [expr {$historyindex - 1}]] == $elt} {
6780        return
6781    }
6782
6783    if {$historyindex < [llength $history]} {
6784        set history [lreplace $history $historyindex end $elt]
6785    } else {
6786        lappend history $elt
6787    }
6788    incr historyindex
6789    if {$historyindex > 1} {
6790        .tf.bar.leftbut conf -state normal
6791    } else {
6792        .tf.bar.leftbut conf -state disabled
6793    }
6794    .tf.bar.rightbut conf -state disabled
6795}
6796
6797proc godo {elt} {
6798    global curview
6799
6800    set view [lindex $elt 0]
6801    set cmd [lindex $elt 1]
6802    if {$curview != $view} {
6803        showview $view
6804    }
6805    eval $cmd
6806}
6807
6808proc goback {} {
6809    global history historyindex
6810    focus .
6811
6812    if {$historyindex > 1} {
6813        incr historyindex -1
6814        godo [lindex $history [expr {$historyindex - 1}]]
6815        .tf.bar.rightbut conf -state normal
6816    }
6817    if {$historyindex <= 1} {
6818        .tf.bar.leftbut conf -state disabled
6819    }
6820}
6821
6822proc goforw {} {
6823    global history historyindex
6824    focus .
6825
6826    if {$historyindex < [llength $history]} {
6827        set cmd [lindex $history $historyindex]
6828        incr historyindex
6829        godo $cmd
6830        .tf.bar.leftbut conf -state normal
6831    }
6832    if {$historyindex >= [llength $history]} {
6833        .tf.bar.rightbut conf -state disabled
6834    }
6835}
6836
6837proc gettree {id} {
6838    global treefilelist treeidlist diffids diffmergeid treepending
6839    global nullid nullid2
6840
6841    set diffids $id
6842    catch {unset diffmergeid}
6843    if {![info exists treefilelist($id)]} {
6844        if {![info exists treepending]} {
6845            if {$id eq $nullid} {
6846                set cmd [list | git ls-files]
6847            } elseif {$id eq $nullid2} {
6848                set cmd [list | git ls-files --stage -t]
6849            } else {
6850                set cmd [list | git ls-tree -r $id]
6851            }
6852            if {[catch {set gtf [open $cmd r]}]} {
6853                return
6854            }
6855            set treepending $id
6856            set treefilelist($id) {}
6857            set treeidlist($id) {}
6858            fconfigure $gtf -blocking 0 -encoding binary
6859            filerun $gtf [list gettreeline $gtf $id]
6860        }
6861    } else {
6862        setfilelist $id
6863    }
6864}
6865
6866proc gettreeline {gtf id} {
6867    global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
6868
6869    set nl 0
6870    while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
6871        if {$diffids eq $nullid} {
6872            set fname $line
6873        } else {
6874            set i [string first "\t" $line]
6875            if {$i < 0} continue
6876            set fname [string range $line [expr {$i+1}] end]
6877            set line [string range $line 0 [expr {$i-1}]]
6878            if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
6879            set sha1 [lindex $line 2]
6880            lappend treeidlist($id) $sha1
6881        }
6882        if {[string index $fname 0] eq "\""} {
6883            set fname [lindex $fname 0]
6884        }
6885        set fname [encoding convertfrom $fname]
6886        lappend treefilelist($id) $fname
6887    }
6888    if {![eof $gtf]} {
6889        return [expr {$nl >= 1000? 2: 1}]
6890    }
6891    close $gtf
6892    unset treepending
6893    if {$cmitmode ne "tree"} {
6894        if {![info exists diffmergeid]} {
6895            gettreediffs $diffids
6896        }
6897    } elseif {$id ne $diffids} {
6898        gettree $diffids
6899    } else {
6900        setfilelist $id
6901    }
6902    return 0
6903}
6904
6905proc showfile {f} {
6906    global treefilelist treeidlist diffids nullid nullid2
6907    global ctext_file_names ctext_file_lines
6908    global ctext commentend
6909
6910    set i [lsearch -exact $treefilelist($diffids) $f]
6911    if {$i < 0} {
6912        puts "oops, $f not in list for id $diffids"
6913        return
6914    }
6915    if {$diffids eq $nullid} {
6916        if {[catch {set bf [open $f r]} err]} {
6917            puts "oops, can't read $f: $err"
6918            return
6919        }
6920    } else {
6921        set blob [lindex $treeidlist($diffids) $i]
6922        if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
6923            puts "oops, error reading blob $blob: $err"
6924            return
6925        }
6926    }
6927    fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
6928    filerun $bf [list getblobline $bf $diffids]
6929    $ctext config -state normal
6930    clear_ctext $commentend
6931    lappend ctext_file_names $f
6932    lappend ctext_file_lines [lindex [split $commentend "."] 0]
6933    $ctext insert end "\n"
6934    $ctext insert end "$f\n" filesep
6935    $ctext config -state disabled
6936    $ctext yview $commentend
6937    settabs 0
6938}
6939
6940proc getblobline {bf id} {
6941    global diffids cmitmode ctext
6942
6943    if {$id ne $diffids || $cmitmode ne "tree"} {
6944        catch {close $bf}
6945        return 0
6946    }
6947    $ctext config -state normal
6948    set nl 0
6949    while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
6950        $ctext insert end "$line\n"
6951    }
6952    if {[eof $bf]} {
6953        global jump_to_here ctext_file_names commentend
6954
6955        # delete last newline
6956        $ctext delete "end - 2c" "end - 1c"
6957        close $bf
6958        if {$jump_to_here ne {} &&
6959            [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
6960            set lnum [expr {[lindex $jump_to_here 1] +
6961                            [lindex [split $commentend .] 0]}]
6962            mark_ctext_line $lnum
6963        }
6964        return 0
6965    }
6966    $ctext config -state disabled
6967    return [expr {$nl >= 1000? 2: 1}]
6968}
6969
6970proc mark_ctext_line {lnum} {
6971    global ctext markbgcolor
6972
6973    $ctext tag delete omark
6974    $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
6975    $ctext tag conf omark -background $markbgcolor
6976    $ctext see $lnum.0
6977}
6978
6979proc mergediff {id} {
6980    global diffmergeid
6981    global diffids treediffs
6982    global parents curview
6983
6984    set diffmergeid $id
6985    set diffids $id
6986    set treediffs($id) {}
6987    set np [llength $parents($curview,$id)]
6988    settabs $np
6989    getblobdiffs $id
6990}
6991
6992proc startdiff {ids} {
6993    global treediffs diffids treepending diffmergeid nullid nullid2
6994
6995    settabs 1
6996    set diffids $ids
6997    catch {unset diffmergeid}
6998    if {![info exists treediffs($ids)] ||
6999        [lsearch -exact $ids $nullid] >= 0 ||
7000        [lsearch -exact $ids $nullid2] >= 0} {
7001        if {![info exists treepending]} {
7002            gettreediffs $ids
7003        }
7004    } else {
7005        addtocflist $ids
7006    }
7007}
7008
7009proc path_filter {filter name} {
7010    foreach p $filter {
7011        set l [string length $p]
7012        if {[string index $p end] eq "/"} {
7013            if {[string compare -length $l $p $name] == 0} {
7014                return 1
7015            }
7016        } else {
7017            if {[string compare -length $l $p $name] == 0 &&
7018                ([string length $name] == $l ||
7019                 [string index $name $l] eq "/")} {
7020                return 1
7021            }
7022        }
7023    }
7024    return 0
7025}
7026
7027proc addtocflist {ids} {
7028    global treediffs
7029
7030    add_flist $treediffs($ids)
7031    getblobdiffs $ids
7032}
7033
7034proc diffcmd {ids flags} {
7035    global nullid nullid2
7036
7037    set i [lsearch -exact $ids $nullid]
7038    set j [lsearch -exact $ids $nullid2]
7039    if {$i >= 0} {
7040        if {[llength $ids] > 1 && $j < 0} {
7041            # comparing working directory with some specific revision
7042            set cmd [concat | git diff-index $flags]
7043            if {$i == 0} {
7044                lappend cmd -R [lindex $ids 1]
7045            } else {
7046                lappend cmd [lindex $ids 0]
7047            }
7048        } else {
7049            # comparing working directory with index
7050            set cmd [concat | git diff-files $flags]
7051            if {$j == 1} {
7052                lappend cmd -R
7053            }
7054        }
7055    } elseif {$j >= 0} {
7056        set cmd [concat | git diff-index --cached $flags]
7057        if {[llength $ids] > 1} {
7058            # comparing index with specific revision
7059            if {$i == 0} {
7060                lappend cmd -R [lindex $ids 1]
7061            } else {
7062                lappend cmd [lindex $ids 0]
7063            }
7064        } else {
7065            # comparing index with HEAD
7066            lappend cmd HEAD
7067        }
7068    } else {
7069        set cmd [concat | git diff-tree -r $flags $ids]
7070    }
7071    return $cmd
7072}
7073
7074proc gettreediffs {ids} {
7075    global treediff treepending
7076
7077    if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
7078
7079    set treepending $ids
7080    set treediff {}
7081    fconfigure $gdtf -blocking 0 -encoding binary
7082    filerun $gdtf [list gettreediffline $gdtf $ids]
7083}
7084
7085proc gettreediffline {gdtf ids} {
7086    global treediff treediffs treepending diffids diffmergeid
7087    global cmitmode vfilelimit curview limitdiffs perfile_attrs
7088
7089    set nr 0
7090    set sublist {}
7091    set max 1000
7092    if {$perfile_attrs} {
7093        # cache_gitattr is slow, and even slower on win32 where we
7094        # have to invoke it for only about 30 paths at a time
7095        set max 500
7096        if {[tk windowingsystem] == "win32"} {
7097            set max 120
7098        }
7099    }
7100    while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7101        set i [string first "\t" $line]
7102        if {$i >= 0} {
7103            set file [string range $line [expr {$i+1}] end]
7104            if {[string index $file 0] eq "\""} {
7105                set file [lindex $file 0]
7106            }
7107            set file [encoding convertfrom $file]
7108            if {$file ne [lindex $treediff end]} {
7109                lappend treediff $file
7110                lappend sublist $file
7111            }
7112        }
7113    }
7114    if {$perfile_attrs} {
7115        cache_gitattr encoding $sublist
7116    }
7117    if {![eof $gdtf]} {
7118        return [expr {$nr >= $max? 2: 1}]
7119    }
7120    close $gdtf
7121    if {$limitdiffs && $vfilelimit($curview) ne {}} {
7122        set flist {}
7123        foreach f $treediff {
7124            if {[path_filter $vfilelimit($curview) $f]} {
7125                lappend flist $f
7126            }
7127        }
7128        set treediffs($ids) $flist
7129    } else {
7130        set treediffs($ids) $treediff
7131    }
7132    unset treepending
7133    if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7134        gettree $diffids
7135    } elseif {$ids != $diffids} {
7136        if {![info exists diffmergeid]} {
7137            gettreediffs $diffids
7138        }
7139    } else {
7140        addtocflist $ids
7141    }
7142    return 0
7143}
7144
7145# empty string or positive integer
7146proc diffcontextvalidate {v} {
7147    return [regexp {^(|[1-9][0-9]*)$} $v]
7148}
7149
7150proc diffcontextchange {n1 n2 op} {
7151    global diffcontextstring diffcontext
7152
7153    if {[string is integer -strict $diffcontextstring]} {
7154        if {$diffcontextstring > 0} {
7155            set diffcontext $diffcontextstring
7156            reselectline
7157        }
7158    }
7159}
7160
7161proc changeignorespace {} {
7162    reselectline
7163}
7164
7165proc getblobdiffs {ids} {
7166    global blobdifffd diffids env
7167    global diffinhdr treediffs
7168    global diffcontext
7169    global ignorespace
7170    global limitdiffs vfilelimit curview
7171    global diffencoding targetline diffnparents
7172
7173    set cmd [diffcmd $ids "-p -C --cc --no-commit-id -U$diffcontext"]
7174    if {$ignorespace} {
7175        append cmd " -w"
7176    }
7177    if {$limitdiffs && $vfilelimit($curview) ne {}} {
7178        set cmd [concat $cmd -- $vfilelimit($curview)]
7179    }
7180    if {[catch {set bdf [open $cmd r]} err]} {
7181        error_popup [mc "Error getting diffs: %s" $err]
7182        return
7183    }
7184    set targetline {}
7185    set diffnparents 0
7186    set diffinhdr 0
7187    set diffencoding [get_path_encoding {}]
7188    fconfigure $bdf -blocking 0 -encoding binary
7189    set blobdifffd($ids) $bdf
7190    filerun $bdf [list getblobdiffline $bdf $diffids]
7191}
7192
7193proc setinlist {var i val} {
7194    global $var
7195
7196    while {[llength [set $var]] < $i} {
7197        lappend $var {}
7198    }
7199    if {[llength [set $var]] == $i} {
7200        lappend $var $val
7201    } else {
7202        lset $var $i $val
7203    }
7204}
7205
7206proc makediffhdr {fname ids} {
7207    global ctext curdiffstart treediffs diffencoding
7208    global ctext_file_names jump_to_here targetline diffline
7209
7210    set fname [encoding convertfrom $fname]
7211    set diffencoding [get_path_encoding $fname]
7212    set i [lsearch -exact $treediffs($ids) $fname]
7213    if {$i >= 0} {
7214        setinlist difffilestart $i $curdiffstart
7215    }
7216    lset ctext_file_names end $fname
7217    set l [expr {(78 - [string length $fname]) / 2}]
7218    set pad [string range "----------------------------------------" 1 $l]
7219    $ctext insert $curdiffstart "$pad $fname $pad" filesep
7220    set targetline {}
7221    if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
7222        set targetline [lindex $jump_to_here 1]
7223    }
7224    set diffline 0
7225}
7226
7227proc getblobdiffline {bdf ids} {
7228    global diffids blobdifffd ctext curdiffstart
7229    global diffnexthead diffnextnote difffilestart
7230    global ctext_file_names ctext_file_lines
7231    global diffinhdr treediffs mergemax diffnparents
7232    global diffencoding jump_to_here targetline diffline
7233
7234    set nr 0
7235    $ctext conf -state normal
7236    while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
7237        if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
7238            close $bdf
7239            return 0
7240        }
7241        if {![string compare -length 5 "diff " $line]} {
7242            if {![regexp {^diff (--cc|--git) } $line m type]} {
7243                set line [encoding convertfrom $line]
7244                $ctext insert end "$line\n" hunksep
7245                continue
7246            }
7247            # start of a new file
7248            set diffinhdr 1
7249            $ctext insert end "\n"
7250            set curdiffstart [$ctext index "end - 1c"]
7251            lappend ctext_file_names ""
7252            lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7253            $ctext insert end "\n" filesep
7254
7255            if {$type eq "--cc"} {
7256                # start of a new file in a merge diff
7257                set fname [string range $line 10 end]
7258                if {[lsearch -exact $treediffs($ids) $fname] < 0} {
7259                    lappend treediffs($ids) $fname
7260                    add_flist [list $fname]
7261                }
7262
7263            } else {
7264                set line [string range $line 11 end]
7265                # If the name hasn't changed the length will be odd,
7266                # the middle char will be a space, and the two bits either
7267                # side will be a/name and b/name, or "a/name" and "b/name".
7268                # If the name has changed we'll get "rename from" and
7269                # "rename to" or "copy from" and "copy to" lines following
7270                # this, and we'll use them to get the filenames.
7271                # This complexity is necessary because spaces in the
7272                # filename(s) don't get escaped.
7273                set l [string length $line]
7274                set i [expr {$l / 2}]
7275                if {!(($l & 1) && [string index $line $i] eq " " &&
7276                      [string range $line 2 [expr {$i - 1}]] eq \
7277                          [string range $line [expr {$i + 3}] end])} {
7278                    continue
7279                }
7280                # unescape if quoted and chop off the a/ from the front
7281                if {[string index $line 0] eq "\""} {
7282                    set fname [string range [lindex $line 0] 2 end]
7283                } else {
7284                    set fname [string range $line 2 [expr {$i - 1}]]
7285                }
7286            }
7287            makediffhdr $fname $ids
7288
7289        } elseif {![string compare -length 16 "* Unmerged path " $line]} {
7290            set fname [encoding convertfrom [string range $line 16 end]]
7291            $ctext insert end "\n"
7292            set curdiffstart [$ctext index "end - 1c"]
7293            lappend ctext_file_names $fname
7294            lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7295            $ctext insert end "$line\n" filesep
7296            set i [lsearch -exact $treediffs($ids) $fname]
7297            if {$i >= 0} {
7298                setinlist difffilestart $i $curdiffstart
7299            }
7300
7301        } elseif {![string compare -length 2 "@@" $line]} {
7302            regexp {^@@+} $line ats
7303            set line [encoding convertfrom $diffencoding $line]
7304            $ctext insert end "$line\n" hunksep
7305            if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
7306                set diffline $nl
7307            }
7308            set diffnparents [expr {[string length $ats] - 1}]
7309            set diffinhdr 0
7310
7311        } elseif {$diffinhdr} {
7312            if {![string compare -length 12 "rename from " $line]} {
7313                set fname [string range $line [expr 6 + [string first " from " $line] ] end]
7314                if {[string index $fname 0] eq "\""} {
7315                    set fname [lindex $fname 0]
7316                }
7317                set fname [encoding convertfrom $fname]
7318                set i [lsearch -exact $treediffs($ids) $fname]
7319                if {$i >= 0} {
7320                    setinlist difffilestart $i $curdiffstart
7321                }
7322            } elseif {![string compare -length 10 $line "rename to "] ||
7323                      ![string compare -length 8 $line "copy to "]} {
7324                set fname [string range $line [expr 4 + [string first " to " $line] ] end]
7325                if {[string index $fname 0] eq "\""} {
7326                    set fname [lindex $fname 0]
7327                }
7328                makediffhdr $fname $ids
7329            } elseif {[string compare -length 3 $line "---"] == 0} {
7330                # do nothing
7331                continue
7332            } elseif {[string compare -length 3 $line "+++"] == 0} {
7333                set diffinhdr 0
7334                continue
7335            }
7336            $ctext insert end "$line\n" filesep
7337
7338        } else {
7339            set line [encoding convertfrom $diffencoding $line]
7340            # parse the prefix - one ' ', '-' or '+' for each parent
7341            set prefix [string range $line 0 [expr {$diffnparents - 1}]]
7342            set tag [expr {$diffnparents > 1? "m": "d"}]
7343            if {[string trim $prefix " -+"] eq {}} {
7344                # prefix only has " ", "-" and "+" in it: normal diff line
7345                set num [string first "-" $prefix]
7346                if {$num >= 0} {
7347                    # removed line, first parent with line is $num
7348                    if {$num >= $mergemax} {
7349                        set num "max"
7350                    }
7351                    $ctext insert end "$line\n" $tag$num
7352                } else {
7353                    set tags {}
7354                    if {[string first "+" $prefix] >= 0} {
7355                        # added line
7356                        lappend tags ${tag}result
7357                        if {$diffnparents > 1} {
7358                            set num [string first " " $prefix]
7359                            if {$num >= 0} {
7360                                if {$num >= $mergemax} {
7361                                    set num "max"
7362                                }
7363                                lappend tags m$num
7364                            }
7365                        }
7366                    }
7367                    if {$targetline ne {}} {
7368                        if {$diffline == $targetline} {
7369                            set seehere [$ctext index "end - 1 chars"]
7370                            set targetline {}
7371                        } else {
7372                            incr diffline
7373                        }
7374                    }
7375                    $ctext insert end "$line\n" $tags
7376                }
7377            } else {
7378                # "\ No newline at end of file",
7379                # or something else we don't recognize
7380                $ctext insert end "$line\n" hunksep
7381            }
7382        }
7383    }
7384    if {[info exists seehere]} {
7385        mark_ctext_line [lindex [split $seehere .] 0]
7386    }
7387    $ctext conf -state disabled
7388    if {[eof $bdf]} {
7389        close $bdf
7390        return 0
7391    }
7392    return [expr {$nr >= 1000? 2: 1}]
7393}
7394
7395proc changediffdisp {} {
7396    global ctext diffelide
7397
7398    $ctext tag conf d0 -elide [lindex $diffelide 0]
7399    $ctext tag conf dresult -elide [lindex $diffelide 1]
7400}
7401
7402proc highlightfile {loc cline} {
7403    global ctext cflist cflist_top
7404
7405    $ctext yview $loc
7406    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
7407    $cflist tag add highlight $cline.0 "$cline.0 lineend"
7408    $cflist see $cline.0
7409    set cflist_top $cline
7410}
7411
7412proc prevfile {} {
7413    global difffilestart ctext cmitmode
7414
7415    if {$cmitmode eq "tree"} return
7416    set prev 0.0
7417    set prevline 1
7418    set here [$ctext index @0,0]
7419    foreach loc $difffilestart {
7420        if {[$ctext compare $loc >= $here]} {
7421            highlightfile $prev $prevline
7422            return
7423        }
7424        set prev $loc
7425        incr prevline
7426    }
7427    highlightfile $prev $prevline
7428}
7429
7430proc nextfile {} {
7431    global difffilestart ctext cmitmode
7432
7433    if {$cmitmode eq "tree"} return
7434    set here [$ctext index @0,0]
7435    set line 1
7436    foreach loc $difffilestart {
7437        incr line
7438        if {[$ctext compare $loc > $here]} {
7439            highlightfile $loc $line
7440            return
7441        }
7442    }
7443}
7444
7445proc clear_ctext {{first 1.0}} {
7446    global ctext smarktop smarkbot
7447    global ctext_file_names ctext_file_lines
7448    global pendinglinks
7449
7450    set l [lindex [split $first .] 0]
7451    if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
7452        set smarktop $l
7453    }
7454    if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
7455        set smarkbot $l
7456    }
7457    $ctext delete $first end
7458    if {$first eq "1.0"} {
7459        catch {unset pendinglinks}
7460    }
7461    set ctext_file_names {}
7462    set ctext_file_lines {}
7463}
7464
7465proc settabs {{firstab {}}} {
7466    global firsttabstop tabstop ctext have_tk85
7467
7468    if {$firstab ne {} && $have_tk85} {
7469        set firsttabstop $firstab
7470    }
7471    set w [font measure textfont "0"]
7472    if {$firsttabstop != 0} {
7473        $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
7474                               [expr {($firsttabstop + 2 * $tabstop) * $w}]]
7475    } elseif {$have_tk85 || $tabstop != 8} {
7476        $ctext conf -tabs [expr {$tabstop * $w}]
7477    } else {
7478        $ctext conf -tabs {}
7479    }
7480}
7481
7482proc incrsearch {name ix op} {
7483    global ctext searchstring searchdirn
7484
7485    $ctext tag remove found 1.0 end
7486    if {[catch {$ctext index anchor}]} {
7487        # no anchor set, use start of selection, or of visible area
7488        set sel [$ctext tag ranges sel]
7489        if {$sel ne {}} {
7490            $ctext mark set anchor [lindex $sel 0]
7491        } elseif {$searchdirn eq "-forwards"} {
7492            $ctext mark set anchor @0,0
7493        } else {
7494            $ctext mark set anchor @0,[winfo height $ctext]
7495        }
7496    }
7497    if {$searchstring ne {}} {
7498        set here [$ctext search $searchdirn -- $searchstring anchor]
7499        if {$here ne {}} {
7500            $ctext see $here
7501        }
7502        searchmarkvisible 1
7503    }
7504}
7505
7506proc dosearch {} {
7507    global sstring ctext searchstring searchdirn
7508
7509    focus $sstring
7510    $sstring icursor end
7511    set searchdirn -forwards
7512    if {$searchstring ne {}} {
7513        set sel [$ctext tag ranges sel]
7514        if {$sel ne {}} {
7515            set start "[lindex $sel 0] + 1c"
7516        } elseif {[catch {set start [$ctext index anchor]}]} {
7517            set start "@0,0"
7518        }
7519        set match [$ctext search -count mlen -- $searchstring $start]
7520        $ctext tag remove sel 1.0 end
7521        if {$match eq {}} {
7522            bell
7523            return
7524        }
7525        $ctext see $match
7526        set mend "$match + $mlen c"
7527        $ctext tag add sel $match $mend
7528        $ctext mark unset anchor
7529    }
7530}
7531
7532proc dosearchback {} {
7533    global sstring ctext searchstring searchdirn
7534
7535    focus $sstring
7536    $sstring icursor end
7537    set searchdirn -backwards
7538    if {$searchstring ne {}} {
7539        set sel [$ctext tag ranges sel]
7540        if {$sel ne {}} {
7541            set start [lindex $sel 0]
7542        } elseif {[catch {set start [$ctext index anchor]}]} {
7543            set start @0,[winfo height $ctext]
7544        }
7545        set match [$ctext search -backwards -count ml -- $searchstring $start]
7546        $ctext tag remove sel 1.0 end
7547        if {$match eq {}} {
7548            bell
7549            return
7550        }
7551        $ctext see $match
7552        set mend "$match + $ml c"
7553        $ctext tag add sel $match $mend
7554        $ctext mark unset anchor
7555    }
7556}
7557
7558proc searchmark {first last} {
7559    global ctext searchstring
7560
7561    set mend $first.0
7562    while {1} {
7563        set match [$ctext search -count mlen -- $searchstring $mend $last.end]
7564        if {$match eq {}} break
7565        set mend "$match + $mlen c"
7566        $ctext tag add found $match $mend
7567    }
7568}
7569
7570proc searchmarkvisible {doall} {
7571    global ctext smarktop smarkbot
7572
7573    set topline [lindex [split [$ctext index @0,0] .] 0]
7574    set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
7575    if {$doall || $botline < $smarktop || $topline > $smarkbot} {
7576        # no overlap with previous
7577        searchmark $topline $botline
7578        set smarktop $topline
7579        set smarkbot $botline
7580    } else {
7581        if {$topline < $smarktop} {
7582            searchmark $topline [expr {$smarktop-1}]
7583            set smarktop $topline
7584        }
7585        if {$botline > $smarkbot} {
7586            searchmark [expr {$smarkbot+1}] $botline
7587            set smarkbot $botline
7588        }
7589    }
7590}
7591
7592proc scrolltext {f0 f1} {
7593    global searchstring
7594
7595    .bleft.bottom.sb set $f0 $f1
7596    if {$searchstring ne {}} {
7597        searchmarkvisible 0
7598    }
7599}
7600
7601proc setcoords {} {
7602    global linespc charspc canvx0 canvy0
7603    global xspc1 xspc2 lthickness
7604
7605    set linespc [font metrics mainfont -linespace]
7606    set charspc [font measure mainfont "m"]
7607    set canvy0 [expr {int(3 + 0.5 * $linespc)}]
7608    set canvx0 [expr {int(3 + 0.5 * $linespc)}]
7609    set lthickness [expr {int($linespc / 9) + 1}]
7610    set xspc1(0) $linespc
7611    set xspc2 $linespc
7612}
7613
7614proc redisplay {} {
7615    global canv
7616    global selectedline
7617
7618    set ymax [lindex [$canv cget -scrollregion] 3]
7619    if {$ymax eq {} || $ymax == 0} return
7620    set span [$canv yview]
7621    clear_display
7622    setcanvscroll
7623    allcanvs yview moveto [lindex $span 0]
7624    drawvisible
7625    if {$selectedline ne {}} {
7626        selectline $selectedline 0
7627        allcanvs yview moveto [lindex $span 0]
7628    }
7629}
7630
7631proc parsefont {f n} {
7632    global fontattr
7633
7634    set fontattr($f,family) [lindex $n 0]
7635    set s [lindex $n 1]
7636    if {$s eq {} || $s == 0} {
7637        set s 10
7638    } elseif {$s < 0} {
7639        set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
7640    }
7641    set fontattr($f,size) $s
7642    set fontattr($f,weight) normal
7643    set fontattr($f,slant) roman
7644    foreach style [lrange $n 2 end] {
7645        switch -- $style {
7646            "normal" -
7647            "bold"   {set fontattr($f,weight) $style}
7648            "roman" -
7649            "italic" {set fontattr($f,slant) $style}
7650        }
7651    }
7652}
7653
7654proc fontflags {f {isbold 0}} {
7655    global fontattr
7656
7657    return [list -family $fontattr($f,family) -size $fontattr($f,size) \
7658                -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
7659                -slant $fontattr($f,slant)]
7660}
7661
7662proc fontname {f} {
7663    global fontattr
7664
7665    set n [list $fontattr($f,family) $fontattr($f,size)]
7666    if {$fontattr($f,weight) eq "bold"} {
7667        lappend n "bold"
7668    }
7669    if {$fontattr($f,slant) eq "italic"} {
7670        lappend n "italic"
7671    }
7672    return $n
7673}
7674
7675proc incrfont {inc} {
7676    global mainfont textfont ctext canv cflist showrefstop
7677    global stopped entries fontattr
7678
7679    unmarkmatches
7680    set s $fontattr(mainfont,size)
7681    incr s $inc
7682    if {$s < 1} {
7683        set s 1
7684    }
7685    set fontattr(mainfont,size) $s
7686    font config mainfont -size $s
7687    font config mainfontbold -size $s
7688    set mainfont [fontname mainfont]
7689    set s $fontattr(textfont,size)
7690    incr s $inc
7691    if {$s < 1} {
7692        set s 1
7693    }
7694    set fontattr(textfont,size) $s
7695    font config textfont -size $s
7696    font config textfontbold -size $s
7697    set textfont [fontname textfont]
7698    setcoords
7699    settabs
7700    redisplay
7701}
7702
7703proc clearsha1 {} {
7704    global sha1entry sha1string
7705    if {[string length $sha1string] == 40} {
7706        $sha1entry delete 0 end
7707    }
7708}
7709
7710proc sha1change {n1 n2 op} {
7711    global sha1string currentid sha1but
7712    if {$sha1string == {}
7713        || ([info exists currentid] && $sha1string == $currentid)} {
7714        set state disabled
7715    } else {
7716        set state normal
7717    }
7718    if {[$sha1but cget -state] == $state} return
7719    if {$state == "normal"} {
7720        $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
7721    } else {
7722        $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
7723    }
7724}
7725
7726proc gotocommit {} {
7727    global sha1string tagids headids curview varcid
7728
7729    if {$sha1string == {}
7730        || ([info exists currentid] && $sha1string == $currentid)} return
7731    if {[info exists tagids($sha1string)]} {
7732        set id $tagids($sha1string)
7733    } elseif {[info exists headids($sha1string)]} {
7734        set id $headids($sha1string)
7735    } else {
7736        set id [string tolower $sha1string]
7737        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
7738            set matches [longid $id]
7739            if {$matches ne {}} {
7740                if {[llength $matches] > 1} {
7741                    error_popup [mc "Short SHA1 id %s is ambiguous" $id]
7742                    return
7743                }
7744                set id [lindex $matches 0]
7745            }
7746        }
7747    }
7748    if {[commitinview $id $curview]} {
7749        selectline [rowofcommit $id] 1
7750        return
7751    }
7752    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
7753        set msg [mc "SHA1 id %s is not known" $sha1string]
7754    } else {
7755        set msg [mc "Tag/Head %s is not known" $sha1string]
7756    }
7757    error_popup $msg
7758}
7759
7760proc lineenter {x y id} {
7761    global hoverx hovery hoverid hovertimer
7762    global commitinfo canv
7763
7764    if {![info exists commitinfo($id)] && ![getcommit $id]} return
7765    set hoverx $x
7766    set hovery $y
7767    set hoverid $id
7768    if {[info exists hovertimer]} {
7769        after cancel $hovertimer
7770    }
7771    set hovertimer [after 500 linehover]
7772    $canv delete hover
7773}
7774
7775proc linemotion {x y id} {
7776    global hoverx hovery hoverid hovertimer
7777
7778    if {[info exists hoverid] && $id == $hoverid} {
7779        set hoverx $x
7780        set hovery $y
7781        if {[info exists hovertimer]} {
7782            after cancel $hovertimer
7783        }
7784        set hovertimer [after 500 linehover]
7785    }
7786}
7787
7788proc lineleave {id} {
7789    global hoverid hovertimer canv
7790
7791    if {[info exists hoverid] && $id == $hoverid} {
7792        $canv delete hover
7793        if {[info exists hovertimer]} {
7794            after cancel $hovertimer
7795            unset hovertimer
7796        }
7797        unset hoverid
7798    }
7799}
7800
7801proc linehover {} {
7802    global hoverx hovery hoverid hovertimer
7803    global canv linespc lthickness
7804    global commitinfo
7805
7806    set text [lindex $commitinfo($hoverid) 0]
7807    set ymax [lindex [$canv cget -scrollregion] 3]
7808    if {$ymax == {}} return
7809    set yfrac [lindex [$canv yview] 0]
7810    set x [expr {$hoverx + 2 * $linespc}]
7811    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
7812    set x0 [expr {$x - 2 * $lthickness}]
7813    set y0 [expr {$y - 2 * $lthickness}]
7814    set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
7815    set y1 [expr {$y + $linespc + 2 * $lthickness}]
7816    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
7817               -fill \#ffff80 -outline black -width 1 -tags hover]
7818    $canv raise $t
7819    set t [$canv create text $x $y -anchor nw -text $text -tags hover \
7820               -font mainfont]
7821    $canv raise $t
7822}
7823
7824proc clickisonarrow {id y} {
7825    global lthickness
7826
7827    set ranges [rowranges $id]
7828    set thresh [expr {2 * $lthickness + 6}]
7829    set n [expr {[llength $ranges] - 1}]
7830    for {set i 1} {$i < $n} {incr i} {
7831        set row [lindex $ranges $i]
7832        if {abs([yc $row] - $y) < $thresh} {
7833            return $i
7834        }
7835    }
7836    return {}
7837}
7838
7839proc arrowjump {id n y} {
7840    global canv
7841
7842    # 1 <-> 2, 3 <-> 4, etc...
7843    set n [expr {(($n - 1) ^ 1) + 1}]
7844    set row [lindex [rowranges $id] $n]
7845    set yt [yc $row]
7846    set ymax [lindex [$canv cget -scrollregion] 3]
7847    if {$ymax eq {} || $ymax <= 0} return
7848    set view [$canv yview]
7849    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
7850    set yfrac [expr {$yt / $ymax - $yspan / 2}]
7851    if {$yfrac < 0} {
7852        set yfrac 0
7853    }
7854    allcanvs yview moveto $yfrac
7855}
7856
7857proc lineclick {x y id isnew} {
7858    global ctext commitinfo children canv thickerline curview
7859
7860    if {![info exists commitinfo($id)] && ![getcommit $id]} return
7861    unmarkmatches
7862    unselectline
7863    normalline
7864    $canv delete hover
7865    # draw this line thicker than normal
7866    set thickerline $id
7867    drawlines $id
7868    if {$isnew} {
7869        set ymax [lindex [$canv cget -scrollregion] 3]
7870        if {$ymax eq {}} return
7871        set yfrac [lindex [$canv yview] 0]
7872        set y [expr {$y + $yfrac * $ymax}]
7873    }
7874    set dirn [clickisonarrow $id $y]
7875    if {$dirn ne {}} {
7876        arrowjump $id $dirn $y
7877        return
7878    }
7879
7880    if {$isnew} {
7881        addtohistory [list lineclick $x $y $id 0]
7882    }
7883    # fill the details pane with info about this line
7884    $ctext conf -state normal
7885    clear_ctext
7886    settabs 0
7887    $ctext insert end "[mc "Parent"]:\t"
7888    $ctext insert end $id link0
7889    setlink $id link0
7890    set info $commitinfo($id)
7891    $ctext insert end "\n\t[lindex $info 0]\n"
7892    $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
7893    set date [formatdate [lindex $info 2]]
7894    $ctext insert end "\t[mc "Date"]:\t$date\n"
7895    set kids $children($curview,$id)
7896    if {$kids ne {}} {
7897        $ctext insert end "\n[mc "Children"]:"
7898        set i 0
7899        foreach child $kids {
7900            incr i
7901            if {![info exists commitinfo($child)] && ![getcommit $child]} continue
7902            set info $commitinfo($child)
7903            $ctext insert end "\n\t"
7904            $ctext insert end $child link$i
7905            setlink $child link$i
7906            $ctext insert end "\n\t[lindex $info 0]"
7907            $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
7908            set date [formatdate [lindex $info 2]]
7909            $ctext insert end "\n\t[mc "Date"]:\t$date\n"
7910        }
7911    }
7912    $ctext conf -state disabled
7913    init_flist {}
7914}
7915
7916proc normalline {} {
7917    global thickerline
7918    if {[info exists thickerline]} {
7919        set id $thickerline
7920        unset thickerline
7921        drawlines $id
7922    }
7923}
7924
7925proc selbyid {id} {
7926    global curview
7927    if {[commitinview $id $curview]} {
7928        selectline [rowofcommit $id] 1
7929    }
7930}
7931
7932proc mstime {} {
7933    global startmstime
7934    if {![info exists startmstime]} {
7935        set startmstime [clock clicks -milliseconds]
7936    }
7937    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
7938}
7939
7940proc rowmenu {x y id} {
7941    global rowctxmenu selectedline rowmenuid curview
7942    global nullid nullid2 fakerowmenu mainhead
7943
7944    stopfinding
7945    set rowmenuid $id
7946    if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
7947        set state disabled
7948    } else {
7949        set state normal
7950    }
7951    if {$id ne $nullid && $id ne $nullid2} {
7952        set menu $rowctxmenu
7953        if {$mainhead ne {}} {
7954            $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
7955        } else {
7956            $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
7957        }
7958    } else {
7959        set menu $fakerowmenu
7960    }
7961    $menu entryconfigure [mca "Diff this -> selected"] -state $state
7962    $menu entryconfigure [mca "Diff selected -> this"] -state $state
7963    $menu entryconfigure [mca "Make patch"] -state $state
7964    tk_popup $menu $x $y
7965}
7966
7967proc diffvssel {dirn} {
7968    global rowmenuid selectedline
7969
7970    if {$selectedline eq {}} return
7971    if {$dirn} {
7972        set oldid [commitonrow $selectedline]
7973        set newid $rowmenuid
7974    } else {
7975        set oldid $rowmenuid
7976        set newid [commitonrow $selectedline]
7977    }
7978    addtohistory [list doseldiff $oldid $newid]
7979    doseldiff $oldid $newid
7980}
7981
7982proc doseldiff {oldid newid} {
7983    global ctext
7984    global commitinfo
7985
7986    $ctext conf -state normal
7987    clear_ctext
7988    init_flist [mc "Top"]
7989    $ctext insert end "[mc "From"] "
7990    $ctext insert end $oldid link0
7991    setlink $oldid link0
7992    $ctext insert end "\n     "
7993    $ctext insert end [lindex $commitinfo($oldid) 0]
7994    $ctext insert end "\n\n[mc "To"]   "
7995    $ctext insert end $newid link1
7996    setlink $newid link1
7997    $ctext insert end "\n     "
7998    $ctext insert end [lindex $commitinfo($newid) 0]
7999    $ctext insert end "\n"
8000    $ctext conf -state disabled
8001    $ctext tag remove found 1.0 end
8002    startdiff [list $oldid $newid]
8003}
8004
8005proc mkpatch {} {
8006    global rowmenuid currentid commitinfo patchtop patchnum
8007
8008    if {![info exists currentid]} return
8009    set oldid $currentid
8010    set oldhead [lindex $commitinfo($oldid) 0]
8011    set newid $rowmenuid
8012    set newhead [lindex $commitinfo($newid) 0]
8013    set top .patch
8014    set patchtop $top
8015    catch {destroy $top}
8016    toplevel $top
8017    make_transient $top .
8018    label $top.title -text [mc "Generate patch"]
8019    grid $top.title - -pady 10
8020    label $top.from -text [mc "From:"]
8021    entry $top.fromsha1 -width 40 -relief flat
8022    $top.fromsha1 insert 0 $oldid
8023    $top.fromsha1 conf -state readonly
8024    grid $top.from $top.fromsha1 -sticky w
8025    entry $top.fromhead -width 60 -relief flat
8026    $top.fromhead insert 0 $oldhead
8027    $top.fromhead conf -state readonly
8028    grid x $top.fromhead -sticky w
8029    label $top.to -text [mc "To:"]
8030    entry $top.tosha1 -width 40 -relief flat
8031    $top.tosha1 insert 0 $newid
8032    $top.tosha1 conf -state readonly
8033    grid $top.to $top.tosha1 -sticky w
8034    entry $top.tohead -width 60 -relief flat
8035    $top.tohead insert 0 $newhead
8036    $top.tohead conf -state readonly
8037    grid x $top.tohead -sticky w
8038    button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
8039    grid $top.rev x -pady 10
8040    label $top.flab -text [mc "Output file:"]
8041    entry $top.fname -width 60
8042    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
8043    incr patchnum
8044    grid $top.flab $top.fname -sticky w
8045    frame $top.buts
8046    button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
8047    button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
8048    bind $top <Key-Return> mkpatchgo
8049    bind $top <Key-Escape> mkpatchcan
8050    grid $top.buts.gen $top.buts.can
8051    grid columnconfigure $top.buts 0 -weight 1 -uniform a
8052    grid columnconfigure $top.buts 1 -weight 1 -uniform a
8053    grid $top.buts - -pady 10 -sticky ew
8054    focus $top.fname
8055}
8056
8057proc mkpatchrev {} {
8058    global patchtop
8059
8060    set oldid [$patchtop.fromsha1 get]
8061    set oldhead [$patchtop.fromhead get]
8062    set newid [$patchtop.tosha1 get]
8063    set newhead [$patchtop.tohead get]
8064    foreach e [list fromsha1 fromhead tosha1 tohead] \
8065            v [list $newid $newhead $oldid $oldhead] {
8066        $patchtop.$e conf -state normal
8067        $patchtop.$e delete 0 end
8068        $patchtop.$e insert 0 $v
8069        $patchtop.$e conf -state readonly
8070    }
8071}
8072
8073proc mkpatchgo {} {
8074    global patchtop nullid nullid2
8075
8076    set oldid [$patchtop.fromsha1 get]
8077    set newid [$patchtop.tosha1 get]
8078    set fname [$patchtop.fname get]
8079    set cmd [diffcmd [list $oldid $newid] -p]
8080    # trim off the initial "|"
8081    set cmd [lrange $cmd 1 end]
8082    lappend cmd >$fname &
8083    if {[catch {eval exec $cmd} err]} {
8084        error_popup "[mc "Error creating patch:"] $err" $patchtop
8085    }
8086    catch {destroy $patchtop}
8087    unset patchtop
8088}
8089
8090proc mkpatchcan {} {
8091    global patchtop
8092
8093    catch {destroy $patchtop}
8094    unset patchtop
8095}
8096
8097proc mktag {} {
8098    global rowmenuid mktagtop commitinfo
8099
8100    set top .maketag
8101    set mktagtop $top
8102    catch {destroy $top}
8103    toplevel $top
8104    make_transient $top .
8105    label $top.title -text [mc "Create tag"]
8106    grid $top.title - -pady 10
8107    label $top.id -text [mc "ID:"]
8108    entry $top.sha1 -width 40 -relief flat
8109    $top.sha1 insert 0 $rowmenuid
8110    $top.sha1 conf -state readonly
8111    grid $top.id $top.sha1 -sticky w
8112    entry $top.head -width 60 -relief flat
8113    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8114    $top.head conf -state readonly
8115    grid x $top.head -sticky w
8116    label $top.tlab -text [mc "Tag name:"]
8117    entry $top.tag -width 60
8118    grid $top.tlab $top.tag -sticky w
8119    frame $top.buts
8120    button $top.buts.gen -text [mc "Create"] -command mktaggo
8121    button $top.buts.can -text [mc "Cancel"] -command mktagcan
8122    bind $top <Key-Return> mktaggo
8123    bind $top <Key-Escape> mktagcan
8124    grid $top.buts.gen $top.buts.can
8125    grid columnconfigure $top.buts 0 -weight 1 -uniform a
8126    grid columnconfigure $top.buts 1 -weight 1 -uniform a
8127    grid $top.buts - -pady 10 -sticky ew
8128    focus $top.tag
8129}
8130
8131proc domktag {} {
8132    global mktagtop env tagids idtags
8133
8134    set id [$mktagtop.sha1 get]
8135    set tag [$mktagtop.tag get]
8136    if {$tag == {}} {
8137        error_popup [mc "No tag name specified"] $mktagtop
8138        return 0
8139    }
8140    if {[info exists tagids($tag)]} {
8141        error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
8142        return 0
8143    }
8144    if {[catch {
8145        exec git tag $tag $id
8146    } err]} {
8147        error_popup "[mc "Error creating tag:"] $err" $mktagtop
8148        return 0
8149    }
8150
8151    set tagids($tag) $id
8152    lappend idtags($id) $tag
8153    redrawtags $id
8154    addedtag $id
8155    dispneartags 0
8156    run refill_reflist
8157    return 1
8158}
8159
8160proc redrawtags {id} {
8161    global canv linehtag idpos currentid curview cmitlisted
8162    global canvxmax iddrawn circleitem mainheadid circlecolors
8163
8164    if {![commitinview $id $curview]} return
8165    if {![info exists iddrawn($id)]} return
8166    set row [rowofcommit $id]
8167    if {$id eq $mainheadid} {
8168        set ofill yellow
8169    } else {
8170        set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
8171    }
8172    $canv itemconf $circleitem($row) -fill $ofill
8173    $canv delete tag.$id
8174    set xt [eval drawtags $id $idpos($id)]
8175    $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
8176    set text [$canv itemcget $linehtag($id) -text]
8177    set font [$canv itemcget $linehtag($id) -font]
8178    set xr [expr {$xt + [font measure $font $text]}]
8179    if {$xr > $canvxmax} {
8180        set canvxmax $xr
8181        setcanvscroll
8182    }
8183    if {[info exists currentid] && $currentid == $id} {
8184        make_secsel $id
8185    }
8186}
8187
8188proc mktagcan {} {
8189    global mktagtop
8190
8191    catch {destroy $mktagtop}
8192    unset mktagtop
8193}
8194
8195proc mktaggo {} {
8196    if {![domktag]} return
8197    mktagcan
8198}
8199
8200proc writecommit {} {
8201    global rowmenuid wrcomtop commitinfo wrcomcmd
8202
8203    set top .writecommit
8204    set wrcomtop $top
8205    catch {destroy $top}
8206    toplevel $top
8207    make_transient $top .
8208    label $top.title -text [mc "Write commit to file"]
8209    grid $top.title - -pady 10
8210    label $top.id -text [mc "ID:"]
8211    entry $top.sha1 -width 40 -relief flat
8212    $top.sha1 insert 0 $rowmenuid
8213    $top.sha1 conf -state readonly
8214    grid $top.id $top.sha1 -sticky w
8215    entry $top.head -width 60 -relief flat
8216    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8217    $top.head conf -state readonly
8218    grid x $top.head -sticky w
8219    label $top.clab -text [mc "Command:"]
8220    entry $top.cmd -width 60 -textvariable wrcomcmd
8221    grid $top.clab $top.cmd -sticky w -pady 10
8222    label $top.flab -text [mc "Output file:"]
8223    entry $top.fname -width 60
8224    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
8225    grid $top.flab $top.fname -sticky w
8226    frame $top.buts
8227    button $top.buts.gen -text [mc "Write"] -command wrcomgo
8228    button $top.buts.can -text [mc "Cancel"] -command wrcomcan
8229    bind $top <Key-Return> wrcomgo
8230    bind $top <Key-Escape> wrcomcan
8231    grid $top.buts.gen $top.buts.can
8232    grid columnconfigure $top.buts 0 -weight 1 -uniform a
8233    grid columnconfigure $top.buts 1 -weight 1 -uniform a
8234    grid $top.buts - -pady 10 -sticky ew
8235    focus $top.fname
8236}
8237
8238proc wrcomgo {} {
8239    global wrcomtop
8240
8241    set id [$wrcomtop.sha1 get]
8242    set cmd "echo $id | [$wrcomtop.cmd get]"
8243    set fname [$wrcomtop.fname get]
8244    if {[catch {exec sh -c $cmd >$fname &} err]} {
8245        error_popup "[mc "Error writing commit:"] $err" $wrcomtop
8246    }
8247    catch {destroy $wrcomtop}
8248    unset wrcomtop
8249}
8250
8251proc wrcomcan {} {
8252    global wrcomtop
8253
8254    catch {destroy $wrcomtop}
8255    unset wrcomtop
8256}
8257
8258proc mkbranch {} {
8259    global rowmenuid mkbrtop
8260
8261    set top .makebranch
8262    catch {destroy $top}
8263    toplevel $top
8264    make_transient $top .
8265    label $top.title -text [mc "Create new branch"]
8266    grid $top.title - -pady 10
8267    label $top.id -text [mc "ID:"]
8268    entry $top.sha1 -width 40 -relief flat
8269    $top.sha1 insert 0 $rowmenuid
8270    $top.sha1 conf -state readonly
8271    grid $top.id $top.sha1 -sticky w
8272    label $top.nlab -text [mc "Name:"]
8273    entry $top.name -width 40
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 {}