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