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