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