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