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