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