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