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