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