d7fea265f3e48a32c11c208749d59f86a8f5bdda
   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    set treepending $ids
6461    set treediff {}
6462    if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
6463    fconfigure $gdtf -blocking 0
6464    filerun $gdtf [list gettreediffline $gdtf $ids]
6465}
6466
6467proc gettreediffline {gdtf ids} {
6468    global treediff treediffs treepending diffids diffmergeid
6469    global cmitmode vfilelimit curview limitdiffs
6470
6471    set nr 0
6472    while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
6473        set i [string first "\t" $line]
6474        if {$i >= 0} {
6475            set file [string range $line [expr {$i+1}] end]
6476            if {[string index $file 0] eq "\""} {
6477                set file [lindex $file 0]
6478            }
6479            lappend treediff $file
6480        }
6481    }
6482    if {![eof $gdtf]} {
6483        return [expr {$nr >= 1000? 2: 1}]
6484    }
6485    close $gdtf
6486    if {$limitdiffs && $vfilelimit($curview) ne {}} {
6487        set flist {}
6488        foreach f $treediff {
6489            if {[path_filter $vfilelimit($curview) $f]} {
6490                lappend flist $f
6491            }
6492        }
6493        set treediffs($ids) $flist
6494    } else {
6495        set treediffs($ids) $treediff
6496    }
6497    unset treepending
6498    if {$cmitmode eq "tree"} {
6499        gettree $diffids
6500    } elseif {$ids != $diffids} {
6501        if {![info exists diffmergeid]} {
6502            gettreediffs $diffids
6503        }
6504    } else {
6505        addtocflist $ids
6506    }
6507    return 0
6508}
6509
6510# empty string or positive integer
6511proc diffcontextvalidate {v} {
6512    return [regexp {^(|[1-9][0-9]*)$} $v]
6513}
6514
6515proc diffcontextchange {n1 n2 op} {
6516    global diffcontextstring diffcontext
6517
6518    if {[string is integer -strict $diffcontextstring]} {
6519        if {$diffcontextstring > 0} {
6520            set diffcontext $diffcontextstring
6521            reselectline
6522        }
6523    }
6524}
6525
6526proc changeignorespace {} {
6527    reselectline
6528}
6529
6530proc getblobdiffs {ids} {
6531    global blobdifffd diffids env
6532    global diffinhdr treediffs
6533    global diffcontext
6534    global ignorespace
6535    global limitdiffs vfilelimit curview
6536
6537    set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
6538    if {$ignorespace} {
6539        append cmd " -w"
6540    }
6541    if {$limitdiffs && $vfilelimit($curview) ne {}} {
6542        set cmd [concat $cmd -- $vfilelimit($curview)]
6543    }
6544    if {[catch {set bdf [open $cmd r]} err]} {
6545        puts "error getting diffs: $err"
6546        return
6547    }
6548    set diffinhdr 0
6549    fconfigure $bdf -blocking 0
6550    set blobdifffd($ids) $bdf
6551    filerun $bdf [list getblobdiffline $bdf $diffids]
6552}
6553
6554proc setinlist {var i val} {
6555    global $var
6556
6557    while {[llength [set $var]] < $i} {
6558        lappend $var {}
6559    }
6560    if {[llength [set $var]] == $i} {
6561        lappend $var $val
6562    } else {
6563        lset $var $i $val
6564    }
6565}
6566
6567proc makediffhdr {fname ids} {
6568    global ctext curdiffstart treediffs
6569
6570    set i [lsearch -exact $treediffs($ids) $fname]
6571    if {$i >= 0} {
6572        setinlist difffilestart $i $curdiffstart
6573    }
6574    set l [expr {(78 - [string length $fname]) / 2}]
6575    set pad [string range "----------------------------------------" 1 $l]
6576    $ctext insert $curdiffstart "$pad $fname $pad" filesep
6577}
6578
6579proc getblobdiffline {bdf ids} {
6580    global diffids blobdifffd ctext curdiffstart
6581    global diffnexthead diffnextnote difffilestart
6582    global diffinhdr treediffs
6583
6584    set nr 0
6585    $ctext conf -state normal
6586    while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
6587        if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
6588            close $bdf
6589            return 0
6590        }
6591        if {![string compare -length 11 "diff --git " $line]} {
6592            # trim off "diff --git "
6593            set line [string range $line 11 end]
6594            set diffinhdr 1
6595            # start of a new file
6596            $ctext insert end "\n"
6597            set curdiffstart [$ctext index "end - 1c"]
6598            $ctext insert end "\n" filesep
6599            # If the name hasn't changed the length will be odd,
6600            # the middle char will be a space, and the two bits either
6601            # side will be a/name and b/name, or "a/name" and "b/name".
6602            # If the name has changed we'll get "rename from" and
6603            # "rename to" or "copy from" and "copy to" lines following this,
6604            # and we'll use them to get the filenames.
6605            # This complexity is necessary because spaces in the filename(s)
6606            # don't get escaped.
6607            set l [string length $line]
6608            set i [expr {$l / 2}]
6609            if {!(($l & 1) && [string index $line $i] eq " " &&
6610                  [string range $line 2 [expr {$i - 1}]] eq \
6611                      [string range $line [expr {$i + 3}] end])} {
6612                continue
6613            }
6614            # unescape if quoted and chop off the a/ from the front
6615            if {[string index $line 0] eq "\""} {
6616                set fname [string range [lindex $line 0] 2 end]
6617            } else {
6618                set fname [string range $line 2 [expr {$i - 1}]]
6619            }
6620            makediffhdr $fname $ids
6621
6622        } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \
6623                       $line match f1l f1c f2l f2c rest]} {
6624            $ctext insert end "$line\n" hunksep
6625            set diffinhdr 0
6626
6627        } elseif {$diffinhdr} {
6628            if {![string compare -length 12 "rename from " $line]} {
6629                set fname [string range $line [expr 6 + [string first " from " $line] ] end]
6630                if {[string index $fname 0] eq "\""} {
6631                    set fname [lindex $fname 0]
6632                }
6633                set i [lsearch -exact $treediffs($ids) $fname]
6634                if {$i >= 0} {
6635                    setinlist difffilestart $i $curdiffstart
6636                }
6637            } elseif {![string compare -length 10 $line "rename to "] ||
6638                      ![string compare -length 8 $line "copy to "]} {
6639                set fname [string range $line [expr 4 + [string first " to " $line] ] end]
6640                if {[string index $fname 0] eq "\""} {
6641                    set fname [lindex $fname 0]
6642                }
6643                makediffhdr $fname $ids
6644            } elseif {[string compare -length 3 $line "---"] == 0} {
6645                # do nothing
6646                continue
6647            } elseif {[string compare -length 3 $line "+++"] == 0} {
6648                set diffinhdr 0
6649                continue
6650            }
6651            $ctext insert end "$line\n" filesep
6652
6653        } else {
6654            set x [string range $line 0 0]
6655            if {$x == "-" || $x == "+"} {
6656                set tag [expr {$x == "+"}]
6657                $ctext insert end "$line\n" d$tag
6658            } elseif {$x == " "} {
6659                $ctext insert end "$line\n"
6660            } else {
6661                # "\ No newline at end of file",
6662                # or something else we don't recognize
6663                $ctext insert end "$line\n" hunksep
6664            }
6665        }
6666    }
6667    $ctext conf -state disabled
6668    if {[eof $bdf]} {
6669        close $bdf
6670        return 0
6671    }
6672    return [expr {$nr >= 1000? 2: 1}]
6673}
6674
6675proc changediffdisp {} {
6676    global ctext diffelide
6677
6678    $ctext tag conf d0 -elide [lindex $diffelide 0]
6679    $ctext tag conf d1 -elide [lindex $diffelide 1]
6680}
6681
6682proc highlightfile {loc cline} {
6683    global ctext cflist cflist_top
6684
6685    $ctext yview $loc
6686    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
6687    $cflist tag add highlight $cline.0 "$cline.0 lineend"
6688    $cflist see $cline.0
6689    set cflist_top $cline
6690}
6691
6692proc prevfile {} {
6693    global difffilestart ctext cmitmode
6694
6695    if {$cmitmode eq "tree"} return
6696    set prev 0.0
6697    set prevline 1
6698    set here [$ctext index @0,0]
6699    foreach loc $difffilestart {
6700        if {[$ctext compare $loc >= $here]} {
6701            highlightfile $prev $prevline
6702            return
6703        }
6704        set prev $loc
6705        incr prevline
6706    }
6707    highlightfile $prev $prevline
6708}
6709
6710proc nextfile {} {
6711    global difffilestart ctext cmitmode
6712
6713    if {$cmitmode eq "tree"} return
6714    set here [$ctext index @0,0]
6715    set line 1
6716    foreach loc $difffilestart {
6717        incr line
6718        if {[$ctext compare $loc > $here]} {
6719            highlightfile $loc $line
6720            return
6721        }
6722    }
6723}
6724
6725proc clear_ctext {{first 1.0}} {
6726    global ctext smarktop smarkbot
6727    global pendinglinks
6728
6729    set l [lindex [split $first .] 0]
6730    if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
6731        set smarktop $l
6732    }
6733    if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
6734        set smarkbot $l
6735    }
6736    $ctext delete $first end
6737    if {$first eq "1.0"} {
6738        catch {unset pendinglinks}
6739    }
6740}
6741
6742proc settabs {{firstab {}}} {
6743    global firsttabstop tabstop ctext have_tk85
6744
6745    if {$firstab ne {} && $have_tk85} {
6746        set firsttabstop $firstab
6747    }
6748    set w [font measure textfont "0"]
6749    if {$firsttabstop != 0} {
6750        $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
6751                               [expr {($firsttabstop + 2 * $tabstop) * $w}]]
6752    } elseif {$have_tk85 || $tabstop != 8} {
6753        $ctext conf -tabs [expr {$tabstop * $w}]
6754    } else {
6755        $ctext conf -tabs {}
6756    }
6757}
6758
6759proc incrsearch {name ix op} {
6760    global ctext searchstring searchdirn
6761
6762    $ctext tag remove found 1.0 end
6763    if {[catch {$ctext index anchor}]} {
6764        # no anchor set, use start of selection, or of visible area
6765        set sel [$ctext tag ranges sel]
6766        if {$sel ne {}} {
6767            $ctext mark set anchor [lindex $sel 0]
6768        } elseif {$searchdirn eq "-forwards"} {
6769            $ctext mark set anchor @0,0
6770        } else {
6771            $ctext mark set anchor @0,[winfo height $ctext]
6772        }
6773    }
6774    if {$searchstring ne {}} {
6775        set here [$ctext search $searchdirn -- $searchstring anchor]
6776        if {$here ne {}} {
6777            $ctext see $here
6778        }
6779        searchmarkvisible 1
6780    }
6781}
6782
6783proc dosearch {} {
6784    global sstring ctext searchstring searchdirn
6785
6786    focus $sstring
6787    $sstring icursor end
6788    set searchdirn -forwards
6789    if {$searchstring ne {}} {
6790        set sel [$ctext tag ranges sel]
6791        if {$sel ne {}} {
6792            set start "[lindex $sel 0] + 1c"
6793        } elseif {[catch {set start [$ctext index anchor]}]} {
6794            set start "@0,0"
6795        }
6796        set match [$ctext search -count mlen -- $searchstring $start]
6797        $ctext tag remove sel 1.0 end
6798        if {$match eq {}} {
6799            bell
6800            return
6801        }
6802        $ctext see $match
6803        set mend "$match + $mlen c"
6804        $ctext tag add sel $match $mend
6805        $ctext mark unset anchor
6806    }
6807}
6808
6809proc dosearchback {} {
6810    global sstring ctext searchstring searchdirn
6811
6812    focus $sstring
6813    $sstring icursor end
6814    set searchdirn -backwards
6815    if {$searchstring ne {}} {
6816        set sel [$ctext tag ranges sel]
6817        if {$sel ne {}} {
6818            set start [lindex $sel 0]
6819        } elseif {[catch {set start [$ctext index anchor]}]} {
6820            set start @0,[winfo height $ctext]
6821        }
6822        set match [$ctext search -backwards -count ml -- $searchstring $start]
6823        $ctext tag remove sel 1.0 end
6824        if {$match eq {}} {
6825            bell
6826            return
6827        }
6828        $ctext see $match
6829        set mend "$match + $ml c"
6830        $ctext tag add sel $match $mend
6831        $ctext mark unset anchor
6832    }
6833}
6834
6835proc searchmark {first last} {
6836    global ctext searchstring
6837
6838    set mend $first.0
6839    while {1} {
6840        set match [$ctext search -count mlen -- $searchstring $mend $last.end]
6841        if {$match eq {}} break
6842        set mend "$match + $mlen c"
6843        $ctext tag add found $match $mend
6844    }
6845}
6846
6847proc searchmarkvisible {doall} {
6848    global ctext smarktop smarkbot
6849
6850    set topline [lindex [split [$ctext index @0,0] .] 0]
6851    set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
6852    if {$doall || $botline < $smarktop || $topline > $smarkbot} {
6853        # no overlap with previous
6854        searchmark $topline $botline
6855        set smarktop $topline
6856        set smarkbot $botline
6857    } else {
6858        if {$topline < $smarktop} {
6859            searchmark $topline [expr {$smarktop-1}]
6860            set smarktop $topline
6861        }
6862        if {$botline > $smarkbot} {
6863            searchmark [expr {$smarkbot+1}] $botline
6864            set smarkbot $botline
6865        }
6866    }
6867}
6868
6869proc scrolltext {f0 f1} {
6870    global searchstring
6871
6872    .bleft.bottom.sb set $f0 $f1
6873    if {$searchstring ne {}} {
6874        searchmarkvisible 0
6875    }
6876}
6877
6878proc setcoords {} {
6879    global linespc charspc canvx0 canvy0
6880    global xspc1 xspc2 lthickness
6881
6882    set linespc [font metrics mainfont -linespace]
6883    set charspc [font measure mainfont "m"]
6884    set canvy0 [expr {int(3 + 0.5 * $linespc)}]
6885    set canvx0 [expr {int(3 + 0.5 * $linespc)}]
6886    set lthickness [expr {int($linespc / 9) + 1}]
6887    set xspc1(0) $linespc
6888    set xspc2 $linespc
6889}
6890
6891proc redisplay {} {
6892    global canv
6893    global selectedline
6894
6895    set ymax [lindex [$canv cget -scrollregion] 3]
6896    if {$ymax eq {} || $ymax == 0} return
6897    set span [$canv yview]
6898    clear_display
6899    setcanvscroll
6900    allcanvs yview moveto [lindex $span 0]
6901    drawvisible
6902    if {$selectedline ne {}} {
6903        selectline $selectedline 0
6904        allcanvs yview moveto [lindex $span 0]
6905    }
6906}
6907
6908proc parsefont {f n} {
6909    global fontattr
6910
6911    set fontattr($f,family) [lindex $n 0]
6912    set s [lindex $n 1]
6913    if {$s eq {} || $s == 0} {
6914        set s 10
6915    } elseif {$s < 0} {
6916        set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
6917    }
6918    set fontattr($f,size) $s
6919    set fontattr($f,weight) normal
6920    set fontattr($f,slant) roman
6921    foreach style [lrange $n 2 end] {
6922        switch -- $style {
6923            "normal" -
6924            "bold"   {set fontattr($f,weight) $style}
6925            "roman" -
6926            "italic" {set fontattr($f,slant) $style}
6927        }
6928    }
6929}
6930
6931proc fontflags {f {isbold 0}} {
6932    global fontattr
6933
6934    return [list -family $fontattr($f,family) -size $fontattr($f,size) \
6935                -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
6936                -slant $fontattr($f,slant)]
6937}
6938
6939proc fontname {f} {
6940    global fontattr
6941
6942    set n [list $fontattr($f,family) $fontattr($f,size)]
6943    if {$fontattr($f,weight) eq "bold"} {
6944        lappend n "bold"
6945    }
6946    if {$fontattr($f,slant) eq "italic"} {
6947        lappend n "italic"
6948    }
6949    return $n
6950}
6951
6952proc incrfont {inc} {
6953    global mainfont textfont ctext canv cflist showrefstop
6954    global stopped entries fontattr
6955
6956    unmarkmatches
6957    set s $fontattr(mainfont,size)
6958    incr s $inc
6959    if {$s < 1} {
6960        set s 1
6961    }
6962    set fontattr(mainfont,size) $s
6963    font config mainfont -size $s
6964    font config mainfontbold -size $s
6965    set mainfont [fontname mainfont]
6966    set s $fontattr(textfont,size)
6967    incr s $inc
6968    if {$s < 1} {
6969        set s 1
6970    }
6971    set fontattr(textfont,size) $s
6972    font config textfont -size $s
6973    font config textfontbold -size $s
6974    set textfont [fontname textfont]
6975    setcoords
6976    settabs
6977    redisplay
6978}
6979
6980proc clearsha1 {} {
6981    global sha1entry sha1string
6982    if {[string length $sha1string] == 40} {
6983        $sha1entry delete 0 end
6984    }
6985}
6986
6987proc sha1change {n1 n2 op} {
6988    global sha1string currentid sha1but
6989    if {$sha1string == {}
6990        || ([info exists currentid] && $sha1string == $currentid)} {
6991        set state disabled
6992    } else {
6993        set state normal
6994    }
6995    if {[$sha1but cget -state] == $state} return
6996    if {$state == "normal"} {
6997        $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
6998    } else {
6999        $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
7000    }
7001}
7002
7003proc gotocommit {} {
7004    global sha1string tagids headids curview varcid
7005
7006    if {$sha1string == {}
7007        || ([info exists currentid] && $sha1string == $currentid)} return
7008    if {[info exists tagids($sha1string)]} {
7009        set id $tagids($sha1string)
7010    } elseif {[info exists headids($sha1string)]} {
7011        set id $headids($sha1string)
7012    } else {
7013        set id [string tolower $sha1string]
7014        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
7015            set matches [array names varcid "$curview,$id*"]
7016            if {$matches ne {}} {
7017                if {[llength $matches] > 1} {
7018                    error_popup [mc "Short SHA1 id %s is ambiguous" $id]
7019                    return
7020                }
7021                set id [lindex [split [lindex $matches 0] ","] 1]
7022            }
7023        }
7024    }
7025    if {[commitinview $id $curview]} {
7026        selectline [rowofcommit $id] 1
7027        return
7028    }
7029    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
7030        set msg [mc "SHA1 id %s is not known" $sha1string]
7031    } else {
7032        set msg [mc "Tag/Head %s is not known" $sha1string]
7033    }
7034    error_popup $msg
7035}
7036
7037proc lineenter {x y id} {
7038    global hoverx hovery hoverid hovertimer
7039    global commitinfo canv
7040
7041    if {![info exists commitinfo($id)] && ![getcommit $id]} return
7042    set hoverx $x
7043    set hovery $y
7044    set hoverid $id
7045    if {[info exists hovertimer]} {
7046        after cancel $hovertimer
7047    }
7048    set hovertimer [after 500 linehover]
7049    $canv delete hover
7050}
7051
7052proc linemotion {x y id} {
7053    global hoverx hovery hoverid hovertimer
7054
7055    if {[info exists hoverid] && $id == $hoverid} {
7056        set hoverx $x
7057        set hovery $y
7058        if {[info exists hovertimer]} {
7059            after cancel $hovertimer
7060        }
7061        set hovertimer [after 500 linehover]
7062    }
7063}
7064
7065proc lineleave {id} {
7066    global hoverid hovertimer canv
7067
7068    if {[info exists hoverid] && $id == $hoverid} {
7069        $canv delete hover
7070        if {[info exists hovertimer]} {
7071            after cancel $hovertimer
7072            unset hovertimer
7073        }
7074        unset hoverid
7075    }
7076}
7077
7078proc linehover {} {
7079    global hoverx hovery hoverid hovertimer
7080    global canv linespc lthickness
7081    global commitinfo
7082
7083    set text [lindex $commitinfo($hoverid) 0]
7084    set ymax [lindex [$canv cget -scrollregion] 3]
7085    if {$ymax == {}} return
7086    set yfrac [lindex [$canv yview] 0]
7087    set x [expr {$hoverx + 2 * $linespc}]
7088    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
7089    set x0 [expr {$x - 2 * $lthickness}]
7090    set y0 [expr {$y - 2 * $lthickness}]
7091    set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
7092    set y1 [expr {$y + $linespc + 2 * $lthickness}]
7093    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
7094               -fill \#ffff80 -outline black -width 1 -tags hover]
7095    $canv raise $t
7096    set t [$canv create text $x $y -anchor nw -text $text -tags hover \
7097               -font mainfont]
7098    $canv raise $t
7099}
7100
7101proc clickisonarrow {id y} {
7102    global lthickness
7103
7104    set ranges [rowranges $id]
7105    set thresh [expr {2 * $lthickness + 6}]
7106    set n [expr {[llength $ranges] - 1}]
7107    for {set i 1} {$i < $n} {incr i} {
7108        set row [lindex $ranges $i]
7109        if {abs([yc $row] - $y) < $thresh} {
7110            return $i
7111        }
7112    }
7113    return {}
7114}
7115
7116proc arrowjump {id n y} {
7117    global canv
7118
7119    # 1 <-> 2, 3 <-> 4, etc...
7120    set n [expr {(($n - 1) ^ 1) + 1}]
7121    set row [lindex [rowranges $id] $n]
7122    set yt [yc $row]
7123    set ymax [lindex [$canv cget -scrollregion] 3]
7124    if {$ymax eq {} || $ymax <= 0} return
7125    set view [$canv yview]
7126    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
7127    set yfrac [expr {$yt / $ymax - $yspan / 2}]
7128    if {$yfrac < 0} {
7129        set yfrac 0
7130    }
7131    allcanvs yview moveto $yfrac
7132}
7133
7134proc lineclick {x y id isnew} {
7135    global ctext commitinfo children canv thickerline curview
7136
7137    if {![info exists commitinfo($id)] && ![getcommit $id]} return
7138    unmarkmatches
7139    unselectline
7140    normalline
7141    $canv delete hover
7142    # draw this line thicker than normal
7143    set thickerline $id
7144    drawlines $id
7145    if {$isnew} {
7146        set ymax [lindex [$canv cget -scrollregion] 3]
7147        if {$ymax eq {}} return
7148        set yfrac [lindex [$canv yview] 0]
7149        set y [expr {$y + $yfrac * $ymax}]
7150    }
7151    set dirn [clickisonarrow $id $y]
7152    if {$dirn ne {}} {
7153        arrowjump $id $dirn $y
7154        return
7155    }
7156
7157    if {$isnew} {
7158        addtohistory [list lineclick $x $y $id 0]
7159    }
7160    # fill the details pane with info about this line
7161    $ctext conf -state normal
7162    clear_ctext
7163    settabs 0
7164    $ctext insert end "[mc "Parent"]:\t"
7165    $ctext insert end $id link0
7166    setlink $id link0
7167    set info $commitinfo($id)
7168    $ctext insert end "\n\t[lindex $info 0]\n"
7169    $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
7170    set date [formatdate [lindex $info 2]]
7171    $ctext insert end "\t[mc "Date"]:\t$date\n"
7172    set kids $children($curview,$id)
7173    if {$kids ne {}} {
7174        $ctext insert end "\n[mc "Children"]:"
7175        set i 0
7176        foreach child $kids {
7177            incr i
7178            if {![info exists commitinfo($child)] && ![getcommit $child]} continue
7179            set info $commitinfo($child)
7180            $ctext insert end "\n\t"
7181            $ctext insert end $child link$i
7182            setlink $child link$i
7183            $ctext insert end "\n\t[lindex $info 0]"
7184            $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
7185            set date [formatdate [lindex $info 2]]
7186            $ctext insert end "\n\t[mc "Date"]:\t$date\n"
7187        }
7188    }
7189    $ctext conf -state disabled
7190    init_flist {}
7191}
7192
7193proc normalline {} {
7194    global thickerline
7195    if {[info exists thickerline]} {
7196        set id $thickerline
7197        unset thickerline
7198        drawlines $id
7199    }
7200}
7201
7202proc selbyid {id} {
7203    global curview
7204    if {[commitinview $id $curview]} {
7205        selectline [rowofcommit $id] 1
7206    }
7207}
7208
7209proc mstime {} {
7210    global startmstime
7211    if {![info exists startmstime]} {
7212        set startmstime [clock clicks -milliseconds]
7213    }
7214    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
7215}
7216
7217proc rowmenu {x y id} {
7218    global rowctxmenu selectedline rowmenuid curview
7219    global nullid nullid2 fakerowmenu mainhead
7220
7221    stopfinding
7222    set rowmenuid $id
7223    if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
7224        set state disabled
7225    } else {
7226        set state normal
7227    }
7228    if {$id ne $nullid && $id ne $nullid2} {
7229        set menu $rowctxmenu
7230        if {$mainhead ne {}} {
7231            $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
7232        } else {
7233            $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
7234        }
7235    } else {
7236        set menu $fakerowmenu
7237    }
7238    $menu entryconfigure [mc "Diff this -> selected"] -state $state
7239    $menu entryconfigure [mc "Diff selected -> this"] -state $state
7240    $menu entryconfigure [mc "Make patch"] -state $state
7241    tk_popup $menu $x $y
7242}
7243
7244proc diffvssel {dirn} {
7245    global rowmenuid selectedline
7246
7247    if {$selectedline eq {}} return
7248    if {$dirn} {
7249        set oldid [commitonrow $selectedline]
7250        set newid $rowmenuid
7251    } else {
7252        set oldid $rowmenuid
7253        set newid [commitonrow $selectedline]
7254    }
7255    addtohistory [list doseldiff $oldid $newid]
7256    doseldiff $oldid $newid
7257}
7258
7259proc doseldiff {oldid newid} {
7260    global ctext
7261    global commitinfo
7262
7263    $ctext conf -state normal
7264    clear_ctext
7265    init_flist [mc "Top"]
7266    $ctext insert end "[mc "From"] "
7267    $ctext insert end $oldid link0
7268    setlink $oldid link0
7269    $ctext insert end "\n     "
7270    $ctext insert end [lindex $commitinfo($oldid) 0]
7271    $ctext insert end "\n\n[mc "To"]   "
7272    $ctext insert end $newid link1
7273    setlink $newid link1
7274    $ctext insert end "\n     "
7275    $ctext insert end [lindex $commitinfo($newid) 0]
7276    $ctext insert end "\n"
7277    $ctext conf -state disabled
7278    $ctext tag remove found 1.0 end
7279    startdiff [list $oldid $newid]
7280}
7281
7282proc mkpatch {} {
7283    global rowmenuid currentid commitinfo patchtop patchnum
7284
7285    if {![info exists currentid]} return
7286    set oldid $currentid
7287    set oldhead [lindex $commitinfo($oldid) 0]
7288    set newid $rowmenuid
7289    set newhead [lindex $commitinfo($newid) 0]
7290    set top .patch
7291    set patchtop $top
7292    catch {destroy $top}
7293    toplevel $top
7294    label $top.title -text [mc "Generate patch"]
7295    grid $top.title - -pady 10
7296    label $top.from -text [mc "From:"]
7297    entry $top.fromsha1 -width 40 -relief flat
7298    $top.fromsha1 insert 0 $oldid
7299    $top.fromsha1 conf -state readonly
7300    grid $top.from $top.fromsha1 -sticky w
7301    entry $top.fromhead -width 60 -relief flat
7302    $top.fromhead insert 0 $oldhead
7303    $top.fromhead conf -state readonly
7304    grid x $top.fromhead -sticky w
7305    label $top.to -text [mc "To:"]
7306    entry $top.tosha1 -width 40 -relief flat
7307    $top.tosha1 insert 0 $newid
7308    $top.tosha1 conf -state readonly
7309    grid $top.to $top.tosha1 -sticky w
7310    entry $top.tohead -width 60 -relief flat
7311    $top.tohead insert 0 $newhead
7312    $top.tohead conf -state readonly
7313    grid x $top.tohead -sticky w
7314    button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
7315    grid $top.rev x -pady 10
7316    label $top.flab -text [mc "Output file:"]
7317    entry $top.fname -width 60
7318    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
7319    incr patchnum
7320    grid $top.flab $top.fname -sticky w
7321    frame $top.buts
7322    button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
7323    button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
7324    grid $top.buts.gen $top.buts.can
7325    grid columnconfigure $top.buts 0 -weight 1 -uniform a
7326    grid columnconfigure $top.buts 1 -weight 1 -uniform a
7327    grid $top.buts - -pady 10 -sticky ew
7328    focus $top.fname
7329}
7330
7331proc mkpatchrev {} {
7332    global patchtop
7333
7334    set oldid [$patchtop.fromsha1 get]
7335    set oldhead [$patchtop.fromhead get]
7336    set newid [$patchtop.tosha1 get]
7337    set newhead [$patchtop.tohead get]
7338    foreach e [list fromsha1 fromhead tosha1 tohead] \
7339            v [list $newid $newhead $oldid $oldhead] {
7340        $patchtop.$e conf -state normal
7341        $patchtop.$e delete 0 end
7342        $patchtop.$e insert 0 $v
7343        $patchtop.$e conf -state readonly
7344    }
7345}
7346
7347proc mkpatchgo {} {
7348    global patchtop nullid nullid2
7349
7350    set oldid [$patchtop.fromsha1 get]
7351    set newid [$patchtop.tosha1 get]
7352    set fname [$patchtop.fname get]
7353    set cmd [diffcmd [list $oldid $newid] -p]
7354    # trim off the initial "|"
7355    set cmd [lrange $cmd 1 end]
7356    lappend cmd >$fname &
7357    if {[catch {eval exec $cmd} err]} {
7358        error_popup "[mc "Error creating patch:"] $err"
7359    }
7360    catch {destroy $patchtop}
7361    unset patchtop
7362}
7363
7364proc mkpatchcan {} {
7365    global patchtop
7366
7367    catch {destroy $patchtop}
7368    unset patchtop
7369}
7370
7371proc mktag {} {
7372    global rowmenuid mktagtop commitinfo
7373
7374    set top .maketag
7375    set mktagtop $top
7376    catch {destroy $top}
7377    toplevel $top
7378    label $top.title -text [mc "Create tag"]
7379    grid $top.title - -pady 10
7380    label $top.id -text [mc "ID:"]
7381    entry $top.sha1 -width 40 -relief flat
7382    $top.sha1 insert 0 $rowmenuid
7383    $top.sha1 conf -state readonly
7384    grid $top.id $top.sha1 -sticky w
7385    entry $top.head -width 60 -relief flat
7386    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
7387    $top.head conf -state readonly
7388    grid x $top.head -sticky w
7389    label $top.tlab -text [mc "Tag name:"]
7390    entry $top.tag -width 60
7391    grid $top.tlab $top.tag -sticky w
7392    frame $top.buts
7393    button $top.buts.gen -text [mc "Create"] -command mktaggo
7394    button $top.buts.can -text [mc "Cancel"] -command mktagcan
7395    grid $top.buts.gen $top.buts.can
7396    grid columnconfigure $top.buts 0 -weight 1 -uniform a
7397    grid columnconfigure $top.buts 1 -weight 1 -uniform a
7398    grid $top.buts - -pady 10 -sticky ew
7399    focus $top.tag
7400}
7401
7402proc domktag {} {
7403    global mktagtop env tagids idtags
7404
7405    set id [$mktagtop.sha1 get]
7406    set tag [$mktagtop.tag get]
7407    if {$tag == {}} {
7408        error_popup [mc "No tag name specified"]
7409        return
7410    }
7411    if {[info exists tagids($tag)]} {
7412        error_popup [mc "Tag \"%s\" already exists" $tag]
7413        return
7414    }
7415    if {[catch {
7416        exec git tag $tag $id
7417    } err]} {
7418        error_popup "[mc "Error creating tag:"] $err"
7419        return
7420    }
7421
7422    set tagids($tag) $id
7423    lappend idtags($id) $tag
7424    redrawtags $id
7425    addedtag $id
7426    dispneartags 0
7427    run refill_reflist
7428}
7429
7430proc redrawtags {id} {
7431    global canv linehtag idpos currentid curview cmitlisted
7432    global canvxmax iddrawn circleitem mainheadid circlecolors
7433
7434    if {![commitinview $id $curview]} return
7435    if {![info exists iddrawn($id)]} return
7436    set row [rowofcommit $id]
7437    if {$id eq $mainheadid} {
7438        set ofill yellow
7439    } else {
7440        set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
7441    }
7442    $canv itemconf $circleitem($row) -fill $ofill
7443    $canv delete tag.$id
7444    set xt [eval drawtags $id $idpos($id)]
7445    $canv coords $linehtag($row) $xt [lindex $idpos($id) 2]
7446    set text [$canv itemcget $linehtag($row) -text]
7447    set font [$canv itemcget $linehtag($row) -font]
7448    set xr [expr {$xt + [font measure $font $text]}]
7449    if {$xr > $canvxmax} {
7450        set canvxmax $xr
7451        setcanvscroll
7452    }
7453    if {[info exists currentid] && $currentid == $id} {
7454        make_secsel $row
7455    }
7456}
7457
7458proc mktagcan {} {
7459    global mktagtop
7460
7461    catch {destroy $mktagtop}
7462    unset mktagtop
7463}
7464
7465proc mktaggo {} {
7466    domktag
7467    mktagcan
7468}
7469
7470proc writecommit {} {
7471    global rowmenuid wrcomtop commitinfo wrcomcmd
7472
7473    set top .writecommit
7474    set wrcomtop $top
7475    catch {destroy $top}
7476    toplevel $top
7477    label $top.title -text [mc "Write commit to file"]
7478    grid $top.title - -pady 10
7479    label $top.id -text [mc "ID:"]
7480    entry $top.sha1 -width 40 -relief flat
7481    $top.sha1 insert 0 $rowmenuid
7482    $top.sha1 conf -state readonly
7483    grid $top.id $top.sha1 -sticky w
7484    entry $top.head -width 60 -relief flat
7485    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
7486    $top.head conf -state readonly
7487    grid x $top.head -sticky w
7488    label $top.clab -text [mc "Command:"]
7489    entry $top.cmd -width 60 -textvariable wrcomcmd
7490    grid $top.clab $top.cmd -sticky w -pady 10
7491    label $top.flab -text [mc "Output file:"]
7492    entry $top.fname -width 60
7493    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
7494    grid $top.flab $top.fname -sticky w
7495    frame $top.buts
7496    button $top.buts.gen -text [mc "Write"] -command wrcomgo
7497    button $top.buts.can -text [mc "Cancel"] -command wrcomcan
7498    grid $top.buts.gen $top.buts.can
7499    grid columnconfigure $top.buts 0 -weight 1 -uniform a
7500    grid columnconfigure $top.buts 1 -weight 1 -uniform a
7501    grid $top.buts - -pady 10 -sticky ew
7502    focus $top.fname
7503}
7504
7505proc wrcomgo {} {
7506    global wrcomtop
7507
7508    set id [$wrcomtop.sha1 get]
7509    set cmd "echo $id | [$wrcomtop.cmd get]"
7510    set fname [$wrcomtop.fname get]
7511    if {[catch {exec sh -c $cmd >$fname &} err]} {
7512        error_popup "[mc "Error writing commit:"] $err"
7513    }
7514    catch {destroy $wrcomtop}
7515    unset wrcomtop
7516}
7517
7518proc wrcomcan {} {
7519    global wrcomtop
7520
7521    catch {destroy $wrcomtop}
7522    unset wrcomtop
7523}
7524
7525proc mkbranch {} {
7526    global rowmenuid mkbrtop
7527
7528    set top .makebranch
7529    catch {destroy $top}
7530    toplevel $top
7531    label $top.title -text [mc "Create new branch"]
7532    grid $top.title - -pady 10
7533    label $top.id -text [mc "ID:"]
7534    entry $top.sha1 -width 40 -relief flat
7535    $top.sha1 insert 0 $rowmenuid
7536    $top.sha1 conf -state readonly
7537    grid $top.id $top.sha1 -sticky w
7538    label $top.nlab -text [mc "Name:"]
7539    entry $top.name -width 40
7540    grid $top.nlab $top.name -sticky w
7541    frame $top.buts
7542    button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
7543    button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
7544    grid $top.buts.go $top.buts.can
7545    grid columnconfigure $top.buts 0 -weight 1 -uniform a
7546    grid columnconfigure $top.buts 1 -weight 1 -uniform a
7547    grid $top.buts - -pady 10 -sticky ew
7548    focus $top.name
7549}
7550
7551proc mkbrgo {top} {
7552    global headids idheads
7553
7554    set name [$top.name get]
7555    set id [$top.sha1 get]
7556    if {$name eq {}} {
7557        error_popup [mc "Please specify a name for the new branch"]
7558        return
7559    }
7560    catch {destroy $top}
7561    nowbusy newbranch
7562    update
7563    if {[catch {
7564        exec git branch $name $id
7565    } err]} {
7566        notbusy newbranch
7567        error_popup $err
7568    } else {
7569        set headids($name) $id
7570        lappend idheads($id) $name
7571        addedhead $id $name
7572        notbusy newbranch
7573        redrawtags $id
7574        dispneartags 0
7575        run refill_reflist
7576    }
7577}
7578
7579proc cherrypick {} {
7580    global rowmenuid curview
7581    global mainhead mainheadid
7582
7583    set oldhead [exec git rev-parse HEAD]
7584    set dheads [descheads $rowmenuid]
7585    if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
7586        set ok [confirm_popup [mc "Commit %s is already\
7587                included in branch %s -- really re-apply it?" \
7588                                   [string range $rowmenuid 0 7] $mainhead]]
7589        if {!$ok} return
7590    }
7591    nowbusy cherrypick [mc "Cherry-picking"]
7592    update
7593    # Unfortunately git-cherry-pick writes stuff to stderr even when
7594    # no error occurs, and exec takes that as an indication of error...
7595    if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
7596        notbusy cherrypick
7597        error_popup $err
7598        return
7599    }
7600    set newhead [exec git rev-parse HEAD]
7601    if {$newhead eq $oldhead} {
7602        notbusy cherrypick
7603        error_popup [mc "No changes committed"]
7604        return
7605    }
7606    addnewchild $newhead $oldhead
7607    if {[commitinview $oldhead $curview]} {
7608        insertrow $newhead $oldhead $curview
7609        if {$mainhead ne {}} {
7610            movehead $newhead $mainhead
7611            movedhead $newhead $mainhead
7612        }
7613        set mainheadid $newhead
7614        redrawtags $oldhead
7615        redrawtags $newhead
7616        selbyid $newhead
7617    }
7618    notbusy cherrypick
7619}
7620
7621proc resethead {} {
7622    global mainhead rowmenuid confirm_ok resettype
7623
7624    set confirm_ok 0
7625    set w ".confirmreset"
7626    toplevel $w
7627    wm transient $w .
7628    wm title $w [mc "Confirm reset"]
7629    message $w.m -text \
7630        [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
7631        -justify center -aspect 1000
7632    pack $w.m -side top -fill x -padx 20 -pady 20
7633    frame $w.f -relief sunken -border 2
7634    message $w.f.rt -text [mc "Reset type:"] -aspect 1000
7635    grid $w.f.rt -sticky w
7636    set resettype mixed
7637    radiobutton $w.f.soft -value soft -variable resettype -justify left \
7638        -text [mc "Soft: Leave working tree and index untouched"]
7639    grid $w.f.soft -sticky w
7640    radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
7641        -text [mc "Mixed: Leave working tree untouched, reset index"]
7642    grid $w.f.mixed -sticky w
7643    radiobutton $w.f.hard -value hard -variable resettype -justify left \
7644        -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
7645    grid $w.f.hard -sticky w
7646    pack $w.f -side top -fill x
7647    button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
7648    pack $w.ok -side left -fill x -padx 20 -pady 20
7649    button $w.cancel -text [mc Cancel] -command "destroy $w"
7650    pack $w.cancel -side right -fill x -padx 20 -pady 20
7651    bind $w <Visibility> "grab $w; focus $w"
7652    tkwait window $w
7653    if {!$confirm_ok} return
7654    if {[catch {set fd [open \
7655            [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
7656        error_popup $err
7657    } else {
7658        dohidelocalchanges
7659        filerun $fd [list readresetstat $fd]
7660        nowbusy reset [mc "Resetting"]
7661        selbyid $rowmenuid
7662    }
7663}
7664
7665proc readresetstat {fd} {
7666    global mainhead mainheadid showlocalchanges rprogcoord
7667
7668    if {[gets $fd line] >= 0} {
7669        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
7670            set rprogcoord [expr {1.0 * $m / $n}]
7671            adjustprogress
7672        }
7673        return 1
7674    }
7675    set rprogcoord 0
7676    adjustprogress
7677    notbusy reset
7678    if {[catch {close $fd} err]} {
7679        error_popup $err
7680    }
7681    set oldhead $mainheadid
7682    set newhead [exec git rev-parse HEAD]
7683    if {$newhead ne $oldhead} {
7684        movehead $newhead $mainhead
7685        movedhead $newhead $mainhead
7686        set mainheadid $newhead
7687        redrawtags $oldhead
7688        redrawtags $newhead
7689    }
7690    if {$showlocalchanges} {
7691        doshowlocalchanges
7692    }
7693    return 0
7694}
7695
7696# context menu for a head
7697proc headmenu {x y id head} {
7698    global headmenuid headmenuhead headctxmenu mainhead
7699
7700    stopfinding
7701    set headmenuid $id
7702    set headmenuhead $head
7703    set state normal
7704    if {$head eq $mainhead} {
7705        set state disabled
7706    }
7707    $headctxmenu entryconfigure 0 -state $state
7708    $headctxmenu entryconfigure 1 -state $state
7709    tk_popup $headctxmenu $x $y
7710}
7711
7712proc cobranch {} {
7713    global headmenuid headmenuhead headids
7714    global showlocalchanges mainheadid
7715
7716    # check the tree is clean first??
7717    nowbusy checkout [mc "Checking out"]
7718    update
7719    dohidelocalchanges
7720    if {[catch {
7721        set fd [open [list | git checkout $headmenuhead 2>@1] r]
7722    } err]} {
7723        notbusy checkout
7724        error_popup $err
7725        if {$showlocalchanges} {
7726            dodiffindex
7727        }
7728    } else {
7729        filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
7730    }
7731}
7732
7733proc readcheckoutstat {fd newhead newheadid} {
7734    global mainhead mainheadid headids showlocalchanges progresscoords
7735
7736    if {[gets $fd line] >= 0} {
7737        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
7738            set progresscoords [list 0 [expr {1.0 * $m / $n}]]
7739            adjustprogress
7740        }
7741        return 1
7742    }
7743    set progresscoords {0 0}
7744    adjustprogress
7745    notbusy checkout
7746    if {[catch {close $fd} err]} {
7747        error_popup $err
7748    }
7749    set oldmainid $mainheadid
7750    set mainhead $newhead
7751    set mainheadid $newheadid
7752    redrawtags $oldmainid
7753    redrawtags $newheadid
7754    selbyid $newheadid
7755    if {$showlocalchanges} {
7756        dodiffindex
7757    }
7758}
7759
7760proc rmbranch {} {
7761    global headmenuid headmenuhead mainhead
7762    global idheads
7763
7764    set head $headmenuhead
7765    set id $headmenuid
7766    # this check shouldn't be needed any more...
7767    if {$head eq $mainhead} {
7768        error_popup [mc "Cannot delete the currently checked-out branch"]
7769        return
7770    }
7771    set dheads [descheads $id]
7772    if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
7773        # the stuff on this branch isn't on any other branch
7774        if {![confirm_popup [mc "The commits on branch %s aren't on any other\
7775                        branch.\nReally delete branch %s?" $head $head]]} return
7776    }
7777    nowbusy rmbranch
7778    update
7779    if {[catch {exec git branch -D $head} err]} {
7780        notbusy rmbranch
7781        error_popup $err
7782        return
7783    }
7784    removehead $id $head
7785    removedhead $id $head
7786    redrawtags $id
7787    notbusy rmbranch
7788    dispneartags 0
7789    run refill_reflist
7790}
7791
7792# Display a list of tags and heads
7793proc showrefs {} {
7794    global showrefstop bgcolor fgcolor selectbgcolor
7795    global bglist fglist reflistfilter reflist maincursor
7796
7797    set top .showrefs
7798    set showrefstop $top
7799    if {[winfo exists $top]} {
7800        raise $top
7801        refill_reflist
7802        return
7803    }
7804    toplevel $top
7805    wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
7806    text $top.list -background $bgcolor -foreground $fgcolor \
7807        -selectbackground $selectbgcolor -font mainfont \
7808        -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
7809        -width 30 -height 20 -cursor $maincursor \
7810        -spacing1 1 -spacing3 1 -state disabled
7811    $top.list tag configure highlight -background $selectbgcolor
7812    lappend bglist $top.list
7813    lappend fglist $top.list
7814    scrollbar $top.ysb -command "$top.list yview" -orient vertical
7815    scrollbar $top.xsb -command "$top.list xview" -orient horizontal
7816    grid $top.list $top.ysb -sticky nsew
7817    grid $top.xsb x -sticky ew
7818    frame $top.f
7819    label $top.f.l -text "[mc "Filter"]: "
7820    entry $top.f.e -width 20 -textvariable reflistfilter
7821    set reflistfilter "*"
7822    trace add variable reflistfilter write reflistfilter_change
7823    pack $top.f.e -side right -fill x -expand 1
7824    pack $top.f.l -side left
7825    grid $top.f - -sticky ew -pady 2
7826    button $top.close -command [list destroy $top] -text [mc "Close"]
7827    grid $top.close -
7828    grid columnconfigure $top 0 -weight 1
7829    grid rowconfigure $top 0 -weight 1
7830    bind $top.list <1> {break}
7831    bind $top.list <B1-Motion> {break}
7832    bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
7833    set reflist {}
7834    refill_reflist
7835}
7836
7837proc sel_reflist {w x y} {
7838    global showrefstop reflist headids tagids otherrefids
7839
7840    if {![winfo exists $showrefstop]} return
7841    set l [lindex [split [$w index "@$x,$y"] "."] 0]
7842    set ref [lindex $reflist [expr {$l-1}]]
7843    set n [lindex $ref 0]
7844    switch -- [lindex $ref 1] {
7845        "H" {selbyid $headids($n)}
7846        "T" {selbyid $tagids($n)}
7847        "o" {selbyid $otherrefids($n)}
7848    }
7849    $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
7850}
7851
7852proc unsel_reflist {} {
7853    global showrefstop
7854
7855    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7856    $showrefstop.list tag remove highlight 0.0 end
7857}
7858
7859proc reflistfilter_change {n1 n2 op} {
7860    global reflistfilter
7861
7862    after cancel refill_reflist
7863    after 200 refill_reflist
7864}
7865
7866proc refill_reflist {} {
7867    global reflist reflistfilter showrefstop headids tagids otherrefids
7868    global curview commitinterest
7869
7870    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
7871    set refs {}
7872    foreach n [array names headids] {
7873        if {[string match $reflistfilter $n]} {
7874            if {[commitinview $headids($n) $curview]} {
7875                lappend refs [list $n H]
7876            } else {
7877                set commitinterest($headids($n)) {run refill_reflist}
7878            }
7879        }
7880    }
7881    foreach n [array names tagids] {
7882        if {[string match $reflistfilter $n]} {
7883            if {[commitinview $tagids($n) $curview]} {
7884                lappend refs [list $n T]
7885            } else {
7886                set commitinterest($tagids($n)) {run refill_reflist}
7887            }
7888        }
7889    }
7890    foreach n [array names otherrefids] {
7891        if {[string match $reflistfilter $n]} {
7892            if {[commitinview $otherrefids($n) $curview]} {
7893                lappend refs [list $n o]
7894            } else {
7895                set commitinterest($otherrefids($n)) {run refill_reflist}
7896            }
7897        }
7898    }
7899    set refs [lsort -index 0 $refs]
7900    if {$refs eq $reflist} return
7901
7902    # Update the contents of $showrefstop.list according to the
7903    # differences between $reflist (old) and $refs (new)
7904    $showrefstop.list conf -state normal
7905    $showrefstop.list insert end "\n"
7906    set i 0
7907    set j 0
7908    while {$i < [llength $reflist] || $j < [llength $refs]} {
7909        if {$i < [llength $reflist]} {
7910            if {$j < [llength $refs]} {
7911                set cmp [string compare [lindex $reflist $i 0] \
7912                             [lindex $refs $j 0]]
7913                if {$cmp == 0} {
7914                    set cmp [string compare [lindex $reflist $i 1] \
7915                                 [lindex $refs $j 1]]
7916                }
7917            } else {
7918                set cmp -1
7919            }
7920        } else {
7921            set cmp 1
7922        }
7923        switch -- $cmp {
7924            -1 {
7925                $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
7926                incr i
7927            }
7928            0 {
7929                incr i
7930                incr j
7931            }
7932            1 {
7933                set l [expr {$j + 1}]
7934                $showrefstop.list image create $l.0 -align baseline \
7935                    -image reficon-[lindex $refs $j 1] -padx 2
7936                $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
7937                incr j
7938            }
7939        }
7940    }
7941    set reflist $refs
7942    # delete last newline
7943    $showrefstop.list delete end-2c end-1c
7944    $showrefstop.list conf -state disabled
7945}
7946
7947# Stuff for finding nearby tags
7948proc getallcommits {} {
7949    global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
7950    global idheads idtags idotherrefs allparents tagobjid
7951
7952    if {![info exists allcommits]} {
7953        set nextarc 0
7954        set allcommits 0
7955        set seeds {}
7956        set allcwait 0
7957        set cachedarcs 0
7958        set allccache [file join [gitdir] "gitk.cache"]
7959        if {![catch {
7960            set f [open $allccache r]
7961            set allcwait 1
7962            getcache $f
7963        }]} return
7964    }
7965
7966    if {$allcwait} {
7967        return
7968    }
7969    set cmd [list | git rev-list --parents]
7970    set allcupdate [expr {$seeds ne {}}]
7971    if {!$allcupdate} {
7972        set ids "--all"
7973    } else {
7974        set refs [concat [array names idheads] [array names idtags] \
7975                      [array names idotherrefs]]
7976        set ids {}
7977        set tagobjs {}
7978        foreach name [array names tagobjid] {
7979            lappend tagobjs $tagobjid($name)
7980        }
7981        foreach id [lsort -unique $refs] {
7982            if {![info exists allparents($id)] &&
7983                [lsearch -exact $tagobjs $id] < 0} {
7984                lappend ids $id
7985            }
7986        }
7987        if {$ids ne {}} {
7988            foreach id $seeds {
7989                lappend ids "^$id"
7990            }
7991        }
7992    }
7993    if {$ids ne {}} {
7994        set fd [open [concat $cmd $ids] r]
7995        fconfigure $fd -blocking 0
7996        incr allcommits
7997        nowbusy allcommits
7998        filerun $fd [list getallclines $fd]
7999    } else {
8000        dispneartags 0
8001    }
8002}
8003
8004# Since most commits have 1 parent and 1 child, we group strings of
8005# such commits into "arcs" joining branch/merge points (BMPs), which
8006# are commits that either don't have 1 parent or don't have 1 child.
8007#
8008# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
8009# arcout(id) - outgoing arcs for BMP
8010# arcids(a) - list of IDs on arc including end but not start
8011# arcstart(a) - BMP ID at start of arc
8012# arcend(a) - BMP ID at end of arc
8013# growing(a) - arc a is still growing
8014# arctags(a) - IDs out of arcids (excluding end) that have tags
8015# archeads(a) - IDs out of arcids (excluding end) that have heads
8016# The start of an arc is at the descendent end, so "incoming" means
8017# coming from descendents, and "outgoing" means going towards ancestors.
8018
8019proc getallclines {fd} {
8020    global allparents allchildren idtags idheads nextarc
8021    global arcnos arcids arctags arcout arcend arcstart archeads growing
8022    global seeds allcommits cachedarcs allcupdate
8023    
8024    set nid 0
8025    while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
8026        set id [lindex $line 0]
8027        if {[info exists allparents($id)]} {
8028            # seen it already
8029            continue
8030        }
8031        set cachedarcs 0
8032        set olds [lrange $line 1 end]
8033        set allparents($id) $olds
8034        if {![info exists allchildren($id)]} {
8035            set allchildren($id) {}
8036            set arcnos($id) {}
8037            lappend seeds $id
8038        } else {
8039            set a $arcnos($id)
8040            if {[llength $olds] == 1 && [llength $a] == 1} {
8041                lappend arcids($a) $id
8042                if {[info exists idtags($id)]} {
8043                    lappend arctags($a) $id
8044                }
8045                if {[info exists idheads($id)]} {
8046                    lappend archeads($a) $id
8047                }
8048                if {[info exists allparents($olds)]} {
8049                    # seen parent already
8050                    if {![info exists arcout($olds)]} {
8051                        splitarc $olds
8052                    }
8053                    lappend arcids($a) $olds
8054                    set arcend($a) $olds
8055                    unset growing($a)
8056                }
8057                lappend allchildren($olds) $id
8058                lappend arcnos($olds) $a
8059                continue
8060            }
8061        }
8062        foreach a $arcnos($id) {
8063            lappend arcids($a) $id
8064            set arcend($a) $id
8065            unset growing($a)
8066        }
8067
8068        set ao {}
8069        foreach p $olds {
8070            lappend allchildren($p) $id
8071            set a [incr nextarc]
8072            set arcstart($a) $id
8073            set archeads($a) {}
8074            set arctags($a) {}
8075            set archeads($a) {}
8076            set arcids($a) {}
8077            lappend ao $a
8078            set growing($a) 1
8079            if {[info exists allparents($p)]} {
8080                # seen it already, may need to make a new branch
8081                if {![info exists arcout($p)]} {
8082                    splitarc $p
8083                }
8084                lappend arcids($a) $p
8085                set arcend($a) $p
8086                unset growing($a)
8087            }
8088            lappend arcnos($p) $a
8089        }
8090        set arcout($id) $ao
8091    }
8092    if {$nid > 0} {
8093        global cached_dheads cached_dtags cached_atags
8094        catch {unset cached_dheads}
8095        catch {unset cached_dtags}
8096        catch {unset cached_atags}
8097    }
8098    if {![eof $fd]} {
8099        return [expr {$nid >= 1000? 2: 1}]
8100    }
8101    set cacheok 1
8102    if {[catch {
8103        fconfigure $fd -blocking 1
8104        close $fd
8105    } err]} {
8106        # got an error reading the list of commits
8107        # if we were updating, try rereading the whole thing again
8108        if {$allcupdate} {
8109            incr allcommits -1
8110            dropcache $err
8111            return
8112        }
8113        error_popup "[mc "Error reading commit topology information;\
8114                branch and preceding/following tag information\
8115                will be incomplete."]\n($err)"
8116        set cacheok 0
8117    }
8118    if {[incr allcommits -1] == 0} {
8119        notbusy allcommits
8120        if {$cacheok} {
8121            run savecache
8122        }
8123    }
8124    dispneartags 0
8125    return 0
8126}
8127
8128proc recalcarc {a} {
8129    global arctags archeads arcids idtags idheads
8130
8131    set at {}
8132    set ah {}
8133    foreach id [lrange $arcids($a) 0 end-1] {
8134        if {[info exists idtags($id)]} {
8135            lappend at $id
8136        }
8137        if {[info exists idheads($id)]} {
8138            lappend ah $id
8139        }
8140    }
8141    set arctags($a) $at
8142    set archeads($a) $ah
8143}
8144
8145proc splitarc {p} {
8146    global arcnos arcids nextarc arctags archeads idtags idheads
8147    global arcstart arcend arcout allparents growing
8148
8149    set a $arcnos($p)
8150    if {[llength $a] != 1} {
8151        puts "oops splitarc called but [llength $a] arcs already"
8152        return
8153    }
8154    set a [lindex $a 0]
8155    set i [lsearch -exact $arcids($a) $p]
8156    if {$i < 0} {
8157        puts "oops splitarc $p not in arc $a"
8158        return
8159    }
8160    set na [incr nextarc]
8161    if {[info exists arcend($a)]} {
8162        set arcend($na) $arcend($a)
8163    } else {
8164        set l [lindex $allparents([lindex $arcids($a) end]) 0]
8165        set j [lsearch -exact $arcnos($l) $a]
8166        set arcnos($l) [lreplace $arcnos($l) $j $j $na]
8167    }
8168    set tail [lrange $arcids($a) [expr {$i+1}] end]
8169    set arcids($a) [lrange $arcids($a) 0 $i]
8170    set arcend($a) $p
8171    set arcstart($na) $p
8172    set arcout($p) $na
8173    set arcids($na) $tail
8174    if {[info exists growing($a)]} {
8175        set growing($na) 1
8176        unset growing($a)
8177    }
8178
8179    foreach id $tail {
8180        if {[llength $arcnos($id)] == 1} {
8181            set arcnos($id) $na
8182        } else {
8183            set j [lsearch -exact $arcnos($id) $a]
8184            set arcnos($id) [lreplace $arcnos($id) $j $j $na]
8185        }
8186    }
8187
8188    # reconstruct tags and heads lists
8189    if {$arctags($a) ne {} || $archeads($a) ne {}} {
8190        recalcarc $a
8191        recalcarc $na
8192    } else {
8193        set arctags($na) {}
8194        set archeads($na) {}
8195    }
8196}
8197
8198# Update things for a new commit added that is a child of one
8199# existing commit.  Used when cherry-picking.
8200proc addnewchild {id p} {
8201    global allparents allchildren idtags nextarc
8202    global arcnos arcids arctags arcout arcend arcstart archeads growing
8203    global seeds allcommits
8204
8205    if {![info exists allcommits] || ![info exists arcnos($p)]} return
8206    set allparents($id) [list $p]
8207    set allchildren($id) {}
8208    set arcnos($id) {}
8209    lappend seeds $id
8210    lappend allchildren($p) $id
8211    set a [incr nextarc]
8212    set arcstart($a) $id
8213    set archeads($a) {}
8214    set arctags($a) {}
8215    set arcids($a) [list $p]
8216    set arcend($a) $p
8217    if {![info exists arcout($p)]} {
8218        splitarc $p
8219    }
8220    lappend arcnos($p) $a
8221    set arcout($id) [list $a]
8222}
8223
8224# This implements a cache for the topology information.
8225# The cache saves, for each arc, the start and end of the arc,
8226# the ids on the arc, and the outgoing arcs from the end.
8227proc readcache {f} {
8228    global arcnos arcids arcout arcstart arcend arctags archeads nextarc
8229    global idtags idheads allparents cachedarcs possible_seeds seeds growing
8230    global allcwait
8231
8232    set a $nextarc
8233    set lim $cachedarcs
8234    if {$lim - $a > 500} {
8235        set lim [expr {$a + 500}]
8236    }
8237    if {[catch {
8238        if {$a == $lim} {
8239            # finish reading the cache and setting up arctags, etc.
8240            set line [gets $f]
8241            if {$line ne "1"} {error "bad final version"}
8242            close $f
8243            foreach id [array names idtags] {
8244                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
8245                    [llength $allparents($id)] == 1} {
8246                    set a [lindex $arcnos($id) 0]
8247                    if {$arctags($a) eq {}} {
8248                        recalcarc $a
8249                    }
8250                }
8251            }
8252            foreach id [array names idheads] {
8253                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
8254                    [llength $allparents($id)] == 1} {
8255                    set a [lindex $arcnos($id) 0]
8256                    if {$archeads($a) eq {}} {
8257                        recalcarc $a
8258                    }
8259                }
8260            }
8261            foreach id [lsort -unique $possible_seeds] {
8262                if {$arcnos($id) eq {}} {
8263                    lappend seeds $id
8264                }
8265            }
8266            set allcwait 0
8267        } else {
8268            while {[incr a] <= $lim} {
8269                set line [gets $f]
8270                if {[llength $line] != 3} {error "bad line"}
8271                set s [lindex $line 0]
8272                set arcstart($a) $s
8273                lappend arcout($s) $a
8274                if {![info exists arcnos($s)]} {
8275                    lappend possible_seeds $s
8276                    set arcnos($s) {}
8277                }
8278                set e [lindex $line 1]
8279                if {$e eq {}} {
8280                    set growing($a) 1
8281                } else {
8282                    set arcend($a) $e
8283                    if {![info exists arcout($e)]} {
8284                        set arcout($e) {}
8285                    }
8286                }
8287                set arcids($a) [lindex $line 2]
8288                foreach id $arcids($a) {
8289                    lappend allparents($s) $id
8290                    set s $id
8291                    lappend arcnos($id) $a
8292                }
8293                if {![info exists allparents($s)]} {
8294                    set allparents($s) {}
8295                }
8296                set arctags($a) {}
8297                set archeads($a) {}
8298            }
8299            set nextarc [expr {$a - 1}]
8300        }
8301    } err]} {
8302        dropcache $err
8303        return 0
8304    }
8305    if {!$allcwait} {
8306        getallcommits
8307    }
8308    return $allcwait
8309}
8310
8311proc getcache {f} {
8312    global nextarc cachedarcs possible_seeds
8313
8314    if {[catch {
8315        set line [gets $f]
8316        if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
8317        # make sure it's an integer
8318        set cachedarcs [expr {int([lindex $line 1])}]
8319        if {$cachedarcs < 0} {error "bad number of arcs"}
8320        set nextarc 0
8321        set possible_seeds {}
8322        run readcache $f
8323    } err]} {
8324        dropcache $err
8325    }
8326    return 0
8327}
8328
8329proc dropcache {err} {
8330    global allcwait nextarc cachedarcs seeds
8331
8332    #puts "dropping cache ($err)"
8333    foreach v {arcnos arcout arcids arcstart arcend growing \
8334                   arctags archeads allparents allchildren} {
8335        global $v
8336        catch {unset $v}
8337    }
8338    set allcwait 0
8339    set nextarc 0
8340    set cachedarcs 0
8341    set seeds {}
8342    getallcommits
8343}
8344
8345proc writecache {f} {
8346    global cachearc cachedarcs allccache
8347    global arcstart arcend arcnos arcids arcout
8348
8349    set a $cachearc
8350    set lim $cachedarcs
8351    if {$lim - $a > 1000} {
8352        set lim [expr {$a + 1000}]
8353    }
8354    if {[catch {
8355        while {[incr a] <= $lim} {
8356            if {[info exists arcend($a)]} {
8357                puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
8358            } else {
8359                puts $f [list $arcstart($a) {} $arcids($a)]
8360            }
8361        }
8362    } err]} {
8363        catch {close $f}
8364        catch {file delete $allccache}
8365        #puts "writing cache failed ($err)"
8366        return 0
8367    }
8368    set cachearc [expr {$a - 1}]
8369    if {$a > $cachedarcs} {
8370        puts $f "1"
8371        close $f
8372        return 0
8373    }
8374    return 1
8375}
8376
8377proc savecache {} {
8378    global nextarc cachedarcs cachearc allccache
8379
8380    if {$nextarc == $cachedarcs} return
8381    set cachearc 0
8382    set cachedarcs $nextarc
8383    catch {
8384        set f [open $allccache w]
8385        puts $f [list 1 $cachedarcs]
8386        run writecache $f
8387    }
8388}
8389
8390# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
8391# or 0 if neither is true.
8392proc anc_or_desc {a b} {
8393    global arcout arcstart arcend arcnos cached_isanc
8394
8395    if {$arcnos($a) eq $arcnos($b)} {
8396        # Both are on the same arc(s); either both are the same BMP,
8397        # or if one is not a BMP, the other is also not a BMP or is
8398        # the BMP at end of the arc (and it only has 1 incoming arc).
8399        # Or both can be BMPs with no incoming arcs.
8400        if {$a eq $b || $arcnos($a) eq {}} {
8401            return 0
8402        }
8403        # assert {[llength $arcnos($a)] == 1}
8404        set arc [lindex $arcnos($a) 0]
8405        set i [lsearch -exact $arcids($arc) $a]
8406        set j [lsearch -exact $arcids($arc) $b]
8407        if {$i < 0 || $i > $j} {
8408            return 1
8409        } else {
8410            return -1
8411        }
8412    }
8413
8414    if {![info exists arcout($a)]} {
8415        set arc [lindex $arcnos($a) 0]
8416        if {[info exists arcend($arc)]} {
8417            set aend $arcend($arc)
8418        } else {
8419            set aend {}
8420        }
8421        set a $arcstart($arc)
8422    } else {
8423        set aend $a
8424    }
8425    if {![info exists arcout($b)]} {
8426        set arc [lindex $arcnos($b) 0]
8427        if {[info exists arcend($arc)]} {
8428            set bend $arcend($arc)
8429        } else {
8430            set bend {}
8431        }
8432        set b $arcstart($arc)
8433    } else {
8434        set bend $b
8435    }
8436    if {$a eq $bend} {
8437        return 1
8438    }
8439    if {$b eq $aend} {
8440        return -1
8441    }
8442    if {[info exists cached_isanc($a,$bend)]} {
8443        if {$cached_isanc($a,$bend)} {
8444            return 1
8445        }
8446    }
8447    if {[info exists cached_isanc($b,$aend)]} {
8448        if {$cached_isanc($b,$aend)} {
8449            return -1
8450        }
8451        if {[info exists cached_isanc($a,$bend)]} {
8452            return 0
8453        }
8454    }
8455
8456    set todo [list $a $b]
8457    set anc($a) a
8458    set anc($b) b
8459    for {set i 0} {$i < [llength $todo]} {incr i} {
8460        set x [lindex $todo $i]
8461        if {$anc($x) eq {}} {
8462            continue
8463        }
8464        foreach arc $arcnos($x) {
8465            set xd $arcstart($arc)
8466            if {$xd eq $bend} {
8467                set cached_isanc($a,$bend) 1
8468                set cached_isanc($b,$aend) 0
8469                return 1
8470            } elseif {$xd eq $aend} {
8471                set cached_isanc($b,$aend) 1
8472                set cached_isanc($a,$bend) 0
8473                return -1
8474            }
8475            if {![info exists anc($xd)]} {
8476                set anc($xd) $anc($x)
8477                lappend todo $xd
8478            } elseif {$anc($xd) ne $anc($x)} {
8479                set anc($xd) {}
8480            }
8481        }
8482    }
8483    set cached_isanc($a,$bend) 0
8484    set cached_isanc($b,$aend) 0
8485    return 0
8486}
8487
8488# This identifies whether $desc has an ancestor that is
8489# a growing tip of the graph and which is not an ancestor of $anc
8490# and returns 0 if so and 1 if not.
8491# If we subsequently discover a tag on such a growing tip, and that
8492# turns out to be a descendent of $anc (which it could, since we
8493# don't necessarily see children before parents), then $desc
8494# isn't a good choice to display as a descendent tag of
8495# $anc (since it is the descendent of another tag which is
8496# a descendent of $anc).  Similarly, $anc isn't a good choice to
8497# display as a ancestor tag of $desc.
8498#
8499proc is_certain {desc anc} {
8500    global arcnos arcout arcstart arcend growing problems
8501
8502    set certain {}
8503    if {[llength $arcnos($anc)] == 1} {
8504        # tags on the same arc are certain
8505        if {$arcnos($desc) eq $arcnos($anc)} {
8506            return 1
8507        }
8508        if {![info exists arcout($anc)]} {
8509            # if $anc is partway along an arc, use the start of the arc instead
8510            set a [lindex $arcnos($anc) 0]
8511            set anc $arcstart($a)
8512        }
8513    }
8514    if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
8515        set x $desc
8516    } else {
8517        set a [lindex $arcnos($desc) 0]
8518        set x $arcend($a)
8519    }
8520    if {$x == $anc} {
8521        return 1
8522    }
8523    set anclist [list $x]
8524    set dl($x) 1
8525    set nnh 1
8526    set ngrowanc 0
8527    for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
8528        set x [lindex $anclist $i]
8529        if {$dl($x)} {
8530            incr nnh -1
8531        }
8532        set done($x) 1
8533        foreach a $arcout($x) {
8534            if {[info exists growing($a)]} {
8535                if {![info exists growanc($x)] && $dl($x)} {
8536                    set growanc($x) 1
8537                    incr ngrowanc
8538                }
8539            } else {
8540                set y $arcend($a)
8541                if {[info exists dl($y)]} {
8542                    if {$dl($y)} {
8543                        if {!$dl($x)} {
8544                            set dl($y) 0
8545                            if {![info exists done($y)]} {
8546                                incr nnh -1
8547                            }
8548                            if {[info exists growanc($x)]} {
8549                                incr ngrowanc -1
8550                            }
8551                            set xl [list $y]
8552                            for {set k 0} {$k < [llength $xl]} {incr k} {
8553                                set z [lindex $xl $k]
8554                                foreach c $arcout($z) {
8555                                    if {[info exists arcend($c)]} {
8556                                        set v $arcend($c)
8557                                        if {[info exists dl($v)] && $dl($v)} {
8558                                            set dl($v) 0
8559                                            if {![info exists done($v)]} {
8560                                                incr nnh -1
8561                                            }
8562                                            if {[info exists growanc($v)]} {
8563                                                incr ngrowanc -1
8564                                            }
8565                                            lappend xl $v
8566                                        }
8567                                    }
8568                                }
8569                            }
8570                        }
8571                    }
8572                } elseif {$y eq $anc || !$dl($x)} {
8573                    set dl($y) 0
8574                    lappend anclist $y
8575                } else {
8576                    set dl($y) 1
8577                    lappend anclist $y
8578                    incr nnh
8579                }
8580            }
8581        }
8582    }
8583    foreach x [array names growanc] {
8584        if {$dl($x)} {
8585            return 0
8586        }
8587        return 0
8588    }
8589    return 1
8590}
8591
8592proc validate_arctags {a} {
8593    global arctags idtags
8594
8595    set i -1
8596    set na $arctags($a)
8597    foreach id $arctags($a) {
8598        incr i
8599        if {![info exists idtags($id)]} {
8600            set na [lreplace $na $i $i]
8601            incr i -1
8602        }
8603    }
8604    set arctags($a) $na
8605}
8606
8607proc validate_archeads {a} {
8608    global archeads idheads
8609
8610    set i -1
8611    set na $archeads($a)
8612    foreach id $archeads($a) {
8613        incr i
8614        if {![info exists idheads($id)]} {
8615            set na [lreplace $na $i $i]
8616            incr i -1
8617        }
8618    }
8619    set archeads($a) $na
8620}
8621
8622# Return the list of IDs that have tags that are descendents of id,
8623# ignoring IDs that are descendents of IDs already reported.
8624proc desctags {id} {
8625    global arcnos arcstart arcids arctags idtags allparents
8626    global growing cached_dtags
8627
8628    if {![info exists allparents($id)]} {
8629        return {}
8630    }
8631    set t1 [clock clicks -milliseconds]
8632    set argid $id
8633    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8634        # part-way along an arc; check that arc first
8635        set a [lindex $arcnos($id) 0]
8636        if {$arctags($a) ne {}} {
8637            validate_arctags $a
8638            set i [lsearch -exact $arcids($a) $id]
8639            set tid {}
8640            foreach t $arctags($a) {
8641                set j [lsearch -exact $arcids($a) $t]
8642                if {$j >= $i} break
8643                set tid $t
8644            }
8645            if {$tid ne {}} {
8646                return $tid
8647            }
8648        }
8649        set id $arcstart($a)
8650        if {[info exists idtags($id)]} {
8651            return $id
8652        }
8653    }
8654    if {[info exists cached_dtags($id)]} {
8655        return $cached_dtags($id)
8656    }
8657
8658    set origid $id
8659    set todo [list $id]
8660    set queued($id) 1
8661    set nc 1
8662    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8663        set id [lindex $todo $i]
8664        set done($id) 1
8665        set ta [info exists hastaggedancestor($id)]
8666        if {!$ta} {
8667            incr nc -1
8668        }
8669        # ignore tags on starting node
8670        if {!$ta && $i > 0} {
8671            if {[info exists idtags($id)]} {
8672                set tagloc($id) $id
8673                set ta 1
8674            } elseif {[info exists cached_dtags($id)]} {
8675                set tagloc($id) $cached_dtags($id)
8676                set ta 1
8677            }
8678        }
8679        foreach a $arcnos($id) {
8680            set d $arcstart($a)
8681            if {!$ta && $arctags($a) ne {}} {
8682                validate_arctags $a
8683                if {$arctags($a) ne {}} {
8684                    lappend tagloc($id) [lindex $arctags($a) end]
8685                }
8686            }
8687            if {$ta || $arctags($a) ne {}} {
8688                set tomark [list $d]
8689                for {set j 0} {$j < [llength $tomark]} {incr j} {
8690                    set dd [lindex $tomark $j]
8691                    if {![info exists hastaggedancestor($dd)]} {
8692                        if {[info exists done($dd)]} {
8693                            foreach b $arcnos($dd) {
8694                                lappend tomark $arcstart($b)
8695                            }
8696                            if {[info exists tagloc($dd)]} {
8697                                unset tagloc($dd)
8698                            }
8699                        } elseif {[info exists queued($dd)]} {
8700                            incr nc -1
8701                        }
8702                        set hastaggedancestor($dd) 1
8703                    }
8704                }
8705            }
8706            if {![info exists queued($d)]} {
8707                lappend todo $d
8708                set queued($d) 1
8709                if {![info exists hastaggedancestor($d)]} {
8710                    incr nc
8711                }
8712            }
8713        }
8714    }
8715    set tags {}
8716    foreach id [array names tagloc] {
8717        if {![info exists hastaggedancestor($id)]} {
8718            foreach t $tagloc($id) {
8719                if {[lsearch -exact $tags $t] < 0} {
8720                    lappend tags $t
8721                }
8722            }
8723        }
8724    }
8725    set t2 [clock clicks -milliseconds]
8726    set loopix $i
8727
8728    # remove tags that are descendents of other tags
8729    for {set i 0} {$i < [llength $tags]} {incr i} {
8730        set a [lindex $tags $i]
8731        for {set j 0} {$j < $i} {incr j} {
8732            set b [lindex $tags $j]
8733            set r [anc_or_desc $a $b]
8734            if {$r == 1} {
8735                set tags [lreplace $tags $j $j]
8736                incr j -1
8737                incr i -1
8738            } elseif {$r == -1} {
8739                set tags [lreplace $tags $i $i]
8740                incr i -1
8741                break
8742            }
8743        }
8744    }
8745
8746    if {[array names growing] ne {}} {
8747        # graph isn't finished, need to check if any tag could get
8748        # eclipsed by another tag coming later.  Simply ignore any
8749        # tags that could later get eclipsed.
8750        set ctags {}
8751        foreach t $tags {
8752            if {[is_certain $t $origid]} {
8753                lappend ctags $t
8754            }
8755        }
8756        if {$tags eq $ctags} {
8757            set cached_dtags($origid) $tags
8758        } else {
8759            set tags $ctags
8760        }
8761    } else {
8762        set cached_dtags($origid) $tags
8763    }
8764    set t3 [clock clicks -milliseconds]
8765    if {0 && $t3 - $t1 >= 100} {
8766        puts "iterating descendents ($loopix/[llength $todo] nodes) took\
8767            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8768    }
8769    return $tags
8770}
8771
8772proc anctags {id} {
8773    global arcnos arcids arcout arcend arctags idtags allparents
8774    global growing cached_atags
8775
8776    if {![info exists allparents($id)]} {
8777        return {}
8778    }
8779    set t1 [clock clicks -milliseconds]
8780    set argid $id
8781    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8782        # part-way along an arc; check that arc first
8783        set a [lindex $arcnos($id) 0]
8784        if {$arctags($a) ne {}} {
8785            validate_arctags $a
8786            set i [lsearch -exact $arcids($a) $id]
8787            foreach t $arctags($a) {
8788                set j [lsearch -exact $arcids($a) $t]
8789                if {$j > $i} {
8790                    return $t
8791                }
8792            }
8793        }
8794        if {![info exists arcend($a)]} {
8795            return {}
8796        }
8797        set id $arcend($a)
8798        if {[info exists idtags($id)]} {
8799            return $id
8800        }
8801    }
8802    if {[info exists cached_atags($id)]} {
8803        return $cached_atags($id)
8804    }
8805
8806    set origid $id
8807    set todo [list $id]
8808    set queued($id) 1
8809    set taglist {}
8810    set nc 1
8811    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
8812        set id [lindex $todo $i]
8813        set done($id) 1
8814        set td [info exists hastaggeddescendent($id)]
8815        if {!$td} {
8816            incr nc -1
8817        }
8818        # ignore tags on starting node
8819        if {!$td && $i > 0} {
8820            if {[info exists idtags($id)]} {
8821                set tagloc($id) $id
8822                set td 1
8823            } elseif {[info exists cached_atags($id)]} {
8824                set tagloc($id) $cached_atags($id)
8825                set td 1
8826            }
8827        }
8828        foreach a $arcout($id) {
8829            if {!$td && $arctags($a) ne {}} {
8830                validate_arctags $a
8831                if {$arctags($a) ne {}} {
8832                    lappend tagloc($id) [lindex $arctags($a) 0]
8833                }
8834            }
8835            if {![info exists arcend($a)]} continue
8836            set d $arcend($a)
8837            if {$td || $arctags($a) ne {}} {
8838                set tomark [list $d]
8839                for {set j 0} {$j < [llength $tomark]} {incr j} {
8840                    set dd [lindex $tomark $j]
8841                    if {![info exists hastaggeddescendent($dd)]} {
8842                        if {[info exists done($dd)]} {
8843                            foreach b $arcout($dd) {
8844                                if {[info exists arcend($b)]} {
8845                                    lappend tomark $arcend($b)
8846                                }
8847                            }
8848                            if {[info exists tagloc($dd)]} {
8849                                unset tagloc($dd)
8850                            }
8851                        } elseif {[info exists queued($dd)]} {
8852                            incr nc -1
8853                        }
8854                        set hastaggeddescendent($dd) 1
8855                    }
8856                }
8857            }
8858            if {![info exists queued($d)]} {
8859                lappend todo $d
8860                set queued($d) 1
8861                if {![info exists hastaggeddescendent($d)]} {
8862                    incr nc
8863                }
8864            }
8865        }
8866    }
8867    set t2 [clock clicks -milliseconds]
8868    set loopix $i
8869    set tags {}
8870    foreach id [array names tagloc] {
8871        if {![info exists hastaggeddescendent($id)]} {
8872            foreach t $tagloc($id) {
8873                if {[lsearch -exact $tags $t] < 0} {
8874                    lappend tags $t
8875                }
8876            }
8877        }
8878    }
8879
8880    # remove tags that are ancestors of other tags
8881    for {set i 0} {$i < [llength $tags]} {incr i} {
8882        set a [lindex $tags $i]
8883        for {set j 0} {$j < $i} {incr j} {
8884            set b [lindex $tags $j]
8885            set r [anc_or_desc $a $b]
8886            if {$r == -1} {
8887                set tags [lreplace $tags $j $j]
8888                incr j -1
8889                incr i -1
8890            } elseif {$r == 1} {
8891                set tags [lreplace $tags $i $i]
8892                incr i -1
8893                break
8894            }
8895        }
8896    }
8897
8898    if {[array names growing] ne {}} {
8899        # graph isn't finished, need to check if any tag could get
8900        # eclipsed by another tag coming later.  Simply ignore any
8901        # tags that could later get eclipsed.
8902        set ctags {}
8903        foreach t $tags {
8904            if {[is_certain $origid $t]} {
8905                lappend ctags $t
8906            }
8907        }
8908        if {$tags eq $ctags} {
8909            set cached_atags($origid) $tags
8910        } else {
8911            set tags $ctags
8912        }
8913    } else {
8914        set cached_atags($origid) $tags
8915    }
8916    set t3 [clock clicks -milliseconds]
8917    if {0 && $t3 - $t1 >= 100} {
8918        puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
8919            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
8920    }
8921    return $tags
8922}
8923
8924# Return the list of IDs that have heads that are descendents of id,
8925# including id itself if it has a head.
8926proc descheads {id} {
8927    global arcnos arcstart arcids archeads idheads cached_dheads
8928    global allparents
8929
8930    if {![info exists allparents($id)]} {
8931        return {}
8932    }
8933    set aret {}
8934    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
8935        # part-way along an arc; check it first
8936        set a [lindex $arcnos($id) 0]
8937        if {$archeads($a) ne {}} {
8938            validate_archeads $a
8939            set i [lsearch -exact $arcids($a) $id]
8940            foreach t $archeads($a) {
8941                set j [lsearch -exact $arcids($a) $t]
8942                if {$j > $i} break
8943                lappend aret $t
8944            }
8945        }
8946        set id $arcstart($a)
8947    }
8948    set origid $id
8949    set todo [list $id]
8950    set seen($id) 1
8951    set ret {}
8952    for {set i 0} {$i < [llength $todo]} {incr i} {
8953        set id [lindex $todo $i]
8954        if {[info exists cached_dheads($id)]} {
8955            set ret [concat $ret $cached_dheads($id)]
8956        } else {
8957            if {[info exists idheads($id)]} {
8958                lappend ret $id
8959            }
8960            foreach a $arcnos($id) {
8961                if {$archeads($a) ne {}} {
8962                    validate_archeads $a
8963                    if {$archeads($a) ne {}} {
8964                        set ret [concat $ret $archeads($a)]
8965                    }
8966                }
8967                set d $arcstart($a)
8968                if {![info exists seen($d)]} {
8969                    lappend todo $d
8970                    set seen($d) 1
8971                }
8972            }
8973        }
8974    }
8975    set ret [lsort -unique $ret]
8976    set cached_dheads($origid) $ret
8977    return [concat $ret $aret]
8978}
8979
8980proc addedtag {id} {
8981    global arcnos arcout cached_dtags cached_atags
8982
8983    if {![info exists arcnos($id)]} return
8984    if {![info exists arcout($id)]} {
8985        recalcarc [lindex $arcnos($id) 0]
8986    }
8987    catch {unset cached_dtags}
8988    catch {unset cached_atags}
8989}
8990
8991proc addedhead {hid head} {
8992    global arcnos arcout cached_dheads
8993
8994    if {![info exists arcnos($hid)]} return
8995    if {![info exists arcout($hid)]} {
8996        recalcarc [lindex $arcnos($hid) 0]
8997    }
8998    catch {unset cached_dheads}
8999}
9000
9001proc removedhead {hid head} {
9002    global cached_dheads
9003
9004    catch {unset cached_dheads}
9005}
9006
9007proc movedhead {hid head} {
9008    global arcnos arcout cached_dheads
9009
9010    if {![info exists arcnos($hid)]} return
9011    if {![info exists arcout($hid)]} {
9012        recalcarc [lindex $arcnos($hid) 0]
9013    }
9014    catch {unset cached_dheads}
9015}
9016
9017proc changedrefs {} {
9018    global cached_dheads cached_dtags cached_atags
9019    global arctags archeads arcnos arcout idheads idtags
9020
9021    foreach id [concat [array names idheads] [array names idtags]] {
9022        if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
9023            set a [lindex $arcnos($id) 0]
9024            if {![info exists donearc($a)]} {
9025                recalcarc $a
9026                set donearc($a) 1
9027            }
9028        }
9029    }
9030    catch {unset cached_dtags}
9031    catch {unset cached_atags}
9032    catch {unset cached_dheads}
9033}
9034
9035proc rereadrefs {} {
9036    global idtags idheads idotherrefs mainheadid
9037
9038    set refids [concat [array names idtags] \
9039                    [array names idheads] [array names idotherrefs]]
9040    foreach id $refids {
9041        if {![info exists ref($id)]} {
9042            set ref($id) [listrefs $id]
9043        }
9044    }
9045    set oldmainhead $mainheadid
9046    readrefs
9047    changedrefs
9048    set refids [lsort -unique [concat $refids [array names idtags] \
9049                        [array names idheads] [array names idotherrefs]]]
9050    foreach id $refids {
9051        set v [listrefs $id]
9052        if {![info exists ref($id)] || $ref($id) != $v} {
9053            redrawtags $id
9054        }
9055    }
9056    if {$oldmainhead ne $mainheadid} {
9057        redrawtags $oldmainhead
9058        redrawtags $mainheadid
9059    }
9060    run refill_reflist
9061}
9062
9063proc listrefs {id} {
9064    global idtags idheads idotherrefs
9065
9066    set x {}
9067    if {[info exists idtags($id)]} {
9068        set x $idtags($id)
9069    }
9070    set y {}
9071    if {[info exists idheads($id)]} {
9072        set y $idheads($id)
9073    }
9074    set z {}
9075    if {[info exists idotherrefs($id)]} {
9076        set z $idotherrefs($id)
9077    }
9078    return [list $x $y $z]
9079}
9080
9081proc showtag {tag isnew} {
9082    global ctext tagcontents tagids linknum tagobjid
9083
9084    if {$isnew} {
9085        addtohistory [list showtag $tag 0]
9086    }
9087    $ctext conf -state normal
9088    clear_ctext
9089    settabs 0
9090    set linknum 0
9091    if {![info exists tagcontents($tag)]} {
9092        catch {
9093            set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)]
9094        }
9095    }
9096    if {[info exists tagcontents($tag)]} {
9097        set text $tagcontents($tag)
9098    } else {
9099        set text "[mc "Tag"]: $tag\n[mc "Id"]:  $tagids($tag)"
9100    }
9101    appendwithlinks $text {}
9102    $ctext conf -state disabled
9103    init_flist {}
9104}
9105
9106proc doquit {} {
9107    global stopped
9108    global gitktmpdir
9109
9110    set stopped 100
9111    savestuff .
9112    destroy .
9113
9114    if {[info exists gitktmpdir]} {
9115        catch {file delete -force $gitktmpdir}
9116    }
9117}
9118
9119proc mkfontdisp {font top which} {
9120    global fontattr fontpref $font
9121
9122    set fontpref($font) [set $font]
9123    button $top.${font}but -text $which -font optionfont \
9124        -command [list choosefont $font $which]
9125    label $top.$font -relief flat -font $font \
9126        -text $fontattr($font,family) -justify left
9127    grid x $top.${font}but $top.$font -sticky w
9128}
9129
9130proc choosefont {font which} {
9131    global fontparam fontlist fonttop fontattr
9132
9133    set fontparam(which) $which
9134    set fontparam(font) $font
9135    set fontparam(family) [font actual $font -family]
9136    set fontparam(size) $fontattr($font,size)
9137    set fontparam(weight) $fontattr($font,weight)
9138    set fontparam(slant) $fontattr($font,slant)
9139    set top .gitkfont
9140    set fonttop $top
9141    if {![winfo exists $top]} {
9142        font create sample
9143        eval font config sample [font actual $font]
9144        toplevel $top
9145        wm title $top [mc "Gitk font chooser"]
9146        label $top.l -textvariable fontparam(which)
9147        pack $top.l -side top
9148        set fontlist [lsort [font families]]
9149        frame $top.f
9150        listbox $top.f.fam -listvariable fontlist \
9151            -yscrollcommand [list $top.f.sb set]
9152        bind $top.f.fam <<ListboxSelect>> selfontfam
9153        scrollbar $top.f.sb -command [list $top.f.fam yview]
9154        pack $top.f.sb -side right -fill y
9155        pack $top.f.fam -side left -fill both -expand 1
9156        pack $top.f -side top -fill both -expand 1
9157        frame $top.g
9158        spinbox $top.g.size -from 4 -to 40 -width 4 \
9159            -textvariable fontparam(size) \
9160            -validatecommand {string is integer -strict %s}
9161        checkbutton $top.g.bold -padx 5 \
9162            -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
9163            -variable fontparam(weight) -onvalue bold -offvalue normal
9164        checkbutton $top.g.ital -padx 5 \
9165            -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
9166            -variable fontparam(slant) -onvalue italic -offvalue roman
9167        pack $top.g.size $top.g.bold $top.g.ital -side left
9168        pack $top.g -side top
9169        canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
9170            -background white
9171        $top.c create text 100 25 -anchor center -text $which -font sample \
9172            -fill black -tags text
9173        bind $top.c <Configure> [list centertext $top.c]
9174        pack $top.c -side top -fill x
9175        frame $top.buts
9176        button $top.buts.ok -text [mc "OK"] -command fontok -default active
9177        button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
9178        grid $top.buts.ok $top.buts.can
9179        grid columnconfigure $top.buts 0 -weight 1 -uniform a
9180        grid columnconfigure $top.buts 1 -weight 1 -uniform a
9181        pack $top.buts -side bottom -fill x
9182        trace add variable fontparam write chg_fontparam
9183    } else {
9184        raise $top
9185        $top.c itemconf text -text $which
9186    }
9187    set i [lsearch -exact $fontlist $fontparam(family)]
9188    if {$i >= 0} {
9189        $top.f.fam selection set $i
9190        $top.f.fam see $i
9191    }
9192}
9193
9194proc centertext {w} {
9195    $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
9196}
9197
9198proc fontok {} {
9199    global fontparam fontpref prefstop
9200
9201    set f $fontparam(font)
9202    set fontpref($f) [list $fontparam(family) $fontparam(size)]
9203    if {$fontparam(weight) eq "bold"} {
9204        lappend fontpref($f) "bold"
9205    }
9206    if {$fontparam(slant) eq "italic"} {
9207        lappend fontpref($f) "italic"
9208    }
9209    set w $prefstop.$f
9210    $w conf -text $fontparam(family) -font $fontpref($f)
9211        
9212    fontcan
9213}
9214
9215proc fontcan {} {
9216    global fonttop fontparam
9217
9218    if {[info exists fonttop]} {
9219        catch {destroy $fonttop}
9220        catch {font delete sample}
9221        unset fonttop
9222        unset fontparam
9223    }
9224}
9225
9226proc selfontfam {} {
9227    global fonttop fontparam
9228
9229    set i [$fonttop.f.fam curselection]
9230    if {$i ne {}} {
9231        set fontparam(family) [$fonttop.f.fam get $i]
9232    }
9233}
9234
9235proc chg_fontparam {v sub op} {
9236    global fontparam
9237
9238    font config sample -$sub $fontparam($sub)
9239}
9240
9241proc doprefs {} {
9242    global maxwidth maxgraphpct
9243    global oldprefs prefstop showneartags showlocalchanges
9244    global bgcolor fgcolor ctext diffcolors selectbgcolor
9245    global tabstop limitdiffs autoselect extdifftool
9246
9247    set top .gitkprefs
9248    set prefstop $top
9249    if {[winfo exists $top]} {
9250        raise $top
9251        return
9252    }
9253    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
9254                   limitdiffs tabstop} {
9255        set oldprefs($v) [set $v]
9256    }
9257    toplevel $top
9258    wm title $top [mc "Gitk preferences"]
9259    label $top.ldisp -text [mc "Commit list display options"]
9260    grid $top.ldisp - -sticky w -pady 10
9261    label $top.spacer -text " "
9262    label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
9263        -font optionfont
9264    spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
9265    grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
9266    label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
9267        -font optionfont
9268    spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
9269    grid x $top.maxpctl $top.maxpct -sticky w
9270    frame $top.showlocal
9271    label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
9272    checkbutton $top.showlocal.b -variable showlocalchanges
9273    pack $top.showlocal.b $top.showlocal.l -side left
9274    grid x $top.showlocal -sticky w
9275    frame $top.autoselect
9276    label $top.autoselect.l -text [mc "Auto-select SHA1"] -font optionfont
9277    checkbutton $top.autoselect.b -variable autoselect
9278    pack $top.autoselect.b $top.autoselect.l -side left
9279    grid x $top.autoselect -sticky w
9280
9281    label $top.ddisp -text [mc "Diff display options"]
9282    grid $top.ddisp - -sticky w -pady 10
9283    label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
9284    spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
9285    grid x $top.tabstopl $top.tabstop -sticky w
9286    frame $top.ntag
9287    label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
9288    checkbutton $top.ntag.b -variable showneartags
9289    pack $top.ntag.b $top.ntag.l -side left
9290    grid x $top.ntag -sticky w
9291    frame $top.ldiff
9292    label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
9293    checkbutton $top.ldiff.b -variable limitdiffs
9294    pack $top.ldiff.b $top.ldiff.l -side left
9295    grid x $top.ldiff -sticky w
9296
9297    entry $top.extdifft -textvariable extdifftool
9298    frame $top.extdifff
9299    label $top.extdifff.l -text [mc "External diff tool" ] -font optionfont \
9300        -padx 10
9301    button $top.extdifff.b -text [mc "Choose..."] -font optionfont \
9302        -command choose_extdiff
9303    pack $top.extdifff.l $top.extdifff.b -side left
9304    grid x $top.extdifff $top.extdifft -sticky w
9305
9306    label $top.cdisp -text [mc "Colors: press to choose"]
9307    grid $top.cdisp - -sticky w -pady 10
9308    label $top.bg -padx 40 -relief sunk -background $bgcolor
9309    button $top.bgbut -text [mc "Background"] -font optionfont \
9310        -command [list choosecolor bgcolor {} $top.bg background setbg]
9311    grid x $top.bgbut $top.bg -sticky w
9312    label $top.fg -padx 40 -relief sunk -background $fgcolor
9313    button $top.fgbut -text [mc "Foreground"] -font optionfont \
9314        -command [list choosecolor fgcolor {} $top.fg foreground setfg]
9315    grid x $top.fgbut $top.fg -sticky w
9316    label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
9317    button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
9318        -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
9319                      [list $ctext tag conf d0 -foreground]]
9320    grid x $top.diffoldbut $top.diffold -sticky w
9321    label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
9322    button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
9323        -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
9324                      [list $ctext tag conf d1 -foreground]]
9325    grid x $top.diffnewbut $top.diffnew -sticky w
9326    label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
9327    button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
9328        -command [list choosecolor diffcolors 2 $top.hunksep \
9329                      "diff hunk header" \
9330                      [list $ctext tag conf hunksep -foreground]]
9331    grid x $top.hunksepbut $top.hunksep -sticky w
9332    label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
9333    button $top.selbgbut -text [mc "Select bg"] -font optionfont \
9334        -command [list choosecolor selectbgcolor {} $top.selbgsep background setselbg]
9335    grid x $top.selbgbut $top.selbgsep -sticky w
9336
9337    label $top.cfont -text [mc "Fonts: press to choose"]
9338    grid $top.cfont - -sticky w -pady 10
9339    mkfontdisp mainfont $top [mc "Main font"]
9340    mkfontdisp textfont $top [mc "Diff display font"]
9341    mkfontdisp uifont $top [mc "User interface font"]
9342
9343    frame $top.buts
9344    button $top.buts.ok -text [mc "OK"] -command prefsok -default active
9345    button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
9346    grid $top.buts.ok $top.buts.can
9347    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9348    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9349    grid $top.buts - - -pady 10 -sticky ew
9350    bind $top <Visibility> "focus $top.buts.ok"
9351}
9352
9353proc choose_extdiff {} {
9354    global extdifftool
9355
9356    set prog [tk_getOpenFile -title "External diff tool" -multiple false]
9357    if {$prog ne {}} {
9358        set extdifftool $prog
9359    }
9360}
9361
9362proc choosecolor {v vi w x cmd} {
9363    global $v
9364
9365    set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
9366               -title [mc "Gitk: choose color for %s" $x]]
9367    if {$c eq {}} return
9368    $w conf -background $c
9369    lset $v $vi $c
9370    eval $cmd $c
9371}
9372
9373proc setselbg {c} {
9374    global bglist cflist
9375    foreach w $bglist {
9376        $w configure -selectbackground $c
9377    }
9378    $cflist tag configure highlight \
9379        -background [$cflist cget -selectbackground]
9380    allcanvs itemconf secsel -fill $c
9381}
9382
9383proc setbg {c} {
9384    global bglist
9385
9386    foreach w $bglist {
9387        $w conf -background $c
9388    }
9389}
9390
9391proc setfg {c} {
9392    global fglist canv
9393
9394    foreach w $fglist {
9395        $w conf -foreground $c
9396    }
9397    allcanvs itemconf text -fill $c
9398    $canv itemconf circle -outline $c
9399}
9400
9401proc prefscan {} {
9402    global oldprefs prefstop
9403
9404    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
9405                   limitdiffs tabstop} {
9406        global $v
9407        set $v $oldprefs($v)
9408    }
9409    catch {destroy $prefstop}
9410    unset prefstop
9411    fontcan
9412}
9413
9414proc prefsok {} {
9415    global maxwidth maxgraphpct
9416    global oldprefs prefstop showneartags showlocalchanges
9417    global fontpref mainfont textfont uifont
9418    global limitdiffs treediffs
9419
9420    catch {destroy $prefstop}
9421    unset prefstop
9422    fontcan
9423    set fontchanged 0
9424    if {$mainfont ne $fontpref(mainfont)} {
9425        set mainfont $fontpref(mainfont)
9426        parsefont mainfont $mainfont
9427        eval font configure mainfont [fontflags mainfont]
9428        eval font configure mainfontbold [fontflags mainfont 1]
9429        setcoords
9430        set fontchanged 1
9431    }
9432    if {$textfont ne $fontpref(textfont)} {
9433        set textfont $fontpref(textfont)
9434        parsefont textfont $textfont
9435        eval font configure textfont [fontflags textfont]
9436        eval font configure textfontbold [fontflags textfont 1]
9437    }
9438    if {$uifont ne $fontpref(uifont)} {
9439        set uifont $fontpref(uifont)
9440        parsefont uifont $uifont
9441        eval font configure uifont [fontflags uifont]
9442    }
9443    settabs
9444    if {$showlocalchanges != $oldprefs(showlocalchanges)} {
9445        if {$showlocalchanges} {
9446            doshowlocalchanges
9447        } else {
9448            dohidelocalchanges
9449        }
9450    }
9451    if {$limitdiffs != $oldprefs(limitdiffs)} {
9452        # treediffs elements are limited by path
9453        catch {unset treediffs}
9454    }
9455    if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
9456        || $maxgraphpct != $oldprefs(maxgraphpct)} {
9457        redisplay
9458    } elseif {$showneartags != $oldprefs(showneartags) ||
9459          $limitdiffs != $oldprefs(limitdiffs)} {
9460        reselectline
9461    }
9462}
9463
9464proc formatdate {d} {
9465    global datetimeformat
9466    if {$d ne {}} {
9467        set d [clock format $d -format $datetimeformat]
9468    }
9469    return $d
9470}
9471
9472# This list of encoding names and aliases is distilled from
9473# http://www.iana.org/assignments/character-sets.
9474# Not all of them are supported by Tcl.
9475set encoding_aliases {
9476    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
9477      ISO646-US US-ASCII us IBM367 cp367 csASCII }
9478    { ISO-10646-UTF-1 csISO10646UTF1 }
9479    { ISO_646.basic:1983 ref csISO646basic1983 }
9480    { INVARIANT csINVARIANT }
9481    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
9482    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
9483    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
9484    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
9485    { NATS-DANO iso-ir-9-1 csNATSDANO }
9486    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
9487    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
9488    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
9489    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
9490    { ISO-2022-KR csISO2022KR }
9491    { EUC-KR csEUCKR }
9492    { ISO-2022-JP csISO2022JP }
9493    { ISO-2022-JP-2 csISO2022JP2 }
9494    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
9495      csISO13JISC6220jp }
9496    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
9497    { IT iso-ir-15 ISO646-IT csISO15Italian }
9498    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
9499    { ES iso-ir-17 ISO646-ES csISO17Spanish }
9500    { greek7-old iso-ir-18 csISO18Greek7Old }
9501    { latin-greek iso-ir-19 csISO19LatinGreek }
9502    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
9503    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
9504    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
9505    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
9506    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
9507    { BS_viewdata iso-ir-47 csISO47BSViewdata }
9508    { INIS iso-ir-49 csISO49INIS }
9509    { INIS-8 iso-ir-50 csISO50INIS8 }
9510    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
9511    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
9512    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
9513    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
9514    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
9515    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
9516      csISO60Norwegian1 }
9517    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
9518    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
9519    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
9520    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
9521    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
9522    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
9523    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
9524    { greek7 iso-ir-88 csISO88Greek7 }
9525    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
9526    { iso-ir-90 csISO90 }
9527    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
9528    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
9529      csISO92JISC62991984b }
9530    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
9531    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
9532    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
9533      csISO95JIS62291984handadd }
9534    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
9535    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
9536    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
9537    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
9538      CP819 csISOLatin1 }
9539    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
9540    { T.61-7bit iso-ir-102 csISO102T617bit }
9541    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
9542    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
9543    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
9544    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
9545    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
9546    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
9547    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
9548    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
9549      arabic csISOLatinArabic }
9550    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
9551    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
9552    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
9553      greek greek8 csISOLatinGreek }
9554    { T.101-G2 iso-ir-128 csISO128T101G2 }
9555    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
9556      csISOLatinHebrew }
9557    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
9558    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
9559    { CSN_369103 iso-ir-139 csISO139CSN369103 }
9560    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
9561    { ISO_6937-2-add iso-ir-142 csISOTextComm }
9562    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
9563    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
9564      csISOLatinCyrillic }
9565    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
9566    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
9567    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
9568    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
9569    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
9570    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
9571    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
9572    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
9573    { ISO_10367-box iso-ir-155 csISO10367Box }
9574    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
9575    { latin-lap lap iso-ir-158 csISO158Lap }
9576    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
9577    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
9578    { us-dk csUSDK }
9579    { dk-us csDKUS }
9580    { JIS_X0201 X0201 csHalfWidthKatakana }
9581    { KSC5636 ISO646-KR csKSC5636 }
9582    { ISO-10646-UCS-2 csUnicode }
9583    { ISO-10646-UCS-4 csUCS4 }
9584    { DEC-MCS dec csDECMCS }
9585    { hp-roman8 roman8 r8 csHPRoman8 }
9586    { macintosh mac csMacintosh }
9587    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
9588      csIBM037 }
9589    { IBM038 EBCDIC-INT cp038 csIBM038 }
9590    { IBM273 CP273 csIBM273 }
9591    { IBM274 EBCDIC-BE CP274 csIBM274 }
9592    { IBM275 EBCDIC-BR cp275 csIBM275 }
9593    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
9594    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
9595    { IBM280 CP280 ebcdic-cp-it csIBM280 }
9596    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
9597    { IBM284 CP284 ebcdic-cp-es csIBM284 }
9598    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
9599    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
9600    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
9601    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
9602    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
9603    { IBM424 cp424 ebcdic-cp-he csIBM424 }
9604    { IBM437 cp437 437 csPC8CodePage437 }
9605    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
9606    { IBM775 cp775 csPC775Baltic }
9607    { IBM850 cp850 850 csPC850Multilingual }
9608    { IBM851 cp851 851 csIBM851 }
9609    { IBM852 cp852 852 csPCp852 }
9610    { IBM855 cp855 855 csIBM855 }
9611    { IBM857 cp857 857 csIBM857 }
9612    { IBM860 cp860 860 csIBM860 }
9613    { IBM861 cp861 861 cp-is csIBM861 }
9614    { IBM862 cp862 862 csPC862LatinHebrew }
9615    { IBM863 cp863 863 csIBM863 }
9616    { IBM864 cp864 csIBM864 }
9617    { IBM865 cp865 865 csIBM865 }
9618    { IBM866 cp866 866 csIBM866 }
9619    { IBM868 CP868 cp-ar csIBM868 }
9620    { IBM869 cp869 869 cp-gr csIBM869 }
9621    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
9622    { IBM871 CP871 ebcdic-cp-is csIBM871 }
9623    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
9624    { IBM891 cp891 csIBM891 }
9625    { IBM903 cp903 csIBM903 }
9626    { IBM904 cp904 904 csIBBM904 }
9627    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
9628    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
9629    { IBM1026 CP1026 csIBM1026 }
9630    { EBCDIC-AT-DE csIBMEBCDICATDE }
9631    { EBCDIC-AT-DE-A csEBCDICATDEA }
9632    { EBCDIC-CA-FR csEBCDICCAFR }
9633    { EBCDIC-DK-NO csEBCDICDKNO }
9634    { EBCDIC-DK-NO-A csEBCDICDKNOA }
9635    { EBCDIC-FI-SE csEBCDICFISE }
9636    { EBCDIC-FI-SE-A csEBCDICFISEA }
9637    { EBCDIC-FR csEBCDICFR }
9638    { EBCDIC-IT csEBCDICIT }
9639    { EBCDIC-PT csEBCDICPT }
9640    { EBCDIC-ES csEBCDICES }
9641    { EBCDIC-ES-A csEBCDICESA }
9642    { EBCDIC-ES-S csEBCDICESS }
9643    { EBCDIC-UK csEBCDICUK }
9644    { EBCDIC-US csEBCDICUS }
9645    { UNKNOWN-8BIT csUnknown8BiT }
9646    { MNEMONIC csMnemonic }
9647    { MNEM csMnem }
9648    { VISCII csVISCII }
9649    { VIQR csVIQR }
9650    { KOI8-R csKOI8R }
9651    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
9652    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
9653    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
9654    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
9655    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
9656    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
9657    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
9658    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
9659    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
9660    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
9661    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
9662    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
9663    { IBM1047 IBM-1047 }
9664    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
9665    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
9666    { UNICODE-1-1 csUnicode11 }
9667    { CESU-8 csCESU-8 }
9668    { BOCU-1 csBOCU-1 }
9669    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
9670    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
9671      l8 }
9672    { ISO-8859-15 ISO_8859-15 Latin-9 }
9673    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
9674    { GBK CP936 MS936 windows-936 }
9675    { JIS_Encoding csJISEncoding }
9676    { Shift_JIS MS_Kanji csShiftJIS }
9677    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
9678      EUC-JP }
9679    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
9680    { ISO-10646-UCS-Basic csUnicodeASCII }
9681    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
9682    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
9683    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
9684    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
9685    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
9686    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
9687    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
9688    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
9689    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
9690    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
9691    { Adobe-Standard-Encoding csAdobeStandardEncoding }
9692    { Ventura-US csVenturaUS }
9693    { Ventura-International csVenturaInternational }
9694    { PC8-Danish-Norwegian csPC8DanishNorwegian }
9695    { PC8-Turkish csPC8Turkish }
9696    { IBM-Symbols csIBMSymbols }
9697    { IBM-Thai csIBMThai }
9698    { HP-Legal csHPLegal }
9699    { HP-Pi-font csHPPiFont }
9700    { HP-Math8 csHPMath8 }
9701    { Adobe-Symbol-Encoding csHPPSMath }
9702    { HP-DeskTop csHPDesktop }
9703    { Ventura-Math csVenturaMath }
9704    { Microsoft-Publishing csMicrosoftPublishing }
9705    { Windows-31J csWindows31J }
9706    { GB2312 csGB2312 }
9707    { Big5 csBig5 }
9708}
9709
9710proc tcl_encoding {enc} {
9711    global encoding_aliases
9712    set names [encoding names]
9713    set lcnames [string tolower $names]
9714    set enc [string tolower $enc]
9715    set i [lsearch -exact $lcnames $enc]
9716    if {$i < 0} {
9717        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
9718        if {[regsub {^iso[-_]} $enc iso encx]} {
9719            set i [lsearch -exact $lcnames $encx]
9720        }
9721    }
9722    if {$i < 0} {
9723        foreach l $encoding_aliases {
9724            set ll [string tolower $l]
9725            if {[lsearch -exact $ll $enc] < 0} continue
9726            # look through the aliases for one that tcl knows about
9727            foreach e $ll {
9728                set i [lsearch -exact $lcnames $e]
9729                if {$i < 0} {
9730                    if {[regsub {^iso[-_]} $e iso ex]} {
9731                        set i [lsearch -exact $lcnames $ex]
9732                    }
9733                }
9734                if {$i >= 0} break
9735            }
9736            break
9737        }
9738    }
9739    if {$i >= 0} {
9740        return [lindex $names $i]
9741    }
9742    return {}
9743}
9744
9745# First check that Tcl/Tk is recent enough
9746if {[catch {package require Tk 8.4} err]} {
9747    show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
9748                     Gitk requires at least Tcl/Tk 8.4."]
9749    exit 1
9750}
9751
9752# defaults...
9753set wrcomcmd "git diff-tree --stdin -p --pretty"
9754
9755set gitencoding {}
9756catch {
9757    set gitencoding [exec git config --get i18n.commitencoding]
9758}
9759if {$gitencoding == ""} {
9760    set gitencoding "utf-8"
9761}
9762set tclencoding [tcl_encoding $gitencoding]
9763if {$tclencoding == {}} {
9764    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
9765}
9766
9767set mainfont {Helvetica 9}
9768set textfont {Courier 9}
9769set uifont {Helvetica 9 bold}
9770set tabstop 8
9771set findmergefiles 0
9772set maxgraphpct 50
9773set maxwidth 16
9774set revlistorder 0
9775set fastdate 0
9776set uparrowlen 5
9777set downarrowlen 5
9778set mingaplen 100
9779set cmitmode "patch"
9780set wrapcomment "none"
9781set showneartags 1
9782set maxrefs 20
9783set maxlinelen 200
9784set showlocalchanges 1
9785set limitdiffs 1
9786set datetimeformat "%Y-%m-%d %H:%M:%S"
9787set autoselect 1
9788
9789set extdifftool "meld"
9790
9791set colors {green red blue magenta darkgrey brown orange}
9792set bgcolor white
9793set fgcolor black
9794set diffcolors {red "#00a000" blue}
9795set diffcontext 3
9796set ignorespace 0
9797set selectbgcolor gray85
9798
9799set circlecolors {white blue gray blue blue}
9800
9801## For msgcat loading, first locate the installation location.
9802if { [info exists ::env(GITK_MSGSDIR)] } {
9803    ## Msgsdir was manually set in the environment.
9804    set gitk_msgsdir $::env(GITK_MSGSDIR)
9805} else {
9806    ## Let's guess the prefix from argv0.
9807    set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
9808    set gitk_libdir [file join $gitk_prefix share gitk lib]
9809    set gitk_msgsdir [file join $gitk_libdir msgs]
9810    unset gitk_prefix
9811}
9812
9813## Internationalization (i18n) through msgcat and gettext. See
9814## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
9815package require msgcat
9816namespace import ::msgcat::mc
9817## And eventually load the actual message catalog
9818::msgcat::mcload $gitk_msgsdir
9819
9820catch {source ~/.gitk}
9821
9822font create optionfont -family sans-serif -size -12
9823
9824parsefont mainfont $mainfont
9825eval font create mainfont [fontflags mainfont]
9826eval font create mainfontbold [fontflags mainfont 1]
9827
9828parsefont textfont $textfont
9829eval font create textfont [fontflags textfont]
9830eval font create textfontbold [fontflags textfont 1]
9831
9832parsefont uifont $uifont
9833eval font create uifont [fontflags uifont]
9834
9835setoptions
9836
9837# check that we can find a .git directory somewhere...
9838if {[catch {set gitdir [gitdir]}]} {
9839    show_error {} . [mc "Cannot find a git repository here."]
9840    exit 1
9841}
9842if {![file isdirectory $gitdir]} {
9843    show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
9844    exit 1
9845}
9846
9847set revtreeargs {}
9848set cmdline_files {}
9849set i 0
9850set revtreeargscmd {}
9851foreach arg $argv {
9852    switch -glob -- $arg {
9853        "" { }
9854        "--" {
9855            set cmdline_files [lrange $argv [expr {$i + 1}] end]
9856            break
9857        }
9858        "--argscmd=*" {
9859            set revtreeargscmd [string range $arg 10 end]
9860        }
9861        default {
9862            lappend revtreeargs $arg
9863        }
9864    }
9865    incr i
9866}
9867
9868if {$i >= [llength $argv] && $revtreeargs ne {}} {
9869    # no -- on command line, but some arguments (other than --argscmd)
9870    if {[catch {
9871        set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
9872        set cmdline_files [split $f "\n"]
9873        set n [llength $cmdline_files]
9874        set revtreeargs [lrange $revtreeargs 0 end-$n]
9875        # Unfortunately git rev-parse doesn't produce an error when
9876        # something is both a revision and a filename.  To be consistent
9877        # with git log and git rev-list, check revtreeargs for filenames.
9878        foreach arg $revtreeargs {
9879            if {[file exists $arg]} {
9880                show_error {} . [mc "Ambiguous argument '%s': both revision\
9881                                 and filename" $arg]
9882                exit 1
9883            }
9884        }
9885    } err]} {
9886        # unfortunately we get both stdout and stderr in $err,
9887        # so look for "fatal:".
9888        set i [string first "fatal:" $err]
9889        if {$i > 0} {
9890            set err [string range $err [expr {$i + 6}] end]
9891        }
9892        show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
9893        exit 1
9894    }
9895}
9896
9897set nullid "0000000000000000000000000000000000000000"
9898set nullid2 "0000000000000000000000000000000000000001"
9899set nullfile "/dev/null"
9900
9901set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
9902
9903set runq {}
9904set history {}
9905set historyindex 0
9906set fh_serial 0
9907set nhl_names {}
9908set highlight_paths {}
9909set findpattern {}
9910set searchdirn -forwards
9911set boldrows {}
9912set boldnamerows {}
9913set diffelide {0 0}
9914set markingmatches 0
9915set linkentercount 0
9916set need_redisplay 0
9917set nrows_drawn 0
9918set firsttabstop 0
9919
9920set nextviewnum 1
9921set curview 0
9922set selectedview 0
9923set selectedhlview [mc "None"]
9924set highlight_related [mc "None"]
9925set highlight_files {}
9926set viewfiles(0) {}
9927set viewperm(0) 0
9928set viewargs(0) {}
9929set viewargscmd(0) {}
9930
9931set selectedline {}
9932set numcommits 0
9933set loginstance 0
9934set cmdlineok 0
9935set stopped 0
9936set stuffsaved 0
9937set patchnum 0
9938set lserial 0
9939set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}]
9940setcoords
9941makewindow
9942# wait for the window to become visible
9943tkwait visibility .
9944wm title . "[file tail $argv0]: [file tail [pwd]]"
9945readrefs
9946
9947if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
9948    # create a view for the files/dirs specified on the command line
9949    set curview 1
9950    set selectedview 1
9951    set nextviewnum 2
9952    set viewname(1) [mc "Command line"]
9953    set viewfiles(1) $cmdline_files
9954    set viewargs(1) $revtreeargs
9955    set viewargscmd(1) $revtreeargscmd
9956    set viewperm(1) 0
9957    set vdatemode(1) 0
9958    addviewmenu 1
9959    .bar.view entryconf [mc "Edit view..."] -state normal
9960    .bar.view entryconf [mc "Delete view"] -state normal
9961}
9962
9963if {[info exists permviews]} {
9964    foreach v $permviews {
9965        set n $nextviewnum
9966        incr nextviewnum
9967        set viewname($n) [lindex $v 0]
9968        set viewfiles($n) [lindex $v 1]
9969        set viewargs($n) [lindex $v 2]
9970        set viewargscmd($n) [lindex $v 3]
9971        set viewperm($n) 1
9972        addviewmenu $n
9973    }
9974}
9975getcommits