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