gitkon commit gitk: Support showing the gathered inline diffs (9403bd0)
   1#!/bin/sh
   2# Tcl ignores the next line -*- tcl -*- \
   3exec wish "$0" -- "$@"
   4
   5# Copyright © 2005-2011 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
  10package require Tk
  11
  12proc hasworktree {} {
  13    return [expr {[exec git rev-parse --is-bare-repository] == "false" &&
  14                  [exec git rev-parse --is-inside-git-dir] == "false"}]
  15}
  16
  17proc reponame {} {
  18    global gitdir
  19    set n [file normalize $gitdir]
  20    if {[string match "*/.git" $n]} {
  21        set n [string range $n 0 end-5]
  22    }
  23    return [file tail $n]
  24}
  25
  26proc gitworktree {} {
  27    variable _gitworktree
  28    if {[info exists _gitworktree]} {
  29        return $_gitworktree
  30    }
  31    # v1.7.0 introduced --show-toplevel to return the canonical work-tree
  32    if {[catch {set _gitworktree [exec git rev-parse --show-toplevel]}]} {
  33        # try to set work tree from environment, core.worktree or use
  34        # cdup to obtain a relative path to the top of the worktree. If
  35        # run from the top, the ./ prefix ensures normalize expands pwd.
  36        if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
  37            catch {set _gitworktree [exec git config --get core.worktree]}
  38            if {$_gitworktree eq ""} {
  39                set _gitworktree [file normalize ./[exec git rev-parse --show-cdup]]
  40            }
  41        }
  42    }
  43    return $_gitworktree
  44}
  45
  46# A simple scheduler for compute-intensive stuff.
  47# The aim is to make sure that event handlers for GUI actions can
  48# run at least every 50-100 ms.  Unfortunately fileevent handlers are
  49# run before X event handlers, so reading from a fast source can
  50# make the GUI completely unresponsive.
  51proc run args {
  52    global isonrunq runq currunq
  53
  54    set script $args
  55    if {[info exists isonrunq($script)]} return
  56    if {$runq eq {} && ![info exists currunq]} {
  57        after idle dorunq
  58    }
  59    lappend runq [list {} $script]
  60    set isonrunq($script) 1
  61}
  62
  63proc filerun {fd script} {
  64    fileevent $fd readable [list filereadable $fd $script]
  65}
  66
  67proc filereadable {fd script} {
  68    global runq currunq
  69
  70    fileevent $fd readable {}
  71    if {$runq eq {} && ![info exists currunq]} {
  72        after idle dorunq
  73    }
  74    lappend runq [list $fd $script]
  75}
  76
  77proc nukefile {fd} {
  78    global runq
  79
  80    for {set i 0} {$i < [llength $runq]} {} {
  81        if {[lindex $runq $i 0] eq $fd} {
  82            set runq [lreplace $runq $i $i]
  83        } else {
  84            incr i
  85        }
  86    }
  87}
  88
  89proc dorunq {} {
  90    global isonrunq runq currunq
  91
  92    set tstart [clock clicks -milliseconds]
  93    set t0 $tstart
  94    while {[llength $runq] > 0} {
  95        set fd [lindex $runq 0 0]
  96        set script [lindex $runq 0 1]
  97        set currunq [lindex $runq 0]
  98        set runq [lrange $runq 1 end]
  99        set repeat [eval $script]
 100        unset currunq
 101        set t1 [clock clicks -milliseconds]
 102        set t [expr {$t1 - $t0}]
 103        if {$repeat ne {} && $repeat} {
 104            if {$fd eq {} || $repeat == 2} {
 105                # script returns 1 if it wants to be readded
 106                # file readers return 2 if they could do more straight away
 107                lappend runq [list $fd $script]
 108            } else {
 109                fileevent $fd readable [list filereadable $fd $script]
 110            }
 111        } elseif {$fd eq {}} {
 112            unset isonrunq($script)
 113        }
 114        set t0 $t1
 115        if {$t1 - $tstart >= 80} break
 116    }
 117    if {$runq ne {}} {
 118        after idle dorunq
 119    }
 120}
 121
 122proc reg_instance {fd} {
 123    global commfd leftover loginstance
 124
 125    set i [incr loginstance]
 126    set commfd($i) $fd
 127    set leftover($i) {}
 128    return $i
 129}
 130
 131proc unmerged_files {files} {
 132    global nr_unmerged
 133
 134    # find the list of unmerged files
 135    set mlist {}
 136    set nr_unmerged 0
 137    if {[catch {
 138        set fd [open "| git ls-files -u" r]
 139    } err]} {
 140        show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
 141        exit 1
 142    }
 143    while {[gets $fd line] >= 0} {
 144        set i [string first "\t" $line]
 145        if {$i < 0} continue
 146        set fname [string range $line [expr {$i+1}] end]
 147        if {[lsearch -exact $mlist $fname] >= 0} continue
 148        incr nr_unmerged
 149        if {$files eq {} || [path_filter $files $fname]} {
 150            lappend mlist $fname
 151        }
 152    }
 153    catch {close $fd}
 154    return $mlist
 155}
 156
 157proc parseviewargs {n arglist} {
 158    global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs env
 159    global vinlinediff
 160    global worddiff git_version
 161
 162    set vdatemode($n) 0
 163    set vmergeonly($n) 0
 164    set vinlinediff($n) 0
 165    set glflags {}
 166    set diffargs {}
 167    set nextisval 0
 168    set revargs {}
 169    set origargs $arglist
 170    set allknown 1
 171    set filtered 0
 172    set i -1
 173    foreach arg $arglist {
 174        incr i
 175        if {$nextisval} {
 176            lappend glflags $arg
 177            set nextisval 0
 178            continue
 179        }
 180        switch -glob -- $arg {
 181            "-d" -
 182            "--date-order" {
 183                set vdatemode($n) 1
 184                # remove from origargs in case we hit an unknown option
 185                set origargs [lreplace $origargs $i $i]
 186                incr i -1
 187            }
 188            "-[puabwcrRBMC]" -
 189            "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
 190            "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
 191            "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
 192            "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
 193            "--ignore-space-change" - "-U*" - "--unified=*" {
 194                # These request or affect diff output, which we don't want.
 195                # Some could be used to set our defaults for diff display.
 196                lappend diffargs $arg
 197            }
 198            "--raw" - "--patch-with-raw" - "--patch-with-stat" -
 199            "--name-only" - "--name-status" - "--color" -
 200            "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
 201            "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
 202            "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
 203            "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
 204            "--objects" - "--objects-edge" - "--reverse" {
 205                # These cause our parsing of git log's output to fail, or else
 206                # they're options we want to set ourselves, so ignore them.
 207            }
 208            "--color-words*" - "--word-diff=color" {
 209                # These trigger a word diff in the console interface,
 210                # so help the user by enabling our own support
 211                if {[package vcompare $git_version "1.7.2"] >= 0} {
 212                    set worddiff [mc "Color words"]
 213                }
 214            }
 215            "--word-diff*" {
 216                if {[package vcompare $git_version "1.7.2"] >= 0} {
 217                    set worddiff [mc "Markup words"]
 218                }
 219            }
 220            "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
 221            "--check" - "--exit-code" - "--quiet" - "--topo-order" -
 222            "--full-history" - "--dense" - "--sparse" -
 223            "--follow" - "--left-right" - "--encoding=*" {
 224                # These are harmless, and some are even useful
 225                lappend glflags $arg
 226            }
 227            "--diff-filter=*" - "--no-merges" - "--unpacked" -
 228            "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
 229            "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
 230            "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
 231            "--remove-empty" - "--first-parent" - "--cherry-pick" -
 232            "-S*" - "-G*" - "--pickaxe-all" - "--pickaxe-regex" -
 233            "--simplify-by-decoration" {
 234                # These mean that we get a subset of the commits
 235                set filtered 1
 236                lappend glflags $arg
 237            }
 238            "-n" {
 239                # This appears to be the only one that has a value as a
 240                # separate word following it
 241                set filtered 1
 242                set nextisval 1
 243                lappend glflags $arg
 244            }
 245            "--not" - "--all" {
 246                lappend revargs $arg
 247            }
 248            "--merge" {
 249                set vmergeonly($n) 1
 250                # git rev-parse doesn't understand --merge
 251                lappend revargs --gitk-symmetric-diff-marker MERGE_HEAD...HEAD
 252            }
 253            "--no-replace-objects" {
 254                set env(GIT_NO_REPLACE_OBJECTS) "1"
 255            }
 256            "-*" {
 257                # Other flag arguments including -<n>
 258                if {[string is digit -strict [string range $arg 1 end]]} {
 259                    set filtered 1
 260                } else {
 261                    # a flag argument that we don't recognize;
 262                    # that means we can't optimize
 263                    set allknown 0
 264                }
 265                lappend glflags $arg
 266            }
 267            default {
 268                # Non-flag arguments specify commits or ranges of commits
 269                if {[string match "*...*" $arg]} {
 270                    lappend revargs --gitk-symmetric-diff-marker
 271                }
 272                lappend revargs $arg
 273            }
 274        }
 275    }
 276    set vdflags($n) $diffargs
 277    set vflags($n) $glflags
 278    set vrevs($n) $revargs
 279    set vfiltered($n) $filtered
 280    set vorigargs($n) $origargs
 281    return $allknown
 282}
 283
 284proc parseviewrevs {view revs} {
 285    global vposids vnegids
 286
 287    if {$revs eq {}} {
 288        set revs HEAD
 289    }
 290    if {[catch {set ids [eval exec git rev-parse $revs]} err]} {
 291        # we get stdout followed by stderr in $err
 292        # for an unknown rev, git rev-parse echoes it and then errors out
 293        set errlines [split $err "\n"]
 294        set badrev {}
 295        for {set l 0} {$l < [llength $errlines]} {incr l} {
 296            set line [lindex $errlines $l]
 297            if {!([string length $line] == 40 && [string is xdigit $line])} {
 298                if {[string match "fatal:*" $line]} {
 299                    if {[string match "fatal: ambiguous argument*" $line]
 300                        && $badrev ne {}} {
 301                        if {[llength $badrev] == 1} {
 302                            set err "unknown revision $badrev"
 303                        } else {
 304                            set err "unknown revisions: [join $badrev ", "]"
 305                        }
 306                    } else {
 307                        set err [join [lrange $errlines $l end] "\n"]
 308                    }
 309                    break
 310                }
 311                lappend badrev $line
 312            }
 313        }
 314        error_popup "[mc "Error parsing revisions:"] $err"
 315        return {}
 316    }
 317    set ret {}
 318    set pos {}
 319    set neg {}
 320    set sdm 0
 321    foreach id [split $ids "\n"] {
 322        if {$id eq "--gitk-symmetric-diff-marker"} {
 323            set sdm 4
 324        } elseif {[string match "^*" $id]} {
 325            if {$sdm != 1} {
 326                lappend ret $id
 327                if {$sdm == 3} {
 328                    set sdm 0
 329                }
 330            }
 331            lappend neg [string range $id 1 end]
 332        } else {
 333            if {$sdm != 2} {
 334                lappend ret $id
 335            } else {
 336                lset ret end $id...[lindex $ret end]
 337            }
 338            lappend pos $id
 339        }
 340        incr sdm -1
 341    }
 342    set vposids($view) $pos
 343    set vnegids($view) $neg
 344    return $ret
 345}
 346
 347# Start off a git log process and arrange to read its output
 348proc start_rev_list {view} {
 349    global startmsecs commitidx viewcomplete curview
 350    global tclencoding
 351    global viewargs viewargscmd viewfiles vfilelimit
 352    global showlocalchanges
 353    global viewactive viewinstances vmergeonly
 354    global mainheadid viewmainheadid viewmainheadid_orig
 355    global vcanopt vflags vrevs vorigargs
 356    global show_notes
 357
 358    set startmsecs [clock clicks -milliseconds]
 359    set commitidx($view) 0
 360    # these are set this way for the error exits
 361    set viewcomplete($view) 1
 362    set viewactive($view) 0
 363    varcinit $view
 364
 365    set args $viewargs($view)
 366    if {$viewargscmd($view) ne {}} {
 367        if {[catch {
 368            set str [exec sh -c $viewargscmd($view)]
 369        } err]} {
 370            error_popup "[mc "Error executing --argscmd command:"] $err"
 371            return 0
 372        }
 373        set args [concat $args [split $str "\n"]]
 374    }
 375    set vcanopt($view) [parseviewargs $view $args]
 376
 377    set files $viewfiles($view)
 378    if {$vmergeonly($view)} {
 379        set files [unmerged_files $files]
 380        if {$files eq {}} {
 381            global nr_unmerged
 382            if {$nr_unmerged == 0} {
 383                error_popup [mc "No files selected: --merge specified but\
 384                             no files are unmerged."]
 385            } else {
 386                error_popup [mc "No files selected: --merge specified but\
 387                             no unmerged files are within file limit."]
 388            }
 389            return 0
 390        }
 391    }
 392    set vfilelimit($view) $files
 393
 394    if {$vcanopt($view)} {
 395        set revs [parseviewrevs $view $vrevs($view)]
 396        if {$revs eq {}} {
 397            return 0
 398        }
 399        set args [concat $vflags($view) $revs]
 400    } else {
 401        set args $vorigargs($view)
 402    }
 403
 404    if {[catch {
 405        set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
 406                        --parents --boundary $args "--" $files] r]
 407    } err]} {
 408        error_popup "[mc "Error executing git log:"] $err"
 409        return 0
 410    }
 411    set i [reg_instance $fd]
 412    set viewinstances($view) [list $i]
 413    set viewmainheadid($view) $mainheadid
 414    set viewmainheadid_orig($view) $mainheadid
 415    if {$files ne {} && $mainheadid ne {}} {
 416        get_viewmainhead $view
 417    }
 418    if {$showlocalchanges && $viewmainheadid($view) ne {}} {
 419        interestedin $viewmainheadid($view) dodiffindex
 420    }
 421    fconfigure $fd -blocking 0 -translation lf -eofchar {}
 422    if {$tclencoding != {}} {
 423        fconfigure $fd -encoding $tclencoding
 424    }
 425    filerun $fd [list getcommitlines $fd $i $view 0]
 426    nowbusy $view [mc "Reading"]
 427    set viewcomplete($view) 0
 428    set viewactive($view) 1
 429    return 1
 430}
 431
 432proc stop_instance {inst} {
 433    global commfd leftover
 434
 435    set fd $commfd($inst)
 436    catch {
 437        set pid [pid $fd]
 438
 439        if {$::tcl_platform(platform) eq {windows}} {
 440            exec kill -f $pid
 441        } else {
 442            exec kill $pid
 443        }
 444    }
 445    catch {close $fd}
 446    nukefile $fd
 447    unset commfd($inst)
 448    unset leftover($inst)
 449}
 450
 451proc stop_backends {} {
 452    global commfd
 453
 454    foreach inst [array names commfd] {
 455        stop_instance $inst
 456    }
 457}
 458
 459proc stop_rev_list {view} {
 460    global viewinstances
 461
 462    foreach inst $viewinstances($view) {
 463        stop_instance $inst
 464    }
 465    set viewinstances($view) {}
 466}
 467
 468proc reset_pending_select {selid} {
 469    global pending_select mainheadid selectheadid
 470
 471    if {$selid ne {}} {
 472        set pending_select $selid
 473    } elseif {$selectheadid ne {}} {
 474        set pending_select $selectheadid
 475    } else {
 476        set pending_select $mainheadid
 477    }
 478}
 479
 480proc getcommits {selid} {
 481    global canv curview need_redisplay viewactive
 482
 483    initlayout
 484    if {[start_rev_list $curview]} {
 485        reset_pending_select $selid
 486        show_status [mc "Reading commits..."]
 487        set need_redisplay 1
 488    } else {
 489        show_status [mc "No commits selected"]
 490    }
 491}
 492
 493proc updatecommits {} {
 494    global curview vcanopt vorigargs vfilelimit viewinstances
 495    global viewactive viewcomplete tclencoding
 496    global startmsecs showneartags showlocalchanges
 497    global mainheadid viewmainheadid viewmainheadid_orig pending_select
 498    global hasworktree
 499    global varcid vposids vnegids vflags vrevs
 500    global show_notes
 501
 502    set hasworktree [hasworktree]
 503    rereadrefs
 504    set view $curview
 505    if {$mainheadid ne $viewmainheadid_orig($view)} {
 506        if {$showlocalchanges} {
 507            dohidelocalchanges
 508        }
 509        set viewmainheadid($view) $mainheadid
 510        set viewmainheadid_orig($view) $mainheadid
 511        if {$vfilelimit($view) ne {}} {
 512            get_viewmainhead $view
 513        }
 514    }
 515    if {$showlocalchanges} {
 516        doshowlocalchanges
 517    }
 518    if {$vcanopt($view)} {
 519        set oldpos $vposids($view)
 520        set oldneg $vnegids($view)
 521        set revs [parseviewrevs $view $vrevs($view)]
 522        if {$revs eq {}} {
 523            return
 524        }
 525        # note: getting the delta when negative refs change is hard,
 526        # and could require multiple git log invocations, so in that
 527        # case we ask git log for all the commits (not just the delta)
 528        if {$oldneg eq $vnegids($view)} {
 529            set newrevs {}
 530            set npos 0
 531            # take out positive refs that we asked for before or
 532            # that we have already seen
 533            foreach rev $revs {
 534                if {[string length $rev] == 40} {
 535                    if {[lsearch -exact $oldpos $rev] < 0
 536                        && ![info exists varcid($view,$rev)]} {
 537                        lappend newrevs $rev
 538                        incr npos
 539                    }
 540                } else {
 541                    lappend $newrevs $rev
 542                }
 543            }
 544            if {$npos == 0} return
 545            set revs $newrevs
 546            set vposids($view) [lsort -unique [concat $oldpos $vposids($view)]]
 547        }
 548        set args [concat $vflags($view) $revs --not $oldpos]
 549    } else {
 550        set args $vorigargs($view)
 551    }
 552    if {[catch {
 553        set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
 554                        --parents --boundary $args "--" $vfilelimit($view)] r]
 555    } err]} {
 556        error_popup "[mc "Error executing git log:"] $err"
 557        return
 558    }
 559    if {$viewactive($view) == 0} {
 560        set startmsecs [clock clicks -milliseconds]
 561    }
 562    set i [reg_instance $fd]
 563    lappend viewinstances($view) $i
 564    fconfigure $fd -blocking 0 -translation lf -eofchar {}
 565    if {$tclencoding != {}} {
 566        fconfigure $fd -encoding $tclencoding
 567    }
 568    filerun $fd [list getcommitlines $fd $i $view 1]
 569    incr viewactive($view)
 570    set viewcomplete($view) 0
 571    reset_pending_select {}
 572    nowbusy $view [mc "Reading"]
 573    if {$showneartags} {
 574        getallcommits
 575    }
 576}
 577
 578proc reloadcommits {} {
 579    global curview viewcomplete selectedline currentid thickerline
 580    global showneartags treediffs commitinterest cached_commitrow
 581    global targetid
 582
 583    set selid {}
 584    if {$selectedline ne {}} {
 585        set selid $currentid
 586    }
 587
 588    if {!$viewcomplete($curview)} {
 589        stop_rev_list $curview
 590    }
 591    resetvarcs $curview
 592    set selectedline {}
 593    catch {unset currentid}
 594    catch {unset thickerline}
 595    catch {unset treediffs}
 596    readrefs
 597    changedrefs
 598    if {$showneartags} {
 599        getallcommits
 600    }
 601    clear_display
 602    catch {unset commitinterest}
 603    catch {unset cached_commitrow}
 604    catch {unset targetid}
 605    setcanvscroll
 606    getcommits $selid
 607    return 0
 608}
 609
 610# This makes a string representation of a positive integer which
 611# sorts as a string in numerical order
 612proc strrep {n} {
 613    if {$n < 16} {
 614        return [format "%x" $n]
 615    } elseif {$n < 256} {
 616        return [format "x%.2x" $n]
 617    } elseif {$n < 65536} {
 618        return [format "y%.4x" $n]
 619    }
 620    return [format "z%.8x" $n]
 621}
 622
 623# Procedures used in reordering commits from git log (without
 624# --topo-order) into the order for display.
 625
 626proc varcinit {view} {
 627    global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
 628    global vtokmod varcmod vrowmod varcix vlastins
 629
 630    set varcstart($view) {{}}
 631    set vupptr($view) {0}
 632    set vdownptr($view) {0}
 633    set vleftptr($view) {0}
 634    set vbackptr($view) {0}
 635    set varctok($view) {{}}
 636    set varcrow($view) {{}}
 637    set vtokmod($view) {}
 638    set varcmod($view) 0
 639    set vrowmod($view) 0
 640    set varcix($view) {{}}
 641    set vlastins($view) {0}
 642}
 643
 644proc resetvarcs {view} {
 645    global varcid varccommits parents children vseedcount ordertok
 646    global vshortids
 647
 648    foreach vid [array names varcid $view,*] {
 649        unset varcid($vid)
 650        unset children($vid)
 651        unset parents($vid)
 652    }
 653    foreach vid [array names vshortids $view,*] {
 654        unset vshortids($vid)
 655    }
 656    # some commits might have children but haven't been seen yet
 657    foreach vid [array names children $view,*] {
 658        unset children($vid)
 659    }
 660    foreach va [array names varccommits $view,*] {
 661        unset varccommits($va)
 662    }
 663    foreach vd [array names vseedcount $view,*] {
 664        unset vseedcount($vd)
 665    }
 666    catch {unset ordertok}
 667}
 668
 669# returns a list of the commits with no children
 670proc seeds {v} {
 671    global vdownptr vleftptr varcstart
 672
 673    set ret {}
 674    set a [lindex $vdownptr($v) 0]
 675    while {$a != 0} {
 676        lappend ret [lindex $varcstart($v) $a]
 677        set a [lindex $vleftptr($v) $a]
 678    }
 679    return $ret
 680}
 681
 682proc newvarc {view id} {
 683    global varcid varctok parents children vdatemode
 684    global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
 685    global commitdata commitinfo vseedcount varccommits vlastins
 686
 687    set a [llength $varctok($view)]
 688    set vid $view,$id
 689    if {[llength $children($vid)] == 0 || $vdatemode($view)} {
 690        if {![info exists commitinfo($id)]} {
 691            parsecommit $id $commitdata($id) 1
 692        }
 693        set cdate [lindex [lindex $commitinfo($id) 4] 0]
 694        if {![string is integer -strict $cdate]} {
 695            set cdate 0
 696        }
 697        if {![info exists vseedcount($view,$cdate)]} {
 698            set vseedcount($view,$cdate) -1
 699        }
 700        set c [incr vseedcount($view,$cdate)]
 701        set cdate [expr {$cdate ^ 0xffffffff}]
 702        set tok "s[strrep $cdate][strrep $c]"
 703    } else {
 704        set tok {}
 705    }
 706    set ka 0
 707    if {[llength $children($vid)] > 0} {
 708        set kid [lindex $children($vid) end]
 709        set k $varcid($view,$kid)
 710        if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
 711            set ki $kid
 712            set ka $k
 713            set tok [lindex $varctok($view) $k]
 714        }
 715    }
 716    if {$ka != 0} {
 717        set i [lsearch -exact $parents($view,$ki) $id]
 718        set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
 719        append tok [strrep $j]
 720    }
 721    set c [lindex $vlastins($view) $ka]
 722    if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
 723        set c $ka
 724        set b [lindex $vdownptr($view) $ka]
 725    } else {
 726        set b [lindex $vleftptr($view) $c]
 727    }
 728    while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
 729        set c $b
 730        set b [lindex $vleftptr($view) $c]
 731    }
 732    if {$c == $ka} {
 733        lset vdownptr($view) $ka $a
 734        lappend vbackptr($view) 0
 735    } else {
 736        lset vleftptr($view) $c $a
 737        lappend vbackptr($view) $c
 738    }
 739    lset vlastins($view) $ka $a
 740    lappend vupptr($view) $ka
 741    lappend vleftptr($view) $b
 742    if {$b != 0} {
 743        lset vbackptr($view) $b $a
 744    }
 745    lappend varctok($view) $tok
 746    lappend varcstart($view) $id
 747    lappend vdownptr($view) 0
 748    lappend varcrow($view) {}
 749    lappend varcix($view) {}
 750    set varccommits($view,$a) {}
 751    lappend vlastins($view) 0
 752    return $a
 753}
 754
 755proc splitvarc {p v} {
 756    global varcid varcstart varccommits varctok vtokmod
 757    global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
 758
 759    set oa $varcid($v,$p)
 760    set otok [lindex $varctok($v) $oa]
 761    set ac $varccommits($v,$oa)
 762    set i [lsearch -exact $varccommits($v,$oa) $p]
 763    if {$i <= 0} return
 764    set na [llength $varctok($v)]
 765    # "%" sorts before "0"...
 766    set tok "$otok%[strrep $i]"
 767    lappend varctok($v) $tok
 768    lappend varcrow($v) {}
 769    lappend varcix($v) {}
 770    set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
 771    set varccommits($v,$na) [lrange $ac $i end]
 772    lappend varcstart($v) $p
 773    foreach id $varccommits($v,$na) {
 774        set varcid($v,$id) $na
 775    }
 776    lappend vdownptr($v) [lindex $vdownptr($v) $oa]
 777    lappend vlastins($v) [lindex $vlastins($v) $oa]
 778    lset vdownptr($v) $oa $na
 779    lset vlastins($v) $oa 0
 780    lappend vupptr($v) $oa
 781    lappend vleftptr($v) 0
 782    lappend vbackptr($v) 0
 783    for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
 784        lset vupptr($v) $b $na
 785    }
 786    if {[string compare $otok $vtokmod($v)] <= 0} {
 787        modify_arc $v $oa
 788    }
 789}
 790
 791proc renumbervarc {a v} {
 792    global parents children varctok varcstart varccommits
 793    global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
 794
 795    set t1 [clock clicks -milliseconds]
 796    set todo {}
 797    set isrelated($a) 1
 798    set kidchanged($a) 1
 799    set ntot 0
 800    while {$a != 0} {
 801        if {[info exists isrelated($a)]} {
 802            lappend todo $a
 803            set id [lindex $varccommits($v,$a) end]
 804            foreach p $parents($v,$id) {
 805                if {[info exists varcid($v,$p)]} {
 806                    set isrelated($varcid($v,$p)) 1
 807                }
 808            }
 809        }
 810        incr ntot
 811        set b [lindex $vdownptr($v) $a]
 812        if {$b == 0} {
 813            while {$a != 0} {
 814                set b [lindex $vleftptr($v) $a]
 815                if {$b != 0} break
 816                set a [lindex $vupptr($v) $a]
 817            }
 818        }
 819        set a $b
 820    }
 821    foreach a $todo {
 822        if {![info exists kidchanged($a)]} continue
 823        set id [lindex $varcstart($v) $a]
 824        if {[llength $children($v,$id)] > 1} {
 825            set children($v,$id) [lsort -command [list vtokcmp $v] \
 826                                      $children($v,$id)]
 827        }
 828        set oldtok [lindex $varctok($v) $a]
 829        if {!$vdatemode($v)} {
 830            set tok {}
 831        } else {
 832            set tok $oldtok
 833        }
 834        set ka 0
 835        set kid [last_real_child $v,$id]
 836        if {$kid ne {}} {
 837            set k $varcid($v,$kid)
 838            if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
 839                set ki $kid
 840                set ka $k
 841                set tok [lindex $varctok($v) $k]
 842            }
 843        }
 844        if {$ka != 0} {
 845            set i [lsearch -exact $parents($v,$ki) $id]
 846            set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
 847            append tok [strrep $j]
 848        }
 849        if {$tok eq $oldtok} {
 850            continue
 851        }
 852        set id [lindex $varccommits($v,$a) end]
 853        foreach p $parents($v,$id) {
 854            if {[info exists varcid($v,$p)]} {
 855                set kidchanged($varcid($v,$p)) 1
 856            } else {
 857                set sortkids($p) 1
 858            }
 859        }
 860        lset varctok($v) $a $tok
 861        set b [lindex $vupptr($v) $a]
 862        if {$b != $ka} {
 863            if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
 864                modify_arc $v $ka
 865            }
 866            if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
 867                modify_arc $v $b
 868            }
 869            set c [lindex $vbackptr($v) $a]
 870            set d [lindex $vleftptr($v) $a]
 871            if {$c == 0} {
 872                lset vdownptr($v) $b $d
 873            } else {
 874                lset vleftptr($v) $c $d
 875            }
 876            if {$d != 0} {
 877                lset vbackptr($v) $d $c
 878            }
 879            if {[lindex $vlastins($v) $b] == $a} {
 880                lset vlastins($v) $b $c
 881            }
 882            lset vupptr($v) $a $ka
 883            set c [lindex $vlastins($v) $ka]
 884            if {$c == 0 || \
 885                    [string compare $tok [lindex $varctok($v) $c]] < 0} {
 886                set c $ka
 887                set b [lindex $vdownptr($v) $ka]
 888            } else {
 889                set b [lindex $vleftptr($v) $c]
 890            }
 891            while {$b != 0 && \
 892                      [string compare $tok [lindex $varctok($v) $b]] >= 0} {
 893                set c $b
 894                set b [lindex $vleftptr($v) $c]
 895            }
 896            if {$c == $ka} {
 897                lset vdownptr($v) $ka $a
 898                lset vbackptr($v) $a 0
 899            } else {
 900                lset vleftptr($v) $c $a
 901                lset vbackptr($v) $a $c
 902            }
 903            lset vleftptr($v) $a $b
 904            if {$b != 0} {
 905                lset vbackptr($v) $b $a
 906            }
 907            lset vlastins($v) $ka $a
 908        }
 909    }
 910    foreach id [array names sortkids] {
 911        if {[llength $children($v,$id)] > 1} {
 912            set children($v,$id) [lsort -command [list vtokcmp $v] \
 913                                      $children($v,$id)]
 914        }
 915    }
 916    set t2 [clock clicks -milliseconds]
 917    #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
 918}
 919
 920# Fix up the graph after we have found out that in view $v,
 921# $p (a commit that we have already seen) is actually the parent
 922# of the last commit in arc $a.
 923proc fix_reversal {p a v} {
 924    global varcid varcstart varctok vupptr
 925
 926    set pa $varcid($v,$p)
 927    if {$p ne [lindex $varcstart($v) $pa]} {
 928        splitvarc $p $v
 929        set pa $varcid($v,$p)
 930    }
 931    # seeds always need to be renumbered
 932    if {[lindex $vupptr($v) $pa] == 0 ||
 933        [string compare [lindex $varctok($v) $a] \
 934             [lindex $varctok($v) $pa]] > 0} {
 935        renumbervarc $pa $v
 936    }
 937}
 938
 939proc insertrow {id p v} {
 940    global cmitlisted children parents varcid varctok vtokmod
 941    global varccommits ordertok commitidx numcommits curview
 942    global targetid targetrow vshortids
 943
 944    readcommit $id
 945    set vid $v,$id
 946    set cmitlisted($vid) 1
 947    set children($vid) {}
 948    set parents($vid) [list $p]
 949    set a [newvarc $v $id]
 950    set varcid($vid) $a
 951    lappend vshortids($v,[string range $id 0 3]) $id
 952    if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
 953        modify_arc $v $a
 954    }
 955    lappend varccommits($v,$a) $id
 956    set vp $v,$p
 957    if {[llength [lappend children($vp) $id]] > 1} {
 958        set children($vp) [lsort -command [list vtokcmp $v] $children($vp)]
 959        catch {unset ordertok}
 960    }
 961    fix_reversal $p $a $v
 962    incr commitidx($v)
 963    if {$v == $curview} {
 964        set numcommits $commitidx($v)
 965        setcanvscroll
 966        if {[info exists targetid]} {
 967            if {![comes_before $targetid $p]} {
 968                incr targetrow
 969            }
 970        }
 971    }
 972}
 973
 974proc insertfakerow {id p} {
 975    global varcid varccommits parents children cmitlisted
 976    global commitidx varctok vtokmod targetid targetrow curview numcommits
 977
 978    set v $curview
 979    set a $varcid($v,$p)
 980    set i [lsearch -exact $varccommits($v,$a) $p]
 981    if {$i < 0} {
 982        puts "oops: insertfakerow can't find [shortids $p] on arc $a"
 983        return
 984    }
 985    set children($v,$id) {}
 986    set parents($v,$id) [list $p]
 987    set varcid($v,$id) $a
 988    lappend children($v,$p) $id
 989    set cmitlisted($v,$id) 1
 990    set numcommits [incr commitidx($v)]
 991    # note we deliberately don't update varcstart($v) even if $i == 0
 992    set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
 993    modify_arc $v $a $i
 994    if {[info exists targetid]} {
 995        if {![comes_before $targetid $p]} {
 996            incr targetrow
 997        }
 998    }
 999    setcanvscroll
1000    drawvisible
1001}
1002
1003proc removefakerow {id} {
1004    global varcid varccommits parents children commitidx
1005    global varctok vtokmod cmitlisted currentid selectedline
1006    global targetid curview numcommits
1007
1008    set v $curview
1009    if {[llength $parents($v,$id)] != 1} {
1010        puts "oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
1011        return
1012    }
1013    set p [lindex $parents($v,$id) 0]
1014    set a $varcid($v,$id)
1015    set i [lsearch -exact $varccommits($v,$a) $id]
1016    if {$i < 0} {
1017        puts "oops: removefakerow can't find [shortids $id] on arc $a"
1018        return
1019    }
1020    unset varcid($v,$id)
1021    set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
1022    unset parents($v,$id)
1023    unset children($v,$id)
1024    unset cmitlisted($v,$id)
1025    set numcommits [incr commitidx($v) -1]
1026    set j [lsearch -exact $children($v,$p) $id]
1027    if {$j >= 0} {
1028        set children($v,$p) [lreplace $children($v,$p) $j $j]
1029    }
1030    modify_arc $v $a $i
1031    if {[info exist currentid] && $id eq $currentid} {
1032        unset currentid
1033        set selectedline {}
1034    }
1035    if {[info exists targetid] && $targetid eq $id} {
1036        set targetid $p
1037    }
1038    setcanvscroll
1039    drawvisible
1040}
1041
1042proc real_children {vp} {
1043    global children nullid nullid2
1044
1045    set kids {}
1046    foreach id $children($vp) {
1047        if {$id ne $nullid && $id ne $nullid2} {
1048            lappend kids $id
1049        }
1050    }
1051    return $kids
1052}
1053
1054proc first_real_child {vp} {
1055    global children nullid nullid2
1056
1057    foreach id $children($vp) {
1058        if {$id ne $nullid && $id ne $nullid2} {
1059            return $id
1060        }
1061    }
1062    return {}
1063}
1064
1065proc last_real_child {vp} {
1066    global children nullid nullid2
1067
1068    set kids $children($vp)
1069    for {set i [llength $kids]} {[incr i -1] >= 0} {} {
1070        set id [lindex $kids $i]
1071        if {$id ne $nullid && $id ne $nullid2} {
1072            return $id
1073        }
1074    }
1075    return {}
1076}
1077
1078proc vtokcmp {v a b} {
1079    global varctok varcid
1080
1081    return [string compare [lindex $varctok($v) $varcid($v,$a)] \
1082                [lindex $varctok($v) $varcid($v,$b)]]
1083}
1084
1085# This assumes that if lim is not given, the caller has checked that
1086# arc a's token is less than $vtokmod($v)
1087proc modify_arc {v a {lim {}}} {
1088    global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
1089
1090    if {$lim ne {}} {
1091        set c [string compare [lindex $varctok($v) $a] $vtokmod($v)]
1092        if {$c > 0} return
1093        if {$c == 0} {
1094            set r [lindex $varcrow($v) $a]
1095            if {$r ne {} && $vrowmod($v) <= $r + $lim} return
1096        }
1097    }
1098    set vtokmod($v) [lindex $varctok($v) $a]
1099    set varcmod($v) $a
1100    if {$v == $curview} {
1101        while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
1102            set a [lindex $vupptr($v) $a]
1103            set lim {}
1104        }
1105        set r 0
1106        if {$a != 0} {
1107            if {$lim eq {}} {
1108                set lim [llength $varccommits($v,$a)]
1109            }
1110            set r [expr {[lindex $varcrow($v) $a] + $lim}]
1111        }
1112        set vrowmod($v) $r
1113        undolayout $r
1114    }
1115}
1116
1117proc update_arcrows {v} {
1118    global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
1119    global varcid vrownum varcorder varcix varccommits
1120    global vupptr vdownptr vleftptr varctok
1121    global displayorder parentlist curview cached_commitrow
1122
1123    if {$vrowmod($v) == $commitidx($v)} return
1124    if {$v == $curview} {
1125        if {[llength $displayorder] > $vrowmod($v)} {
1126            set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
1127            set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
1128        }
1129        catch {unset cached_commitrow}
1130    }
1131    set narctot [expr {[llength $varctok($v)] - 1}]
1132    set a $varcmod($v)
1133    while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
1134        # go up the tree until we find something that has a row number,
1135        # or we get to a seed
1136        set a [lindex $vupptr($v) $a]
1137    }
1138    if {$a == 0} {
1139        set a [lindex $vdownptr($v) 0]
1140        if {$a == 0} return
1141        set vrownum($v) {0}
1142        set varcorder($v) [list $a]
1143        lset varcix($v) $a 0
1144        lset varcrow($v) $a 0
1145        set arcn 0
1146        set row 0
1147    } else {
1148        set arcn [lindex $varcix($v) $a]
1149        if {[llength $vrownum($v)] > $arcn + 1} {
1150            set vrownum($v) [lrange $vrownum($v) 0 $arcn]
1151            set varcorder($v) [lrange $varcorder($v) 0 $arcn]
1152        }
1153        set row [lindex $varcrow($v) $a]
1154    }
1155    while {1} {
1156        set p $a
1157        incr row [llength $varccommits($v,$a)]
1158        # go down if possible
1159        set b [lindex $vdownptr($v) $a]
1160        if {$b == 0} {
1161            # if not, go left, or go up until we can go left
1162            while {$a != 0} {
1163                set b [lindex $vleftptr($v) $a]
1164                if {$b != 0} break
1165                set a [lindex $vupptr($v) $a]
1166            }
1167            if {$a == 0} break
1168        }
1169        set a $b
1170        incr arcn
1171        lappend vrownum($v) $row
1172        lappend varcorder($v) $a
1173        lset varcix($v) $a $arcn
1174        lset varcrow($v) $a $row
1175    }
1176    set vtokmod($v) [lindex $varctok($v) $p]
1177    set varcmod($v) $p
1178    set vrowmod($v) $row
1179    if {[info exists currentid]} {
1180        set selectedline [rowofcommit $currentid]
1181    }
1182}
1183
1184# Test whether view $v contains commit $id
1185proc commitinview {id v} {
1186    global varcid
1187
1188    return [info exists varcid($v,$id)]
1189}
1190
1191# Return the row number for commit $id in the current view
1192proc rowofcommit {id} {
1193    global varcid varccommits varcrow curview cached_commitrow
1194    global varctok vtokmod
1195
1196    set v $curview
1197    if {![info exists varcid($v,$id)]} {
1198        puts "oops rowofcommit no arc for [shortids $id]"
1199        return {}
1200    }
1201    set a $varcid($v,$id)
1202    if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
1203        update_arcrows $v
1204    }
1205    if {[info exists cached_commitrow($id)]} {
1206        return $cached_commitrow($id)
1207    }
1208    set i [lsearch -exact $varccommits($v,$a) $id]
1209    if {$i < 0} {
1210        puts "oops didn't find commit [shortids $id] in arc $a"
1211        return {}
1212    }
1213    incr i [lindex $varcrow($v) $a]
1214    set cached_commitrow($id) $i
1215    return $i
1216}
1217
1218# Returns 1 if a is on an earlier row than b, otherwise 0
1219proc comes_before {a b} {
1220    global varcid varctok curview
1221
1222    set v $curview
1223    if {$a eq $b || ![info exists varcid($v,$a)] || \
1224            ![info exists varcid($v,$b)]} {
1225        return 0
1226    }
1227    if {$varcid($v,$a) != $varcid($v,$b)} {
1228        return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
1229                           [lindex $varctok($v) $varcid($v,$b)]] < 0}]
1230    }
1231    return [expr {[rowofcommit $a] < [rowofcommit $b]}]
1232}
1233
1234proc bsearch {l elt} {
1235    if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
1236        return 0
1237    }
1238    set lo 0
1239    set hi [llength $l]
1240    while {$hi - $lo > 1} {
1241        set mid [expr {int(($lo + $hi) / 2)}]
1242        set t [lindex $l $mid]
1243        if {$elt < $t} {
1244            set hi $mid
1245        } elseif {$elt > $t} {
1246            set lo $mid
1247        } else {
1248            return $mid
1249        }
1250    }
1251    return $lo
1252}
1253
1254# Make sure rows $start..$end-1 are valid in displayorder and parentlist
1255proc make_disporder {start end} {
1256    global vrownum curview commitidx displayorder parentlist
1257    global varccommits varcorder parents vrowmod varcrow
1258    global d_valid_start d_valid_end
1259
1260    if {$end > $vrowmod($curview)} {
1261        update_arcrows $curview
1262    }
1263    set ai [bsearch $vrownum($curview) $start]
1264    set start [lindex $vrownum($curview) $ai]
1265    set narc [llength $vrownum($curview)]
1266    for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
1267        set a [lindex $varcorder($curview) $ai]
1268        set l [llength $displayorder]
1269        set al [llength $varccommits($curview,$a)]
1270        if {$l < $r + $al} {
1271            if {$l < $r} {
1272                set pad [ntimes [expr {$r - $l}] {}]
1273                set displayorder [concat $displayorder $pad]
1274                set parentlist [concat $parentlist $pad]
1275            } elseif {$l > $r} {
1276                set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
1277                set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
1278            }
1279            foreach id $varccommits($curview,$a) {
1280                lappend displayorder $id
1281                lappend parentlist $parents($curview,$id)
1282            }
1283        } elseif {[lindex $displayorder [expr {$r + $al - 1}]] eq {}} {
1284            set i $r
1285            foreach id $varccommits($curview,$a) {
1286                lset displayorder $i $id
1287                lset parentlist $i $parents($curview,$id)
1288                incr i
1289            }
1290        }
1291        incr r $al
1292    }
1293}
1294
1295proc commitonrow {row} {
1296    global displayorder
1297
1298    set id [lindex $displayorder $row]
1299    if {$id eq {}} {
1300        make_disporder $row [expr {$row + 1}]
1301        set id [lindex $displayorder $row]
1302    }
1303    return $id
1304}
1305
1306proc closevarcs {v} {
1307    global varctok varccommits varcid parents children
1308    global cmitlisted commitidx vtokmod
1309
1310    set missing_parents 0
1311    set scripts {}
1312    set narcs [llength $varctok($v)]
1313    for {set a 1} {$a < $narcs} {incr a} {
1314        set id [lindex $varccommits($v,$a) end]
1315        foreach p $parents($v,$id) {
1316            if {[info exists varcid($v,$p)]} continue
1317            # add p as a new commit
1318            incr missing_parents
1319            set cmitlisted($v,$p) 0
1320            set parents($v,$p) {}
1321            if {[llength $children($v,$p)] == 1 &&
1322                [llength $parents($v,$id)] == 1} {
1323                set b $a
1324            } else {
1325                set b [newvarc $v $p]
1326            }
1327            set varcid($v,$p) $b
1328            if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
1329                modify_arc $v $b
1330            }
1331            lappend varccommits($v,$b) $p
1332            incr commitidx($v)
1333            set scripts [check_interest $p $scripts]
1334        }
1335    }
1336    if {$missing_parents > 0} {
1337        foreach s $scripts {
1338            eval $s
1339        }
1340    }
1341}
1342
1343# Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1344# Assumes we already have an arc for $rwid.
1345proc rewrite_commit {v id rwid} {
1346    global children parents varcid varctok vtokmod varccommits
1347
1348    foreach ch $children($v,$id) {
1349        # make $rwid be $ch's parent in place of $id
1350        set i [lsearch -exact $parents($v,$ch) $id]
1351        if {$i < 0} {
1352            puts "oops rewrite_commit didn't find $id in parent list for $ch"
1353        }
1354        set parents($v,$ch) [lreplace $parents($v,$ch) $i $i $rwid]
1355        # add $ch to $rwid's children and sort the list if necessary
1356        if {[llength [lappend children($v,$rwid) $ch]] > 1} {
1357            set children($v,$rwid) [lsort -command [list vtokcmp $v] \
1358                                        $children($v,$rwid)]
1359        }
1360        # fix the graph after joining $id to $rwid
1361        set a $varcid($v,$ch)
1362        fix_reversal $rwid $a $v
1363        # parentlist is wrong for the last element of arc $a
1364        # even if displayorder is right, hence the 3rd arg here
1365        modify_arc $v $a [expr {[llength $varccommits($v,$a)] - 1}]
1366    }
1367}
1368
1369# Mechanism for registering a command to be executed when we come
1370# across a particular commit.  To handle the case when only the
1371# prefix of the commit is known, the commitinterest array is now
1372# indexed by the first 4 characters of the ID.  Each element is a
1373# list of id, cmd pairs.
1374proc interestedin {id cmd} {
1375    global commitinterest
1376
1377    lappend commitinterest([string range $id 0 3]) $id $cmd
1378}
1379
1380proc check_interest {id scripts} {
1381    global commitinterest
1382
1383    set prefix [string range $id 0 3]
1384    if {[info exists commitinterest($prefix)]} {
1385        set newlist {}
1386        foreach {i script} $commitinterest($prefix) {
1387            if {[string match "$i*" $id]} {
1388                lappend scripts [string map [list "%I" $id "%P" $i] $script]
1389            } else {
1390                lappend newlist $i $script
1391            }
1392        }
1393        if {$newlist ne {}} {
1394            set commitinterest($prefix) $newlist
1395        } else {
1396            unset commitinterest($prefix)
1397        }
1398    }
1399    return $scripts
1400}
1401
1402proc getcommitlines {fd inst view updating}  {
1403    global cmitlisted leftover
1404    global commitidx commitdata vdatemode
1405    global parents children curview hlview
1406    global idpending ordertok
1407    global varccommits varcid varctok vtokmod vfilelimit vshortids
1408
1409    set stuff [read $fd 500000]
1410    # git log doesn't terminate the last commit with a null...
1411    if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
1412        set stuff "\0"
1413    }
1414    if {$stuff == {}} {
1415        if {![eof $fd]} {
1416            return 1
1417        }
1418        global commfd viewcomplete viewactive viewname
1419        global viewinstances
1420        unset commfd($inst)
1421        set i [lsearch -exact $viewinstances($view) $inst]
1422        if {$i >= 0} {
1423            set viewinstances($view) [lreplace $viewinstances($view) $i $i]
1424        }
1425        # set it blocking so we wait for the process to terminate
1426        fconfigure $fd -blocking 1
1427        if {[catch {close $fd} err]} {
1428            set fv {}
1429            if {$view != $curview} {
1430                set fv " for the \"$viewname($view)\" view"
1431            }
1432            if {[string range $err 0 4] == "usage"} {
1433                set err "Gitk: error reading commits$fv:\
1434                        bad arguments to git log."
1435                if {$viewname($view) eq "Command line"} {
1436                    append err \
1437                        "  (Note: arguments to gitk are passed to git log\
1438                         to allow selection of commits to be displayed.)"
1439                }
1440            } else {
1441                set err "Error reading commits$fv: $err"
1442            }
1443            error_popup $err
1444        }
1445        if {[incr viewactive($view) -1] <= 0} {
1446            set viewcomplete($view) 1
1447            # Check if we have seen any ids listed as parents that haven't
1448            # appeared in the list
1449            closevarcs $view
1450            notbusy $view
1451        }
1452        if {$view == $curview} {
1453            run chewcommits
1454        }
1455        return 0
1456    }
1457    set start 0
1458    set gotsome 0
1459    set scripts {}
1460    while 1 {
1461        set i [string first "\0" $stuff $start]
1462        if {$i < 0} {
1463            append leftover($inst) [string range $stuff $start end]
1464            break
1465        }
1466        if {$start == 0} {
1467            set cmit $leftover($inst)
1468            append cmit [string range $stuff 0 [expr {$i - 1}]]
1469            set leftover($inst) {}
1470        } else {
1471            set cmit [string range $stuff $start [expr {$i - 1}]]
1472        }
1473        set start [expr {$i + 1}]
1474        set j [string first "\n" $cmit]
1475        set ok 0
1476        set listed 1
1477        if {$j >= 0 && [string match "commit *" $cmit]} {
1478            set ids [string range $cmit 7 [expr {$j - 1}]]
1479            if {[string match {[-^<>]*} $ids]} {
1480                switch -- [string index $ids 0] {
1481                    "-" {set listed 0}
1482                    "^" {set listed 2}
1483                    "<" {set listed 3}
1484                    ">" {set listed 4}
1485                }
1486                set ids [string range $ids 1 end]
1487            }
1488            set ok 1
1489            foreach id $ids {
1490                if {[string length $id] != 40} {
1491                    set ok 0
1492                    break
1493                }
1494            }
1495        }
1496        if {!$ok} {
1497            set shortcmit $cmit
1498            if {[string length $shortcmit] > 80} {
1499                set shortcmit "[string range $shortcmit 0 80]..."
1500            }
1501            error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
1502            exit 1
1503        }
1504        set id [lindex $ids 0]
1505        set vid $view,$id
1506
1507        lappend vshortids($view,[string range $id 0 3]) $id
1508
1509        if {!$listed && $updating && ![info exists varcid($vid)] &&
1510            $vfilelimit($view) ne {}} {
1511            # git log doesn't rewrite parents for unlisted commits
1512            # when doing path limiting, so work around that here
1513            # by working out the rewritten parent with git rev-list
1514            # and if we already know about it, using the rewritten
1515            # parent as a substitute parent for $id's children.
1516            if {![catch {
1517                set rwid [exec git rev-list --first-parent --max-count=1 \
1518                              $id -- $vfilelimit($view)]
1519            }]} {
1520                if {$rwid ne {} && [info exists varcid($view,$rwid)]} {
1521                    # use $rwid in place of $id
1522                    rewrite_commit $view $id $rwid
1523                    continue
1524                }
1525            }
1526        }
1527
1528        set a 0
1529        if {[info exists varcid($vid)]} {
1530            if {$cmitlisted($vid) || !$listed} continue
1531            set a $varcid($vid)
1532        }
1533        if {$listed} {
1534            set olds [lrange $ids 1 end]
1535        } else {
1536            set olds {}
1537        }
1538        set commitdata($id) [string range $cmit [expr {$j + 1}] end]
1539        set cmitlisted($vid) $listed
1540        set parents($vid) $olds
1541        if {![info exists children($vid)]} {
1542            set children($vid) {}
1543        } elseif {$a == 0 && [llength $children($vid)] == 1} {
1544            set k [lindex $children($vid) 0]
1545            if {[llength $parents($view,$k)] == 1 &&
1546                (!$vdatemode($view) ||
1547                 $varcid($view,$k) == [llength $varctok($view)] - 1)} {
1548                set a $varcid($view,$k)
1549            }
1550        }
1551        if {$a == 0} {
1552            # new arc
1553            set a [newvarc $view $id]
1554        }
1555        if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
1556            modify_arc $view $a
1557        }
1558        if {![info exists varcid($vid)]} {
1559            set varcid($vid) $a
1560            lappend varccommits($view,$a) $id
1561            incr commitidx($view)
1562        }
1563
1564        set i 0
1565        foreach p $olds {
1566            if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
1567                set vp $view,$p
1568                if {[llength [lappend children($vp) $id]] > 1 &&
1569                    [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
1570                    set children($vp) [lsort -command [list vtokcmp $view] \
1571                                           $children($vp)]
1572                    catch {unset ordertok}
1573                }
1574                if {[info exists varcid($view,$p)]} {
1575                    fix_reversal $p $a $view
1576                }
1577            }
1578            incr i
1579        }
1580
1581        set scripts [check_interest $id $scripts]
1582        set gotsome 1
1583    }
1584    if {$gotsome} {
1585        global numcommits hlview
1586
1587        if {$view == $curview} {
1588            set numcommits $commitidx($view)
1589            run chewcommits
1590        }
1591        if {[info exists hlview] && $view == $hlview} {
1592            # we never actually get here...
1593            run vhighlightmore
1594        }
1595        foreach s $scripts {
1596            eval $s
1597        }
1598    }
1599    return 2
1600}
1601
1602proc chewcommits {} {
1603    global curview hlview viewcomplete
1604    global pending_select
1605
1606    layoutmore
1607    if {$viewcomplete($curview)} {
1608        global commitidx varctok
1609        global numcommits startmsecs
1610
1611        if {[info exists pending_select]} {
1612            update
1613            reset_pending_select {}
1614
1615            if {[commitinview $pending_select $curview]} {
1616                selectline [rowofcommit $pending_select] 1
1617            } else {
1618                set row [first_real_row]
1619                selectline $row 1
1620            }
1621        }
1622        if {$commitidx($curview) > 0} {
1623            #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1624            #puts "overall $ms ms for $numcommits commits"
1625            #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1626        } else {
1627            show_status [mc "No commits selected"]
1628        }
1629        notbusy layout
1630    }
1631    return 0
1632}
1633
1634proc do_readcommit {id} {
1635    global tclencoding
1636
1637    # Invoke git-log to handle automatic encoding conversion
1638    set fd [open [concat | git log --no-color --pretty=raw -1 $id] r]
1639    # Read the results using i18n.logoutputencoding
1640    fconfigure $fd -translation lf -eofchar {}
1641    if {$tclencoding != {}} {
1642        fconfigure $fd -encoding $tclencoding
1643    }
1644    set contents [read $fd]
1645    close $fd
1646    # Remove the heading line
1647    regsub {^commit [0-9a-f]+\n} $contents {} contents
1648
1649    return $contents
1650}
1651
1652proc readcommit {id} {
1653    if {[catch {set contents [do_readcommit $id]}]} return
1654    parsecommit $id $contents 1
1655}
1656
1657proc parsecommit {id contents listed} {
1658    global commitinfo
1659
1660    set inhdr 1
1661    set comment {}
1662    set headline {}
1663    set auname {}
1664    set audate {}
1665    set comname {}
1666    set comdate {}
1667    set hdrend [string first "\n\n" $contents]
1668    if {$hdrend < 0} {
1669        # should never happen...
1670        set hdrend [string length $contents]
1671    }
1672    set header [string range $contents 0 [expr {$hdrend - 1}]]
1673    set comment [string range $contents [expr {$hdrend + 2}] end]
1674    foreach line [split $header "\n"] {
1675        set line [split $line " "]
1676        set tag [lindex $line 0]
1677        if {$tag == "author"} {
1678            set audate [lrange $line end-1 end]
1679            set auname [join [lrange $line 1 end-2] " "]
1680        } elseif {$tag == "committer"} {
1681            set comdate [lrange $line end-1 end]
1682            set comname [join [lrange $line 1 end-2] " "]
1683        }
1684    }
1685    set headline {}
1686    # take the first non-blank line of the comment as the headline
1687    set headline [string trimleft $comment]
1688    set i [string first "\n" $headline]
1689    if {$i >= 0} {
1690        set headline [string range $headline 0 $i]
1691    }
1692    set headline [string trimright $headline]
1693    set i [string first "\r" $headline]
1694    if {$i >= 0} {
1695        set headline [string trimright [string range $headline 0 $i]]
1696    }
1697    if {!$listed} {
1698        # git log indents the comment by 4 spaces;
1699        # if we got this via git cat-file, add the indentation
1700        set newcomment {}
1701        foreach line [split $comment "\n"] {
1702            append newcomment "    "
1703            append newcomment $line
1704            append newcomment "\n"
1705        }
1706        set comment $newcomment
1707    }
1708    set hasnote [string first "\nNotes:\n" $contents]
1709    set diff ""
1710    # If there is diff output shown in the git-log stream, split it
1711    # out.  But get rid of the empty line that always precedes the
1712    # diff.
1713    set i [string first "\n\ndiff" $comment]
1714    if {$i >= 0} {
1715        set diff [string range $comment $i+1 end]
1716        set comment [string range $comment 0 $i-1]
1717    }
1718    set commitinfo($id) [list $headline $auname $audate \
1719                             $comname $comdate $comment $hasnote $diff]
1720}
1721
1722proc getcommit {id} {
1723    global commitdata commitinfo
1724
1725    if {[info exists commitdata($id)]} {
1726        parsecommit $id $commitdata($id) 1
1727    } else {
1728        readcommit $id
1729        if {![info exists commitinfo($id)]} {
1730            set commitinfo($id) [list [mc "No commit information available"]]
1731        }
1732    }
1733    return 1
1734}
1735
1736# Expand an abbreviated commit ID to a list of full 40-char IDs that match
1737# and are present in the current view.
1738# This is fairly slow...
1739proc longid {prefix} {
1740    global varcid curview vshortids
1741
1742    set ids {}
1743    if {[string length $prefix] >= 4} {
1744        set vshortid $curview,[string range $prefix 0 3]
1745        if {[info exists vshortids($vshortid)]} {
1746            foreach id $vshortids($vshortid) {
1747                if {[string match "$prefix*" $id]} {
1748                    if {[lsearch -exact $ids $id] < 0} {
1749                        lappend ids $id
1750                        if {[llength $ids] >= 2} break
1751                    }
1752                }
1753            }
1754        }
1755    } else {
1756        foreach match [array names varcid "$curview,$prefix*"] {
1757            lappend ids [lindex [split $match ","] 1]
1758            if {[llength $ids] >= 2} break
1759        }
1760    }
1761    return $ids
1762}
1763
1764proc readrefs {} {
1765    global tagids idtags headids idheads tagobjid
1766    global otherrefids idotherrefs mainhead mainheadid
1767    global selecthead selectheadid
1768    global hideremotes
1769
1770    foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
1771        catch {unset $v}
1772    }
1773    set refd [open [list | git show-ref -d] r]
1774    while {[gets $refd line] >= 0} {
1775        if {[string index $line 40] ne " "} continue
1776        set id [string range $line 0 39]
1777        set ref [string range $line 41 end]
1778        if {![string match "refs/*" $ref]} continue
1779        set name [string range $ref 5 end]
1780        if {[string match "remotes/*" $name]} {
1781            if {![string match "*/HEAD" $name] && !$hideremotes} {
1782                set headids($name) $id
1783                lappend idheads($id) $name
1784            }
1785        } elseif {[string match "heads/*" $name]} {
1786            set name [string range $name 6 end]
1787            set headids($name) $id
1788            lappend idheads($id) $name
1789        } elseif {[string match "tags/*" $name]} {
1790            # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1791            # which is what we want since the former is the commit ID
1792            set name [string range $name 5 end]
1793            if {[string match "*^{}" $name]} {
1794                set name [string range $name 0 end-3]
1795            } else {
1796                set tagobjid($name) $id
1797            }
1798            set tagids($name) $id
1799            lappend idtags($id) $name
1800        } else {
1801            set otherrefids($name) $id
1802            lappend idotherrefs($id) $name
1803        }
1804    }
1805    catch {close $refd}
1806    set mainhead {}
1807    set mainheadid {}
1808    catch {
1809        set mainheadid [exec git rev-parse HEAD]
1810        set thehead [exec git symbolic-ref HEAD]
1811        if {[string match "refs/heads/*" $thehead]} {
1812            set mainhead [string range $thehead 11 end]
1813        }
1814    }
1815    set selectheadid {}
1816    if {$selecthead ne {}} {
1817        catch {
1818            set selectheadid [exec git rev-parse --verify $selecthead]
1819        }
1820    }
1821}
1822
1823# skip over fake commits
1824proc first_real_row {} {
1825    global nullid nullid2 numcommits
1826
1827    for {set row 0} {$row < $numcommits} {incr row} {
1828        set id [commitonrow $row]
1829        if {$id ne $nullid && $id ne $nullid2} {
1830            break
1831        }
1832    }
1833    return $row
1834}
1835
1836# update things for a head moved to a child of its previous location
1837proc movehead {id name} {
1838    global headids idheads
1839
1840    removehead $headids($name) $name
1841    set headids($name) $id
1842    lappend idheads($id) $name
1843}
1844
1845# update things when a head has been removed
1846proc removehead {id name} {
1847    global headids idheads
1848
1849    if {$idheads($id) eq $name} {
1850        unset idheads($id)
1851    } else {
1852        set i [lsearch -exact $idheads($id) $name]
1853        if {$i >= 0} {
1854            set idheads($id) [lreplace $idheads($id) $i $i]
1855        }
1856    }
1857    unset headids($name)
1858}
1859
1860proc ttk_toplevel {w args} {
1861    global use_ttk
1862    eval [linsert $args 0 ::toplevel $w]
1863    if {$use_ttk} {
1864        place [ttk::frame $w._toplevel_background] -x 0 -y 0 -relwidth 1 -relheight 1
1865    }
1866    return $w
1867}
1868
1869proc make_transient {window origin} {
1870    global have_tk85
1871
1872    # In MacOS Tk 8.4 transient appears to work by setting
1873    # overrideredirect, which is utterly useless, since the
1874    # windows get no border, and are not even kept above
1875    # the parent.
1876    if {!$have_tk85 && [tk windowingsystem] eq {aqua}} return
1877
1878    wm transient $window $origin
1879
1880    # Windows fails to place transient windows normally, so
1881    # schedule a callback to center them on the parent.
1882    if {[tk windowingsystem] eq {win32}} {
1883        after idle [list tk::PlaceWindow $window widget $origin]
1884    }
1885}
1886
1887proc show_error {w top msg {mc mc}} {
1888    global NS
1889    if {![info exists NS]} {set NS ""}
1890    if {[wm state $top] eq "withdrawn"} { wm deiconify $top }
1891    message $w.m -text $msg -justify center -aspect 400
1892    pack $w.m -side top -fill x -padx 20 -pady 20
1893    ${NS}::button $w.ok -default active -text [$mc OK] -command "destroy $top"
1894    pack $w.ok -side bottom -fill x
1895    bind $top <Visibility> "grab $top; focus $top"
1896    bind $top <Key-Return> "destroy $top"
1897    bind $top <Key-space>  "destroy $top"
1898    bind $top <Key-Escape> "destroy $top"
1899    tkwait window $top
1900}
1901
1902proc error_popup {msg {owner .}} {
1903    if {[tk windowingsystem] eq "win32"} {
1904        tk_messageBox -icon error -type ok -title [wm title .] \
1905            -parent $owner -message $msg
1906    } else {
1907        set w .error
1908        ttk_toplevel $w
1909        make_transient $w $owner
1910        show_error $w $w $msg
1911    }
1912}
1913
1914proc confirm_popup {msg {owner .}} {
1915    global confirm_ok NS
1916    set confirm_ok 0
1917    set w .confirm
1918    ttk_toplevel $w
1919    make_transient $w $owner
1920    message $w.m -text $msg -justify center -aspect 400
1921    pack $w.m -side top -fill x -padx 20 -pady 20
1922    ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
1923    pack $w.ok -side left -fill x
1924    ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
1925    pack $w.cancel -side right -fill x
1926    bind $w <Visibility> "grab $w; focus $w"
1927    bind $w <Key-Return> "set confirm_ok 1; destroy $w"
1928    bind $w <Key-space>  "set confirm_ok 1; destroy $w"
1929    bind $w <Key-Escape> "destroy $w"
1930    tk::PlaceWindow $w widget $owner
1931    tkwait window $w
1932    return $confirm_ok
1933}
1934
1935proc setoptions {} {
1936    if {[tk windowingsystem] ne "win32"} {
1937        option add *Panedwindow.showHandle 1 startupFile
1938        option add *Panedwindow.sashRelief raised startupFile
1939        if {[tk windowingsystem] ne "aqua"} {
1940            option add *Menu.font uifont startupFile
1941        }
1942    } else {
1943        option add *Menu.TearOff 0 startupFile
1944    }
1945    option add *Button.font uifont startupFile
1946    option add *Checkbutton.font uifont startupFile
1947    option add *Radiobutton.font uifont startupFile
1948    option add *Menubutton.font uifont startupFile
1949    option add *Label.font uifont startupFile
1950    option add *Message.font uifont startupFile
1951    option add *Entry.font textfont startupFile
1952    option add *Text.font textfont startupFile
1953    option add *Labelframe.font uifont startupFile
1954    option add *Spinbox.font textfont startupFile
1955    option add *Listbox.font mainfont startupFile
1956}
1957
1958# Make a menu and submenus.
1959# m is the window name for the menu, items is the list of menu items to add.
1960# Each item is a list {mc label type description options...}
1961# mc is ignored; it's so we can put mc there to alert xgettext
1962# label is the string that appears in the menu
1963# type is cascade, command or radiobutton (should add checkbutton)
1964# description depends on type; it's the sublist for cascade, the
1965# command to invoke for command, or {variable value} for radiobutton
1966proc makemenu {m items} {
1967    menu $m
1968    if {[tk windowingsystem] eq {aqua}} {
1969        set Meta1 Cmd
1970    } else {
1971        set Meta1 Ctrl
1972    }
1973    foreach i $items {
1974        set name [mc [lindex $i 1]]
1975        set type [lindex $i 2]
1976        set thing [lindex $i 3]
1977        set params [list $type]
1978        if {$name ne {}} {
1979            set u [string first "&" [string map {&& x} $name]]
1980            lappend params -label [string map {&& & & {}} $name]
1981            if {$u >= 0} {
1982                lappend params -underline $u
1983            }
1984        }
1985        switch -- $type {
1986            "cascade" {
1987                set submenu [string tolower [string map {& ""} [lindex $i 1]]]
1988                lappend params -menu $m.$submenu
1989            }
1990            "command" {
1991                lappend params -command $thing
1992            }
1993            "radiobutton" {
1994                lappend params -variable [lindex $thing 0] \
1995                    -value [lindex $thing 1]
1996            }
1997        }
1998        set tail [lrange $i 4 end]
1999        regsub -all {\yMeta1\y} $tail $Meta1 tail
2000        eval $m add $params $tail
2001        if {$type eq "cascade"} {
2002            makemenu $m.$submenu $thing
2003        }
2004    }
2005}
2006
2007# translate string and remove ampersands
2008proc mca {str} {
2009    return [string map {&& & & {}} [mc $str]]
2010}
2011
2012proc cleardropsel {w} {
2013    $w selection clear
2014}
2015proc makedroplist {w varname args} {
2016    global use_ttk
2017    if {$use_ttk} {
2018        set width 0
2019        foreach label $args {
2020            set cx [string length $label]
2021            if {$cx > $width} {set width $cx}
2022        }
2023        set gm [ttk::combobox $w -width $width -state readonly\
2024                    -textvariable $varname -values $args \
2025                    -exportselection false]
2026        bind $gm <<ComboboxSelected>> [list $gm selection clear]
2027    } else {
2028        set gm [eval [linsert $args 0 tk_optionMenu $w $varname]]
2029    }
2030    return $gm
2031}
2032
2033proc makewindow {} {
2034    global canv canv2 canv3 linespc charspc ctext cflist cscroll
2035    global tabstop
2036    global findtype findtypemenu findloc findstring fstring geometry
2037    global entries sha1entry sha1string sha1but
2038    global diffcontextstring diffcontext
2039    global ignorespace
2040    global maincursor textcursor curtextcursor
2041    global rowctxmenu fakerowmenu mergemax wrapcomment
2042    global highlight_files gdttype
2043    global searchstring sstring
2044    global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
2045    global uifgcolor uifgdisabledcolor
2046    global filesepbgcolor filesepfgcolor
2047    global mergecolors foundbgcolor currentsearchhitbgcolor
2048    global headctxmenu progresscanv progressitem progresscoords statusw
2049    global fprogitem fprogcoord lastprogupdate progupdatepending
2050    global rprogitem rprogcoord rownumsel numcommits
2051    global have_tk85 use_ttk NS
2052    global git_version
2053    global worddiff
2054
2055    # The "mc" arguments here are purely so that xgettext
2056    # sees the following string as needing to be translated
2057    set file {
2058        mc "File" cascade {
2059            {mc "Update" command updatecommits -accelerator F5}
2060            {mc "Reload" command reloadcommits -accelerator Shift-F5}
2061            {mc "Reread references" command rereadrefs}
2062            {mc "List references" command showrefs -accelerator F2}
2063            {xx "" separator}
2064            {mc "Start git gui" command {exec git gui &}}
2065            {xx "" separator}
2066            {mc "Quit" command doquit -accelerator Meta1-Q}
2067        }}
2068    set edit {
2069        mc "Edit" cascade {
2070            {mc "Preferences" command doprefs}
2071        }}
2072    set view {
2073        mc "View" cascade {
2074            {mc "New view..." command {newview 0} -accelerator Shift-F4}
2075            {mc "Edit view..." command editview -state disabled -accelerator F4}
2076            {mc "Delete view" command delview -state disabled}
2077            {xx "" separator}
2078            {mc "All files" radiobutton {selectedview 0} -command {showview 0}}
2079        }}
2080    if {[tk windowingsystem] ne "aqua"} {
2081        set help {
2082        mc "Help" cascade {
2083            {mc "About gitk" command about}
2084            {mc "Key bindings" command keys}
2085        }}
2086        set bar [list $file $edit $view $help]
2087    } else {
2088        proc ::tk::mac::ShowPreferences {} {doprefs}
2089        proc ::tk::mac::Quit {} {doquit}
2090        lset file end [lreplace [lindex $file end] end-1 end]
2091        set apple {
2092        xx "Apple" cascade {
2093            {mc "About gitk" command about}
2094            {xx "" separator}
2095        }}
2096        set help {
2097        mc "Help" cascade {
2098            {mc "Key bindings" command keys}
2099        }}
2100        set bar [list $apple $file $view $help]
2101    }
2102    makemenu .bar $bar
2103    . configure -menu .bar
2104
2105    if {$use_ttk} {
2106        # cover the non-themed toplevel with a themed frame.
2107        place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1
2108    }
2109
2110    # the gui has upper and lower half, parts of a paned window.
2111    ${NS}::panedwindow .ctop -orient vertical
2112
2113    # possibly use assumed geometry
2114    if {![info exists geometry(pwsash0)]} {
2115        set geometry(topheight) [expr {15 * $linespc}]
2116        set geometry(topwidth) [expr {80 * $charspc}]
2117        set geometry(botheight) [expr {15 * $linespc}]
2118        set geometry(botwidth) [expr {50 * $charspc}]
2119        set geometry(pwsash0) [list [expr {40 * $charspc}] 2]
2120        set geometry(pwsash1) [list [expr {60 * $charspc}] 2]
2121    }
2122
2123    # the upper half will have a paned window, a scroll bar to the right, and some stuff below
2124    ${NS}::frame .tf -height $geometry(topheight) -width $geometry(topwidth)
2125    ${NS}::frame .tf.histframe
2126    ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal
2127    if {!$use_ttk} {
2128        .tf.histframe.pwclist configure -sashpad 0 -handlesize 4
2129    }
2130
2131    # create three canvases
2132    set cscroll .tf.histframe.csb
2133    set canv .tf.histframe.pwclist.canv
2134    canvas $canv \
2135        -selectbackground $selectbgcolor \
2136        -background $bgcolor -bd 0 \
2137        -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
2138    .tf.histframe.pwclist add $canv
2139    set canv2 .tf.histframe.pwclist.canv2
2140    canvas $canv2 \
2141        -selectbackground $selectbgcolor \
2142        -background $bgcolor -bd 0 -yscrollincr $linespc
2143    .tf.histframe.pwclist add $canv2
2144    set canv3 .tf.histframe.pwclist.canv3
2145    canvas $canv3 \
2146        -selectbackground $selectbgcolor \
2147        -background $bgcolor -bd 0 -yscrollincr $linespc
2148    .tf.histframe.pwclist add $canv3
2149    if {$use_ttk} {
2150        bind .tf.histframe.pwclist <Map> {
2151            bind %W <Map> {}
2152            .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0]
2153            .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0]
2154        }
2155    } else {
2156        eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
2157        eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
2158    }
2159
2160    # a scroll bar to rule them
2161    ${NS}::scrollbar $cscroll -command {allcanvs yview}
2162    if {!$use_ttk} {$cscroll configure -highlightthickness 0}
2163    pack $cscroll -side right -fill y
2164    bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
2165    lappend bglist $canv $canv2 $canv3
2166    pack .tf.histframe.pwclist -fill both -expand 1 -side left
2167
2168    # we have two button bars at bottom of top frame. Bar 1
2169    ${NS}::frame .tf.bar
2170    ${NS}::frame .tf.lbar -height 15
2171
2172    set sha1entry .tf.bar.sha1
2173    set entries $sha1entry
2174    set sha1but .tf.bar.sha1label
2175    button $sha1but -text "[mc "SHA1 ID:"] " -state disabled -relief flat \
2176        -command gotocommit -width 8
2177    $sha1but conf -disabledforeground [$sha1but cget -foreground]
2178    pack .tf.bar.sha1label -side left
2179    ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string
2180    trace add variable sha1string write sha1change
2181    pack $sha1entry -side left -pady 2
2182
2183    set bm_left_data {
2184        #define left_width 16
2185        #define left_height 16
2186        static unsigned char left_bits[] = {
2187        0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
2188        0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
2189        0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
2190    }
2191    set bm_right_data {
2192        #define right_width 16
2193        #define right_height 16
2194        static unsigned char right_bits[] = {
2195        0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
2196        0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
2197        0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
2198    }
2199    image create bitmap bm-left -data $bm_left_data -foreground $uifgcolor
2200    image create bitmap bm-left-gray -data $bm_left_data -foreground $uifgdisabledcolor
2201    image create bitmap bm-right -data $bm_right_data -foreground $uifgcolor
2202    image create bitmap bm-right-gray -data $bm_right_data -foreground $uifgdisabledcolor
2203
2204    ${NS}::button .tf.bar.leftbut -command goback -state disabled -width 26
2205    if {$use_ttk} {
2206        .tf.bar.leftbut configure -image [list bm-left disabled bm-left-gray]
2207    } else {
2208        .tf.bar.leftbut configure -image bm-left
2209    }
2210    pack .tf.bar.leftbut -side left -fill y
2211    ${NS}::button .tf.bar.rightbut -command goforw -state disabled -width 26
2212    if {$use_ttk} {
2213        .tf.bar.rightbut configure -image [list bm-right disabled bm-right-gray]
2214    } else {
2215        .tf.bar.rightbut configure -image bm-right
2216    }
2217    pack .tf.bar.rightbut -side left -fill y
2218
2219    ${NS}::label .tf.bar.rowlabel -text [mc "Row"]
2220    set rownumsel {}
2221    ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \
2222        -relief sunken -anchor e
2223    ${NS}::label .tf.bar.rowlabel2 -text "/"
2224    ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \
2225        -relief sunken -anchor e
2226    pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
2227        -side left
2228    if {!$use_ttk} {
2229        foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont}
2230    }
2231    global selectedline
2232    trace add variable selectedline write selectedline_change
2233
2234    # Status label and progress bar
2235    set statusw .tf.bar.status
2236    ${NS}::label $statusw -width 15 -relief sunken
2237    pack $statusw -side left -padx 5
2238    if {$use_ttk} {
2239        set progresscanv [ttk::progressbar .tf.bar.progress]
2240    } else {
2241        set h [expr {[font metrics uifont -linespace] + 2}]
2242        set progresscanv .tf.bar.progress
2243        canvas $progresscanv -relief sunken -height $h -borderwidth 2
2244        set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
2245        set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
2246        set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
2247    }
2248    pack $progresscanv -side right -expand 1 -fill x -padx {0 2}
2249    set progresscoords {0 0}
2250    set fprogcoord 0
2251    set rprogcoord 0
2252    bind $progresscanv <Configure> adjustprogress
2253    set lastprogupdate [clock clicks -milliseconds]
2254    set progupdatepending 0
2255
2256    # build up the bottom bar of upper window
2257    ${NS}::label .tf.lbar.flabel -text "[mc "Find"] "
2258    ${NS}::button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
2259    ${NS}::button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
2260    ${NS}::label .tf.lbar.flab2 -text " [mc "commit"] "
2261    pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
2262        -side left -fill y
2263    set gdttype [mc "containing:"]
2264    set gm [makedroplist .tf.lbar.gdttype gdttype \
2265                [mc "containing:"] \
2266                [mc "touching paths:"] \
2267                [mc "adding/removing string:"] \
2268                [mc "changing lines matching:"]]
2269    trace add variable gdttype write gdttype_change
2270    pack .tf.lbar.gdttype -side left -fill y
2271
2272    set findstring {}
2273    set fstring .tf.lbar.findstring
2274    lappend entries $fstring
2275    ${NS}::entry $fstring -width 30 -textvariable findstring
2276    trace add variable findstring write find_change
2277    set findtype [mc "Exact"]
2278    set findtypemenu [makedroplist .tf.lbar.findtype \
2279                          findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
2280    trace add variable findtype write findcom_change
2281    set findloc [mc "All fields"]
2282    makedroplist .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
2283        [mc "Comments"] [mc "Author"] [mc "Committer"]
2284    trace add variable findloc write find_change
2285    pack .tf.lbar.findloc -side right
2286    pack .tf.lbar.findtype -side right
2287    pack $fstring -side left -expand 1 -fill x
2288
2289    # Finish putting the upper half of the viewer together
2290    pack .tf.lbar -in .tf -side bottom -fill x
2291    pack .tf.bar -in .tf -side bottom -fill x
2292    pack .tf.histframe -fill both -side top -expand 1
2293    .ctop add .tf
2294    if {!$use_ttk} {
2295        .ctop paneconfigure .tf -height $geometry(topheight)
2296        .ctop paneconfigure .tf -width $geometry(topwidth)
2297    }
2298
2299    # now build up the bottom
2300    ${NS}::panedwindow .pwbottom -orient horizontal
2301
2302    # lower left, a text box over search bar, scroll bar to the right
2303    # if we know window height, then that will set the lower text height, otherwise
2304    # we set lower text height which will drive window height
2305    if {[info exists geometry(main)]} {
2306        ${NS}::frame .bleft -width $geometry(botwidth)
2307    } else {
2308        ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
2309    }
2310    ${NS}::frame .bleft.top
2311    ${NS}::frame .bleft.mid
2312    ${NS}::frame .bleft.bottom
2313
2314    ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch
2315    pack .bleft.top.search -side left -padx 5
2316    set sstring .bleft.top.sstring
2317    set searchstring ""
2318    ${NS}::entry $sstring -width 20 -textvariable searchstring
2319    lappend entries $sstring
2320    trace add variable searchstring write incrsearch
2321    pack $sstring -side left -expand 1 -fill x
2322    ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \
2323        -command changediffdisp -variable diffelide -value {0 0}
2324    ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \
2325        -command changediffdisp -variable diffelide -value {0 1}
2326    ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \
2327        -command changediffdisp -variable diffelide -value {1 0}
2328    ${NS}::label .bleft.mid.labeldiffcontext -text "      [mc "Lines of context"]: "
2329    pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
2330    spinbox .bleft.mid.diffcontext -width 5 \
2331        -from 0 -increment 1 -to 10000000 \
2332        -validate all -validatecommand "diffcontextvalidate %P" \
2333        -textvariable diffcontextstring
2334    .bleft.mid.diffcontext set $diffcontext
2335    trace add variable diffcontextstring write diffcontextchange
2336    lappend entries .bleft.mid.diffcontext
2337    pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
2338    ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
2339        -command changeignorespace -variable ignorespace
2340    pack .bleft.mid.ignspace -side left -padx 5
2341
2342    set worddiff [mc "Line diff"]
2343    if {[package vcompare $git_version "1.7.2"] >= 0} {
2344        makedroplist .bleft.mid.worddiff worddiff [mc "Line diff"] \
2345            [mc "Markup words"] [mc "Color words"]
2346        trace add variable worddiff write changeworddiff
2347        pack .bleft.mid.worddiff -side left -padx 5
2348    }
2349
2350    set ctext .bleft.bottom.ctext
2351    text $ctext -background $bgcolor -foreground $fgcolor \
2352        -state disabled -font textfont \
2353        -yscrollcommand scrolltext -wrap none \
2354        -xscrollcommand ".bleft.bottom.sbhorizontal set"
2355    if {$have_tk85} {
2356        $ctext conf -tabstyle wordprocessor
2357    }
2358    ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview"
2359    ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h
2360    pack .bleft.top -side top -fill x
2361    pack .bleft.mid -side top -fill x
2362    grid $ctext .bleft.bottom.sb -sticky nsew
2363    grid .bleft.bottom.sbhorizontal -sticky ew
2364    grid columnconfigure .bleft.bottom 0 -weight 1
2365    grid rowconfigure .bleft.bottom 0 -weight 1
2366    grid rowconfigure .bleft.bottom 1 -weight 0
2367    pack .bleft.bottom -side top -fill both -expand 1
2368    lappend bglist $ctext
2369    lappend fglist $ctext
2370
2371    $ctext tag conf comment -wrap $wrapcomment
2372    $ctext tag conf filesep -font textfontbold -fore $filesepfgcolor -back $filesepbgcolor
2373    $ctext tag conf hunksep -fore [lindex $diffcolors 2]
2374    $ctext tag conf d0 -fore [lindex $diffcolors 0]
2375    $ctext tag conf dresult -fore [lindex $diffcolors 1]
2376    $ctext tag conf m0 -fore [lindex $mergecolors 0]
2377    $ctext tag conf m1 -fore [lindex $mergecolors 1]
2378    $ctext tag conf m2 -fore [lindex $mergecolors 2]
2379    $ctext tag conf m3 -fore [lindex $mergecolors 3]
2380    $ctext tag conf m4 -fore [lindex $mergecolors 4]
2381    $ctext tag conf m5 -fore [lindex $mergecolors 5]
2382    $ctext tag conf m6 -fore [lindex $mergecolors 6]
2383    $ctext tag conf m7 -fore [lindex $mergecolors 7]
2384    $ctext tag conf m8 -fore [lindex $mergecolors 8]
2385    $ctext tag conf m9 -fore [lindex $mergecolors 9]
2386    $ctext tag conf m10 -fore [lindex $mergecolors 10]
2387    $ctext tag conf m11 -fore [lindex $mergecolors 11]
2388    $ctext tag conf m12 -fore [lindex $mergecolors 12]
2389    $ctext tag conf m13 -fore [lindex $mergecolors 13]
2390    $ctext tag conf m14 -fore [lindex $mergecolors 14]
2391    $ctext tag conf m15 -fore [lindex $mergecolors 15]
2392    $ctext tag conf mmax -fore darkgrey
2393    set mergemax 16
2394    $ctext tag conf mresult -font textfontbold
2395    $ctext tag conf msep -font textfontbold
2396    $ctext tag conf found -back $foundbgcolor
2397    $ctext tag conf currentsearchhit -back $currentsearchhitbgcolor
2398    $ctext tag conf wwrap -wrap word
2399    $ctext tag conf bold -font textfontbold
2400
2401    .pwbottom add .bleft
2402    if {!$use_ttk} {
2403        .pwbottom paneconfigure .bleft -width $geometry(botwidth)
2404    }
2405
2406    # lower right
2407    ${NS}::frame .bright
2408    ${NS}::frame .bright.mode
2409    ${NS}::radiobutton .bright.mode.patch -text [mc "Patch"] \
2410        -command reselectline -variable cmitmode -value "patch"
2411    ${NS}::radiobutton .bright.mode.tree -text [mc "Tree"] \
2412        -command reselectline -variable cmitmode -value "tree"
2413    grid .bright.mode.patch .bright.mode.tree -sticky ew
2414    pack .bright.mode -side top -fill x
2415    set cflist .bright.cfiles
2416    set indent [font measure mainfont "nn"]
2417    text $cflist \
2418        -selectbackground $selectbgcolor \
2419        -background $bgcolor -foreground $fgcolor \
2420        -font mainfont \
2421        -tabs [list $indent [expr {2 * $indent}]] \
2422        -yscrollcommand ".bright.sb set" \
2423        -cursor [. cget -cursor] \
2424        -spacing1 1 -spacing3 1
2425    lappend bglist $cflist
2426    lappend fglist $cflist
2427    ${NS}::scrollbar .bright.sb -command "$cflist yview"
2428    pack .bright.sb -side right -fill y
2429    pack $cflist -side left -fill both -expand 1
2430    $cflist tag configure highlight \
2431        -background [$cflist cget -selectbackground]
2432    $cflist tag configure bold -font mainfontbold
2433
2434    .pwbottom add .bright
2435    .ctop add .pwbottom
2436
2437    # restore window width & height if known
2438    if {[info exists geometry(main)]} {
2439        if {[scan $geometry(main) "%dx%d" w h] >= 2} {
2440            if {$w > [winfo screenwidth .]} {
2441                set w [winfo screenwidth .]
2442            }
2443            if {$h > [winfo screenheight .]} {
2444                set h [winfo screenheight .]
2445            }
2446            wm geometry . "${w}x$h"
2447        }
2448    }
2449
2450    if {[info exists geometry(state)] && $geometry(state) eq "zoomed"} {
2451        wm state . $geometry(state)
2452    }
2453
2454    if {[tk windowingsystem] eq {aqua}} {
2455        set M1B M1
2456        set ::BM "3"
2457    } else {
2458        set M1B Control
2459        set ::BM "2"
2460    }
2461
2462    if {$use_ttk} {
2463        bind .ctop <Map> {
2464            bind %W <Map> {}
2465            %W sashpos 0 $::geometry(topheight)
2466        }
2467        bind .pwbottom <Map> {
2468            bind %W <Map> {}
2469            %W sashpos 0 $::geometry(botwidth)
2470        }
2471    }
2472
2473    bind .pwbottom <Configure> {resizecdetpanes %W %w}
2474    pack .ctop -fill both -expand 1
2475    bindall <1> {selcanvline %W %x %y}
2476    #bindall <B1-Motion> {selcanvline %W %x %y}
2477    if {[tk windowingsystem] == "win32"} {
2478        bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
2479        bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
2480    } else {
2481        bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
2482        bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
2483        if {[tk windowingsystem] eq "aqua"} {
2484            bindall <MouseWheel> {
2485                set delta [expr {- (%D)}]
2486                allcanvs yview scroll $delta units
2487            }
2488            bindall <Shift-MouseWheel> {
2489                set delta [expr {- (%D)}]
2490                $canv xview scroll $delta units
2491            }
2492        }
2493    }
2494    bindall <$::BM> "canvscan mark %W %x %y"
2495    bindall <B$::BM-Motion> "canvscan dragto %W %x %y"
2496    bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2497    bind . <$M1B-Key-w> doquit
2498    bindkey <Home> selfirstline
2499    bindkey <End> sellastline
2500    bind . <Key-Up> "selnextline -1"
2501    bind . <Key-Down> "selnextline 1"
2502    bind . <Shift-Key-Up> "dofind -1 0"
2503    bind . <Shift-Key-Down> "dofind 1 0"
2504    bindkey <Key-Right> "goforw"
2505    bindkey <Key-Left> "goback"
2506    bind . <Key-Prior> "selnextpage -1"
2507    bind . <Key-Next> "selnextpage 1"
2508    bind . <$M1B-Home> "allcanvs yview moveto 0.0"
2509    bind . <$M1B-End> "allcanvs yview moveto 1.0"
2510    bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
2511    bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
2512    bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2513    bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
2514    bindkey <Key-Delete> "$ctext yview scroll -1 pages"
2515    bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
2516    bindkey <Key-space> "$ctext yview scroll 1 pages"
2517    bindkey p "selnextline -1"
2518    bindkey n "selnextline 1"
2519    bindkey z "goback"
2520    bindkey x "goforw"
2521    bindkey k "selnextline -1"
2522    bindkey j "selnextline 1"
2523    bindkey h "goback"
2524    bindkey l "goforw"
2525    bindkey b prevfile
2526    bindkey d "$ctext yview scroll 18 units"
2527    bindkey u "$ctext yview scroll -18 units"
2528    bindkey / {focus $fstring}
2529    bindkey <Key-KP_Divide> {focus $fstring}
2530    bindkey <Key-Return> {dofind 1 1}
2531    bindkey ? {dofind -1 1}
2532    bindkey f nextfile
2533    bind . <F5> updatecommits
2534    bindmodfunctionkey Shift 5 reloadcommits
2535    bind . <F2> showrefs
2536    bindmodfunctionkey Shift 4 {newview 0}
2537    bind . <F4> edit_or_newview
2538    bind . <$M1B-q> doquit
2539    bind . <$M1B-f> {dofind 1 1}
2540    bind . <$M1B-g> {dofind 1 0}
2541    bind . <$M1B-r> dosearchback
2542    bind . <$M1B-s> dosearch
2543    bind . <$M1B-equal> {incrfont 1}
2544    bind . <$M1B-plus> {incrfont 1}
2545    bind . <$M1B-KP_Add> {incrfont 1}
2546    bind . <$M1B-minus> {incrfont -1}
2547    bind . <$M1B-KP_Subtract> {incrfont -1}
2548    wm protocol . WM_DELETE_WINDOW doquit
2549    bind . <Destroy> {stop_backends}
2550    bind . <Button-1> "click %W"
2551    bind $fstring <Key-Return> {dofind 1 1}
2552    bind $sha1entry <Key-Return> {gotocommit; break}
2553    bind $sha1entry <<PasteSelection>> clearsha1
2554    bind $cflist <1> {sel_flist %W %x %y; break}
2555    bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
2556    bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
2557    global ctxbut
2558    bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
2559    bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
2560    bind $ctext <Button-1> {focus %W}
2561    bind $ctext <<Selection>> rehighlight_search_results
2562
2563    set maincursor [. cget -cursor]
2564    set textcursor [$ctext cget -cursor]
2565    set curtextcursor $textcursor
2566
2567    set rowctxmenu .rowctxmenu
2568    makemenu $rowctxmenu {
2569        {mc "Diff this -> selected" command {diffvssel 0}}
2570        {mc "Diff selected -> this" command {diffvssel 1}}
2571        {mc "Make patch" command mkpatch}
2572        {mc "Create tag" command mktag}
2573        {mc "Write commit to file" command writecommit}
2574        {mc "Create new branch" command mkbranch}
2575        {mc "Cherry-pick this commit" command cherrypick}
2576        {mc "Reset HEAD branch to here" command resethead}
2577        {mc "Mark this commit" command markhere}
2578        {mc "Return to mark" command gotomark}
2579        {mc "Find descendant of this and mark" command find_common_desc}
2580        {mc "Compare with marked commit" command compare_commits}
2581        {mc "Diff this -> marked commit" command {diffvsmark 0}}
2582        {mc "Diff marked commit -> this" command {diffvsmark 1}}
2583        {mc "Revert this commit" command revert}
2584    }
2585    $rowctxmenu configure -tearoff 0
2586
2587    set fakerowmenu .fakerowmenu
2588    makemenu $fakerowmenu {
2589        {mc "Diff this -> selected" command {diffvssel 0}}
2590        {mc "Diff selected -> this" command {diffvssel 1}}
2591        {mc "Make patch" command mkpatch}
2592        {mc "Diff this -> marked commit" command {diffvsmark 0}}
2593        {mc "Diff marked commit -> this" command {diffvsmark 1}}
2594    }
2595    $fakerowmenu configure -tearoff 0
2596
2597    set headctxmenu .headctxmenu
2598    makemenu $headctxmenu {
2599        {mc "Check out this branch" command cobranch}
2600        {mc "Remove this branch" command rmbranch}
2601    }
2602    $headctxmenu configure -tearoff 0
2603
2604    global flist_menu
2605    set flist_menu .flistctxmenu
2606    makemenu $flist_menu {
2607        {mc "Highlight this too" command {flist_hl 0}}
2608        {mc "Highlight this only" command {flist_hl 1}}
2609        {mc "External diff" command {external_diff}}
2610        {mc "Blame parent commit" command {external_blame 1}}
2611    }
2612    $flist_menu configure -tearoff 0
2613
2614    global diff_menu
2615    set diff_menu .diffctxmenu
2616    makemenu $diff_menu {
2617        {mc "Show origin of this line" command show_line_source}
2618        {mc "Run git gui blame on this line" command {external_blame_diff}}
2619    }
2620    $diff_menu configure -tearoff 0
2621}
2622
2623# Windows sends all mouse wheel events to the current focused window, not
2624# the one where the mouse hovers, so bind those events here and redirect
2625# to the correct window
2626proc windows_mousewheel_redirector {W X Y D} {
2627    global canv canv2 canv3
2628    set w [winfo containing -displayof $W $X $Y]
2629    if {$w ne ""} {
2630        set u [expr {$D < 0 ? 5 : -5}]
2631        if {$w == $canv || $w == $canv2 || $w == $canv3} {
2632            allcanvs yview scroll $u units
2633        } else {
2634            catch {
2635                $w yview scroll $u units
2636            }
2637        }
2638    }
2639}
2640
2641# Update row number label when selectedline changes
2642proc selectedline_change {n1 n2 op} {
2643    global selectedline rownumsel
2644
2645    if {$selectedline eq {}} {
2646        set rownumsel {}
2647    } else {
2648        set rownumsel [expr {$selectedline + 1}]
2649    }
2650}
2651
2652# mouse-2 makes all windows scan vertically, but only the one
2653# the cursor is in scans horizontally
2654proc canvscan {op w x y} {
2655    global canv canv2 canv3
2656    foreach c [list $canv $canv2 $canv3] {
2657        if {$c == $w} {
2658            $c scan $op $x $y
2659        } else {
2660            $c scan $op 0 $y
2661        }
2662    }
2663}
2664
2665proc scrollcanv {cscroll f0 f1} {
2666    $cscroll set $f0 $f1
2667    drawvisible
2668    flushhighlights
2669}
2670
2671# when we make a key binding for the toplevel, make sure
2672# it doesn't get triggered when that key is pressed in the
2673# find string entry widget.
2674proc bindkey {ev script} {
2675    global entries
2676    bind . $ev $script
2677    set escript [bind Entry $ev]
2678    if {$escript == {}} {
2679        set escript [bind Entry <Key>]
2680    }
2681    foreach e $entries {
2682        bind $e $ev "$escript; break"
2683    }
2684}
2685
2686proc bindmodfunctionkey {mod n script} {
2687    bind . <$mod-F$n> $script
2688    catch { bind . <$mod-XF86_Switch_VT_$n> $script }
2689}
2690
2691# set the focus back to the toplevel for any click outside
2692# the entry widgets
2693proc click {w} {
2694    global ctext entries
2695    foreach e [concat $entries $ctext] {
2696        if {$w == $e} return
2697    }
2698    focus .
2699}
2700
2701# Adjust the progress bar for a change in requested extent or canvas size
2702proc adjustprogress {} {
2703    global progresscanv progressitem progresscoords
2704    global fprogitem fprogcoord lastprogupdate progupdatepending
2705    global rprogitem rprogcoord use_ttk
2706
2707    if {$use_ttk} {
2708        $progresscanv configure -value [expr {int($fprogcoord * 100)}]
2709        return
2710    }
2711
2712    set w [expr {[winfo width $progresscanv] - 4}]
2713    set x0 [expr {$w * [lindex $progresscoords 0]}]
2714    set x1 [expr {$w * [lindex $progresscoords 1]}]
2715    set h [winfo height $progresscanv]
2716    $progresscanv coords $progressitem $x0 0 $x1 $h
2717    $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2718    $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2719    set now [clock clicks -milliseconds]
2720    if {$now >= $lastprogupdate + 100} {
2721        set progupdatepending 0
2722        update
2723    } elseif {!$progupdatepending} {
2724        set progupdatepending 1
2725        after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2726    }
2727}
2728
2729proc doprogupdate {} {
2730    global lastprogupdate progupdatepending
2731
2732    if {$progupdatepending} {
2733        set progupdatepending 0
2734        set lastprogupdate [clock clicks -milliseconds]
2735        update
2736    }
2737}
2738
2739proc savestuff {w} {
2740    global canv canv2 canv3 mainfont textfont uifont tabstop
2741    global stuffsaved findmergefiles maxgraphpct
2742    global maxwidth showneartags showlocalchanges
2743    global viewname viewfiles viewargs viewargscmd viewperm nextviewnum
2744    global cmitmode wrapcomment datetimeformat limitdiffs
2745    global colors uicolor bgcolor fgcolor diffcolors diffcontext selectbgcolor
2746    global uifgcolor uifgdisabledcolor
2747    global headbgcolor headfgcolor headoutlinecolor remotebgcolor
2748    global tagbgcolor tagfgcolor tagoutlinecolor
2749    global reflinecolor filesepbgcolor filesepfgcolor
2750    global mergecolors foundbgcolor currentsearchhitbgcolor
2751    global linehoverbgcolor linehoverfgcolor linehoveroutlinecolor circlecolors
2752    global mainheadcirclecolor workingfilescirclecolor indexcirclecolor
2753    global linkfgcolor circleoutlinecolor
2754    global autoselect autosellen extdifftool perfile_attrs markbgcolor use_ttk
2755    global hideremotes want_ttk maxrefs
2756
2757    if {$stuffsaved} return
2758    if {![winfo viewable .]} return
2759    catch {
2760        if {[file exists ~/.gitk-new]} {file delete -force ~/.gitk-new}
2761        set f [open "~/.gitk-new" w]
2762        if {$::tcl_platform(platform) eq {windows}} {
2763            file attributes "~/.gitk-new" -hidden true
2764        }
2765        puts $f [list set mainfont $mainfont]
2766        puts $f [list set textfont $textfont]
2767        puts $f [list set uifont $uifont]
2768        puts $f [list set tabstop $tabstop]
2769        puts $f [list set findmergefiles $findmergefiles]
2770        puts $f [list set maxgraphpct $maxgraphpct]
2771        puts $f [list set maxwidth $maxwidth]
2772        puts $f [list set cmitmode $cmitmode]
2773        puts $f [list set wrapcomment $wrapcomment]
2774        puts $f [list set autoselect $autoselect]
2775        puts $f [list set autosellen $autosellen]
2776        puts $f [list set showneartags $showneartags]
2777        puts $f [list set maxrefs $maxrefs]
2778        puts $f [list set hideremotes $hideremotes]
2779        puts $f [list set showlocalchanges $showlocalchanges]
2780        puts $f [list set datetimeformat $datetimeformat]
2781        puts $f [list set limitdiffs $limitdiffs]
2782        puts $f [list set uicolor $uicolor]
2783        puts $f [list set want_ttk $want_ttk]
2784        puts $f [list set bgcolor $bgcolor]
2785        puts $f [list set fgcolor $fgcolor]
2786        puts $f [list set uifgcolor $uifgcolor]
2787        puts $f [list set uifgdisabledcolor $uifgdisabledcolor]
2788        puts $f [list set colors $colors]
2789        puts $f [list set diffcolors $diffcolors]
2790        puts $f [list set mergecolors $mergecolors]
2791        puts $f [list set markbgcolor $markbgcolor]
2792        puts $f [list set diffcontext $diffcontext]
2793        puts $f [list set selectbgcolor $selectbgcolor]
2794        puts $f [list set foundbgcolor $foundbgcolor]
2795        puts $f [list set currentsearchhitbgcolor $currentsearchhitbgcolor]
2796        puts $f [list set extdifftool $extdifftool]
2797        puts $f [list set perfile_attrs $perfile_attrs]
2798        puts $f [list set headbgcolor $headbgcolor]
2799        puts $f [list set headfgcolor $headfgcolor]
2800        puts $f [list set headoutlinecolor $headoutlinecolor]
2801        puts $f [list set remotebgcolor $remotebgcolor]
2802        puts $f [list set tagbgcolor $tagbgcolor]
2803        puts $f [list set tagfgcolor $tagfgcolor]
2804        puts $f [list set tagoutlinecolor $tagoutlinecolor]
2805        puts $f [list set reflinecolor $reflinecolor]
2806        puts $f [list set filesepbgcolor $filesepbgcolor]
2807        puts $f [list set filesepfgcolor $filesepfgcolor]
2808        puts $f [list set linehoverbgcolor $linehoverbgcolor]
2809        puts $f [list set linehoverfgcolor $linehoverfgcolor]
2810        puts $f [list set linehoveroutlinecolor $linehoveroutlinecolor]
2811        puts $f [list set mainheadcirclecolor $mainheadcirclecolor]
2812        puts $f [list set workingfilescirclecolor $workingfilescirclecolor]
2813        puts $f [list set indexcirclecolor $indexcirclecolor]
2814        puts $f [list set circlecolors $circlecolors]
2815        puts $f [list set linkfgcolor $linkfgcolor]
2816        puts $f [list set circleoutlinecolor $circleoutlinecolor]
2817
2818        puts $f "set geometry(main) [wm geometry .]"
2819        puts $f "set geometry(state) [wm state .]"
2820        puts $f "set geometry(topwidth) [winfo width .tf]"
2821        puts $f "set geometry(topheight) [winfo height .tf]"
2822        if {$use_ttk} {
2823            puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
2824            puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
2825        } else {
2826            puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2827            puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2828        }
2829        puts $f "set geometry(botwidth) [winfo width .bleft]"
2830        puts $f "set geometry(botheight) [winfo height .bleft]"
2831
2832        puts -nonewline $f "set permviews {"
2833        for {set v 0} {$v < $nextviewnum} {incr v} {
2834            if {$viewperm($v)} {
2835                puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}"
2836            }
2837        }
2838        puts $f "}"
2839        close $f
2840        file rename -force "~/.gitk-new" "~/.gitk"
2841    }
2842    set stuffsaved 1
2843}
2844
2845proc resizeclistpanes {win w} {
2846    global oldwidth use_ttk
2847    if {[info exists oldwidth($win)]} {
2848        if {$use_ttk} {
2849            set s0 [$win sashpos 0]
2850            set s1 [$win sashpos 1]
2851        } else {
2852            set s0 [$win sash coord 0]
2853            set s1 [$win sash coord 1]
2854        }
2855        if {$w < 60} {
2856            set sash0 [expr {int($w/2 - 2)}]
2857            set sash1 [expr {int($w*5/6 - 2)}]
2858        } else {
2859            set factor [expr {1.0 * $w / $oldwidth($win)}]
2860            set sash0 [expr {int($factor * [lindex $s0 0])}]
2861            set sash1 [expr {int($factor * [lindex $s1 0])}]
2862            if {$sash0 < 30} {
2863                set sash0 30
2864            }
2865            if {$sash1 < $sash0 + 20} {
2866                set sash1 [expr {$sash0 + 20}]
2867            }
2868            if {$sash1 > $w - 10} {
2869                set sash1 [expr {$w - 10}]
2870                if {$sash0 > $sash1 - 20} {
2871                    set sash0 [expr {$sash1 - 20}]
2872                }
2873            }
2874        }
2875        if {$use_ttk} {
2876            $win sashpos 0 $sash0
2877            $win sashpos 1 $sash1
2878        } else {
2879            $win sash place 0 $sash0 [lindex $s0 1]
2880            $win sash place 1 $sash1 [lindex $s1 1]
2881        }
2882    }
2883    set oldwidth($win) $w
2884}
2885
2886proc resizecdetpanes {win w} {
2887    global oldwidth use_ttk
2888    if {[info exists oldwidth($win)]} {
2889        if {$use_ttk} {
2890            set s0 [$win sashpos 0]
2891        } else {
2892            set s0 [$win sash coord 0]
2893        }
2894        if {$w < 60} {
2895            set sash0 [expr {int($w*3/4 - 2)}]
2896        } else {
2897            set factor [expr {1.0 * $w / $oldwidth($win)}]
2898            set sash0 [expr {int($factor * [lindex $s0 0])}]
2899            if {$sash0 < 45} {
2900                set sash0 45
2901            }
2902            if {$sash0 > $w - 15} {
2903                set sash0 [expr {$w - 15}]
2904            }
2905        }
2906        if {$use_ttk} {
2907            $win sashpos 0 $sash0
2908        } else {
2909            $win sash place 0 $sash0 [lindex $s0 1]
2910        }
2911    }
2912    set oldwidth($win) $w
2913}
2914
2915proc allcanvs args {
2916    global canv canv2 canv3
2917    eval $canv $args
2918    eval $canv2 $args
2919    eval $canv3 $args
2920}
2921
2922proc bindall {event action} {
2923    global canv canv2 canv3
2924    bind $canv $event $action
2925    bind $canv2 $event $action
2926    bind $canv3 $event $action
2927}
2928
2929proc about {} {
2930    global uifont NS
2931    set w .about
2932    if {[winfo exists $w]} {
2933        raise $w
2934        return
2935    }
2936    ttk_toplevel $w
2937    wm title $w [mc "About gitk"]
2938    make_transient $w .
2939    message $w.m -text [mc "
2940Gitk - a commit viewer for git
2941
2942Copyright \u00a9 2005-2011 Paul Mackerras
2943
2944Use and redistribute under the terms of the GNU General Public License"] \
2945            -justify center -aspect 400 -border 2 -bg white -relief groove
2946    pack $w.m -side top -fill x -padx 2 -pady 2
2947    ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
2948    pack $w.ok -side bottom
2949    bind $w <Visibility> "focus $w.ok"
2950    bind $w <Key-Escape> "destroy $w"
2951    bind $w <Key-Return> "destroy $w"
2952    tk::PlaceWindow $w widget .
2953}
2954
2955proc keys {} {
2956    global NS
2957    set w .keys
2958    if {[winfo exists $w]} {
2959        raise $w
2960        return
2961    }
2962    if {[tk windowingsystem] eq {aqua}} {
2963        set M1T Cmd
2964    } else {
2965        set M1T Ctrl
2966    }
2967    ttk_toplevel $w
2968    wm title $w [mc "Gitk key bindings"]
2969    make_transient $w .
2970    message $w.m -text "
2971[mc "Gitk key bindings:"]
2972
2973[mc "<%s-Q>             Quit" $M1T]
2974[mc "<%s-W>             Close window" $M1T]
2975[mc "<Home>             Move to first commit"]
2976[mc "<End>              Move to last commit"]
2977[mc "<Up>, p, k Move up one commit"]
2978[mc "<Down>, n, j       Move down one commit"]
2979[mc "<Left>, z, h       Go back in history list"]
2980[mc "<Right>, x, l      Go forward in history list"]
2981[mc "<PageUp>   Move up one page in commit list"]
2982[mc "<PageDown> Move down one page in commit list"]
2983[mc "<%s-Home>  Scroll to top of commit list" $M1T]
2984[mc "<%s-End>   Scroll to bottom of commit list" $M1T]
2985[mc "<%s-Up>    Scroll commit list up one line" $M1T]
2986[mc "<%s-Down>  Scroll commit list down one line" $M1T]
2987[mc "<%s-PageUp>        Scroll commit list up one page" $M1T]
2988[mc "<%s-PageDown>      Scroll commit list down one page" $M1T]
2989[mc "<Shift-Up> Find backwards (upwards, later commits)"]
2990[mc "<Shift-Down>       Find forwards (downwards, earlier commits)"]
2991[mc "<Delete>, b        Scroll diff view up one page"]
2992[mc "<Backspace>        Scroll diff view up one page"]
2993[mc "<Space>            Scroll diff view down one page"]
2994[mc "u          Scroll diff view up 18 lines"]
2995[mc "d          Scroll diff view down 18 lines"]
2996[mc "<%s-F>             Find" $M1T]
2997[mc "<%s-G>             Move to next find hit" $M1T]
2998[mc "<Return>   Move to next find hit"]
2999[mc "/          Focus the search box"]
3000[mc "?          Move to previous find hit"]
3001[mc "f          Scroll diff view to next file"]
3002[mc "<%s-S>             Search for next hit in diff view" $M1T]
3003[mc "<%s-R>             Search for previous hit in diff view" $M1T]
3004[mc "<%s-KP+>   Increase font size" $M1T]
3005[mc "<%s-plus>  Increase font size" $M1T]
3006[mc "<%s-KP->   Decrease font size" $M1T]
3007[mc "<%s-minus> Decrease font size" $M1T]
3008[mc "<F5>               Update"]
3009" \
3010            -justify left -bg white -border 2 -relief groove
3011    pack $w.m -side top -fill both -padx 2 -pady 2
3012    ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
3013    bind $w <Key-Escape> [list destroy $w]
3014    pack $w.ok -side bottom
3015    bind $w <Visibility> "focus $w.ok"
3016    bind $w <Key-Escape> "destroy $w"
3017    bind $w <Key-Return> "destroy $w"
3018}
3019
3020# Procedures for manipulating the file list window at the
3021# bottom right of the overall window.
3022
3023proc treeview {w l openlevs} {
3024    global treecontents treediropen treeheight treeparent treeindex
3025
3026    set ix 0
3027    set treeindex() 0
3028    set lev 0
3029    set prefix {}
3030    set prefixend -1
3031    set prefendstack {}
3032    set htstack {}
3033    set ht 0
3034    set treecontents() {}
3035    $w conf -state normal
3036    foreach f $l {
3037        while {[string range $f 0 $prefixend] ne $prefix} {
3038            if {$lev <= $openlevs} {
3039                $w mark set e:$treeindex($prefix) "end -1c"
3040                $w mark gravity e:$treeindex($prefix) left
3041            }
3042            set treeheight($prefix) $ht
3043            incr ht [lindex $htstack end]
3044            set htstack [lreplace $htstack end end]
3045            set prefixend [lindex $prefendstack end]
3046            set prefendstack [lreplace $prefendstack end end]
3047            set prefix [string range $prefix 0 $prefixend]
3048            incr lev -1
3049        }
3050        set tail [string range $f [expr {$prefixend+1}] end]
3051        while {[set slash [string first "/" $tail]] >= 0} {
3052            lappend htstack $ht
3053            set ht 0
3054            lappend prefendstack $prefixend
3055            incr prefixend [expr {$slash + 1}]
3056            set d [string range $tail 0 $slash]
3057            lappend treecontents($prefix) $d
3058            set oldprefix $prefix
3059            append prefix $d
3060            set treecontents($prefix) {}
3061            set treeindex($prefix) [incr ix]
3062            set treeparent($prefix) $oldprefix
3063            set tail [string range $tail [expr {$slash+1}] end]
3064            if {$lev <= $openlevs} {
3065                set ht 1
3066                set treediropen($prefix) [expr {$lev < $openlevs}]
3067                set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
3068                $w mark set d:$ix "end -1c"
3069                $w mark gravity d:$ix left
3070                set str "\n"
3071                for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3072                $w insert end $str
3073                $w image create end -align center -image $bm -padx 1 \
3074                    -name a:$ix
3075                $w insert end $d [highlight_tag $prefix]
3076                $w mark set s:$ix "end -1c"
3077                $w mark gravity s:$ix left
3078            }
3079            incr lev
3080        }
3081        if {$tail ne {}} {
3082            if {$lev <= $openlevs} {
3083                incr ht
3084                set str "\n"
3085                for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3086                $w insert end $str
3087                $w insert end $tail [highlight_tag $f]
3088            }
3089            lappend treecontents($prefix) $tail
3090        }
3091    }
3092    while {$htstack ne {}} {
3093        set treeheight($prefix) $ht
3094        incr ht [lindex $htstack end]
3095        set htstack [lreplace $htstack end end]
3096        set prefixend [lindex $prefendstack end]
3097        set prefendstack [lreplace $prefendstack end end]
3098        set prefix [string range $prefix 0 $prefixend]
3099    }
3100    $w conf -state disabled
3101}
3102
3103proc linetoelt {l} {
3104    global treeheight treecontents
3105
3106    set y 2
3107    set prefix {}
3108    while {1} {
3109        foreach e $treecontents($prefix) {
3110            if {$y == $l} {
3111                return "$prefix$e"
3112            }
3113            set n 1
3114            if {[string index $e end] eq "/"} {
3115                set n $treeheight($prefix$e)
3116                if {$y + $n > $l} {
3117                    append prefix $e
3118                    incr y
3119                    break
3120                }
3121            }
3122            incr y $n
3123        }
3124    }
3125}
3126
3127proc highlight_tree {y prefix} {
3128    global treeheight treecontents cflist
3129
3130    foreach e $treecontents($prefix) {
3131        set path $prefix$e
3132        if {[highlight_tag $path] ne {}} {
3133            $cflist tag add bold $y.0 "$y.0 lineend"
3134        }
3135        incr y
3136        if {[string index $e end] eq "/" && $treeheight($path) > 1} {
3137            set y [highlight_tree $y $path]
3138        }
3139    }
3140    return $y
3141}
3142
3143proc treeclosedir {w dir} {
3144    global treediropen treeheight treeparent treeindex
3145
3146    set ix $treeindex($dir)
3147    $w conf -state normal
3148    $w delete s:$ix e:$ix
3149    set treediropen($dir) 0
3150    $w image configure a:$ix -image tri-rt
3151    $w conf -state disabled
3152    set n [expr {1 - $treeheight($dir)}]
3153    while {$dir ne {}} {
3154        incr treeheight($dir) $n
3155        set dir $treeparent($dir)
3156    }
3157}
3158
3159proc treeopendir {w dir} {
3160    global treediropen treeheight treeparent treecontents treeindex
3161
3162    set ix $treeindex($dir)
3163    $w conf -state normal
3164    $w image configure a:$ix -image tri-dn
3165    $w mark set e:$ix s:$ix
3166    $w mark gravity e:$ix right
3167    set lev 0
3168    set str "\n"
3169    set n [llength $treecontents($dir)]
3170    for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
3171        incr lev
3172        append str "\t"
3173        incr treeheight($x) $n
3174    }
3175    foreach e $treecontents($dir) {
3176        set de $dir$e
3177        if {[string index $e end] eq "/"} {
3178            set iy $treeindex($de)
3179            $w mark set d:$iy e:$ix
3180            $w mark gravity d:$iy left
3181            $w insert e:$ix $str
3182            set treediropen($de) 0
3183            $w image create e:$ix -align center -image tri-rt -padx 1 \
3184                -name a:$iy
3185            $w insert e:$ix $e [highlight_tag $de]
3186            $w mark set s:$iy e:$ix
3187            $w mark gravity s:$iy left
3188            set treeheight($de) 1
3189        } else {
3190            $w insert e:$ix $str
3191            $w insert e:$ix $e [highlight_tag $de]
3192        }
3193    }
3194    $w mark gravity e:$ix right
3195    $w conf -state disabled
3196    set treediropen($dir) 1
3197    set top [lindex [split [$w index @0,0] .] 0]
3198    set ht [$w cget -height]
3199    set l [lindex [split [$w index s:$ix] .] 0]
3200    if {$l < $top} {
3201        $w yview $l.0
3202    } elseif {$l + $n + 1 > $top + $ht} {
3203        set top [expr {$l + $n + 2 - $ht}]
3204        if {$l < $top} {
3205            set top $l
3206        }
3207        $w yview $top.0
3208    }
3209}
3210
3211proc treeclick {w x y} {
3212    global treediropen cmitmode ctext cflist cflist_top
3213
3214    if {$cmitmode ne "tree"} return
3215    if {![info exists cflist_top]} return
3216    set l [lindex [split [$w index "@$x,$y"] "."] 0]
3217    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3218    $cflist tag add highlight $l.0 "$l.0 lineend"
3219    set cflist_top $l
3220    if {$l == 1} {
3221        $ctext yview 1.0
3222        return
3223    }
3224    set e [linetoelt $l]
3225    if {[string index $e end] ne "/"} {
3226        showfile $e
3227    } elseif {$treediropen($e)} {
3228        treeclosedir $w $e
3229    } else {
3230        treeopendir $w $e
3231    }
3232}
3233
3234proc setfilelist {id} {
3235    global treefilelist cflist jump_to_here
3236
3237    treeview $cflist $treefilelist($id) 0
3238    if {$jump_to_here ne {}} {
3239        set f [lindex $jump_to_here 0]
3240        if {[lsearch -exact $treefilelist($id) $f] >= 0} {
3241            showfile $f
3242        }
3243    }
3244}
3245
3246image create bitmap tri-rt -background black -foreground blue -data {
3247    #define tri-rt_width 13
3248    #define tri-rt_height 13
3249    static unsigned char tri-rt_bits[] = {
3250       0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
3251       0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
3252       0x00, 0x00};
3253} -maskdata {
3254    #define tri-rt-mask_width 13
3255    #define tri-rt-mask_height 13
3256    static unsigned char tri-rt-mask_bits[] = {
3257       0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
3258       0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
3259       0x08, 0x00};
3260}
3261image create bitmap tri-dn -background black -foreground blue -data {
3262    #define tri-dn_width 13
3263    #define tri-dn_height 13
3264    static unsigned char tri-dn_bits[] = {
3265       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
3266       0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3267       0x00, 0x00};
3268} -maskdata {
3269    #define tri-dn-mask_width 13
3270    #define tri-dn-mask_height 13
3271    static unsigned char tri-dn-mask_bits[] = {
3272       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
3273       0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
3274       0x00, 0x00};
3275}
3276
3277image create bitmap reficon-T -background black -foreground yellow -data {
3278    #define tagicon_width 13
3279    #define tagicon_height 9
3280    static unsigned char tagicon_bits[] = {
3281       0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
3282       0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
3283} -maskdata {
3284    #define tagicon-mask_width 13
3285    #define tagicon-mask_height 9
3286    static unsigned char tagicon-mask_bits[] = {
3287       0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
3288       0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
3289}
3290set rectdata {
3291    #define headicon_width 13
3292    #define headicon_height 9
3293    static unsigned char headicon_bits[] = {
3294       0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3295       0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3296}
3297set rectmask {
3298    #define headicon-mask_width 13
3299    #define headicon-mask_height 9
3300    static unsigned char headicon-mask_bits[] = {
3301       0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3302       0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3303}
3304image create bitmap reficon-H -background black -foreground green \
3305    -data $rectdata -maskdata $rectmask
3306image create bitmap reficon-o -background black -foreground "#ddddff" \
3307    -data $rectdata -maskdata $rectmask
3308
3309proc init_flist {first} {
3310    global cflist cflist_top difffilestart
3311
3312    $cflist conf -state normal
3313    $cflist delete 0.0 end
3314    if {$first ne {}} {
3315        $cflist insert end $first
3316        set cflist_top 1
3317        $cflist tag add highlight 1.0 "1.0 lineend"
3318    } else {
3319        catch {unset cflist_top}
3320    }
3321    $cflist conf -state disabled
3322    set difffilestart {}
3323}
3324
3325proc highlight_tag {f} {
3326    global highlight_paths
3327
3328    foreach p $highlight_paths {
3329        if {[string match $p $f]} {
3330            return "bold"
3331        }
3332    }
3333    return {}
3334}
3335
3336proc highlight_filelist {} {
3337    global cmitmode cflist
3338
3339    $cflist conf -state normal
3340    if {$cmitmode ne "tree"} {
3341        set end [lindex [split [$cflist index end] .] 0]
3342        for {set l 2} {$l < $end} {incr l} {
3343            set line [$cflist get $l.0 "$l.0 lineend"]
3344            if {[highlight_tag $line] ne {}} {
3345                $cflist tag add bold $l.0 "$l.0 lineend"
3346            }
3347        }
3348    } else {
3349        highlight_tree 2 {}
3350    }
3351    $cflist conf -state disabled
3352}
3353
3354proc unhighlight_filelist {} {
3355    global cflist
3356
3357    $cflist conf -state normal
3358    $cflist tag remove bold 1.0 end
3359    $cflist conf -state disabled
3360}
3361
3362proc add_flist {fl} {
3363    global cflist
3364
3365    $cflist conf -state normal
3366    foreach f $fl {
3367        $cflist insert end "\n"
3368        $cflist insert end $f [highlight_tag $f]
3369    }
3370    $cflist conf -state disabled
3371}
3372
3373proc sel_flist {w x y} {
3374    global ctext difffilestart cflist cflist_top cmitmode
3375
3376    if {$cmitmode eq "tree"} return
3377    if {![info exists cflist_top]} return
3378    set l [lindex [split [$w index "@$x,$y"] "."] 0]
3379    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3380    $cflist tag add highlight $l.0 "$l.0 lineend"
3381    set cflist_top $l
3382    if {$l == 1} {
3383        $ctext yview 1.0
3384    } else {
3385        catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
3386    }
3387    suppress_highlighting_file_for_current_scrollpos
3388}
3389
3390proc pop_flist_menu {w X Y x y} {
3391    global ctext cflist cmitmode flist_menu flist_menu_file
3392    global treediffs diffids
3393
3394    stopfinding
3395    set l [lindex [split [$w index "@$x,$y"] "."] 0]
3396    if {$l <= 1} return
3397    if {$cmitmode eq "tree"} {
3398        set e [linetoelt $l]
3399        if {[string index $e end] eq "/"} return
3400    } else {
3401        set e [lindex $treediffs($diffids) [expr {$l-2}]]
3402    }
3403    set flist_menu_file $e
3404    set xdiffstate "normal"
3405    if {$cmitmode eq "tree"} {
3406        set xdiffstate "disabled"
3407    }
3408    # Disable "External diff" item in tree mode
3409    $flist_menu entryconf 2 -state $xdiffstate
3410    tk_popup $flist_menu $X $Y
3411}
3412
3413proc find_ctext_fileinfo {line} {
3414    global ctext_file_names ctext_file_lines
3415
3416    set ok [bsearch $ctext_file_lines $line]
3417    set tline [lindex $ctext_file_lines $ok]
3418
3419    if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3420        return {}
3421    } else {
3422        return [list [lindex $ctext_file_names $ok] $tline]
3423    }
3424}
3425
3426proc pop_diff_menu {w X Y x y} {
3427    global ctext diff_menu flist_menu_file
3428    global diff_menu_txtpos diff_menu_line
3429    global diff_menu_filebase
3430
3431    set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3432    set diff_menu_line [lindex $diff_menu_txtpos 0]
3433    # don't pop up the menu on hunk-separator or file-separator lines
3434    if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3435        return
3436    }
3437    stopfinding
3438    set f [find_ctext_fileinfo $diff_menu_line]
3439    if {$f eq {}} return
3440    set flist_menu_file [lindex $f 0]
3441    set diff_menu_filebase [lindex $f 1]
3442    tk_popup $diff_menu $X $Y
3443}
3444
3445proc flist_hl {only} {
3446    global flist_menu_file findstring gdttype
3447
3448    set x [shellquote $flist_menu_file]
3449    if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
3450        set findstring $x
3451    } else {
3452        append findstring " " $x
3453    }
3454    set gdttype [mc "touching paths:"]
3455}
3456
3457proc gitknewtmpdir {} {
3458    global diffnum gitktmpdir gitdir
3459
3460    if {![info exists gitktmpdir]} {
3461        set gitktmpdir [file join $gitdir [format ".gitk-tmp.%s" [pid]]]
3462        if {[catch {file mkdir $gitktmpdir} err]} {
3463            error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3464            unset gitktmpdir
3465            return {}
3466        }
3467        set diffnum 0
3468    }
3469    incr diffnum
3470    set diffdir [file join $gitktmpdir $diffnum]
3471    if {[catch {file mkdir $diffdir} err]} {
3472        error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3473        return {}
3474    }
3475    return $diffdir
3476}
3477
3478proc save_file_from_commit {filename output what} {
3479    global nullfile
3480
3481    if {[catch {exec git show $filename -- > $output} err]} {
3482        if {[string match "fatal: bad revision *" $err]} {
3483            return $nullfile
3484        }
3485        error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
3486        return {}
3487    }
3488    return $output
3489}
3490
3491proc external_diff_get_one_file {diffid filename diffdir} {
3492    global nullid nullid2 nullfile
3493    global worktree
3494
3495    if {$diffid == $nullid} {
3496        set difffile [file join $worktree $filename]
3497        if {[file exists $difffile]} {
3498            return $difffile
3499        }
3500        return $nullfile
3501    }
3502    if {$diffid == $nullid2} {
3503        set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3504        return [save_file_from_commit :$filename $difffile index]
3505    }
3506    set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3507    return [save_file_from_commit $diffid:$filename $difffile \
3508               "revision $diffid"]
3509}
3510
3511proc external_diff {} {
3512    global nullid nullid2
3513    global flist_menu_file
3514    global diffids
3515    global extdifftool
3516
3517    if {[llength $diffids] == 1} {
3518        # no reference commit given
3519        set diffidto [lindex $diffids 0]
3520        if {$diffidto eq $nullid} {
3521            # diffing working copy with index
3522            set diffidfrom $nullid2
3523        } elseif {$diffidto eq $nullid2} {
3524            # diffing index with HEAD
3525            set diffidfrom "HEAD"
3526        } else {
3527            # use first parent commit
3528            global parentlist selectedline
3529            set diffidfrom [lindex $parentlist $selectedline 0]
3530        }
3531    } else {
3532        set diffidfrom [lindex $diffids 0]
3533        set diffidto [lindex $diffids 1]
3534    }
3535
3536    # make sure that several diffs wont collide
3537    set diffdir [gitknewtmpdir]
3538    if {$diffdir eq {}} return
3539
3540    # gather files to diff
3541    set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3542    set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3543
3544    if {$difffromfile ne {} && $difftofile ne {}} {
3545        set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
3546        if {[catch {set fl [open |$cmd r]} err]} {
3547            file delete -force $diffdir
3548            error_popup "$extdifftool: [mc "command failed:"] $err"
3549        } else {
3550            fconfigure $fl -blocking 0
3551            filerun $fl [list delete_at_eof $fl $diffdir]
3552        }
3553    }
3554}
3555
3556proc find_hunk_blamespec {base line} {
3557    global ctext
3558
3559    # Find and parse the hunk header
3560    set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3561    if {$s_lix eq {}} return
3562
3563    set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3564    if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3565            s_line old_specs osz osz1 new_line nsz]} {
3566        return
3567    }
3568
3569    # base lines for the parents
3570    set base_lines [list $new_line]
3571    foreach old_spec [lrange [split $old_specs " "] 1 end] {
3572        if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3573                old_spec old_line osz]} {
3574            return
3575        }
3576        lappend base_lines $old_line
3577    }
3578
3579    # Now scan the lines to determine offset within the hunk
3580    set max_parent [expr {[llength $base_lines]-2}]
3581    set dline 0
3582    set s_lno [lindex [split $s_lix "."] 0]
3583
3584    # Determine if the line is removed
3585    set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3586    if {[string match {[-+ ]*} $chunk]} {
3587        set removed_idx [string first "-" $chunk]
3588        # Choose a parent index
3589        if {$removed_idx >= 0} {
3590            set parent $removed_idx
3591        } else {
3592            set unchanged_idx [string first " " $chunk]
3593            if {$unchanged_idx >= 0} {
3594                set parent $unchanged_idx
3595            } else {
3596                # blame the current commit
3597                set parent -1
3598            }
3599        }
3600        # then count other lines that belong to it
3601        for {set i $line} {[incr i -1] > $s_lno} {} {
3602            set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3603            # Determine if the line is removed
3604            set removed_idx [string first "-" $chunk]
3605            if {$parent >= 0} {
3606                set code [string index $chunk $parent]
3607                if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3608                    incr dline
3609                }
3610            } else {
3611                if {$removed_idx < 0} {
3612                    incr dline
3613                }
3614            }
3615        }
3616        incr parent
3617    } else {
3618        set parent 0
3619    }
3620
3621    incr dline [lindex $base_lines $parent]
3622    return [list $parent $dline]
3623}
3624
3625proc external_blame_diff {} {
3626    global currentid cmitmode
3627    global diff_menu_txtpos diff_menu_line
3628    global diff_menu_filebase flist_menu_file
3629
3630    if {$cmitmode eq "tree"} {
3631        set parent_idx 0
3632        set line [expr {$diff_menu_line - $diff_menu_filebase}]
3633    } else {
3634        set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3635        if {$hinfo ne {}} {
3636            set parent_idx [lindex $hinfo 0]
3637            set line [lindex $hinfo 1]
3638        } else {
3639            set parent_idx 0
3640            set line 0
3641        }
3642    }
3643
3644    external_blame $parent_idx $line
3645}
3646
3647# Find the SHA1 ID of the blob for file $fname in the index
3648# at stage 0 or 2
3649proc index_sha1 {fname} {
3650    set f [open [list | git ls-files -s $fname] r]
3651    while {[gets $f line] >= 0} {
3652        set info [lindex [split $line "\t"] 0]
3653        set stage [lindex $info 2]
3654        if {$stage eq "0" || $stage eq "2"} {
3655            close $f
3656            return [lindex $info 1]
3657        }
3658    }
3659    close $f
3660    return {}
3661}
3662
3663# Turn an absolute path into one relative to the current directory
3664proc make_relative {f} {
3665    if {[file pathtype $f] eq "relative"} {
3666        return $f
3667    }
3668    set elts [file split $f]
3669    set here [file split [pwd]]
3670    set ei 0
3671    set hi 0
3672    set res {}
3673    foreach d $here {
3674        if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3675            lappend res ".."
3676        } else {
3677            incr ei
3678        }
3679        incr hi
3680    }
3681    set elts [concat $res [lrange $elts $ei end]]
3682    return [eval file join $elts]
3683}
3684
3685proc external_blame {parent_idx {line {}}} {
3686    global flist_menu_file cdup
3687    global nullid nullid2
3688    global parentlist selectedline currentid
3689
3690    if {$parent_idx > 0} {
3691        set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3692    } else {
3693        set base_commit $currentid
3694    }
3695
3696    if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3697        error_popup [mc "No such commit"]
3698        return
3699    }
3700
3701    set cmdline [list git gui blame]
3702    if {$line ne {} && $line > 1} {
3703        lappend cmdline "--line=$line"
3704    }
3705    set f [file join $cdup $flist_menu_file]
3706    # Unfortunately it seems git gui blame doesn't like
3707    # being given an absolute path...
3708    set f [make_relative $f]
3709    lappend cmdline $base_commit $f
3710    if {[catch {eval exec $cmdline &} err]} {
3711        error_popup "[mc "git gui blame: command failed:"] $err"
3712    }
3713}
3714
3715proc show_line_source {} {
3716    global cmitmode currentid parents curview blamestuff blameinst
3717    global diff_menu_line diff_menu_filebase flist_menu_file
3718    global nullid nullid2 gitdir cdup
3719
3720    set from_index {}
3721    if {$cmitmode eq "tree"} {
3722        set id $currentid
3723        set line [expr {$diff_menu_line - $diff_menu_filebase}]
3724    } else {
3725        set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3726        if {$h eq {}} return
3727        set pi [lindex $h 0]
3728        if {$pi == 0} {
3729            mark_ctext_line $diff_menu_line
3730            return
3731        }
3732        incr pi -1
3733        if {$currentid eq $nullid} {
3734            if {$pi > 0} {
3735                # must be a merge in progress...
3736                if {[catch {
3737                    # get the last line from .git/MERGE_HEAD
3738                    set f [open [file join $gitdir MERGE_HEAD] r]
3739                    set id [lindex [split [read $f] "\n"] end-1]
3740                    close $f
3741                } err]} {
3742                    error_popup [mc "Couldn't read merge head: %s" $err]
3743                    return
3744                }
3745            } elseif {$parents($curview,$currentid) eq $nullid2} {
3746                # need to do the blame from the index
3747                if {[catch {
3748                    set from_index [index_sha1 $flist_menu_file]
3749                } err]} {
3750                    error_popup [mc "Error reading index: %s" $err]
3751                    return
3752                }
3753            } else {
3754                set id $parents($curview,$currentid)
3755            }
3756        } else {
3757            set id [lindex $parents($curview,$currentid) $pi]
3758        }
3759        set line [lindex $h 1]
3760    }
3761    set blameargs {}
3762    if {$from_index ne {}} {
3763        lappend blameargs | git cat-file blob $from_index
3764    }
3765    lappend blameargs | git blame -p -L$line,+1
3766    if {$from_index ne {}} {
3767        lappend blameargs --contents -
3768    } else {
3769        lappend blameargs $id
3770    }
3771    lappend blameargs -- [file join $cdup $flist_menu_file]
3772    if {[catch {
3773        set f [open $blameargs r]
3774    } err]} {
3775        error_popup [mc "Couldn't start git blame: %s" $err]
3776        return
3777    }
3778    nowbusy blaming [mc "Searching"]
3779    fconfigure $f -blocking 0
3780    set i [reg_instance $f]
3781    set blamestuff($i) {}
3782    set blameinst $i
3783    filerun $f [list read_line_source $f $i]
3784}
3785
3786proc stopblaming {} {
3787    global blameinst
3788
3789    if {[info exists blameinst]} {
3790        stop_instance $blameinst
3791        unset blameinst
3792        notbusy blaming
3793    }
3794}
3795
3796proc read_line_source {fd inst} {
3797    global blamestuff curview commfd blameinst nullid nullid2
3798
3799    while {[gets $fd line] >= 0} {
3800        lappend blamestuff($inst) $line
3801    }
3802    if {![eof $fd]} {
3803        return 1
3804    }
3805    unset commfd($inst)
3806    unset blameinst
3807    notbusy blaming
3808    fconfigure $fd -blocking 1
3809    if {[catch {close $fd} err]} {
3810        error_popup [mc "Error running git blame: %s" $err]
3811        return 0
3812    }
3813
3814    set fname {}
3815    set line [split [lindex $blamestuff($inst) 0] " "]
3816    set id [lindex $line 0]
3817    set lnum [lindex $line 1]
3818    if {[string length $id] == 40 && [string is xdigit $id] &&
3819        [string is digit -strict $lnum]} {
3820        # look for "filename" line
3821        foreach l $blamestuff($inst) {
3822            if {[string match "filename *" $l]} {
3823                set fname [string range $l 9 end]
3824                break
3825            }
3826        }
3827    }
3828    if {$fname ne {}} {
3829        # all looks good, select it
3830        if {$id eq $nullid} {
3831            # blame uses all-zeroes to mean not committed,
3832            # which would mean a change in the index
3833            set id $nullid2
3834        }
3835        if {[commitinview $id $curview]} {
3836            selectline [rowofcommit $id] 1 [list $fname $lnum]
3837        } else {
3838            error_popup [mc "That line comes from commit %s, \
3839                             which is not in this view" [shortids $id]]
3840        }
3841    } else {
3842        puts "oops couldn't parse git blame output"
3843    }
3844    return 0
3845}
3846
3847# delete $dir when we see eof on $f (presumably because the child has exited)
3848proc delete_at_eof {f dir} {
3849    while {[gets $f line] >= 0} {}
3850    if {[eof $f]} {
3851        if {[catch {close $f} err]} {
3852            error_popup "[mc "External diff viewer failed:"] $err"
3853        }
3854        file delete -force $dir
3855        return 0
3856    }
3857    return 1
3858}
3859
3860# Functions for adding and removing shell-type quoting
3861
3862proc shellquote {str} {
3863    if {![string match "*\['\"\\ \t]*" $str]} {
3864        return $str
3865    }
3866    if {![string match "*\['\"\\]*" $str]} {
3867        return "\"$str\""
3868    }
3869    if {![string match "*'*" $str]} {
3870        return "'$str'"
3871    }
3872    return "\"[string map {\" \\\" \\ \\\\} $str]\""
3873}
3874
3875proc shellarglist {l} {
3876    set str {}
3877    foreach a $l {
3878        if {$str ne {}} {
3879            append str " "
3880        }
3881        append str [shellquote $a]
3882    }
3883    return $str
3884}
3885
3886proc shelldequote {str} {
3887    set ret {}
3888    set used -1
3889    while {1} {
3890        incr used
3891        if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
3892            append ret [string range $str $used end]
3893            set used [string length $str]
3894            break
3895        }
3896        set first [lindex $first 0]
3897        set ch [string index $str $first]
3898        if {$first > $used} {
3899            append ret [string range $str $used [expr {$first - 1}]]
3900            set used $first
3901        }
3902        if {$ch eq " " || $ch eq "\t"} break
3903        incr used
3904        if {$ch eq "'"} {
3905            set first [string first "'" $str $used]
3906            if {$first < 0} {
3907                error "unmatched single-quote"
3908            }
3909            append ret [string range $str $used [expr {$first - 1}]]
3910            set used $first
3911            continue
3912        }
3913        if {$ch eq "\\"} {
3914            if {$used >= [string length $str]} {
3915                error "trailing backslash"
3916            }
3917            append ret [string index $str $used]
3918            continue
3919        }
3920        # here ch == "\""
3921        while {1} {
3922            if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
3923                error "unmatched double-quote"
3924            }
3925            set first [lindex $first 0]
3926            set ch [string index $str $first]
3927            if {$first > $used} {
3928                append ret [string range $str $used [expr {$first - 1}]]
3929                set used $first
3930            }
3931            if {$ch eq "\""} break
3932            incr used
3933            append ret [string index $str $used]
3934            incr used
3935        }
3936    }
3937    return [list $used $ret]
3938}
3939
3940proc shellsplit {str} {
3941    set l {}
3942    while {1} {
3943        set str [string trimleft $str]
3944        if {$str eq {}} break
3945        set dq [shelldequote $str]
3946        set n [lindex $dq 0]
3947        set word [lindex $dq 1]
3948        set str [string range $str $n end]
3949        lappend l $word
3950    }
3951    return $l
3952}
3953
3954# Code to implement multiple views
3955
3956proc newview {ishighlight} {
3957    global nextviewnum newviewname newishighlight
3958    global revtreeargs viewargscmd newviewopts curview
3959
3960    set newishighlight $ishighlight
3961    set top .gitkview
3962    if {[winfo exists $top]} {
3963        raise $top
3964        return
3965    }
3966    decode_view_opts $nextviewnum $revtreeargs
3967    set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
3968    set newviewopts($nextviewnum,perm) 0
3969    set newviewopts($nextviewnum,cmd)  $viewargscmd($curview)
3970    vieweditor $top $nextviewnum [mc "Gitk view definition"]
3971}
3972
3973set known_view_options {
3974    {perm      b    .  {}               {mc "Remember this view"}}
3975    {reflabel  l    +  {}               {mc "References (space separated list):"}}
3976    {refs      t15  .. {}               {mc "Branches & tags:"}}
3977    {allrefs   b    *. "--all"          {mc "All refs"}}
3978    {branches  b    .  "--branches"     {mc "All (local) branches"}}
3979    {tags      b    .  "--tags"         {mc "All tags"}}
3980    {remotes   b    .  "--remotes"      {mc "All remote-tracking branches"}}
3981    {commitlbl l    +  {}               {mc "Commit Info (regular expressions):"}}
3982    {author    t15  .. "--author=*"     {mc "Author:"}}
3983    {committer t15  .  "--committer=*"  {mc "Committer:"}}
3984    {loginfo   t15  .. "--grep=*"       {mc "Commit Message:"}}
3985    {allmatch  b    .. "--all-match"    {mc "Matches all Commit Info criteria"}}
3986    {changes_l l    +  {}               {mc "Changes to Files:"}}
3987    {pickaxe_s r0   .  {}               {mc "Fixed String"}}
3988    {pickaxe_t r1   .  "--pickaxe-regex"  {mc "Regular Expression"}}
3989    {pickaxe   t15  .. "-S*"            {mc "Search string:"}}
3990    {datelabel l    +  {}               {mc "Commit Dates (\"2 weeks ago\", \"2009-03-17 15:27:38\", \"March 17, 2009 15:27:38\"):"}}
3991    {since     t15  ..  {"--since=*" "--after=*"}  {mc "Since:"}}
3992    {until     t15  .   {"--until=*" "--before=*"} {mc "Until:"}}
3993    {limit_lbl l    +  {}               {mc "Limit and/or skip a number of revisions (positive integer):"}}
3994    {limit     t10  *. "--max-count=*"  {mc "Number to show:"}}
3995    {skip      t10  .  "--skip=*"       {mc "Number to skip:"}}
3996    {misc_lbl  l    +  {}               {mc "Miscellaneous options:"}}
3997    {dorder    b    *. {"--date-order" "-d"}      {mc "Strictly sort by date"}}
3998    {lright    b    .  "--left-right"   {mc "Mark branch sides"}}
3999    {first     b    .  "--first-parent" {mc "Limit to first parent"}}
4000    {smplhst   b    .  "--simplify-by-decoration"   {mc "Simple history"}}
4001    {args      t50  *. {}               {mc "Additional arguments to git log:"}}
4002    {allpaths  path +  {}               {mc "Enter files and directories to include, one per line:"}}
4003    {cmd       t50= +  {}               {mc "Command to generate more commits to include:"}}
4004    }
4005
4006# Convert $newviewopts($n, ...) into args for git log.
4007proc encode_view_opts {n} {
4008    global known_view_options newviewopts
4009
4010    set rargs [list]
4011    foreach opt $known_view_options {
4012        set patterns [lindex $opt 3]
4013        if {$patterns eq {}} continue
4014        set pattern [lindex $patterns 0]
4015
4016        if {[lindex $opt 1] eq "b"} {
4017            set val $newviewopts($n,[lindex $opt 0])
4018            if {$val} {
4019                lappend rargs $pattern
4020            }
4021        } elseif {[regexp {^r(\d+)$} [lindex $opt 1] type value]} {
4022            regexp {^(.*_)} [lindex $opt 0] uselessvar button_id
4023            set val $newviewopts($n,$button_id)
4024            if {$val eq $value} {
4025                lappend rargs $pattern
4026            }
4027        } else {
4028            set val $newviewopts($n,[lindex $opt 0])
4029            set val [string trim $val]
4030            if {$val ne {}} {
4031                set pfix [string range $pattern 0 end-1]
4032                lappend rargs $pfix$val
4033            }
4034        }
4035    }
4036    set rargs [concat $rargs [shellsplit $newviewopts($n,refs)]]
4037    return [concat $rargs [shellsplit $newviewopts($n,args)]]
4038}
4039
4040# Fill $newviewopts($n, ...) based on args for git log.
4041proc decode_view_opts {n view_args} {
4042    global known_view_options newviewopts
4043
4044    foreach opt $known_view_options {
4045        set id [lindex $opt 0]
4046        if {[lindex $opt 1] eq "b"} {
4047            # Checkboxes
4048            set val 0
4049        } elseif {[regexp {^r(\d+)$} [lindex $opt 1]]} {
4050            # Radiobuttons
4051            regexp {^(.*_)} $id uselessvar id
4052            set val 0
4053        } else {
4054            # Text fields
4055            set val {}
4056        }
4057        set newviewopts($n,$id) $val
4058    }
4059    set oargs [list]
4060    set refargs [list]
4061    foreach arg $view_args {
4062        if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
4063            && ![info exists found(limit)]} {
4064            set newviewopts($n,limit) $cnt
4065            set found(limit) 1
4066            continue
4067        }
4068        catch { unset val }
4069        foreach opt $known_view_options {
4070            set id [lindex $opt 0]
4071            if {[info exists found($id)]} continue
4072            foreach pattern [lindex $opt 3] {
4073                if {![string match $pattern $arg]} continue
4074                if {[lindex $opt 1] eq "b"} {
4075                    # Check buttons
4076                    set val 1
4077                } elseif {[regexp {^r(\d+)$} [lindex $opt 1] match num]} {
4078                    # Radio buttons
4079                    regexp {^(.*_)} $id uselessvar id
4080                    set val $num
4081                } else {
4082                    # Text input fields
4083                    set size [string length $pattern]
4084                    set val [string range $arg [expr {$size-1}] end]
4085                }
4086                set newviewopts($n,$id) $val
4087                set found($id) 1
4088                break
4089            }
4090            if {[info exists val]} break
4091        }
4092        if {[info exists val]} continue
4093        if {[regexp {^-} $arg]} {
4094            lappend oargs $arg
4095        } else {
4096            lappend refargs $arg
4097        }
4098    }
4099    set newviewopts($n,refs) [shellarglist $refargs]
4100    set newviewopts($n,args) [shellarglist $oargs]
4101}
4102
4103proc edit_or_newview {} {
4104    global curview
4105
4106    if {$curview > 0} {
4107        editview
4108    } else {
4109        newview 0
4110    }
4111}
4112
4113proc editview {} {
4114    global curview
4115    global viewname viewperm newviewname newviewopts
4116    global viewargs viewargscmd
4117
4118    set top .gitkvedit-$curview
4119    if {[winfo exists $top]} {
4120        raise $top
4121        return
4122    }
4123    decode_view_opts $curview $viewargs($curview)
4124    set newviewname($curview)      $viewname($curview)
4125    set newviewopts($curview,perm) $viewperm($curview)
4126    set newviewopts($curview,cmd)  $viewargscmd($curview)
4127    vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
4128}
4129
4130proc vieweditor {top n title} {
4131    global newviewname newviewopts viewfiles bgcolor
4132    global known_view_options NS
4133
4134    ttk_toplevel $top
4135    wm title $top [concat $title [mc "-- criteria for selecting revisions"]]
4136    make_transient $top .
4137
4138    # View name
4139    ${NS}::frame $top.nfr
4140    ${NS}::label $top.nl -text [mc "View Name"]
4141    ${NS}::entry $top.name -width 20 -textvariable newviewname($n)
4142    pack $top.nfr -in $top -fill x -pady 5 -padx 3
4143    pack $top.nl -in $top.nfr -side left -padx {0 5}
4144    pack $top.name -in $top.nfr -side left -padx {0 25}
4145
4146    # View options
4147    set cframe $top.nfr
4148    set cexpand 0
4149    set cnt 0
4150    foreach opt $known_view_options {
4151        set id [lindex $opt 0]
4152        set type [lindex $opt 1]
4153        set flags [lindex $opt 2]
4154        set title [eval [lindex $opt 4]]
4155        set lxpad 0
4156
4157        if {$flags eq "+" || $flags eq "*"} {
4158            set cframe $top.fr$cnt
4159            incr cnt
4160            ${NS}::frame $cframe
4161            pack $cframe -in $top -fill x -pady 3 -padx 3
4162            set cexpand [expr {$flags eq "*"}]
4163        } elseif {$flags eq ".." || $flags eq "*."} {
4164            set cframe $top.fr$cnt
4165            incr cnt
4166            ${NS}::frame $cframe
4167            pack $cframe -in $top -fill x -pady 3 -padx [list 15 3]
4168            set cexpand [expr {$flags eq "*."}]
4169        } else {
4170            set lxpad 5
4171        }
4172
4173        if {$type eq "l"} {
4174            ${NS}::label $cframe.l_$id -text $title
4175            pack $cframe.l_$id -in $cframe -side left -pady [list 3 0] -anchor w
4176        } elseif {$type eq "b"} {
4177            ${NS}::checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
4178            pack $cframe.c_$id -in $cframe -side left \
4179                -padx [list $lxpad 0] -expand $cexpand -anchor w
4180        } elseif {[regexp {^r(\d+)$} $type type sz]} {
4181            regexp {^(.*_)} $id uselessvar button_id
4182            ${NS}::radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz
4183            pack $cframe.c_$id -in $cframe -side left \
4184                -padx [list $lxpad 0] -expand $cexpand -anchor w
4185        } elseif {[regexp {^t(\d+)$} $type type sz]} {
4186            ${NS}::label $cframe.l_$id -text $title
4187            ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4188                -textvariable newviewopts($n,$id)
4189            pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
4190            pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
4191        } elseif {[regexp {^t(\d+)=$} $type type sz]} {
4192            ${NS}::label $cframe.l_$id -text $title
4193            ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4194                -textvariable newviewopts($n,$id)
4195            pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
4196            pack $cframe.e_$id -in $cframe -side top -fill x
4197        } elseif {$type eq "path"} {
4198            ${NS}::label $top.l -text $title
4199            pack $top.l -in $top -side top -pady [list 3 0] -anchor w -padx 3
4200            text $top.t -width 40 -height 5 -background $bgcolor
4201            if {[info exists viewfiles($n)]} {
4202                foreach f $viewfiles($n) {
4203                    $top.t insert end $f
4204                    $top.t insert end "\n"
4205                }
4206                $top.t delete {end - 1c} end
4207                $top.t mark set insert 0.0
4208            }
4209            pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
4210        }
4211    }
4212
4213    ${NS}::frame $top.buts
4214    ${NS}::button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
4215    ${NS}::button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
4216    ${NS}::button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
4217    bind $top <Control-Return> [list newviewok $top $n]
4218    bind $top <F5> [list newviewok $top $n 1]
4219    bind $top <Escape> [list destroy $top]
4220    grid $top.buts.ok $top.buts.apply $top.buts.can
4221    grid columnconfigure $top.buts 0 -weight 1 -uniform a
4222    grid columnconfigure $top.buts 1 -weight 1 -uniform a
4223    grid columnconfigure $top.buts 2 -weight 1 -uniform a
4224    pack $top.buts -in $top -side top -fill x
4225    focus $top.t
4226}
4227
4228proc doviewmenu {m first cmd op argv} {
4229    set nmenu [$m index end]
4230    for {set i $first} {$i <= $nmenu} {incr i} {
4231        if {[$m entrycget $i -command] eq $cmd} {
4232            eval $m $op $i $argv
4233            break
4234        }
4235    }
4236}
4237
4238proc allviewmenus {n op args} {
4239    # global viewhlmenu
4240
4241    doviewmenu .bar.view 5 [list showview $n] $op $args
4242    # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
4243}
4244
4245proc newviewok {top n {apply 0}} {
4246    global nextviewnum newviewperm newviewname newishighlight
4247    global viewname viewfiles viewperm selectedview curview
4248    global viewargs viewargscmd newviewopts viewhlmenu
4249
4250    if {[catch {
4251        set newargs [encode_view_opts $n]
4252    } err]} {
4253        error_popup "[mc "Error in commit selection arguments:"] $err" $top
4254        return
4255    }
4256    set files {}
4257    foreach f [split [$top.t get 0.0 end] "\n"] {
4258        set ft [string trim $f]
4259        if {$ft ne {}} {
4260            lappend files $ft
4261        }
4262    }
4263    if {![info exists viewfiles($n)]} {
4264        # creating a new view
4265        incr nextviewnum
4266        set viewname($n) $newviewname($n)
4267        set viewperm($n) $newviewopts($n,perm)
4268        set viewfiles($n) $files
4269        set viewargs($n) $newargs
4270        set viewargscmd($n) $newviewopts($n,cmd)
4271        addviewmenu $n
4272        if {!$newishighlight} {
4273            run showview $n
4274        } else {
4275            run addvhighlight $n
4276        }
4277    } else {
4278        # editing an existing view
4279        set viewperm($n) $newviewopts($n,perm)
4280        if {$newviewname($n) ne $viewname($n)} {
4281            set viewname($n) $newviewname($n)
4282            doviewmenu .bar.view 5 [list showview $n] \
4283                entryconf [list -label $viewname($n)]
4284            # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
4285                # entryconf [list -label $viewname($n) -value $viewname($n)]
4286        }
4287        if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
4288                $newviewopts($n,cmd) ne $viewargscmd($n)} {
4289            set viewfiles($n) $files
4290            set viewargs($n) $newargs
4291            set viewargscmd($n) $newviewopts($n,cmd)
4292            if {$curview == $n} {
4293                run reloadcommits
4294            }
4295        }
4296    }
4297    if {$apply} return
4298    catch {destroy $top}
4299}
4300
4301proc delview {} {
4302    global curview viewperm hlview selectedhlview
4303
4304    if {$curview == 0} return
4305    if {[info exists hlview] && $hlview == $curview} {
4306        set selectedhlview [mc "None"]
4307        unset hlview
4308    }
4309    allviewmenus $curview delete
4310    set viewperm($curview) 0
4311    showview 0
4312}
4313
4314proc addviewmenu {n} {
4315    global viewname viewhlmenu
4316
4317    .bar.view add radiobutton -label $viewname($n) \
4318        -command [list showview $n] -variable selectedview -value $n
4319    #$viewhlmenu add radiobutton -label $viewname($n) \
4320    #   -command [list addvhighlight $n] -variable selectedhlview
4321}
4322
4323proc showview {n} {
4324    global curview cached_commitrow ordertok
4325    global displayorder parentlist rowidlist rowisopt rowfinal
4326    global colormap rowtextx nextcolor canvxmax
4327    global numcommits viewcomplete
4328    global selectedline currentid canv canvy0
4329    global treediffs
4330    global pending_select mainheadid
4331    global commitidx
4332    global selectedview
4333    global hlview selectedhlview commitinterest
4334
4335    if {$n == $curview} return
4336    set selid {}
4337    set ymax [lindex [$canv cget -scrollregion] 3]
4338    set span [$canv yview]
4339    set ytop [expr {[lindex $span 0] * $ymax}]
4340    set ybot [expr {[lindex $span 1] * $ymax}]
4341    set yscreen [expr {($ybot - $ytop) / 2}]
4342    if {$selectedline ne {}} {
4343        set selid $currentid
4344        set y [yc $selectedline]
4345        if {$ytop < $y && $y < $ybot} {
4346            set yscreen [expr {$y - $ytop}]
4347        }
4348    } elseif {[info exists pending_select]} {
4349        set selid $pending_select
4350        unset pending_select
4351    }
4352    unselectline
4353    normalline
4354    catch {unset treediffs}
4355    clear_display
4356    if {[info exists hlview] && $hlview == $n} {
4357        unset hlview
4358        set selectedhlview [mc "None"]
4359    }
4360    catch {unset commitinterest}
4361    catch {unset cached_commitrow}
4362    catch {unset ordertok}
4363
4364    set curview $n
4365    set selectedview $n
4366    .bar.view entryconf [mca "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
4367    .bar.view entryconf [mca "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
4368
4369    run refill_reflist
4370    if {![info exists viewcomplete($n)]} {
4371        getcommits $selid
4372        return
4373    }
4374
4375    set displayorder {}
4376    set parentlist {}
4377    set rowidlist {}
4378    set rowisopt {}
4379    set rowfinal {}
4380    set numcommits $commitidx($n)
4381
4382    catch {unset colormap}
4383    catch {unset rowtextx}
4384    set nextcolor 0
4385    set canvxmax [$canv cget -width]
4386    set curview $n
4387    set row 0
4388    setcanvscroll
4389    set yf 0
4390    set row {}
4391    if {$selid ne {} && [commitinview $selid $n]} {
4392        set row [rowofcommit $selid]
4393        # try to get the selected row in the same position on the screen
4394        set ymax [lindex [$canv cget -scrollregion] 3]
4395        set ytop [expr {[yc $row] - $yscreen}]
4396        if {$ytop < 0} {
4397            set ytop 0
4398        }
4399        set yf [expr {$ytop * 1.0 / $ymax}]
4400    }
4401    allcanvs yview moveto $yf
4402    drawvisible
4403    if {$row ne {}} {
4404        selectline $row 0
4405    } elseif {!$viewcomplete($n)} {
4406        reset_pending_select $selid
4407    } else {
4408        reset_pending_select {}
4409
4410        if {[commitinview $pending_select $curview]} {
4411            selectline [rowofcommit $pending_select] 1
4412        } else {
4413            set row [first_real_row]
4414            if {$row < $numcommits} {
4415                selectline $row 0
4416            }
4417        }
4418    }
4419    if {!$viewcomplete($n)} {
4420        if {$numcommits == 0} {
4421            show_status [mc "Reading commits..."]
4422        }
4423    } elseif {$numcommits == 0} {
4424        show_status [mc "No commits selected"]
4425    }
4426}
4427
4428# Stuff relating to the highlighting facility
4429
4430proc ishighlighted {id} {
4431    global vhighlights fhighlights nhighlights rhighlights
4432
4433    if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
4434        return $nhighlights($id)
4435    }
4436    if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
4437        return $vhighlights($id)
4438    }
4439    if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
4440        return $fhighlights($id)
4441    }
4442    if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4443        return $rhighlights($id)
4444    }
4445    return 0
4446}
4447
4448proc bolden {id font} {
4449    global canv linehtag currentid boldids need_redisplay markedid
4450
4451    # need_redisplay = 1 means the display is stale and about to be redrawn
4452    if {$need_redisplay} return
4453    lappend boldids $id
4454    $canv itemconf $linehtag($id) -font $font
4455    if {[info exists currentid] && $id eq $currentid} {
4456        $canv delete secsel
4457        set t [eval $canv create rect [$canv bbox $linehtag($id)] \
4458                   -outline {{}} -tags secsel \
4459                   -fill [$canv cget -selectbackground]]
4460        $canv lower $t
4461    }
4462    if {[info exists markedid] && $id eq $markedid} {
4463        make_idmark $id
4464    }
4465}
4466
4467proc bolden_name {id font} {
4468    global canv2 linentag currentid boldnameids need_redisplay
4469
4470    if {$need_redisplay} return
4471    lappend boldnameids $id
4472    $canv2 itemconf $linentag($id) -font $font
4473    if {[info exists currentid] && $id eq $currentid} {
4474        $canv2 delete secsel
4475        set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
4476                   -outline {{}} -tags secsel \
4477                   -fill [$canv2 cget -selectbackground]]
4478        $canv2 lower $t
4479    }
4480}
4481
4482proc unbolden {} {
4483    global boldids
4484
4485    set stillbold {}
4486    foreach id $boldids {
4487        if {![ishighlighted $id]} {
4488            bolden $id mainfont
4489        } else {
4490            lappend stillbold $id
4491        }
4492    }
4493    set boldids $stillbold
4494}
4495
4496proc addvhighlight {n} {
4497    global hlview viewcomplete curview vhl_done commitidx
4498
4499    if {[info exists hlview]} {
4500        delvhighlight
4501    }
4502    set hlview $n
4503    if {$n != $curview && ![info exists viewcomplete($n)]} {
4504        start_rev_list $n
4505    }
4506    set vhl_done $commitidx($hlview)
4507    if {$vhl_done > 0} {
4508        drawvisible
4509    }
4510}
4511
4512proc delvhighlight {} {
4513    global hlview vhighlights
4514
4515    if {![info exists hlview]} return
4516    unset hlview
4517    catch {unset vhighlights}
4518    unbolden
4519}
4520
4521proc vhighlightmore {} {
4522    global hlview vhl_done commitidx vhighlights curview
4523
4524    set max $commitidx($hlview)
4525    set vr [visiblerows]
4526    set r0 [lindex $vr 0]
4527    set r1 [lindex $vr 1]
4528    for {set i $vhl_done} {$i < $max} {incr i} {
4529        set id [commitonrow $i $hlview]
4530        if {[commitinview $id $curview]} {
4531            set row [rowofcommit $id]
4532            if {$r0 <= $row && $row <= $r1} {
4533                if {![highlighted $row]} {
4534                    bolden $id mainfontbold
4535                }
4536                set vhighlights($id) 1
4537            }
4538        }
4539    }
4540    set vhl_done $max
4541    return 0
4542}
4543
4544proc askvhighlight {row id} {
4545    global hlview vhighlights iddrawn
4546
4547    if {[commitinview $id $hlview]} {
4548        if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
4549            bolden $id mainfontbold
4550        }
4551        set vhighlights($id) 1
4552    } else {
4553        set vhighlights($id) 0
4554    }
4555}
4556
4557proc hfiles_change {} {
4558    global highlight_files filehighlight fhighlights fh_serial
4559    global highlight_paths
4560
4561    if {[info exists filehighlight]} {
4562        # delete previous highlights
4563        catch {close $filehighlight}
4564        unset filehighlight
4565        catch {unset fhighlights}
4566        unbolden
4567        unhighlight_filelist
4568    }
4569    set highlight_paths {}
4570    after cancel do_file_hl $fh_serial
4571    incr fh_serial
4572    if {$highlight_files ne {}} {
4573        after 300 do_file_hl $fh_serial
4574    }
4575}
4576
4577proc gdttype_change {name ix op} {
4578    global gdttype highlight_files findstring findpattern
4579
4580    stopfinding
4581    if {$findstring ne {}} {
4582        if {$gdttype eq [mc "containing:"]} {
4583            if {$highlight_files ne {}} {
4584                set highlight_files {}
4585                hfiles_change
4586            }
4587            findcom_change
4588        } else {
4589            if {$findpattern ne {}} {
4590                set findpattern {}
4591                findcom_change
4592            }
4593            set highlight_files $findstring
4594            hfiles_change
4595        }
4596        drawvisible
4597    }
4598    # enable/disable findtype/findloc menus too
4599}
4600
4601proc find_change {name ix op} {
4602    global gdttype findstring highlight_files
4603
4604    stopfinding
4605    if {$gdttype eq [mc "containing:"]} {
4606        findcom_change
4607    } else {
4608        if {$highlight_files ne $findstring} {
4609            set highlight_files $findstring
4610            hfiles_change
4611        }
4612    }
4613    drawvisible
4614}
4615
4616proc findcom_change args {
4617    global nhighlights boldnameids
4618    global findpattern findtype findstring gdttype
4619
4620    stopfinding
4621    # delete previous highlights, if any
4622    foreach id $boldnameids {
4623        bolden_name $id mainfont
4624    }
4625    set boldnameids {}
4626    catch {unset nhighlights}
4627    unbolden
4628    unmarkmatches
4629    if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
4630        set findpattern {}
4631    } elseif {$findtype eq [mc "Regexp"]} {
4632        set findpattern $findstring
4633    } else {
4634        set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4635                   $findstring]
4636        set findpattern "*$e*"
4637    }
4638}
4639
4640proc makepatterns {l} {
4641    set ret {}
4642    foreach e $l {
4643        set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4644        if {[string index $ee end] eq "/"} {
4645            lappend ret "$ee*"
4646        } else {
4647            lappend ret $ee
4648            lappend ret "$ee/*"
4649        }
4650    }
4651    return $ret
4652}
4653
4654proc do_file_hl {serial} {
4655    global highlight_files filehighlight highlight_paths gdttype fhl_list
4656    global cdup findtype
4657
4658    if {$gdttype eq [mc "touching paths:"]} {
4659        # If "exact" match then convert backslashes to forward slashes.
4660        # Most useful to support Windows-flavoured file paths.
4661        if {$findtype eq [mc "Exact"]} {
4662            set highlight_files [string map {"\\" "/"} $highlight_files]
4663        }
4664        if {[catch {set paths [shellsplit $highlight_files]}]} return
4665        set highlight_paths [makepatterns $paths]
4666        highlight_filelist
4667        set relative_paths {}
4668        foreach path $paths {
4669            lappend relative_paths [file join $cdup $path]
4670        }
4671        set gdtargs [concat -- $relative_paths]
4672    } elseif {$gdttype eq [mc "adding/removing string:"]} {
4673        set gdtargs [list "-S$highlight_files"]
4674    } elseif {$gdttype eq [mc "changing lines matching:"]} {
4675        set gdtargs [list "-G$highlight_files"]
4676    } else {
4677        # must be "containing:", i.e. we're searching commit info
4678        return
4679    }
4680    set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
4681    set filehighlight [open $cmd r+]
4682    fconfigure $filehighlight -blocking 0
4683    filerun $filehighlight readfhighlight
4684    set fhl_list {}
4685    drawvisible
4686    flushhighlights
4687}
4688
4689proc flushhighlights {} {
4690    global filehighlight fhl_list
4691
4692    if {[info exists filehighlight]} {
4693        lappend fhl_list {}
4694        puts $filehighlight ""
4695        flush $filehighlight
4696    }
4697}
4698
4699proc askfilehighlight {row id} {
4700    global filehighlight fhighlights fhl_list
4701
4702    lappend fhl_list $id
4703    set fhighlights($id) -1
4704    puts $filehighlight $id
4705}
4706
4707proc readfhighlight {} {
4708    global filehighlight fhighlights curview iddrawn
4709    global fhl_list find_dirn
4710
4711    if {![info exists filehighlight]} {
4712        return 0
4713    }
4714    set nr 0
4715    while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4716        set line [string trim $line]
4717        set i [lsearch -exact $fhl_list $line]
4718        if {$i < 0} continue
4719        for {set j 0} {$j < $i} {incr j} {
4720            set id [lindex $fhl_list $j]
4721            set fhighlights($id) 0
4722        }
4723        set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4724        if {$line eq {}} continue
4725        if {![commitinview $line $curview]} continue
4726        if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4727            bolden $line mainfontbold
4728        }
4729        set fhighlights($line) 1
4730    }
4731    if {[eof $filehighlight]} {
4732        # strange...
4733        puts "oops, git diff-tree died"
4734        catch {close $filehighlight}
4735        unset filehighlight
4736        return 0
4737    }
4738    if {[info exists find_dirn]} {
4739        run findmore
4740    }
4741    return 1
4742}
4743
4744proc doesmatch {f} {
4745    global findtype findpattern
4746
4747    if {$findtype eq [mc "Regexp"]} {
4748        return [regexp $findpattern $f]
4749    } elseif {$findtype eq [mc "IgnCase"]} {
4750        return [string match -nocase $findpattern $f]
4751    } else {
4752        return [string match $findpattern $f]
4753    }
4754}
4755
4756proc askfindhighlight {row id} {
4757    global nhighlights commitinfo iddrawn
4758    global findloc
4759    global markingmatches
4760
4761    if {![info exists commitinfo($id)]} {
4762        getcommit $id
4763    }
4764    set info $commitinfo($id)
4765    set isbold 0
4766    set fldtypes [list [mc Headline] [mc Author] "" [mc Committer] "" [mc Comments]]
4767    foreach f $info ty $fldtypes {
4768        if {$ty eq ""} continue
4769        if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4770            [doesmatch $f]} {
4771            if {$ty eq [mc "Author"]} {
4772                set isbold 2
4773                break
4774            }
4775            set isbold 1
4776        }
4777    }
4778    if {$isbold && [info exists iddrawn($id)]} {
4779        if {![ishighlighted $id]} {
4780            bolden $id mainfontbold
4781            if {$isbold > 1} {
4782                bolden_name $id mainfontbold
4783            }
4784        }
4785        if {$markingmatches} {
4786            markrowmatches $row $id
4787        }
4788    }
4789    set nhighlights($id) $isbold
4790}
4791
4792proc markrowmatches {row id} {
4793    global canv canv2 linehtag linentag commitinfo findloc
4794
4795    set headline [lindex $commitinfo($id) 0]
4796    set author [lindex $commitinfo($id) 1]
4797    $canv delete match$row
4798    $canv2 delete match$row
4799    if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4800        set m [findmatches $headline]
4801        if {$m ne {}} {
4802            markmatches $canv $row $headline $linehtag($id) $m \
4803                [$canv itemcget $linehtag($id) -font] $row
4804        }
4805    }
4806    if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4807        set m [findmatches $author]
4808        if {$m ne {}} {
4809            markmatches $canv2 $row $author $linentag($id) $m \
4810                [$canv2 itemcget $linentag($id) -font] $row
4811        }
4812    }
4813}
4814
4815proc vrel_change {name ix op} {
4816    global highlight_related
4817
4818    rhighlight_none
4819    if {$highlight_related ne [mc "None"]} {
4820        run drawvisible
4821    }
4822}
4823
4824# prepare for testing whether commits are descendents or ancestors of a
4825proc rhighlight_sel {a} {
4826    global descendent desc_todo ancestor anc_todo
4827    global highlight_related
4828
4829    catch {unset descendent}
4830    set desc_todo [list $a]
4831    catch {unset ancestor}
4832    set anc_todo [list $a]
4833    if {$highlight_related ne [mc "None"]} {
4834        rhighlight_none
4835        run drawvisible
4836    }
4837}
4838
4839proc rhighlight_none {} {
4840    global rhighlights
4841
4842    catch {unset rhighlights}
4843    unbolden
4844}
4845
4846proc is_descendent {a} {
4847    global curview children descendent desc_todo
4848
4849    set v $curview
4850    set la [rowofcommit $a]
4851    set todo $desc_todo
4852    set leftover {}
4853    set done 0
4854    for {set i 0} {$i < [llength $todo]} {incr i} {
4855        set do [lindex $todo $i]
4856        if {[rowofcommit $do] < $la} {
4857            lappend leftover $do
4858            continue
4859        }
4860        foreach nk $children($v,$do) {
4861            if {![info exists descendent($nk)]} {
4862                set descendent($nk) 1
4863                lappend todo $nk
4864                if {$nk eq $a} {
4865                    set done 1
4866                }
4867            }
4868        }
4869        if {$done} {
4870            set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4871            return
4872        }
4873    }
4874    set descendent($a) 0
4875    set desc_todo $leftover
4876}
4877
4878proc is_ancestor {a} {
4879    global curview parents ancestor anc_todo
4880
4881    set v $curview
4882    set la [rowofcommit $a]
4883    set todo $anc_todo
4884    set leftover {}
4885    set done 0
4886    for {set i 0} {$i < [llength $todo]} {incr i} {
4887        set do [lindex $todo $i]
4888        if {![commitinview $do $v] || [rowofcommit $do] > $la} {
4889            lappend leftover $do
4890            continue
4891        }
4892        foreach np $parents($v,$do) {
4893            if {![info exists ancestor($np)]} {
4894                set ancestor($np) 1
4895                lappend todo $np
4896                if {$np eq $a} {
4897                    set done 1
4898                }
4899            }
4900        }
4901        if {$done} {
4902            set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4903            return
4904        }
4905    }
4906    set ancestor($a) 0
4907    set anc_todo $leftover
4908}
4909
4910proc askrelhighlight {row id} {
4911    global descendent highlight_related iddrawn rhighlights
4912    global selectedline ancestor
4913
4914    if {$selectedline eq {}} return
4915    set isbold 0
4916    if {$highlight_related eq [mc "Descendant"] ||
4917        $highlight_related eq [mc "Not descendant"]} {
4918        if {![info exists descendent($id)]} {
4919            is_descendent $id
4920        }
4921        if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
4922            set isbold 1
4923        }
4924    } elseif {$highlight_related eq [mc "Ancestor"] ||
4925              $highlight_related eq [mc "Not ancestor"]} {
4926        if {![info exists ancestor($id)]} {
4927            is_ancestor $id
4928        }
4929        if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
4930            set isbold 1
4931        }
4932    }
4933    if {[info exists iddrawn($id)]} {
4934        if {$isbold && ![ishighlighted $id]} {
4935            bolden $id mainfontbold
4936        }
4937    }
4938    set rhighlights($id) $isbold
4939}
4940
4941# Graph layout functions
4942
4943proc shortids {ids} {
4944    set res {}
4945    foreach id $ids {
4946        if {[llength $id] > 1} {
4947            lappend res [shortids $id]
4948        } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
4949            lappend res [string range $id 0 7]
4950        } else {
4951            lappend res $id
4952        }
4953    }
4954    return $res
4955}
4956
4957proc ntimes {n o} {
4958    set ret {}
4959    set o [list $o]
4960    for {set mask 1} {$mask <= $n} {incr mask $mask} {
4961        if {($n & $mask) != 0} {
4962            set ret [concat $ret $o]
4963        }
4964        set o [concat $o $o]
4965    }
4966    return $ret
4967}
4968
4969proc ordertoken {id} {
4970    global ordertok curview varcid varcstart varctok curview parents children
4971    global nullid nullid2
4972
4973    if {[info exists ordertok($id)]} {
4974        return $ordertok($id)
4975    }
4976    set origid $id
4977    set todo {}
4978    while {1} {
4979        if {[info exists varcid($curview,$id)]} {
4980            set a $varcid($curview,$id)
4981            set p [lindex $varcstart($curview) $a]
4982        } else {
4983            set p [lindex $children($curview,$id) 0]
4984        }
4985        if {[info exists ordertok($p)]} {
4986            set tok $ordertok($p)
4987            break
4988        }
4989        set id [first_real_child $curview,$p]
4990        if {$id eq {}} {
4991            # it's a root
4992            set tok [lindex $varctok($curview) $varcid($curview,$p)]
4993            break
4994        }
4995        if {[llength $parents($curview,$id)] == 1} {
4996            lappend todo [list $p {}]
4997        } else {
4998            set j [lsearch -exact $parents($curview,$id) $p]
4999            if {$j < 0} {
5000                puts "oops didn't find [shortids $p] in parents of [shortids $id]"
5001            }
5002            lappend todo [list $p [strrep $j]]
5003        }
5004    }
5005    for {set i [llength $todo]} {[incr i -1] >= 0} {} {
5006        set p [lindex $todo $i 0]
5007        append tok [lindex $todo $i 1]
5008        set ordertok($p) $tok
5009    }
5010    set ordertok($origid) $tok
5011    return $tok
5012}
5013
5014# Work out where id should go in idlist so that order-token
5015# values increase from left to right
5016proc idcol {idlist id {i 0}} {
5017    set t [ordertoken $id]
5018    if {$i < 0} {
5019        set i 0
5020    }
5021    if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
5022        if {$i > [llength $idlist]} {
5023            set i [llength $idlist]
5024        }
5025        while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
5026        incr i
5027    } else {
5028        if {$t > [ordertoken [lindex $idlist $i]]} {
5029            while {[incr i] < [llength $idlist] &&
5030                   $t >= [ordertoken [lindex $idlist $i]]} {}
5031        }
5032    }
5033    return $i
5034}
5035
5036proc initlayout {} {
5037    global rowidlist rowisopt rowfinal displayorder parentlist
5038    global numcommits canvxmax canv
5039    global nextcolor
5040    global colormap rowtextx
5041
5042    set numcommits 0
5043    set displayorder {}
5044    set parentlist {}
5045    set nextcolor 0
5046    set rowidlist {}
5047    set rowisopt {}
5048    set rowfinal {}
5049    set canvxmax [$canv cget -width]
5050    catch {unset colormap}
5051    catch {unset rowtextx}
5052    setcanvscroll
5053}
5054
5055proc setcanvscroll {} {
5056    global canv canv2 canv3 numcommits linespc canvxmax canvy0
5057    global lastscrollset lastscrollrows
5058
5059    set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
5060    $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
5061    $canv2 conf -scrollregion [list 0 0 0 $ymax]
5062    $canv3 conf -scrollregion [list 0 0 0 $ymax]
5063    set lastscrollset [clock clicks -milliseconds]
5064    set lastscrollrows $numcommits
5065}
5066
5067proc visiblerows {} {
5068    global canv numcommits linespc
5069
5070    set ymax [lindex [$canv cget -scrollregion] 3]
5071    if {$ymax eq {} || $ymax == 0} return
5072    set f [$canv yview]
5073    set y0 [expr {int([lindex $f 0] * $ymax)}]
5074    set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
5075    if {$r0 < 0} {
5076        set r0 0
5077    }
5078    set y1 [expr {int([lindex $f 1] * $ymax)}]
5079    set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
5080    if {$r1 >= $numcommits} {
5081        set r1 [expr {$numcommits - 1}]
5082    }
5083    return [list $r0 $r1]
5084}
5085
5086proc layoutmore {} {
5087    global commitidx viewcomplete curview
5088    global numcommits pending_select curview
5089    global lastscrollset lastscrollrows
5090
5091    if {$lastscrollrows < 100 || $viewcomplete($curview) ||
5092        [clock clicks -milliseconds] - $lastscrollset > 500} {
5093        setcanvscroll
5094    }
5095    if {[info exists pending_select] &&
5096        [commitinview $pending_select $curview]} {
5097        update
5098        selectline [rowofcommit $pending_select] 1
5099    }
5100    drawvisible
5101}
5102
5103# With path limiting, we mightn't get the actual HEAD commit,
5104# so ask git rev-list what is the first ancestor of HEAD that
5105# touches a file in the path limit.
5106proc get_viewmainhead {view} {
5107    global viewmainheadid vfilelimit viewinstances mainheadid
5108
5109    catch {
5110        set rfd [open [concat | git rev-list -1 $mainheadid \
5111                           -- $vfilelimit($view)] r]
5112        set j [reg_instance $rfd]
5113        lappend viewinstances($view) $j
5114        fconfigure $rfd -blocking 0
5115        filerun $rfd [list getviewhead $rfd $j $view]
5116        set viewmainheadid($curview) {}
5117    }
5118}
5119
5120# git rev-list should give us just 1 line to use as viewmainheadid($view)
5121proc getviewhead {fd inst view} {
5122    global viewmainheadid commfd curview viewinstances showlocalchanges
5123
5124    set id {}
5125    if {[gets $fd line] < 0} {
5126        if {![eof $fd]} {
5127            return 1
5128        }
5129    } elseif {[string length $line] == 40 && [string is xdigit $line]} {
5130        set id $line
5131    }
5132    set viewmainheadid($view) $id
5133    close $fd
5134    unset commfd($inst)
5135    set i [lsearch -exact $viewinstances($view) $inst]
5136    if {$i >= 0} {
5137        set viewinstances($view) [lreplace $viewinstances($view) $i $i]
5138    }
5139    if {$showlocalchanges && $id ne {} && $view == $curview} {
5140        doshowlocalchanges
5141    }
5142    return 0
5143}
5144
5145proc doshowlocalchanges {} {
5146    global curview viewmainheadid
5147
5148    if {$viewmainheadid($curview) eq {}} return
5149    if {[commitinview $viewmainheadid($curview) $curview]} {
5150        dodiffindex
5151    } else {
5152        interestedin $viewmainheadid($curview) dodiffindex
5153    }
5154}
5155
5156proc dohidelocalchanges {} {
5157    global nullid nullid2 lserial curview
5158
5159    if {[commitinview $nullid $curview]} {
5160        removefakerow $nullid
5161    }
5162    if {[commitinview $nullid2 $curview]} {
5163        removefakerow $nullid2
5164    }
5165    incr lserial
5166}
5167
5168# spawn off a process to do git diff-index --cached HEAD
5169proc dodiffindex {} {
5170    global lserial showlocalchanges vfilelimit curview
5171    global hasworktree
5172
5173    if {!$showlocalchanges || !$hasworktree} return
5174    incr lserial
5175    set cmd "|git diff-index --cached HEAD"
5176    if {$vfilelimit($curview) ne {}} {
5177        set cmd [concat $cmd -- $vfilelimit($curview)]
5178    }
5179    set fd [open $cmd r]
5180    fconfigure $fd -blocking 0
5181    set i [reg_instance $fd]
5182    filerun $fd [list readdiffindex $fd $lserial $i]
5183}
5184
5185proc readdiffindex {fd serial inst} {
5186    global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
5187    global vfilelimit
5188
5189    set isdiff 1
5190    if {[gets $fd line] < 0} {
5191        if {![eof $fd]} {
5192            return 1
5193        }
5194        set isdiff 0
5195    }
5196    # we only need to see one line and we don't really care what it says...
5197    stop_instance $inst
5198
5199    if {$serial != $lserial} {
5200        return 0
5201    }
5202
5203    # now see if there are any local changes not checked in to the index
5204    set cmd "|git diff-files"
5205    if {$vfilelimit($curview) ne {}} {
5206        set cmd [concat $cmd -- $vfilelimit($curview)]
5207    }
5208    set fd [open $cmd r]
5209    fconfigure $fd -blocking 0
5210    set i [reg_instance $fd]
5211    filerun $fd [list readdifffiles $fd $serial $i]
5212
5213    if {$isdiff && ![commitinview $nullid2 $curview]} {
5214        # add the line for the changes in the index to the graph
5215        set hl [mc "Local changes checked in to index but not committed"]
5216        set commitinfo($nullid2) [list  $hl {} {} {} {} "    $hl\n"]
5217        set commitdata($nullid2) "\n    $hl\n"
5218        if {[commitinview $nullid $curview]} {
5219            removefakerow $nullid
5220        }
5221        insertfakerow $nullid2 $viewmainheadid($curview)
5222    } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
5223        if {[commitinview $nullid $curview]} {
5224            removefakerow $nullid
5225        }
5226        removefakerow $nullid2
5227    }
5228    return 0
5229}
5230
5231proc readdifffiles {fd serial inst} {
5232    global viewmainheadid nullid nullid2 curview
5233    global commitinfo commitdata lserial
5234
5235    set isdiff 1
5236    if {[gets $fd line] < 0} {
5237        if {![eof $fd]} {
5238            return 1
5239        }
5240        set isdiff 0
5241    }
5242    # we only need to see one line and we don't really care what it says...
5243    stop_instance $inst
5244
5245    if {$serial != $lserial} {
5246        return 0
5247    }
5248
5249    if {$isdiff && ![commitinview $nullid $curview]} {
5250        # add the line for the local diff to the graph
5251        set hl [mc "Local uncommitted changes, not checked in to index"]
5252        set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
5253        set commitdata($nullid) "\n    $hl\n"
5254        if {[commitinview $nullid2 $curview]} {
5255            set p $nullid2
5256        } else {
5257            set p $viewmainheadid($curview)
5258        }
5259        insertfakerow $nullid $p
5260    } elseif {!$isdiff && [commitinview $nullid $curview]} {
5261        removefakerow $nullid
5262    }
5263    return 0
5264}
5265
5266proc nextuse {id row} {
5267    global curview children
5268
5269    if {[info exists children($curview,$id)]} {
5270        foreach kid $children($curview,$id) {
5271            if {![commitinview $kid $curview]} {
5272                return -1
5273            }
5274            if {[rowofcommit $kid] > $row} {
5275                return [rowofcommit $kid]
5276            }
5277        }
5278    }
5279    if {[commitinview $id $curview]} {
5280        return [rowofcommit $id]
5281    }
5282    return -1
5283}
5284
5285proc prevuse {id row} {
5286    global curview children
5287
5288    set ret -1
5289    if {[info exists children($curview,$id)]} {
5290        foreach kid $children($curview,$id) {
5291            if {![commitinview $kid $curview]} break
5292            if {[rowofcommit $kid] < $row} {
5293                set ret [rowofcommit $kid]
5294            }
5295        }
5296    }
5297    return $ret
5298}
5299
5300proc make_idlist {row} {
5301    global displayorder parentlist uparrowlen downarrowlen mingaplen
5302    global commitidx curview children
5303
5304    set r [expr {$row - $mingaplen - $downarrowlen - 1}]
5305    if {$r < 0} {
5306        set r 0
5307    }
5308    set ra [expr {$row - $downarrowlen}]
5309    if {$ra < 0} {
5310        set ra 0
5311    }
5312    set rb [expr {$row + $uparrowlen}]
5313    if {$rb > $commitidx($curview)} {
5314        set rb $commitidx($curview)
5315    }
5316    make_disporder $r [expr {$rb + 1}]
5317    set ids {}
5318    for {} {$r < $ra} {incr r} {
5319        set nextid [lindex $displayorder [expr {$r + 1}]]
5320        foreach p [lindex $parentlist $r] {
5321            if {$p eq $nextid} continue
5322            set rn [nextuse $p $r]
5323            if {$rn >= $row &&
5324                $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
5325                lappend ids [list [ordertoken $p] $p]
5326            }
5327        }
5328    }
5329    for {} {$r < $row} {incr r} {
5330        set nextid [lindex $displayorder [expr {$r + 1}]]
5331        foreach p [lindex $parentlist $r] {
5332            if {$p eq $nextid} continue
5333            set rn [nextuse $p $r]
5334            if {$rn < 0 || $rn >= $row} {
5335                lappend ids [list [ordertoken $p] $p]
5336            }
5337        }
5338    }
5339    set id [lindex $displayorder $row]
5340    lappend ids [list [ordertoken $id] $id]
5341    while {$r < $rb} {
5342        foreach p [lindex $parentlist $r] {
5343            set firstkid [lindex $children($curview,$p) 0]
5344            if {[rowofcommit $firstkid] < $row} {
5345                lappend ids [list [ordertoken $p] $p]
5346            }
5347        }
5348        incr r
5349        set id [lindex $displayorder $r]
5350        if {$id ne {}} {
5351            set firstkid [lindex $children($curview,$id) 0]
5352            if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
5353                lappend ids [list [ordertoken $id] $id]
5354            }
5355        }
5356    }
5357    set idlist {}
5358    foreach idx [lsort -unique $ids] {
5359        lappend idlist [lindex $idx 1]
5360    }
5361    return $idlist
5362}
5363
5364proc rowsequal {a b} {
5365    while {[set i [lsearch -exact $a {}]] >= 0} {
5366        set a [lreplace $a $i $i]
5367    }
5368    while {[set i [lsearch -exact $b {}]] >= 0} {
5369        set b [lreplace $b $i $i]
5370    }
5371    return [expr {$a eq $b}]
5372}
5373
5374proc makeupline {id row rend col} {
5375    global rowidlist uparrowlen downarrowlen mingaplen
5376
5377    for {set r $rend} {1} {set r $rstart} {
5378        set rstart [prevuse $id $r]
5379        if {$rstart < 0} return
5380        if {$rstart < $row} break
5381    }
5382    if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5383        set rstart [expr {$rend - $uparrowlen - 1}]
5384    }
5385    for {set r $rstart} {[incr r] <= $row} {} {
5386        set idlist [lindex $rowidlist $r]
5387        if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5388            set col [idcol $idlist $id $col]
5389            lset rowidlist $r [linsert $idlist $col $id]
5390            changedrow $r
5391        }
5392    }
5393}
5394
5395proc layoutrows {row endrow} {
5396    global rowidlist rowisopt rowfinal displayorder
5397    global uparrowlen downarrowlen maxwidth mingaplen
5398    global children parentlist
5399    global commitidx viewcomplete curview
5400
5401    make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
5402    set idlist {}
5403    if {$row > 0} {
5404        set rm1 [expr {$row - 1}]
5405        foreach id [lindex $rowidlist $rm1] {
5406            if {$id ne {}} {
5407                lappend idlist $id
5408            }
5409        }
5410        set final [lindex $rowfinal $rm1]
5411    }
5412    for {} {$row < $endrow} {incr row} {
5413        set rm1 [expr {$row - 1}]
5414        if {$rm1 < 0 || $idlist eq {}} {
5415            set idlist [make_idlist $row]
5416            set final 1
5417        } else {
5418            set id [lindex $displayorder $rm1]
5419            set col [lsearch -exact $idlist $id]
5420            set idlist [lreplace $idlist $col $col]
5421            foreach p [lindex $parentlist $rm1] {
5422                if {[lsearch -exact $idlist $p] < 0} {
5423                    set col [idcol $idlist $p $col]
5424                    set idlist [linsert $idlist $col $p]
5425                    # if not the first child, we have to insert a line going up
5426                    if {$id ne [lindex $children($curview,$p) 0]} {
5427                        makeupline $p $rm1 $row $col
5428                    }
5429                }
5430            }
5431            set id [lindex $displayorder $row]
5432            if {$row > $downarrowlen} {
5433                set termrow [expr {$row - $downarrowlen - 1}]
5434                foreach p [lindex $parentlist $termrow] {
5435                    set i [lsearch -exact $idlist $p]
5436                    if {$i < 0} continue
5437                    set nr [nextuse $p $termrow]
5438                    if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5439                        set idlist [lreplace $idlist $i $i]
5440                    }
5441                }
5442            }
5443            set col [lsearch -exact $idlist $id]
5444            if {$col < 0} {
5445                set col [idcol $idlist $id]
5446                set idlist [linsert $idlist $col $id]
5447                if {$children($curview,$id) ne {}} {
5448                    makeupline $id $rm1 $row $col
5449                }
5450            }
5451            set r [expr {$row + $uparrowlen - 1}]
5452            if {$r < $commitidx($curview)} {
5453                set x $col
5454                foreach p [lindex $parentlist $r] {
5455                    if {[lsearch -exact $idlist $p] >= 0} continue
5456                    set fk [lindex $children($curview,$p) 0]
5457                    if {[rowofcommit $fk] < $row} {
5458                        set x [idcol $idlist $p $x]
5459                        set idlist [linsert $idlist $x $p]
5460                    }
5461                }
5462                if {[incr r] < $commitidx($curview)} {
5463                    set p [lindex $displayorder $r]
5464                    if {[lsearch -exact $idlist $p] < 0} {
5465                        set fk [lindex $children($curview,$p) 0]
5466                        if {$fk ne {} && [rowofcommit $fk] < $row} {
5467                            set x [idcol $idlist $p $x]
5468                            set idlist [linsert $idlist $x $p]
5469                        }
5470                    }
5471                }
5472            }
5473        }
5474        if {$final && !$viewcomplete($curview) &&
5475            $row + $uparrowlen + $mingaplen + $downarrowlen
5476                >= $commitidx($curview)} {
5477            set final 0
5478        }
5479        set l [llength $rowidlist]
5480        if {$row == $l} {
5481            lappend rowidlist $idlist
5482            lappend rowisopt 0
5483            lappend rowfinal $final
5484        } elseif {$row < $l} {
5485            if {![rowsequal $idlist [lindex $rowidlist $row]]} {
5486                lset rowidlist $row $idlist
5487                changedrow $row
5488            }
5489            lset rowfinal $row $final
5490        } else {
5491            set pad [ntimes [expr {$row - $l}] {}]
5492            set rowidlist [concat $rowidlist $pad]
5493            lappend rowidlist $idlist
5494            set rowfinal [concat $rowfinal $pad]
5495            lappend rowfinal $final
5496            set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5497        }
5498    }
5499    return $row
5500}
5501
5502proc changedrow {row} {
5503    global displayorder iddrawn rowisopt need_redisplay
5504
5505    set l [llength $rowisopt]
5506    if {$row < $l} {
5507        lset rowisopt $row 0
5508        if {$row + 1 < $l} {
5509            lset rowisopt [expr {$row + 1}] 0
5510            if {$row + 2 < $l} {
5511                lset rowisopt [expr {$row + 2}] 0
5512            }
5513        }
5514    }
5515    set id [lindex $displayorder $row]
5516    if {[info exists iddrawn($id)]} {
5517        set need_redisplay 1
5518    }
5519}
5520
5521proc insert_pad {row col npad} {
5522    global rowidlist
5523
5524    set pad [ntimes $npad {}]
5525    set idlist [lindex $rowidlist $row]
5526    set bef [lrange $idlist 0 [expr {$col - 1}]]
5527    set aft [lrange $idlist $col end]
5528    set i [lsearch -exact $aft {}]
5529    if {$i > 0} {
5530        set aft [lreplace $aft $i $i]
5531    }
5532    lset rowidlist $row [concat $bef $pad $aft]
5533    changedrow $row
5534}
5535
5536proc optimize_rows {row col endrow} {
5537    global rowidlist rowisopt displayorder curview children
5538
5539    if {$row < 1} {
5540        set row 1
5541    }
5542    for {} {$row < $endrow} {incr row; set col 0} {
5543        if {[lindex $rowisopt $row]} continue
5544        set haspad 0
5545        set y0 [expr {$row - 1}]
5546        set ym [expr {$row - 2}]
5547        set idlist [lindex $rowidlist $row]
5548        set previdlist [lindex $rowidlist $y0]
5549        if {$idlist eq {} || $previdlist eq {}} continue
5550        if {$ym >= 0} {
5551            set pprevidlist [lindex $rowidlist $ym]
5552            if {$pprevidlist eq {}} continue
5553        } else {
5554            set pprevidlist {}
5555        }
5556        set x0 -1
5557        set xm -1
5558        for {} {$col < [llength $idlist]} {incr col} {
5559            set id [lindex $idlist $col]
5560            if {[lindex $previdlist $col] eq $id} continue
5561            if {$id eq {}} {
5562                set haspad 1
5563                continue
5564            }
5565            set x0 [lsearch -exact $previdlist $id]
5566            if {$x0 < 0} continue
5567            set z [expr {$x0 - $col}]
5568            set isarrow 0
5569            set z0 {}
5570            if {$ym >= 0} {
5571                set xm [lsearch -exact $pprevidlist $id]
5572                if {$xm >= 0} {
5573                    set z0 [expr {$xm - $x0}]
5574                }
5575            }
5576            if {$z0 eq {}} {
5577                # if row y0 is the first child of $id then it's not an arrow
5578                if {[lindex $children($curview,$id) 0] ne
5579                    [lindex $displayorder $y0]} {
5580                    set isarrow 1
5581                }
5582            }
5583            if {!$isarrow && $id ne [lindex $displayorder $row] &&
5584                [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5585                set isarrow 1
5586            }
5587            # Looking at lines from this row to the previous row,
5588            # make them go straight up if they end in an arrow on
5589            # the previous row; otherwise make them go straight up
5590            # or at 45 degrees.
5591            if {$z < -1 || ($z < 0 && $isarrow)} {
5592                # Line currently goes left too much;
5593                # insert pads in the previous row, then optimize it
5594                set npad [expr {-1 - $z + $isarrow}]
5595                insert_pad $y0 $x0 $npad
5596                if {$y0 > 0} {
5597                    optimize_rows $y0 $x0 $row
5598                }
5599                set previdlist [lindex $rowidlist $y0]
5600                set x0 [lsearch -exact $previdlist $id]
5601                set z [expr {$x0 - $col}]
5602                if {$z0 ne {}} {
5603                    set pprevidlist [lindex $rowidlist $ym]
5604                    set xm [lsearch -exact $pprevidlist $id]
5605                    set z0 [expr {$xm - $x0}]
5606                }
5607            } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5608                # Line currently goes right too much;
5609                # insert pads in this line
5610                set npad [expr {$z - 1 + $isarrow}]
5611                insert_pad $row $col $npad
5612                set idlist [lindex $rowidlist $row]
5613                incr col $npad
5614                set z [expr {$x0 - $col}]
5615                set haspad 1
5616            }
5617            if {$z0 eq {} && !$isarrow && $ym >= 0} {
5618                # this line links to its first child on row $row-2
5619                set id [lindex $displayorder $ym]
5620                set xc [lsearch -exact $pprevidlist $id]
5621                if {$xc >= 0} {
5622                    set z0 [expr {$xc - $x0}]
5623                }
5624            }
5625            # avoid lines jigging left then immediately right
5626            if {$z0 ne {} && $z < 0 && $z0 > 0} {
5627                insert_pad $y0 $x0 1
5628                incr x0
5629                optimize_rows $y0 $x0 $row
5630                set previdlist [lindex $rowidlist $y0]
5631            }
5632        }
5633        if {!$haspad} {
5634            # Find the first column that doesn't have a line going right
5635            for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5636                set id [lindex $idlist $col]
5637                if {$id eq {}} break
5638                set x0 [lsearch -exact $previdlist $id]
5639                if {$x0 < 0} {
5640                    # check if this is the link to the first child
5641                    set kid [lindex $displayorder $y0]
5642                    if {[lindex $children($curview,$id) 0] eq $kid} {
5643                        # it is, work out offset to child
5644                        set x0 [lsearch -exact $previdlist $kid]
5645                    }
5646                }
5647                if {$x0 <= $col} break
5648            }
5649            # Insert a pad at that column as long as it has a line and
5650            # isn't the last column
5651            if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5652                set idlist [linsert $idlist $col {}]
5653                lset rowidlist $row $idlist
5654                changedrow $row
5655            }
5656        }
5657    }
5658}
5659
5660proc xc {row col} {
5661    global canvx0 linespc
5662    return [expr {$canvx0 + $col * $linespc}]
5663}
5664
5665proc yc {row} {
5666    global canvy0 linespc
5667    return [expr {$canvy0 + $row * $linespc}]
5668}
5669
5670proc linewidth {id} {
5671    global thickerline lthickness
5672
5673    set wid $lthickness
5674    if {[info exists thickerline] && $id eq $thickerline} {
5675        set wid [expr {2 * $lthickness}]
5676    }
5677    return $wid
5678}
5679
5680proc rowranges {id} {
5681    global curview children uparrowlen downarrowlen
5682    global rowidlist
5683
5684    set kids $children($curview,$id)
5685    if {$kids eq {}} {
5686        return {}
5687    }
5688    set ret {}
5689    lappend kids $id
5690    foreach child $kids {
5691        if {![commitinview $child $curview]} break
5692        set row [rowofcommit $child]
5693        if {![info exists prev]} {
5694            lappend ret [expr {$row + 1}]
5695        } else {
5696            if {$row <= $prevrow} {
5697                puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5698            }
5699            # see if the line extends the whole way from prevrow to row
5700            if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5701                [lsearch -exact [lindex $rowidlist \
5702                            [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5703                # it doesn't, see where it ends
5704                set r [expr {$prevrow + $downarrowlen}]
5705                if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5706                    while {[incr r -1] > $prevrow &&
5707                           [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5708                } else {
5709                    while {[incr r] <= $row &&
5710                           [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5711                    incr r -1
5712                }
5713                lappend ret $r
5714                # see where it starts up again
5715                set r [expr {$row - $uparrowlen}]
5716                if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5717                    while {[incr r] < $row &&
5718                           [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5719                } else {
5720                    while {[incr r -1] >= $prevrow &&
5721                           [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5722                    incr r
5723                }
5724                lappend ret $r
5725            }
5726        }
5727        if {$child eq $id} {
5728            lappend ret $row
5729        }
5730        set prev $child
5731        set prevrow $row
5732    }
5733    return $ret
5734}
5735
5736proc drawlineseg {id row endrow arrowlow} {
5737    global rowidlist displayorder iddrawn linesegs
5738    global canv colormap linespc curview maxlinelen parentlist
5739
5740    set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5741    set le [expr {$row + 1}]
5742    set arrowhigh 1
5743    while {1} {
5744        set c [lsearch -exact [lindex $rowidlist $le] $id]
5745        if {$c < 0} {
5746            incr le -1
5747            break
5748        }
5749        lappend cols $c
5750        set x [lindex $displayorder $le]
5751        if {$x eq $id} {
5752            set arrowhigh 0
5753            break
5754        }
5755        if {[info exists iddrawn($x)] || $le == $endrow} {
5756            set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5757            if {$c >= 0} {
5758                lappend cols $c
5759                set arrowhigh 0
5760            }
5761            break
5762        }
5763        incr le
5764    }
5765    if {$le <= $row} {
5766        return $row
5767    }
5768
5769    set lines {}
5770    set i 0
5771    set joinhigh 0
5772    if {[info exists linesegs($id)]} {
5773        set lines $linesegs($id)
5774        foreach li $lines {
5775            set r0 [lindex $li 0]
5776            if {$r0 > $row} {
5777                if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5778                    set joinhigh 1
5779                }
5780                break
5781            }
5782            incr i
5783        }
5784    }
5785    set joinlow 0
5786    if {$i > 0} {
5787        set li [lindex $lines [expr {$i-1}]]
5788        set r1 [lindex $li 1]
5789        if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5790            set joinlow 1
5791        }
5792    }
5793
5794    set x [lindex $cols [expr {$le - $row}]]
5795    set xp [lindex $cols [expr {$le - 1 - $row}]]
5796    set dir [expr {$xp - $x}]
5797    if {$joinhigh} {
5798        set ith [lindex $lines $i 2]
5799        set coords [$canv coords $ith]
5800        set ah [$canv itemcget $ith -arrow]
5801        set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5802        set x2 [lindex $cols [expr {$le + 1 - $row}]]
5803        if {$x2 ne {} && $x - $x2 == $dir} {
5804            set coords [lrange $coords 0 end-2]
5805        }
5806    } else {
5807        set coords [list [xc $le $x] [yc $le]]
5808    }
5809    if {$joinlow} {
5810        set itl [lindex $lines [expr {$i-1}] 2]
5811        set al [$canv itemcget $itl -arrow]
5812        set arrowlow [expr {$al eq "last" || $al eq "both"}]
5813    } elseif {$arrowlow} {
5814        if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5815            [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5816            set arrowlow 0
5817        }
5818    }
5819    set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5820    for {set y $le} {[incr y -1] > $row} {} {
5821        set x $xp
5822        set xp [lindex $cols [expr {$y - 1 - $row}]]
5823        set ndir [expr {$xp - $x}]
5824        if {$dir != $ndir || $xp < 0} {
5825            lappend coords [xc $y $x] [yc $y]
5826        }
5827        set dir $ndir
5828    }
5829    if {!$joinlow} {
5830        if {$xp < 0} {
5831            # join parent line to first child
5832            set ch [lindex $displayorder $row]
5833            set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5834            if {$xc < 0} {
5835                puts "oops: drawlineseg: child $ch not on row $row"
5836            } elseif {$xc != $x} {
5837                if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5838                    set d [expr {int(0.5 * $linespc)}]
5839                    set x1 [xc $row $x]
5840                    if {$xc < $x} {
5841                        set x2 [expr {$x1 - $d}]
5842                    } else {
5843                        set x2 [expr {$x1 + $d}]
5844                    }
5845                    set y2 [yc $row]
5846                    set y1 [expr {$y2 + $d}]
5847                    lappend coords $x1 $y1 $x2 $y2
5848                } elseif {$xc < $x - 1} {
5849                    lappend coords [xc $row [expr {$x-1}]] [yc $row]
5850                } elseif {$xc > $x + 1} {
5851                    lappend coords [xc $row [expr {$x+1}]] [yc $row]
5852                }
5853                set x $xc
5854            }
5855            lappend coords [xc $row $x] [yc $row]
5856        } else {
5857            set xn [xc $row $xp]
5858            set yn [yc $row]
5859            lappend coords $xn $yn
5860        }
5861        if {!$joinhigh} {
5862            assigncolor $id
5863            set t [$canv create line $coords -width [linewidth $id] \
5864                       -fill $colormap($id) -tags lines.$id -arrow $arrow]
5865            $canv lower $t
5866            bindline $t $id
5867            set lines [linsert $lines $i [list $row $le $t]]
5868        } else {
5869            $canv coords $ith $coords
5870            if {$arrow ne $ah} {
5871                $canv itemconf $ith -arrow $arrow
5872            }
5873            lset lines $i 0 $row
5874        }
5875    } else {
5876        set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
5877        set ndir [expr {$xo - $xp}]
5878        set clow [$canv coords $itl]
5879        if {$dir == $ndir} {
5880            set clow [lrange $clow 2 end]
5881        }
5882        set coords [concat $coords $clow]
5883        if {!$joinhigh} {
5884            lset lines [expr {$i-1}] 1 $le
5885        } else {
5886            # coalesce two pieces
5887            $canv delete $ith
5888            set b [lindex $lines [expr {$i-1}] 0]
5889            set e [lindex $lines $i 1]
5890            set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
5891        }
5892        $canv coords $itl $coords
5893        if {$arrow ne $al} {
5894            $canv itemconf $itl -arrow $arrow
5895        }
5896    }
5897
5898    set linesegs($id) $lines
5899    return $le
5900}
5901
5902proc drawparentlinks {id row} {
5903    global rowidlist canv colormap curview parentlist
5904    global idpos linespc
5905
5906    set rowids [lindex $rowidlist $row]
5907    set col [lsearch -exact $rowids $id]
5908    if {$col < 0} return
5909    set olds [lindex $parentlist $row]
5910    set row2 [expr {$row + 1}]
5911    set x [xc $row $col]
5912    set y [yc $row]
5913    set y2 [yc $row2]
5914    set d [expr {int(0.5 * $linespc)}]
5915    set ymid [expr {$y + $d}]
5916    set ids [lindex $rowidlist $row2]
5917    # rmx = right-most X coord used
5918    set rmx 0
5919    foreach p $olds {
5920        set i [lsearch -exact $ids $p]
5921        if {$i < 0} {
5922            puts "oops, parent $p of $id not in list"
5923            continue
5924        }
5925        set x2 [xc $row2 $i]
5926        if {$x2 > $rmx} {
5927            set rmx $x2
5928        }
5929        set j [lsearch -exact $rowids $p]
5930        if {$j < 0} {
5931            # drawlineseg will do this one for us
5932            continue
5933        }
5934        assigncolor $p
5935        # should handle duplicated parents here...
5936        set coords [list $x $y]
5937        if {$i != $col} {
5938            # if attaching to a vertical segment, draw a smaller
5939            # slant for visual distinctness
5940            if {$i == $j} {
5941                if {$i < $col} {
5942                    lappend coords [expr {$x2 + $d}] $y $x2 $ymid
5943                } else {
5944                    lappend coords [expr {$x2 - $d}] $y $x2 $ymid
5945                }
5946            } elseif {$i < $col && $i < $j} {
5947                # segment slants towards us already
5948                lappend coords [xc $row $j] $y
5949            } else {
5950                if {$i < $col - 1} {
5951                    lappend coords [expr {$x2 + $linespc}] $y
5952                } elseif {$i > $col + 1} {
5953                    lappend coords [expr {$x2 - $linespc}] $y
5954                }
5955                lappend coords $x2 $y2
5956            }
5957        } else {
5958            lappend coords $x2 $y2
5959        }
5960        set t [$canv create line $coords -width [linewidth $p] \
5961                   -fill $colormap($p) -tags lines.$p]
5962        $canv lower $t
5963        bindline $t $p
5964    }
5965    if {$rmx > [lindex $idpos($id) 1]} {
5966        lset idpos($id) 1 $rmx
5967        redrawtags $id
5968    }
5969}
5970
5971proc drawlines {id} {
5972    global canv
5973
5974    $canv itemconf lines.$id -width [linewidth $id]
5975}
5976
5977proc drawcmittext {id row col} {
5978    global linespc canv canv2 canv3 fgcolor curview
5979    global cmitlisted commitinfo rowidlist parentlist
5980    global rowtextx idpos idtags idheads idotherrefs
5981    global linehtag linentag linedtag selectedline
5982    global canvxmax boldids boldnameids fgcolor markedid
5983    global mainheadid nullid nullid2 circleitem circlecolors ctxbut
5984    global mainheadcirclecolor workingfilescirclecolor indexcirclecolor
5985    global circleoutlinecolor
5986
5987    # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
5988    set listed $cmitlisted($curview,$id)
5989    if {$id eq $nullid} {
5990        set ofill $workingfilescirclecolor
5991    } elseif {$id eq $nullid2} {
5992        set ofill $indexcirclecolor
5993    } elseif {$id eq $mainheadid} {
5994        set ofill $mainheadcirclecolor
5995    } else {
5996        set ofill [lindex $circlecolors $listed]
5997    }
5998    set x [xc $row $col]
5999    set y [yc $row]
6000    set orad [expr {$linespc / 3}]
6001    if {$listed <= 2} {
6002        set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
6003                   [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6004                   -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6005    } elseif {$listed == 3} {
6006        # triangle pointing left for left-side commits
6007        set t [$canv create polygon \
6008                   [expr {$x - $orad}] $y \
6009                   [expr {$x + $orad - 1}] [expr {$y - $orad}] \
6010                   [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6011                   -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6012    } else {
6013        # triangle pointing right for right-side commits
6014        set t [$canv create polygon \
6015                   [expr {$x + $orad - 1}] $y \
6016                   [expr {$x - $orad}] [expr {$y - $orad}] \
6017                   [expr {$x - $orad}] [expr {$y + $orad - 1}] \
6018                   -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6019    }
6020    set circleitem($row) $t
6021    $canv raise $t
6022    $canv bind $t <1> {selcanvline {} %x %y}
6023    set rmx [llength [lindex $rowidlist $row]]
6024    set olds [lindex $parentlist $row]
6025    if {$olds ne {}} {
6026        set nextids [lindex $rowidlist [expr {$row + 1}]]
6027        foreach p $olds {
6028            set i [lsearch -exact $nextids $p]
6029            if {$i > $rmx} {
6030                set rmx $i
6031            }
6032        }
6033    }
6034    set xt [xc $row $rmx]
6035    set rowtextx($row) $xt
6036    set idpos($id) [list $x $xt $y]
6037    if {[info exists idtags($id)] || [info exists idheads($id)]
6038        || [info exists idotherrefs($id)]} {
6039        set xt [drawtags $id $x $xt $y]
6040    }
6041    if {[lindex $commitinfo($id) 6] > 0} {
6042        set xt [drawnotesign $xt $y]
6043    }
6044    set headline [lindex $commitinfo($id) 0]
6045    set name [lindex $commitinfo($id) 1]
6046    set date [lindex $commitinfo($id) 2]
6047    set date [formatdate $date]
6048    set font mainfont
6049    set nfont mainfont
6050    set isbold [ishighlighted $id]
6051    if {$isbold > 0} {
6052        lappend boldids $id
6053        set font mainfontbold
6054        if {$isbold > 1} {
6055            lappend boldnameids $id
6056            set nfont mainfontbold
6057        }
6058    }
6059    set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
6060                           -text $headline -font $font -tags text]
6061    $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
6062    set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
6063                           -text $name -font $nfont -tags text]
6064    set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
6065                           -text $date -font mainfont -tags text]
6066    if {$selectedline == $row} {
6067        make_secsel $id
6068    }
6069    if {[info exists markedid] && $markedid eq $id} {
6070        make_idmark $id
6071    }
6072    set xr [expr {$xt + [font measure $font $headline]}]
6073    if {$xr > $canvxmax} {
6074        set canvxmax $xr
6075        setcanvscroll
6076    }
6077}
6078
6079proc drawcmitrow {row} {
6080    global displayorder rowidlist nrows_drawn
6081    global iddrawn markingmatches
6082    global commitinfo numcommits
6083    global filehighlight fhighlights findpattern nhighlights
6084    global hlview vhighlights
6085    global highlight_related rhighlights
6086
6087    if {$row >= $numcommits} return
6088
6089    set id [lindex $displayorder $row]
6090    if {[info exists hlview] && ![info exists vhighlights($id)]} {
6091        askvhighlight $row $id
6092    }
6093    if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
6094        askfilehighlight $row $id
6095    }
6096    if {$findpattern ne {} && ![info exists nhighlights($id)]} {
6097        askfindhighlight $row $id
6098    }
6099    if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
6100        askrelhighlight $row $id
6101    }
6102    if {![info exists iddrawn($id)]} {
6103        set col [lsearch -exact [lindex $rowidlist $row] $id]
6104        if {$col < 0} {
6105            puts "oops, row $row id $id not in list"
6106            return
6107        }
6108        if {![info exists commitinfo($id)]} {
6109            getcommit $id
6110        }
6111        assigncolor $id
6112        drawcmittext $id $row $col
6113        set iddrawn($id) 1
6114        incr nrows_drawn
6115    }
6116    if {$markingmatches} {
6117        markrowmatches $row $id
6118    }
6119}
6120
6121proc drawcommits {row {endrow {}}} {
6122    global numcommits iddrawn displayorder curview need_redisplay
6123    global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
6124
6125    if {$row < 0} {
6126        set row 0
6127    }
6128    if {$endrow eq {}} {
6129        set endrow $row
6130    }
6131    if {$endrow >= $numcommits} {
6132        set endrow [expr {$numcommits - 1}]
6133    }
6134
6135    set rl1 [expr {$row - $downarrowlen - 3}]
6136    if {$rl1 < 0} {
6137        set rl1 0
6138    }
6139    set ro1 [expr {$row - 3}]
6140    if {$ro1 < 0} {
6141        set ro1 0
6142    }
6143    set r2 [expr {$endrow + $uparrowlen + 3}]
6144    if {$r2 > $numcommits} {
6145        set r2 $numcommits
6146    }
6147    for {set r $rl1} {$r < $r2} {incr r} {
6148        if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
6149            if {$rl1 < $r} {
6150                layoutrows $rl1 $r
6151            }
6152            set rl1 [expr {$r + 1}]
6153        }
6154    }
6155    if {$rl1 < $r} {
6156        layoutrows $rl1 $r
6157    }
6158    optimize_rows $ro1 0 $r2
6159    if {$need_redisplay || $nrows_drawn > 2000} {
6160        clear_display
6161    }
6162
6163    # make the lines join to already-drawn rows either side
6164    set r [expr {$row - 1}]
6165    if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
6166        set r $row
6167    }
6168    set er [expr {$endrow + 1}]
6169    if {$er >= $numcommits ||
6170        ![info exists iddrawn([lindex $displayorder $er])]} {
6171        set er $endrow
6172    }
6173    for {} {$r <= $er} {incr r} {
6174        set id [lindex $displayorder $r]
6175        set wasdrawn [info exists iddrawn($id)]
6176        drawcmitrow $r
6177        if {$r == $er} break
6178        set nextid [lindex $displayorder [expr {$r + 1}]]
6179        if {$wasdrawn && [info exists iddrawn($nextid)]} continue
6180        drawparentlinks $id $r
6181
6182        set rowids [lindex $rowidlist $r]
6183        foreach lid $rowids {
6184            if {$lid eq {}} continue
6185            if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
6186            if {$lid eq $id} {
6187                # see if this is the first child of any of its parents
6188                foreach p [lindex $parentlist $r] {
6189                    if {[lsearch -exact $rowids $p] < 0} {
6190                        # make this line extend up to the child
6191                        set lineend($p) [drawlineseg $p $r $er 0]
6192                    }
6193                }
6194            } else {
6195                set lineend($lid) [drawlineseg $lid $r $er 1]
6196            }
6197        }
6198    }
6199}
6200
6201proc undolayout {row} {
6202    global uparrowlen mingaplen downarrowlen
6203    global rowidlist rowisopt rowfinal need_redisplay
6204
6205    set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
6206    if {$r < 0} {
6207        set r 0
6208    }
6209    if {[llength $rowidlist] > $r} {
6210        incr r -1
6211        set rowidlist [lrange $rowidlist 0 $r]
6212        set rowfinal [lrange $rowfinal 0 $r]
6213        set rowisopt [lrange $rowisopt 0 $r]
6214        set need_redisplay 1
6215        run drawvisible
6216    }
6217}
6218
6219proc drawvisible {} {
6220    global canv linespc curview vrowmod selectedline targetrow targetid
6221    global need_redisplay cscroll numcommits
6222
6223    set fs [$canv yview]
6224    set ymax [lindex [$canv cget -scrollregion] 3]
6225    if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
6226    set f0 [lindex $fs 0]
6227    set f1 [lindex $fs 1]
6228    set y0 [expr {int($f0 * $ymax)}]
6229    set y1 [expr {int($f1 * $ymax)}]
6230
6231    if {[info exists targetid]} {
6232        if {[commitinview $targetid $curview]} {
6233            set r [rowofcommit $targetid]
6234            if {$r != $targetrow} {
6235                # Fix up the scrollregion and change the scrolling position
6236                # now that our target row has moved.
6237                set diff [expr {($r - $targetrow) * $linespc}]
6238                set targetrow $r
6239                setcanvscroll
6240                set ymax [lindex [$canv cget -scrollregion] 3]
6241                incr y0 $diff
6242                incr y1 $diff
6243                set f0 [expr {$y0 / $ymax}]
6244                set f1 [expr {$y1 / $ymax}]
6245                allcanvs yview moveto $f0
6246                $cscroll set $f0 $f1
6247                set need_redisplay 1
6248            }
6249        } else {
6250            unset targetid
6251        }
6252    }
6253
6254    set row [expr {int(($y0 - 3) / $linespc) - 1}]
6255    set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
6256    if {$endrow >= $vrowmod($curview)} {
6257        update_arcrows $curview
6258    }
6259    if {$selectedline ne {} &&
6260        $row <= $selectedline && $selectedline <= $endrow} {
6261        set targetrow $selectedline
6262    } elseif {[info exists targetid]} {
6263        set targetrow [expr {int(($row + $endrow) / 2)}]
6264    }
6265    if {[info exists targetrow]} {
6266        if {$targetrow >= $numcommits} {
6267            set targetrow [expr {$numcommits - 1}]
6268        }
6269        set targetid [commitonrow $targetrow]
6270    }
6271    drawcommits $row $endrow
6272}
6273
6274proc clear_display {} {
6275    global iddrawn linesegs need_redisplay nrows_drawn
6276    global vhighlights fhighlights nhighlights rhighlights
6277    global linehtag linentag linedtag boldids boldnameids
6278
6279    allcanvs delete all
6280    catch {unset iddrawn}
6281    catch {unset linesegs}
6282    catch {unset linehtag}
6283    catch {unset linentag}
6284    catch {unset linedtag}
6285    set boldids {}
6286    set boldnameids {}
6287    catch {unset vhighlights}
6288    catch {unset fhighlights}
6289    catch {unset nhighlights}
6290    catch {unset rhighlights}
6291    set need_redisplay 0
6292    set nrows_drawn 0
6293}
6294
6295proc findcrossings {id} {
6296    global rowidlist parentlist numcommits displayorder
6297
6298    set cross {}
6299    set ccross {}
6300    foreach {s e} [rowranges $id] {
6301        if {$e >= $numcommits} {
6302            set e [expr {$numcommits - 1}]
6303        }
6304        if {$e <= $s} continue
6305        for {set row $e} {[incr row -1] >= $s} {} {
6306            set x [lsearch -exact [lindex $rowidlist $row] $id]
6307            if {$x < 0} break
6308            set olds [lindex $parentlist $row]
6309            set kid [lindex $displayorder $row]
6310            set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
6311            if {$kidx < 0} continue
6312            set nextrow [lindex $rowidlist [expr {$row + 1}]]
6313            foreach p $olds {
6314                set px [lsearch -exact $nextrow $p]
6315                if {$px < 0} continue
6316                if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
6317                    if {[lsearch -exact $ccross $p] >= 0} continue
6318                    if {$x == $px + ($kidx < $px? -1: 1)} {
6319                        lappend ccross $p
6320                    } elseif {[lsearch -exact $cross $p] < 0} {
6321                        lappend cross $p
6322                    }
6323                }
6324            }
6325        }
6326    }
6327    return [concat $ccross {{}} $cross]
6328}
6329
6330proc assigncolor {id} {
6331    global colormap colors nextcolor
6332    global parents children children curview
6333
6334    if {[info exists colormap($id)]} return
6335    set ncolors [llength $colors]
6336    if {[info exists children($curview,$id)]} {
6337        set kids $children($curview,$id)
6338    } else {
6339        set kids {}
6340    }
6341    if {[llength $kids] == 1} {
6342        set child [lindex $kids 0]
6343        if {[info exists colormap($child)]
6344            && [llength $parents($curview,$child)] == 1} {
6345            set colormap($id) $colormap($child)
6346            return
6347        }
6348    }
6349    set badcolors {}
6350    set origbad {}
6351    foreach x [findcrossings $id] {
6352        if {$x eq {}} {
6353            # delimiter between corner crossings and other crossings
6354            if {[llength $badcolors] >= $ncolors - 1} break
6355            set origbad $badcolors
6356        }
6357        if {[info exists colormap($x)]
6358            && [lsearch -exact $badcolors $colormap($x)] < 0} {
6359            lappend badcolors $colormap($x)
6360        }
6361    }
6362    if {[llength $badcolors] >= $ncolors} {
6363        set badcolors $origbad
6364    }
6365    set origbad $badcolors
6366    if {[llength $badcolors] < $ncolors - 1} {
6367        foreach child $kids {
6368            if {[info exists colormap($child)]
6369                && [lsearch -exact $badcolors $colormap($child)] < 0} {
6370                lappend badcolors $colormap($child)
6371            }
6372            foreach p $parents($curview,$child) {
6373                if {[info exists colormap($p)]
6374                    && [lsearch -exact $badcolors $colormap($p)] < 0} {
6375                    lappend badcolors $colormap($p)
6376                }
6377            }
6378        }
6379        if {[llength $badcolors] >= $ncolors} {
6380            set badcolors $origbad
6381        }
6382    }
6383    for {set i 0} {$i <= $ncolors} {incr i} {
6384        set c [lindex $colors $nextcolor]
6385        if {[incr nextcolor] >= $ncolors} {
6386            set nextcolor 0
6387        }
6388        if {[lsearch -exact $badcolors $c]} break
6389    }
6390    set colormap($id) $c
6391}
6392
6393proc bindline {t id} {
6394    global canv
6395
6396    $canv bind $t <Enter> "lineenter %x %y $id"
6397    $canv bind $t <Motion> "linemotion %x %y $id"
6398    $canv bind $t <Leave> "lineleave $id"
6399    $canv bind $t <Button-1> "lineclick %x %y $id 1"
6400}
6401
6402proc graph_pane_width {} {
6403    global use_ttk
6404
6405    if {$use_ttk} {
6406        set g [.tf.histframe.pwclist sashpos 0]
6407    } else {
6408        set g [.tf.histframe.pwclist sash coord 0]
6409    }
6410    return [lindex $g 0]
6411}
6412
6413proc totalwidth {l font extra} {
6414    set tot 0
6415    foreach str $l {
6416        set tot [expr {$tot + [font measure $font $str] + $extra}]
6417    }
6418    return $tot
6419}
6420
6421proc drawtags {id x xt y1} {
6422    global idtags idheads idotherrefs mainhead
6423    global linespc lthickness
6424    global canv rowtextx curview fgcolor bgcolor ctxbut
6425    global headbgcolor headfgcolor headoutlinecolor remotebgcolor
6426    global tagbgcolor tagfgcolor tagoutlinecolor
6427    global reflinecolor
6428
6429    set marks {}
6430    set ntags 0
6431    set nheads 0
6432    set singletag 0
6433    set maxtags 3
6434    set maxtagpct 25
6435    set maxwidth [expr {[graph_pane_width] * $maxtagpct / 100}]
6436    set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6437    set extra [expr {$delta + $lthickness + $linespc}]
6438
6439    if {[info exists idtags($id)]} {
6440        set marks $idtags($id)
6441        set ntags [llength $marks]
6442        if {$ntags > $maxtags ||
6443            [totalwidth $marks mainfont $extra] > $maxwidth} {
6444            # show just a single "n tags..." tag
6445            set singletag 1
6446            if {$ntags == 1} {
6447                set marks [list "tag..."]
6448            } else {
6449                set marks [list [format "%d tags..." $ntags]]
6450            }
6451            set ntags 1
6452        }
6453    }
6454    if {[info exists idheads($id)]} {
6455        set marks [concat $marks $idheads($id)]
6456        set nheads [llength $idheads($id)]
6457    }
6458    if {[info exists idotherrefs($id)]} {
6459        set marks [concat $marks $idotherrefs($id)]
6460    }
6461    if {$marks eq {}} {
6462        return $xt
6463    }
6464
6465    set yt [expr {$y1 - 0.5 * $linespc}]
6466    set yb [expr {$yt + $linespc - 1}]
6467    set xvals {}
6468    set wvals {}
6469    set i -1
6470    foreach tag $marks {
6471        incr i
6472        if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
6473            set wid [font measure mainfontbold $tag]
6474        } else {
6475            set wid [font measure mainfont $tag]
6476        }
6477        lappend xvals $xt
6478        lappend wvals $wid
6479        set xt [expr {$xt + $wid + $extra}]
6480    }
6481    set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
6482               -width $lthickness -fill $reflinecolor -tags tag.$id]
6483    $canv lower $t
6484    foreach tag $marks x $xvals wid $wvals {
6485        set tag_quoted [string map {% %%} $tag]
6486        set xl [expr {$x + $delta}]
6487        set xr [expr {$x + $delta + $wid + $lthickness}]
6488        set font mainfont
6489        if {[incr ntags -1] >= 0} {
6490            # draw a tag
6491            set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6492                       $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
6493                       -width 1 -outline $tagoutlinecolor -fill $tagbgcolor \
6494                       -tags tag.$id]
6495            if {$singletag} {
6496                set tagclick [list showtags $id 1]
6497            } else {
6498                set tagclick [list showtag $tag_quoted 1]
6499            }
6500            $canv bind $t <1> $tagclick
6501            set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
6502        } else {
6503            # draw a head or other ref
6504            if {[incr nheads -1] >= 0} {
6505                set col $headbgcolor
6506                if {$tag eq $mainhead} {
6507                    set font mainfontbold
6508                }
6509            } else {
6510                set col "#ddddff"
6511            }
6512            set xl [expr {$xl - $delta/2}]
6513            $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
6514                -width 1 -outline black -fill $col -tags tag.$id
6515            if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
6516                set rwid [font measure mainfont $remoteprefix]
6517                set xi [expr {$x + 1}]
6518                set yti [expr {$yt + 1}]
6519                set xri [expr {$x + $rwid}]
6520                $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6521                        -width 0 -fill $remotebgcolor -tags tag.$id
6522            }
6523        }
6524        set t [$canv create text $xl $y1 -anchor w -text $tag -fill $headfgcolor \
6525                   -font $font -tags [list tag.$id text]]
6526        if {$ntags >= 0} {
6527            $canv bind $t <1> $tagclick
6528        } elseif {$nheads >= 0} {
6529            $canv bind $t $ctxbut [list headmenu %X %Y $id $tag_quoted]
6530        }
6531    }
6532    return $xt
6533}
6534
6535proc drawnotesign {xt y} {
6536    global linespc canv fgcolor
6537
6538    set orad [expr {$linespc / 3}]
6539    set t [$canv create rectangle [expr {$xt - $orad}] [expr {$y - $orad}] \
6540               [expr {$xt + $orad - 1}] [expr {$y + $orad - 1}] \
6541               -fill yellow -outline $fgcolor -width 1 -tags circle]
6542    set xt [expr {$xt + $orad * 3}]
6543    return $xt
6544}
6545
6546proc xcoord {i level ln} {
6547    global canvx0 xspc1 xspc2
6548
6549    set x [expr {$canvx0 + $i * $xspc1($ln)}]
6550    if {$i > 0 && $i == $level} {
6551        set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6552    } elseif {$i > $level} {
6553        set x [expr {$x + $xspc2 - $xspc1($ln)}]
6554    }
6555    return $x
6556}
6557
6558proc show_status {msg} {
6559    global canv fgcolor
6560
6561    clear_display
6562    $canv create text 3 3 -anchor nw -text $msg -font mainfont \
6563        -tags text -fill $fgcolor
6564}
6565
6566# Don't change the text pane cursor if it is currently the hand cursor,
6567# showing that we are over a sha1 ID link.
6568proc settextcursor {c} {
6569    global ctext curtextcursor
6570
6571    if {[$ctext cget -cursor] == $curtextcursor} {
6572        $ctext config -cursor $c
6573    }
6574    set curtextcursor $c
6575}
6576
6577proc nowbusy {what {name {}}} {
6578    global isbusy busyname statusw
6579
6580    if {[array names isbusy] eq {}} {
6581        . config -cursor watch
6582        settextcursor watch
6583    }
6584    set isbusy($what) 1
6585    set busyname($what) $name
6586    if {$name ne {}} {
6587        $statusw conf -text $name
6588    }
6589}
6590
6591proc notbusy {what} {
6592    global isbusy maincursor textcursor busyname statusw
6593
6594    catch {
6595        unset isbusy($what)
6596        if {$busyname($what) ne {} &&
6597            [$statusw cget -text] eq $busyname($what)} {
6598            $statusw conf -text {}
6599        }
6600    }
6601    if {[array names isbusy] eq {}} {
6602        . config -cursor $maincursor
6603        settextcursor $textcursor
6604    }
6605}
6606
6607proc findmatches {f} {
6608    global findtype findstring
6609    if {$findtype == [mc "Regexp"]} {
6610        set matches [regexp -indices -all -inline $findstring $f]
6611    } else {
6612        set fs $findstring
6613        if {$findtype == [mc "IgnCase"]} {
6614            set f [string tolower $f]
6615            set fs [string tolower $fs]
6616        }
6617        set matches {}
6618        set i 0
6619        set l [string length $fs]
6620        while {[set j [string first $fs $f $i]] >= 0} {
6621            lappend matches [list $j [expr {$j+$l-1}]]
6622            set i [expr {$j + $l}]
6623        }
6624    }
6625    return $matches
6626}
6627
6628proc dofind {{dirn 1} {wrap 1}} {
6629    global findstring findstartline findcurline selectedline numcommits
6630    global gdttype filehighlight fh_serial find_dirn findallowwrap
6631
6632    if {[info exists find_dirn]} {
6633        if {$find_dirn == $dirn} return
6634        stopfinding
6635    }
6636    focus .
6637    if {$findstring eq {} || $numcommits == 0} return
6638    if {$selectedline eq {}} {
6639        set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6640    } else {
6641        set findstartline $selectedline
6642    }
6643    set findcurline $findstartline
6644    nowbusy finding [mc "Searching"]
6645    if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6646        after cancel do_file_hl $fh_serial
6647        do_file_hl $fh_serial
6648    }
6649    set find_dirn $dirn
6650    set findallowwrap $wrap
6651    run findmore
6652}
6653
6654proc stopfinding {} {
6655    global find_dirn findcurline fprogcoord
6656
6657    if {[info exists find_dirn]} {
6658        unset find_dirn
6659        unset findcurline
6660        notbusy finding
6661        set fprogcoord 0
6662        adjustprogress
6663    }
6664    stopblaming
6665}
6666
6667proc findmore {} {
6668    global commitdata commitinfo numcommits findpattern findloc
6669    global findstartline findcurline findallowwrap
6670    global find_dirn gdttype fhighlights fprogcoord
6671    global curview varcorder vrownum varccommits vrowmod
6672
6673    if {![info exists find_dirn]} {
6674        return 0
6675    }
6676    set fldtypes [list [mc "Headline"] [mc "Author"] "" [mc "Committer"] "" [mc "Comments"]]
6677    set l $findcurline
6678    set moretodo 0
6679    if {$find_dirn > 0} {
6680        incr l
6681        if {$l >= $numcommits} {
6682            set l 0
6683        }
6684        if {$l <= $findstartline} {
6685            set lim [expr {$findstartline + 1}]
6686        } else {
6687            set lim $numcommits
6688            set moretodo $findallowwrap
6689        }
6690    } else {
6691        if {$l == 0} {
6692            set l $numcommits
6693        }
6694        incr l -1
6695        if {$l >= $findstartline} {
6696            set lim [expr {$findstartline - 1}]
6697        } else {
6698            set lim -1
6699            set moretodo $findallowwrap
6700        }
6701    }
6702    set n [expr {($lim - $l) * $find_dirn}]
6703    if {$n > 500} {
6704        set n 500
6705        set moretodo 1
6706    }
6707    if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6708        update_arcrows $curview
6709    }
6710    set found 0
6711    set domore 1
6712    set ai [bsearch $vrownum($curview) $l]
6713    set a [lindex $varcorder($curview) $ai]
6714    set arow [lindex $vrownum($curview) $ai]
6715    set ids [lindex $varccommits($curview,$a)]
6716    set arowend [expr {$arow + [llength $ids]}]
6717    if {$gdttype eq [mc "containing:"]} {
6718        for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6719            if {$l < $arow || $l >= $arowend} {
6720                incr ai $find_dirn
6721                set a [lindex $varcorder($curview) $ai]
6722                set arow [lindex $vrownum($curview) $ai]
6723                set ids [lindex $varccommits($curview,$a)]
6724                set arowend [expr {$arow + [llength $ids]}]
6725            }
6726            set id [lindex $ids [expr {$l - $arow}]]
6727            # shouldn't happen unless git log doesn't give all the commits...
6728            if {![info exists commitdata($id)] ||
6729                ![doesmatch $commitdata($id)]} {
6730                continue
6731            }
6732            if {![info exists commitinfo($id)]} {
6733                getcommit $id
6734            }
6735            set info $commitinfo($id)
6736            foreach f $info ty $fldtypes {
6737                if {$ty eq ""} continue
6738                if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6739                    [doesmatch $f]} {
6740                    set found 1
6741                    break
6742                }
6743            }
6744            if {$found} break
6745        }
6746    } else {
6747        for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6748            if {$l < $arow || $l >= $arowend} {
6749                incr ai $find_dirn
6750                set a [lindex $varcorder($curview) $ai]
6751                set arow [lindex $vrownum($curview) $ai]
6752                set ids [lindex $varccommits($curview,$a)]
6753                set arowend [expr {$arow + [llength $ids]}]
6754            }
6755            set id [lindex $ids [expr {$l - $arow}]]
6756            if {![info exists fhighlights($id)]} {
6757                # this sets fhighlights($id) to -1
6758                askfilehighlight $l $id
6759            }
6760            if {$fhighlights($id) > 0} {
6761                set found $domore
6762                break
6763            }
6764            if {$fhighlights($id) < 0} {
6765                if {$domore} {
6766                    set domore 0
6767                    set findcurline [expr {$l - $find_dirn}]
6768                }
6769            }
6770        }
6771    }
6772    if {$found || ($domore && !$moretodo)} {
6773        unset findcurline
6774        unset find_dirn
6775        notbusy finding
6776        set fprogcoord 0
6777        adjustprogress
6778        if {$found} {
6779            findselectline $l
6780        } else {
6781            bell
6782        }
6783        return 0
6784    }
6785    if {!$domore} {
6786        flushhighlights
6787    } else {
6788        set findcurline [expr {$l - $find_dirn}]
6789    }
6790    set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6791    if {$n < 0} {
6792        incr n $numcommits
6793    }
6794    set fprogcoord [expr {$n * 1.0 / $numcommits}]
6795    adjustprogress
6796    return $domore
6797}
6798
6799proc findselectline {l} {
6800    global findloc commentend ctext findcurline markingmatches gdttype
6801
6802    set markingmatches [expr {$gdttype eq [mc "containing:"]}]
6803    set findcurline $l
6804    selectline $l 1
6805    if {$markingmatches &&
6806        ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
6807        # highlight the matches in the comments
6808        set f [$ctext get 1.0 $commentend]
6809        set matches [findmatches $f]
6810        foreach match $matches {
6811            set start [lindex $match 0]
6812            set end [expr {[lindex $match 1] + 1}]
6813            $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6814        }
6815    }
6816    drawvisible
6817}
6818
6819# mark the bits of a headline or author that match a find string
6820proc markmatches {canv l str tag matches font row} {
6821    global selectedline
6822
6823    set bbox [$canv bbox $tag]
6824    set x0 [lindex $bbox 0]
6825    set y0 [lindex $bbox 1]
6826    set y1 [lindex $bbox 3]
6827    foreach match $matches {
6828        set start [lindex $match 0]
6829        set end [lindex $match 1]
6830        if {$start > $end} continue
6831        set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6832        set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6833        set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6834                   [expr {$x0+$xlen+2}] $y1 \
6835                   -outline {} -tags [list match$l matches] -fill yellow]
6836        $canv lower $t
6837        if {$row == $selectedline} {
6838            $canv raise $t secsel
6839        }
6840    }
6841}
6842
6843proc unmarkmatches {} {
6844    global markingmatches
6845
6846    allcanvs delete matches
6847    set markingmatches 0
6848    stopfinding
6849}
6850
6851proc selcanvline {w x y} {
6852    global canv canvy0 ctext linespc
6853    global rowtextx
6854    set ymax [lindex [$canv cget -scrollregion] 3]
6855    if {$ymax == {}} return
6856    set yfrac [lindex [$canv yview] 0]
6857    set y [expr {$y + $yfrac * $ymax}]
6858    set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6859    if {$l < 0} {
6860        set l 0
6861    }
6862    if {$w eq $canv} {
6863        set xmax [lindex [$canv cget -scrollregion] 2]
6864        set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6865        if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
6866    }
6867    unmarkmatches
6868    selectline $l 1
6869}
6870
6871proc commit_descriptor {p} {
6872    global commitinfo
6873    if {![info exists commitinfo($p)]} {
6874        getcommit $p
6875    }
6876    set l "..."
6877    if {[llength $commitinfo($p)] > 1} {
6878        set l [lindex $commitinfo($p) 0]
6879    }
6880    return "$p ($l)\n"
6881}
6882
6883# append some text to the ctext widget, and make any SHA1 ID
6884# that we know about be a clickable link.
6885proc appendwithlinks {text tags} {
6886    global ctext linknum curview
6887
6888    set start [$ctext index "end - 1c"]
6889    $ctext insert end $text $tags
6890    set links [regexp -indices -all -inline {(?:\m|-g)[0-9a-f]{6,40}\M} $text]
6891    foreach l $links {
6892        set s [lindex $l 0]
6893        set e [lindex $l 1]
6894        set linkid [string range $text $s $e]
6895        incr e
6896        $ctext tag delete link$linknum
6897        $ctext tag add link$linknum "$start + $s c" "$start + $e c"
6898        setlink $linkid link$linknum
6899        incr linknum
6900    }
6901}
6902
6903proc setlink {id lk} {
6904    global curview ctext pendinglinks
6905    global linkfgcolor
6906
6907    if {[string range $id 0 1] eq "-g"} {
6908      set id [string range $id 2 end]
6909    }
6910
6911    set known 0
6912    if {[string length $id] < 40} {
6913        set matches [longid $id]
6914        if {[llength $matches] > 0} {
6915            if {[llength $matches] > 1} return
6916            set known 1
6917            set id [lindex $matches 0]
6918        }
6919    } else {
6920        set known [commitinview $id $curview]
6921    }
6922    if {$known} {
6923        $ctext tag conf $lk -foreground $linkfgcolor -underline 1
6924        $ctext tag bind $lk <1> [list selbyid $id]
6925        $ctext tag bind $lk <Enter> {linkcursor %W 1}
6926        $ctext tag bind $lk <Leave> {linkcursor %W -1}
6927    } else {
6928        lappend pendinglinks($id) $lk
6929        interestedin $id {makelink %P}
6930    }
6931}
6932
6933proc appendshortlink {id {pre {}} {post {}}} {
6934    global ctext linknum
6935
6936    $ctext insert end $pre
6937    $ctext tag delete link$linknum
6938    $ctext insert end [string range $id 0 7] link$linknum
6939    $ctext insert end $post
6940    setlink $id link$linknum
6941    incr linknum
6942}
6943
6944proc makelink {id} {
6945    global pendinglinks
6946
6947    if {![info exists pendinglinks($id)]} return
6948    foreach lk $pendinglinks($id) {
6949        setlink $id $lk
6950    }
6951    unset pendinglinks($id)
6952}
6953
6954proc linkcursor {w inc} {
6955    global linkentercount curtextcursor
6956
6957    if {[incr linkentercount $inc] > 0} {
6958        $w configure -cursor hand2
6959    } else {
6960        $w configure -cursor $curtextcursor
6961        if {$linkentercount < 0} {
6962            set linkentercount 0
6963        }
6964    }
6965}
6966
6967proc viewnextline {dir} {
6968    global canv linespc
6969
6970    $canv delete hover
6971    set ymax [lindex [$canv cget -scrollregion] 3]
6972    set wnow [$canv yview]
6973    set wtop [expr {[lindex $wnow 0] * $ymax}]
6974    set newtop [expr {$wtop + $dir * $linespc}]
6975    if {$newtop < 0} {
6976        set newtop 0
6977    } elseif {$newtop > $ymax} {
6978        set newtop $ymax
6979    }
6980    allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6981}
6982
6983# add a list of tag or branch names at position pos
6984# returns the number of names inserted
6985proc appendrefs {pos ids var} {
6986    global ctext linknum curview $var maxrefs mainheadid
6987
6988    if {[catch {$ctext index $pos}]} {
6989        return 0
6990    }
6991    $ctext conf -state normal
6992    $ctext delete $pos "$pos lineend"
6993    set tags {}
6994    foreach id $ids {
6995        foreach tag [set $var\($id\)] {
6996            lappend tags [list $tag $id]
6997        }
6998    }
6999
7000    set sep {}
7001    set tags [lsort -index 0 -decreasing $tags]
7002    set nutags 0
7003
7004    if {[llength $tags] > $maxrefs} {
7005        # If we are displaying heads, and there are too many,
7006        # see if there are some important heads to display.
7007        # Currently this means "master" and the current head.
7008        set itags {}
7009        if {$var eq "idheads"} {
7010            set utags {}
7011            foreach ti $tags {
7012                set hname [lindex $ti 0]
7013                set id [lindex $ti 1]
7014                if {($hname eq "master" || $id eq $mainheadid) &&
7015                    [llength $itags] < $maxrefs} {
7016                    lappend itags $ti
7017                } else {
7018                    lappend utags $ti
7019                }
7020            }
7021            set tags $utags
7022        }
7023        if {$itags ne {}} {
7024            set str [mc "and many more"]
7025            set sep " "
7026        } else {
7027            set str [mc "many"]
7028        }
7029        $ctext insert $pos "$str ([llength $tags])"
7030        set nutags [llength $tags]
7031        set tags $itags
7032    }
7033
7034    foreach ti $tags {
7035        set id [lindex $ti 1]
7036        set lk link$linknum
7037        incr linknum
7038        $ctext tag delete $lk
7039        $ctext insert $pos $sep
7040        $ctext insert $pos [lindex $ti 0] $lk
7041        setlink $id $lk
7042        set sep ", "
7043    }
7044    $ctext tag add wwrap "$pos linestart" "$pos lineend"
7045    $ctext conf -state disabled
7046    return [expr {[llength $tags] + $nutags}]
7047}
7048
7049# called when we have finished computing the nearby tags
7050proc dispneartags {delay} {
7051    global selectedline currentid showneartags tagphase
7052
7053    if {$selectedline eq {} || !$showneartags} return
7054    after cancel dispnexttag
7055    if {$delay} {
7056        after 200 dispnexttag
7057        set tagphase -1
7058    } else {
7059        after idle dispnexttag
7060        set tagphase 0
7061    }
7062}
7063
7064proc dispnexttag {} {
7065    global selectedline currentid showneartags tagphase ctext
7066
7067    if {$selectedline eq {} || !$showneartags} return
7068    switch -- $tagphase {
7069        0 {
7070            set dtags [desctags $currentid]
7071            if {$dtags ne {}} {
7072                appendrefs precedes $dtags idtags
7073            }
7074        }
7075        1 {
7076            set atags [anctags $currentid]
7077            if {$atags ne {}} {
7078                appendrefs follows $atags idtags
7079            }
7080        }
7081        2 {
7082            set dheads [descheads $currentid]
7083            if {$dheads ne {}} {
7084                if {[appendrefs branch $dheads idheads] > 1
7085                    && [$ctext get "branch -3c"] eq "h"} {
7086                    # turn "Branch" into "Branches"
7087                    $ctext conf -state normal
7088                    $ctext insert "branch -2c" "es"
7089                    $ctext conf -state disabled
7090                }
7091            }
7092        }
7093    }
7094    if {[incr tagphase] <= 2} {
7095        after idle dispnexttag
7096    }
7097}
7098
7099proc make_secsel {id} {
7100    global linehtag linentag linedtag canv canv2 canv3
7101
7102    if {![info exists linehtag($id)]} return
7103    $canv delete secsel
7104    set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
7105               -tags secsel -fill [$canv cget -selectbackground]]
7106    $canv lower $t
7107    $canv2 delete secsel
7108    set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
7109               -tags secsel -fill [$canv2 cget -selectbackground]]
7110    $canv2 lower $t
7111    $canv3 delete secsel
7112    set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
7113               -tags secsel -fill [$canv3 cget -selectbackground]]
7114    $canv3 lower $t
7115}
7116
7117proc make_idmark {id} {
7118    global linehtag canv fgcolor
7119
7120    if {![info exists linehtag($id)]} return
7121    $canv delete markid
7122    set t [eval $canv create rect [$canv bbox $linehtag($id)] \
7123               -tags markid -outline $fgcolor]
7124    $canv raise $t
7125}
7126
7127proc selectline {l isnew {desired_loc {}}} {
7128    global canv ctext commitinfo selectedline
7129    global canvy0 linespc parents children curview
7130    global currentid sha1entry
7131    global commentend idtags linknum
7132    global mergemax numcommits pending_select
7133    global cmitmode showneartags allcommits
7134    global targetrow targetid lastscrollrows
7135    global autoselect autosellen jump_to_here
7136    global vinlinediff
7137
7138    catch {unset pending_select}
7139    $canv delete hover
7140    normalline
7141    unsel_reflist
7142    stopfinding
7143    if {$l < 0 || $l >= $numcommits} return
7144    set id [commitonrow $l]
7145    set targetid $id
7146    set targetrow $l
7147    set selectedline $l
7148    set currentid $id
7149    if {$lastscrollrows < $numcommits} {
7150        setcanvscroll
7151    }
7152
7153    set y [expr {$canvy0 + $l * $linespc}]
7154    set ymax [lindex [$canv cget -scrollregion] 3]
7155    set ytop [expr {$y - $linespc - 1}]
7156    set ybot [expr {$y + $linespc + 1}]
7157    set wnow [$canv yview]
7158    set wtop [expr {[lindex $wnow 0] * $ymax}]
7159    set wbot [expr {[lindex $wnow 1] * $ymax}]
7160    set wh [expr {$wbot - $wtop}]
7161    set newtop $wtop
7162    if {$ytop < $wtop} {
7163        if {$ybot < $wtop} {
7164            set newtop [expr {$y - $wh / 2.0}]
7165        } else {
7166            set newtop $ytop
7167            if {$newtop > $wtop - $linespc} {
7168                set newtop [expr {$wtop - $linespc}]
7169            }
7170        }
7171    } elseif {$ybot > $wbot} {
7172        if {$ytop > $wbot} {
7173            set newtop [expr {$y - $wh / 2.0}]
7174        } else {
7175            set newtop [expr {$ybot - $wh}]
7176            if {$newtop < $wtop + $linespc} {
7177                set newtop [expr {$wtop + $linespc}]
7178            }
7179        }
7180    }
7181    if {$newtop != $wtop} {
7182        if {$newtop < 0} {
7183            set newtop 0
7184        }
7185        allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7186        drawvisible
7187    }
7188
7189    make_secsel $id
7190
7191    if {$isnew} {
7192        addtohistory [list selbyid $id 0] savecmitpos
7193    }
7194
7195    $sha1entry delete 0 end
7196    $sha1entry insert 0 $id
7197    if {$autoselect} {
7198        $sha1entry selection range 0 $autosellen
7199    }
7200    rhighlight_sel $id
7201
7202    $ctext conf -state normal
7203    clear_ctext
7204    set linknum 0
7205    if {![info exists commitinfo($id)]} {
7206        getcommit $id
7207    }
7208    set info $commitinfo($id)
7209    set date [formatdate [lindex $info 2]]
7210    $ctext insert end "[mc "Author"]: [lindex $info 1]  $date\n"
7211    set date [formatdate [lindex $info 4]]
7212    $ctext insert end "[mc "Committer"]: [lindex $info 3]  $date\n"
7213    if {[info exists idtags($id)]} {
7214        $ctext insert end [mc "Tags:"]
7215        foreach tag $idtags($id) {
7216            $ctext insert end " $tag"
7217        }
7218        $ctext insert end "\n"
7219    }
7220
7221    set headers {}
7222    set olds $parents($curview,$id)
7223    if {[llength $olds] > 1} {
7224        set np 0
7225        foreach p $olds {
7226            if {$np >= $mergemax} {
7227                set tag mmax
7228            } else {
7229                set tag m$np
7230            }
7231            $ctext insert end "[mc "Parent"]: " $tag
7232            appendwithlinks [commit_descriptor $p] {}
7233            incr np
7234        }
7235    } else {
7236        foreach p $olds {
7237            append headers "[mc "Parent"]: [commit_descriptor $p]"
7238        }
7239    }
7240
7241    foreach c $children($curview,$id) {
7242        append headers "[mc "Child"]:  [commit_descriptor $c]"
7243    }
7244
7245    # make anything that looks like a SHA1 ID be a clickable link
7246    appendwithlinks $headers {}
7247    if {$showneartags} {
7248        if {![info exists allcommits]} {
7249            getallcommits
7250        }
7251        $ctext insert end "[mc "Branch"]: "
7252        $ctext mark set branch "end -1c"
7253        $ctext mark gravity branch left
7254        $ctext insert end "\n[mc "Follows"]: "
7255        $ctext mark set follows "end -1c"
7256        $ctext mark gravity follows left
7257        $ctext insert end "\n[mc "Precedes"]: "
7258        $ctext mark set precedes "end -1c"
7259        $ctext mark gravity precedes left
7260        $ctext insert end "\n"
7261        dispneartags 1
7262    }
7263    $ctext insert end "\n"
7264    set comment [lindex $info 5]
7265    if {[string first "\r" $comment] >= 0} {
7266        set comment [string map {"\r" "\n    "} $comment]
7267    }
7268    appendwithlinks $comment {comment}
7269
7270    $ctext tag remove found 1.0 end
7271    $ctext conf -state disabled
7272    set commentend [$ctext index "end - 1c"]
7273
7274    set jump_to_here $desired_loc
7275    init_flist [mc "Comments"]
7276    if {$cmitmode eq "tree"} {
7277        gettree $id
7278    } elseif {$vinlinediff($curview) == 1} {
7279        showinlinediff $id
7280    } elseif {[llength $olds] <= 1} {
7281        startdiff $id
7282    } else {
7283        mergediff $id
7284    }
7285}
7286
7287proc selfirstline {} {
7288    unmarkmatches
7289    selectline 0 1
7290}
7291
7292proc sellastline {} {
7293    global numcommits
7294    unmarkmatches
7295    set l [expr {$numcommits - 1}]
7296    selectline $l 1
7297}
7298
7299proc selnextline {dir} {
7300    global selectedline
7301    focus .
7302    if {$selectedline eq {}} return
7303    set l [expr {$selectedline + $dir}]
7304    unmarkmatches
7305    selectline $l 1
7306}
7307
7308proc selnextpage {dir} {
7309    global canv linespc selectedline numcommits
7310
7311    set lpp [expr {([winfo height $canv] - 2) / $linespc}]
7312    if {$lpp < 1} {
7313        set lpp 1
7314    }
7315    allcanvs yview scroll [expr {$dir * $lpp}] units
7316    drawvisible
7317    if {$selectedline eq {}} return
7318    set l [expr {$selectedline + $dir * $lpp}]
7319    if {$l < 0} {
7320        set l 0
7321    } elseif {$l >= $numcommits} {
7322        set l [expr $numcommits - 1]
7323    }
7324    unmarkmatches
7325    selectline $l 1
7326}
7327
7328proc unselectline {} {
7329    global selectedline currentid
7330
7331    set selectedline {}
7332    catch {unset currentid}
7333    allcanvs delete secsel
7334    rhighlight_none
7335}
7336
7337proc reselectline {} {
7338    global selectedline
7339
7340    if {$selectedline ne {}} {
7341        selectline $selectedline 0
7342    }
7343}
7344
7345proc addtohistory {cmd {saveproc {}}} {
7346    global history historyindex curview
7347
7348    unset_posvars
7349    save_position
7350    set elt [list $curview $cmd $saveproc {}]
7351    if {$historyindex > 0
7352        && [lindex $history [expr {$historyindex - 1}]] == $elt} {
7353        return
7354    }
7355
7356    if {$historyindex < [llength $history]} {
7357        set history [lreplace $history $historyindex end $elt]
7358    } else {
7359        lappend history $elt
7360    }
7361    incr historyindex
7362    if {$historyindex > 1} {
7363        .tf.bar.leftbut conf -state normal
7364    } else {
7365        .tf.bar.leftbut conf -state disabled
7366    }
7367    .tf.bar.rightbut conf -state disabled
7368}
7369
7370# save the scrolling position of the diff display pane
7371proc save_position {} {
7372    global historyindex history
7373
7374    if {$historyindex < 1} return
7375    set hi [expr {$historyindex - 1}]
7376    set fn [lindex $history $hi 2]
7377    if {$fn ne {}} {
7378        lset history $hi 3 [eval $fn]
7379    }
7380}
7381
7382proc unset_posvars {} {
7383    global last_posvars
7384
7385    if {[info exists last_posvars]} {
7386        foreach {var val} $last_posvars {
7387            global $var
7388            catch {unset $var}
7389        }
7390        unset last_posvars
7391    }
7392}
7393
7394proc godo {elt} {
7395    global curview last_posvars
7396
7397    set view [lindex $elt 0]
7398    set cmd [lindex $elt 1]
7399    set pv [lindex $elt 3]
7400    if {$curview != $view} {
7401        showview $view
7402    }
7403    unset_posvars
7404    foreach {var val} $pv {
7405        global $var
7406        set $var $val
7407    }
7408    set last_posvars $pv
7409    eval $cmd
7410}
7411
7412proc goback {} {
7413    global history historyindex
7414    focus .
7415
7416    if {$historyindex > 1} {
7417        save_position
7418        incr historyindex -1
7419        godo [lindex $history [expr {$historyindex - 1}]]
7420        .tf.bar.rightbut conf -state normal
7421    }
7422    if {$historyindex <= 1} {
7423        .tf.bar.leftbut conf -state disabled
7424    }
7425}
7426
7427proc goforw {} {
7428    global history historyindex
7429    focus .
7430
7431    if {$historyindex < [llength $history]} {
7432        save_position
7433        set cmd [lindex $history $historyindex]
7434        incr historyindex
7435        godo $cmd
7436        .tf.bar.leftbut conf -state normal
7437    }
7438    if {$historyindex >= [llength $history]} {
7439        .tf.bar.rightbut conf -state disabled
7440    }
7441}
7442
7443proc gettree {id} {
7444    global treefilelist treeidlist diffids diffmergeid treepending
7445    global nullid nullid2
7446
7447    set diffids $id
7448    catch {unset diffmergeid}
7449    if {![info exists treefilelist($id)]} {
7450        if {![info exists treepending]} {
7451            if {$id eq $nullid} {
7452                set cmd [list | git ls-files]
7453            } elseif {$id eq $nullid2} {
7454                set cmd [list | git ls-files --stage -t]
7455            } else {
7456                set cmd [list | git ls-tree -r $id]
7457            }
7458            if {[catch {set gtf [open $cmd r]}]} {
7459                return
7460            }
7461            set treepending $id
7462            set treefilelist($id) {}
7463            set treeidlist($id) {}
7464            fconfigure $gtf -blocking 0 -encoding binary
7465            filerun $gtf [list gettreeline $gtf $id]
7466        }
7467    } else {
7468        setfilelist $id
7469    }
7470}
7471
7472proc gettreeline {gtf id} {
7473    global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
7474
7475    set nl 0
7476    while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
7477        if {$diffids eq $nullid} {
7478            set fname $line
7479        } else {
7480            set i [string first "\t" $line]
7481            if {$i < 0} continue
7482            set fname [string range $line [expr {$i+1}] end]
7483            set line [string range $line 0 [expr {$i-1}]]
7484            if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7485            set sha1 [lindex $line 2]
7486            lappend treeidlist($id) $sha1
7487        }
7488        if {[string index $fname 0] eq "\""} {
7489            set fname [lindex $fname 0]
7490        }
7491        set fname [encoding convertfrom $fname]
7492        lappend treefilelist($id) $fname
7493    }
7494    if {![eof $gtf]} {
7495        return [expr {$nl >= 1000? 2: 1}]
7496    }
7497    close $gtf
7498    unset treepending
7499    if {$cmitmode ne "tree"} {
7500        if {![info exists diffmergeid]} {
7501            gettreediffs $diffids
7502        }
7503    } elseif {$id ne $diffids} {
7504        gettree $diffids
7505    } else {
7506        setfilelist $id
7507    }
7508    return 0
7509}
7510
7511proc showfile {f} {
7512    global treefilelist treeidlist diffids nullid nullid2
7513    global ctext_file_names ctext_file_lines
7514    global ctext commentend
7515
7516    set i [lsearch -exact $treefilelist($diffids) $f]
7517    if {$i < 0} {
7518        puts "oops, $f not in list for id $diffids"
7519        return
7520    }
7521    if {$diffids eq $nullid} {
7522        if {[catch {set bf [open $f r]} err]} {
7523            puts "oops, can't read $f: $err"
7524            return
7525        }
7526    } else {
7527        set blob [lindex $treeidlist($diffids) $i]
7528        if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7529            puts "oops, error reading blob $blob: $err"
7530            return
7531        }
7532    }
7533    fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7534    filerun $bf [list getblobline $bf $diffids]
7535    $ctext config -state normal
7536    clear_ctext $commentend
7537    lappend ctext_file_names $f
7538    lappend ctext_file_lines [lindex [split $commentend "."] 0]
7539    $ctext insert end "\n"
7540    $ctext insert end "$f\n" filesep
7541    $ctext config -state disabled
7542    $ctext yview $commentend
7543    settabs 0
7544}
7545
7546proc getblobline {bf id} {
7547    global diffids cmitmode ctext
7548
7549    if {$id ne $diffids || $cmitmode ne "tree"} {
7550        catch {close $bf}
7551        return 0
7552    }
7553    $ctext config -state normal
7554    set nl 0
7555    while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7556        $ctext insert end "$line\n"
7557    }
7558    if {[eof $bf]} {
7559        global jump_to_here ctext_file_names commentend
7560
7561        # delete last newline
7562        $ctext delete "end - 2c" "end - 1c"
7563        close $bf
7564        if {$jump_to_here ne {} &&
7565            [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7566            set lnum [expr {[lindex $jump_to_here 1] +
7567                            [lindex [split $commentend .] 0]}]
7568            mark_ctext_line $lnum
7569        }
7570        $ctext config -state disabled
7571        return 0
7572    }
7573    $ctext config -state disabled
7574    return [expr {$nl >= 1000? 2: 1}]
7575}
7576
7577proc mark_ctext_line {lnum} {
7578    global ctext markbgcolor
7579
7580    $ctext tag delete omark
7581    $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7582    $ctext tag conf omark -background $markbgcolor
7583    $ctext see $lnum.0
7584}
7585
7586proc mergediff {id} {
7587    global diffmergeid
7588    global diffids treediffs
7589    global parents curview
7590
7591    set diffmergeid $id
7592    set diffids $id
7593    set treediffs($id) {}
7594    set np [llength $parents($curview,$id)]
7595    settabs $np
7596    getblobdiffs $id
7597}
7598
7599proc startdiff {ids} {
7600    global treediffs diffids treepending diffmergeid nullid nullid2
7601
7602    settabs 1
7603    set diffids $ids
7604    catch {unset diffmergeid}
7605    if {![info exists treediffs($ids)] ||
7606        [lsearch -exact $ids $nullid] >= 0 ||
7607        [lsearch -exact $ids $nullid2] >= 0} {
7608        if {![info exists treepending]} {
7609            gettreediffs $ids
7610        }
7611    } else {
7612        addtocflist $ids
7613    }
7614}
7615
7616proc showinlinediff {ids} {
7617    global commitinfo commitdata ctext
7618    global treediffs
7619
7620    set info $commitinfo($ids)
7621    set diff [lindex $info 7]
7622    set difflines [split $diff "\n"]
7623
7624    initblobdiffvars
7625    set treediff {}
7626
7627    set inhdr 0
7628    foreach line $difflines {
7629        if {![string compare -length 5 "diff " $line]} {
7630            set inhdr 1
7631        } elseif {$inhdr && ![string compare -length 4 "+++ " $line]} {
7632            # offset also accounts for the b/ prefix
7633            lappend treediff [string range $line 6 end]
7634            set inhdr 0
7635        }
7636    }
7637
7638    set treediffs($ids) $treediff
7639    add_flist $treediff
7640
7641    $ctext conf -state normal
7642    foreach line $difflines {
7643        parseblobdiffline $ids $line
7644    }
7645    maybe_scroll_ctext 1
7646    $ctext conf -state disabled
7647}
7648
7649# If the filename (name) is under any of the passed filter paths
7650# then return true to include the file in the listing.
7651proc path_filter {filter name} {
7652    set worktree [gitworktree]
7653    foreach p $filter {
7654        set fq_p [file normalize $p]
7655        set fq_n [file normalize [file join $worktree $name]]
7656        if {[string match [file normalize $fq_p]* $fq_n]} {
7657            return 1
7658        }
7659    }
7660    return 0
7661}
7662
7663proc addtocflist {ids} {
7664    global treediffs
7665
7666    add_flist $treediffs($ids)
7667    getblobdiffs $ids
7668}
7669
7670proc diffcmd {ids flags} {
7671    global log_showroot nullid nullid2
7672
7673    set i [lsearch -exact $ids $nullid]
7674    set j [lsearch -exact $ids $nullid2]
7675    if {$i >= 0} {
7676        if {[llength $ids] > 1 && $j < 0} {
7677            # comparing working directory with some specific revision
7678            set cmd [concat | git diff-index $flags]
7679            if {$i == 0} {
7680                lappend cmd -R [lindex $ids 1]
7681            } else {
7682                lappend cmd [lindex $ids 0]
7683            }
7684        } else {
7685            # comparing working directory with index
7686            set cmd [concat | git diff-files $flags]
7687            if {$j == 1} {
7688                lappend cmd -R
7689            }
7690        }
7691    } elseif {$j >= 0} {
7692        set cmd [concat | git diff-index --cached $flags]
7693        if {[llength $ids] > 1} {
7694            # comparing index with specific revision
7695            if {$j == 0} {
7696                lappend cmd -R [lindex $ids 1]
7697            } else {
7698                lappend cmd [lindex $ids 0]
7699            }
7700        } else {
7701            # comparing index with HEAD
7702            lappend cmd HEAD
7703        }
7704    } else {
7705        if {$log_showroot} {
7706            lappend flags --root
7707        }
7708        set cmd [concat | git diff-tree -r $flags $ids]
7709    }
7710    return $cmd
7711}
7712
7713proc gettreediffs {ids} {
7714    global treediff treepending limitdiffs vfilelimit curview
7715
7716    set cmd [diffcmd $ids {--no-commit-id}]
7717    if {$limitdiffs && $vfilelimit($curview) ne {}} {
7718            set cmd [concat $cmd -- $vfilelimit($curview)]
7719    }
7720    if {[catch {set gdtf [open $cmd r]}]} return
7721
7722    set treepending $ids
7723    set treediff {}
7724    fconfigure $gdtf -blocking 0 -encoding binary
7725    filerun $gdtf [list gettreediffline $gdtf $ids]
7726}
7727
7728proc gettreediffline {gdtf ids} {
7729    global treediff treediffs treepending diffids diffmergeid
7730    global cmitmode vfilelimit curview limitdiffs perfile_attrs
7731
7732    set nr 0
7733    set sublist {}
7734    set max 1000
7735    if {$perfile_attrs} {
7736        # cache_gitattr is slow, and even slower on win32 where we
7737        # have to invoke it for only about 30 paths at a time
7738        set max 500
7739        if {[tk windowingsystem] == "win32"} {
7740            set max 120
7741        }
7742    }
7743    while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7744        set i [string first "\t" $line]
7745        if {$i >= 0} {
7746            set file [string range $line [expr {$i+1}] end]
7747            if {[string index $file 0] eq "\""} {
7748                set file [lindex $file 0]
7749            }
7750            set file [encoding convertfrom $file]
7751            if {$file ne [lindex $treediff end]} {
7752                lappend treediff $file
7753                lappend sublist $file
7754            }
7755        }
7756    }
7757    if {$perfile_attrs} {
7758        cache_gitattr encoding $sublist
7759    }
7760    if {![eof $gdtf]} {
7761        return [expr {$nr >= $max? 2: 1}]
7762    }
7763    close $gdtf
7764    set treediffs($ids) $treediff
7765    unset treepending
7766    if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7767        gettree $diffids
7768    } elseif {$ids != $diffids} {
7769        if {![info exists diffmergeid]} {
7770            gettreediffs $diffids
7771        }
7772    } else {
7773        addtocflist $ids
7774    }
7775    return 0
7776}
7777
7778# empty string or positive integer
7779proc diffcontextvalidate {v} {
7780    return [regexp {^(|[1-9][0-9]*)$} $v]
7781}
7782
7783proc diffcontextchange {n1 n2 op} {
7784    global diffcontextstring diffcontext
7785
7786    if {[string is integer -strict $diffcontextstring]} {
7787        if {$diffcontextstring >= 0} {
7788            set diffcontext $diffcontextstring
7789            reselectline
7790        }
7791    }
7792}
7793
7794proc changeignorespace {} {
7795    reselectline
7796}
7797
7798proc changeworddiff {name ix op} {
7799    reselectline
7800}
7801
7802proc initblobdiffvars {} {
7803    global diffencoding targetline diffnparents
7804    global diffinhdr currdiffsubmod diffseehere
7805    set targetline {}
7806    set diffnparents 0
7807    set diffinhdr 0
7808    set diffencoding [get_path_encoding {}]
7809    set currdiffsubmod ""
7810    set diffseehere -1
7811}
7812
7813proc getblobdiffs {ids} {
7814    global blobdifffd diffids env
7815    global treediffs
7816    global diffcontext
7817    global ignorespace
7818    global worddiff
7819    global limitdiffs vfilelimit curview
7820    global git_version
7821
7822    set textconv {}
7823    if {[package vcompare $git_version "1.6.1"] >= 0} {
7824        set textconv "--textconv"
7825    }
7826    set submodule {}
7827    if {[package vcompare $git_version "1.6.6"] >= 0} {
7828        set submodule "--submodule"
7829    }
7830    set cmd [diffcmd $ids "-p $textconv $submodule  -C --cc --no-commit-id -U$diffcontext"]
7831    if {$ignorespace} {
7832        append cmd " -w"
7833    }
7834    if {$worddiff ne [mc "Line diff"]} {
7835        append cmd " --word-diff=porcelain"
7836    }
7837    if {$limitdiffs && $vfilelimit($curview) ne {}} {
7838        set cmd [concat $cmd -- $vfilelimit($curview)]
7839    }
7840    if {[catch {set bdf [open $cmd r]} err]} {
7841        error_popup [mc "Error getting diffs: %s" $err]
7842        return
7843    }
7844    fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
7845    set blobdifffd($ids) $bdf
7846    initblobdiffvars
7847    filerun $bdf [list getblobdiffline $bdf $diffids]
7848}
7849
7850proc savecmitpos {} {
7851    global ctext cmitmode
7852
7853    if {$cmitmode eq "tree"} {
7854        return {}
7855    }
7856    return [list target_scrollpos [$ctext index @0,0]]
7857}
7858
7859proc savectextpos {} {
7860    global ctext
7861
7862    return [list target_scrollpos [$ctext index @0,0]]
7863}
7864
7865proc maybe_scroll_ctext {ateof} {
7866    global ctext target_scrollpos
7867
7868    if {![info exists target_scrollpos]} return
7869    if {!$ateof} {
7870        set nlines [expr {[winfo height $ctext]
7871                          / [font metrics textfont -linespace]}]
7872        if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
7873    }
7874    $ctext yview $target_scrollpos
7875    unset target_scrollpos
7876}
7877
7878proc setinlist {var i val} {
7879    global $var
7880
7881    while {[llength [set $var]] < $i} {
7882        lappend $var {}
7883    }
7884    if {[llength [set $var]] == $i} {
7885        lappend $var $val
7886    } else {
7887        lset $var $i $val
7888    }
7889}
7890
7891proc makediffhdr {fname ids} {
7892    global ctext curdiffstart treediffs diffencoding
7893    global ctext_file_names jump_to_here targetline diffline
7894
7895    set fname [encoding convertfrom $fname]
7896    set diffencoding [get_path_encoding $fname]
7897    set i [lsearch -exact $treediffs($ids) $fname]
7898    if {$i >= 0} {
7899        setinlist difffilestart $i $curdiffstart
7900    }
7901    lset ctext_file_names end $fname
7902    set l [expr {(78 - [string length $fname]) / 2}]
7903    set pad [string range "----------------------------------------" 1 $l]
7904    $ctext insert $curdiffstart "$pad $fname $pad" filesep
7905    set targetline {}
7906    if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
7907        set targetline [lindex $jump_to_here 1]
7908    }
7909    set diffline 0
7910}
7911
7912proc blobdiffmaybeseehere {ateof} {
7913    global diffseehere
7914    if {$diffseehere >= 0} {
7915        mark_ctext_line [lindex [split $diffseehere .] 0]
7916    }
7917    maybe_scroll_ctext ateof
7918}
7919
7920proc getblobdiffline {bdf ids} {
7921    global diffids blobdifffd
7922    global ctext
7923
7924    set nr 0
7925    $ctext conf -state normal
7926    while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
7927        if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
7928            catch {close $bdf}
7929            return 0
7930        }
7931        parseblobdiffline $ids $line
7932    }
7933    $ctext conf -state disabled
7934    blobdiffmaybeseehere [eof $bdf]
7935    if {[eof $bdf]} {
7936        catch {close $bdf}
7937        return 0
7938    }
7939    return [expr {$nr >= 1000? 2: 1}]
7940}
7941
7942proc parseblobdiffline {ids line} {
7943    global ctext curdiffstart
7944    global diffnexthead diffnextnote difffilestart
7945    global ctext_file_names ctext_file_lines
7946    global diffinhdr treediffs mergemax diffnparents
7947    global diffencoding jump_to_here targetline diffline currdiffsubmod
7948    global worddiff diffseehere
7949
7950    if {![string compare -length 5 "diff " $line]} {
7951        if {![regexp {^diff (--cc|--git) } $line m type]} {
7952            set line [encoding convertfrom $line]
7953            $ctext insert end "$line\n" hunksep
7954            continue
7955        }
7956        # start of a new file
7957        set diffinhdr 1
7958        $ctext insert end "\n"
7959        set curdiffstart [$ctext index "end - 1c"]
7960        lappend ctext_file_names ""
7961        lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7962        $ctext insert end "\n" filesep
7963
7964        if {$type eq "--cc"} {
7965            # start of a new file in a merge diff
7966            set fname [string range $line 10 end]
7967            if {[lsearch -exact $treediffs($ids) $fname] < 0} {
7968                lappend treediffs($ids) $fname
7969                add_flist [list $fname]
7970            }
7971
7972        } else {
7973            set line [string range $line 11 end]
7974            # If the name hasn't changed the length will be odd,
7975            # the middle char will be a space, and the two bits either
7976            # side will be a/name and b/name, or "a/name" and "b/name".
7977            # If the name has changed we'll get "rename from" and
7978            # "rename to" or "copy from" and "copy to" lines following
7979            # this, and we'll use them to get the filenames.
7980            # This complexity is necessary because spaces in the
7981            # filename(s) don't get escaped.
7982            set l [string length $line]
7983            set i [expr {$l / 2}]
7984            if {!(($l & 1) && [string index $line $i] eq " " &&
7985                  [string range $line 2 [expr {$i - 1}]] eq \
7986                      [string range $line [expr {$i + 3}] end])} {
7987                return
7988            }
7989            # unescape if quoted and chop off the a/ from the front
7990            if {[string index $line 0] eq "\""} {
7991                set fname [string range [lindex $line 0] 2 end]
7992            } else {
7993                set fname [string range $line 2 [expr {$i - 1}]]
7994            }
7995        }
7996        makediffhdr $fname $ids
7997
7998    } elseif {![string compare -length 16 "* Unmerged path " $line]} {
7999        set fname [encoding convertfrom [string range $line 16 end]]
8000        $ctext insert end "\n"
8001        set curdiffstart [$ctext index "end - 1c"]
8002        lappend ctext_file_names $fname
8003        lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8004        $ctext insert end "$line\n" filesep
8005        set i [lsearch -exact $treediffs($ids) $fname]
8006        if {$i >= 0} {
8007            setinlist difffilestart $i $curdiffstart
8008        }
8009
8010    } elseif {![string compare -length 2 "@@" $line]} {
8011        regexp {^@@+} $line ats
8012        set line [encoding convertfrom $diffencoding $line]
8013        $ctext insert end "$line\n" hunksep
8014        if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
8015            set diffline $nl
8016        }
8017        set diffnparents [expr {[string length $ats] - 1}]
8018        set diffinhdr 0
8019
8020    } elseif {![string compare -length 10 "Submodule " $line]} {
8021        # start of a new submodule
8022        if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
8023            set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
8024        } else {
8025            set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
8026        }
8027        if {$currdiffsubmod != $fname} {
8028            $ctext insert end "\n";     # Add newline after commit message
8029        }
8030        set curdiffstart [$ctext index "end - 1c"]
8031        lappend ctext_file_names ""
8032        if {$currdiffsubmod != $fname} {
8033            lappend ctext_file_lines $fname
8034            makediffhdr $fname $ids
8035            set currdiffsubmod $fname
8036            $ctext insert end "\n$line\n" filesep
8037        } else {
8038            $ctext insert end "$line\n" filesep
8039        }
8040    } elseif {![string compare -length 3 "  >" $line]} {
8041        set $currdiffsubmod ""
8042        set line [encoding convertfrom $diffencoding $line]
8043        $ctext insert end "$line\n" dresult
8044    } elseif {![string compare -length 3 "  <" $line]} {
8045        set $currdiffsubmod ""
8046        set line [encoding convertfrom $diffencoding $line]
8047        $ctext insert end "$line\n" d0
8048    } elseif {$diffinhdr} {
8049        if {![string compare -length 12 "rename from " $line]} {
8050            set fname [string range $line [expr 6 + [string first " from " $line] ] end]
8051            if {[string index $fname 0] eq "\""} {
8052                set fname [lindex $fname 0]
8053            }
8054            set fname [encoding convertfrom $fname]
8055            set i [lsearch -exact $treediffs($ids) $fname]
8056            if {$i >= 0} {
8057                setinlist difffilestart $i $curdiffstart
8058            }
8059        } elseif {![string compare -length 10 $line "rename to "] ||
8060                  ![string compare -length 8 $line "copy to "]} {
8061            set fname [string range $line [expr 4 + [string first " to " $line] ] end]
8062            if {[string index $fname 0] eq "\""} {
8063                set fname [lindex $fname 0]
8064            }
8065            makediffhdr $fname $ids
8066        } elseif {[string compare -length 3 $line "---"] == 0} {
8067            # do nothing
8068            return
8069        } elseif {[string compare -length 3 $line "+++"] == 0} {
8070            set diffinhdr 0
8071            return
8072        }
8073        $ctext insert end "$line\n" filesep
8074
8075    } else {
8076        set line [string map {\x1A ^Z} \
8077                      [encoding convertfrom $diffencoding $line]]
8078        # parse the prefix - one ' ', '-' or '+' for each parent
8079        set prefix [string range $line 0 [expr {$diffnparents - 1}]]
8080        set tag [expr {$diffnparents > 1? "m": "d"}]
8081        set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
8082        set words_pre_markup ""
8083        set words_post_markup ""
8084        if {[string trim $prefix " -+"] eq {}} {
8085            # prefix only has " ", "-" and "+" in it: normal diff line
8086            set num [string first "-" $prefix]
8087            if {$dowords} {
8088                set line [string range $line 1 end]
8089            }
8090            if {$num >= 0} {
8091                # removed line, first parent with line is $num
8092                if {$num >= $mergemax} {
8093                    set num "max"
8094                }
8095                if {$dowords && $worddiff eq [mc "Markup words"]} {
8096                    $ctext insert end "\[-$line-\]" $tag$num
8097                } else {
8098                    $ctext insert end "$line" $tag$num
8099                }
8100                if {!$dowords} {
8101                    $ctext insert end "\n" $tag$num
8102                }
8103            } else {
8104                set tags {}
8105                if {[string first "+" $prefix] >= 0} {
8106                    # added line
8107                    lappend tags ${tag}result
8108                    if {$diffnparents > 1} {
8109                        set num [string first " " $prefix]
8110                        if {$num >= 0} {
8111                            if {$num >= $mergemax} {
8112                                set num "max"
8113                            }
8114                            lappend tags m$num
8115                        }
8116                    }
8117                    set words_pre_markup "{+"
8118                    set words_post_markup "+}"
8119                }
8120                if {$targetline ne {}} {
8121                    if {$diffline == $targetline} {
8122                        set diffseehere [$ctext index "end - 1 chars"]
8123                        set targetline {}
8124                    } else {
8125                        incr diffline
8126                    }
8127                }
8128                if {$dowords && $worddiff eq [mc "Markup words"]} {
8129                    $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
8130                } else {
8131                    $ctext insert end "$line" $tags
8132                }
8133                if {!$dowords} {
8134                    $ctext insert end "\n" $tags
8135                }
8136            }
8137        } elseif {$dowords && $prefix eq "~"} {
8138            $ctext insert end "\n" {}
8139        } else {
8140            # "\ No newline at end of file",
8141            # or something else we don't recognize
8142            $ctext insert end "$line\n" hunksep
8143        }
8144    }
8145}
8146
8147proc changediffdisp {} {
8148    global ctext diffelide
8149
8150    $ctext tag conf d0 -elide [lindex $diffelide 0]
8151    $ctext tag conf dresult -elide [lindex $diffelide 1]
8152}
8153
8154proc highlightfile {cline} {
8155    global cflist cflist_top
8156
8157    if {![info exists cflist_top]} return
8158
8159    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
8160    $cflist tag add highlight $cline.0 "$cline.0 lineend"
8161    $cflist see $cline.0
8162    set cflist_top $cline
8163}
8164
8165proc highlightfile_for_scrollpos {topidx} {
8166    global cmitmode difffilestart
8167
8168    if {$cmitmode eq "tree"} return
8169    if {![info exists difffilestart]} return
8170
8171    set top [lindex [split $topidx .] 0]
8172    if {$difffilestart eq {} || $top < [lindex $difffilestart 0]} {
8173        highlightfile 0
8174    } else {
8175        highlightfile [expr {[bsearch $difffilestart $top] + 2}]
8176    }
8177}
8178
8179proc prevfile {} {
8180    global difffilestart ctext cmitmode
8181
8182    if {$cmitmode eq "tree"} return
8183    set prev 0.0
8184    set here [$ctext index @0,0]
8185    foreach loc $difffilestart {
8186        if {[$ctext compare $loc >= $here]} {
8187            $ctext yview $prev
8188            return
8189        }
8190        set prev $loc
8191    }
8192    $ctext yview $prev
8193}
8194
8195proc nextfile {} {
8196    global difffilestart ctext cmitmode
8197
8198    if {$cmitmode eq "tree"} return
8199    set here [$ctext index @0,0]
8200    foreach loc $difffilestart {
8201        if {[$ctext compare $loc > $here]} {
8202            $ctext yview $loc
8203            return
8204        }
8205    }
8206}
8207
8208proc clear_ctext {{first 1.0}} {
8209    global ctext smarktop smarkbot
8210    global ctext_file_names ctext_file_lines
8211    global pendinglinks
8212
8213    set l [lindex [split $first .] 0]
8214    if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
8215        set smarktop $l
8216    }
8217    if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
8218        set smarkbot $l
8219    }
8220    $ctext delete $first end
8221    if {$first eq "1.0"} {
8222        catch {unset pendinglinks}
8223    }
8224    set ctext_file_names {}
8225    set ctext_file_lines {}
8226}
8227
8228proc settabs {{firstab {}}} {
8229    global firsttabstop tabstop ctext have_tk85
8230
8231    if {$firstab ne {} && $have_tk85} {
8232        set firsttabstop $firstab
8233    }
8234    set w [font measure textfont "0"]
8235    if {$firsttabstop != 0} {
8236        $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
8237                               [expr {($firsttabstop + 2 * $tabstop) * $w}]]
8238    } elseif {$have_tk85 || $tabstop != 8} {
8239        $ctext conf -tabs [expr {$tabstop * $w}]
8240    } else {
8241        $ctext conf -tabs {}
8242    }
8243}
8244
8245proc incrsearch {name ix op} {
8246    global ctext searchstring searchdirn
8247
8248    if {[catch {$ctext index anchor}]} {
8249        # no anchor set, use start of selection, or of visible area
8250        set sel [$ctext tag ranges sel]
8251        if {$sel ne {}} {
8252            $ctext mark set anchor [lindex $sel 0]
8253        } elseif {$searchdirn eq "-forwards"} {
8254            $ctext mark set anchor @0,0
8255        } else {
8256            $ctext mark set anchor @0,[winfo height $ctext]
8257        }
8258    }
8259    if {$searchstring ne {}} {
8260        set here [$ctext search -count mlen $searchdirn -- $searchstring anchor]
8261        if {$here ne {}} {
8262            $ctext see $here
8263            set mend "$here + $mlen c"
8264            $ctext tag remove sel 1.0 end
8265            $ctext tag add sel $here $mend
8266            suppress_highlighting_file_for_current_scrollpos
8267            highlightfile_for_scrollpos $here
8268        }
8269    }
8270    rehighlight_search_results
8271}
8272
8273proc dosearch {} {
8274    global sstring ctext searchstring searchdirn
8275
8276    focus $sstring
8277    $sstring icursor end
8278    set searchdirn -forwards
8279    if {$searchstring ne {}} {
8280        set sel [$ctext tag ranges sel]
8281        if {$sel ne {}} {
8282            set start "[lindex $sel 0] + 1c"
8283        } elseif {[catch {set start [$ctext index anchor]}]} {
8284            set start "@0,0"
8285        }
8286        set match [$ctext search -count mlen -- $searchstring $start]
8287        $ctext tag remove sel 1.0 end
8288        if {$match eq {}} {
8289            bell
8290            return
8291        }
8292        $ctext see $match
8293        suppress_highlighting_file_for_current_scrollpos
8294        highlightfile_for_scrollpos $match
8295        set mend "$match + $mlen c"
8296        $ctext tag add sel $match $mend
8297        $ctext mark unset anchor
8298        rehighlight_search_results
8299    }
8300}
8301
8302proc dosearchback {} {
8303    global sstring ctext searchstring searchdirn
8304
8305    focus $sstring
8306    $sstring icursor end
8307    set searchdirn -backwards
8308    if {$searchstring ne {}} {
8309        set sel [$ctext tag ranges sel]
8310        if {$sel ne {}} {
8311            set start [lindex $sel 0]
8312        } elseif {[catch {set start [$ctext index anchor]}]} {
8313            set start @0,[winfo height $ctext]
8314        }
8315        set match [$ctext search -backwards -count ml -- $searchstring $start]
8316        $ctext tag remove sel 1.0 end
8317        if {$match eq {}} {
8318            bell
8319            return
8320        }
8321        $ctext see $match
8322        suppress_highlighting_file_for_current_scrollpos
8323        highlightfile_for_scrollpos $match
8324        set mend "$match + $ml c"
8325        $ctext tag add sel $match $mend
8326        $ctext mark unset anchor
8327        rehighlight_search_results
8328    }
8329}
8330
8331proc rehighlight_search_results {} {
8332    global ctext searchstring
8333
8334    $ctext tag remove found 1.0 end
8335    $ctext tag remove currentsearchhit 1.0 end
8336
8337    if {$searchstring ne {}} {
8338        searchmarkvisible 1
8339    }
8340}
8341
8342proc searchmark {first last} {
8343    global ctext searchstring
8344
8345    set sel [$ctext tag ranges sel]
8346
8347    set mend $first.0
8348    while {1} {
8349        set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8350        if {$match eq {}} break
8351        set mend "$match + $mlen c"
8352        if {$sel ne {} && [$ctext compare $match == [lindex $sel 0]]} {
8353            $ctext tag add currentsearchhit $match $mend
8354        } else {
8355            $ctext tag add found $match $mend
8356        }
8357    }
8358}
8359
8360proc searchmarkvisible {doall} {
8361    global ctext smarktop smarkbot
8362
8363    set topline [lindex [split [$ctext index @0,0] .] 0]
8364    set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8365    if {$doall || $botline < $smarktop || $topline > $smarkbot} {
8366        # no overlap with previous
8367        searchmark $topline $botline
8368        set smarktop $topline
8369        set smarkbot $botline
8370    } else {
8371        if {$topline < $smarktop} {
8372            searchmark $topline [expr {$smarktop-1}]
8373            set smarktop $topline
8374        }
8375        if {$botline > $smarkbot} {
8376            searchmark [expr {$smarkbot+1}] $botline
8377            set smarkbot $botline
8378        }
8379    }
8380}
8381
8382proc suppress_highlighting_file_for_current_scrollpos {} {
8383    global ctext suppress_highlighting_file_for_this_scrollpos
8384
8385    set suppress_highlighting_file_for_this_scrollpos [$ctext index @0,0]
8386}
8387
8388proc scrolltext {f0 f1} {
8389    global searchstring cmitmode ctext
8390    global suppress_highlighting_file_for_this_scrollpos
8391
8392    set topidx [$ctext index @0,0]
8393    if {![info exists suppress_highlighting_file_for_this_scrollpos]
8394        || $topidx ne $suppress_highlighting_file_for_this_scrollpos} {
8395        highlightfile_for_scrollpos $topidx
8396    }
8397
8398    catch {unset suppress_highlighting_file_for_this_scrollpos}
8399
8400    .bleft.bottom.sb set $f0 $f1
8401    if {$searchstring ne {}} {
8402        searchmarkvisible 0
8403    }
8404}
8405
8406proc setcoords {} {
8407    global linespc charspc canvx0 canvy0
8408    global xspc1 xspc2 lthickness
8409
8410    set linespc [font metrics mainfont -linespace]
8411    set charspc [font measure mainfont "m"]
8412    set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8413    set canvx0 [expr {int(3 + 0.5 * $linespc)}]
8414    set lthickness [expr {int($linespc / 9) + 1}]
8415    set xspc1(0) $linespc
8416    set xspc2 $linespc
8417}
8418
8419proc redisplay {} {
8420    global canv
8421    global selectedline
8422
8423    set ymax [lindex [$canv cget -scrollregion] 3]
8424    if {$ymax eq {} || $ymax == 0} return
8425    set span [$canv yview]
8426    clear_display
8427    setcanvscroll
8428    allcanvs yview moveto [lindex $span 0]
8429    drawvisible
8430    if {$selectedline ne {}} {
8431        selectline $selectedline 0
8432        allcanvs yview moveto [lindex $span 0]
8433    }
8434}
8435
8436proc parsefont {f n} {
8437    global fontattr
8438
8439    set fontattr($f,family) [lindex $n 0]
8440    set s [lindex $n 1]
8441    if {$s eq {} || $s == 0} {
8442        set s 10
8443    } elseif {$s < 0} {
8444        set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
8445    }
8446    set fontattr($f,size) $s
8447    set fontattr($f,weight) normal
8448    set fontattr($f,slant) roman
8449    foreach style [lrange $n 2 end] {
8450        switch -- $style {
8451            "normal" -
8452            "bold"   {set fontattr($f,weight) $style}
8453            "roman" -
8454            "italic" {set fontattr($f,slant) $style}
8455        }
8456    }
8457}
8458
8459proc fontflags {f {isbold 0}} {
8460    global fontattr
8461
8462    return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8463                -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8464                -slant $fontattr($f,slant)]
8465}
8466
8467proc fontname {f} {
8468    global fontattr
8469
8470    set n [list $fontattr($f,family) $fontattr($f,size)]
8471    if {$fontattr($f,weight) eq "bold"} {
8472        lappend n "bold"
8473    }
8474    if {$fontattr($f,slant) eq "italic"} {
8475        lappend n "italic"
8476    }
8477    return $n
8478}
8479
8480proc incrfont {inc} {
8481    global mainfont textfont ctext canv cflist showrefstop
8482    global stopped entries fontattr
8483
8484    unmarkmatches
8485    set s $fontattr(mainfont,size)
8486    incr s $inc
8487    if {$s < 1} {
8488        set s 1
8489    }
8490    set fontattr(mainfont,size) $s
8491    font config mainfont -size $s
8492    font config mainfontbold -size $s
8493    set mainfont [fontname mainfont]
8494    set s $fontattr(textfont,size)
8495    incr s $inc
8496    if {$s < 1} {
8497        set s 1
8498    }
8499    set fontattr(textfont,size) $s
8500    font config textfont -size $s
8501    font config textfontbold -size $s
8502    set textfont [fontname textfont]
8503    setcoords
8504    settabs
8505    redisplay
8506}
8507
8508proc clearsha1 {} {
8509    global sha1entry sha1string
8510    if {[string length $sha1string] == 40} {
8511        $sha1entry delete 0 end
8512    }
8513}
8514
8515proc sha1change {n1 n2 op} {
8516    global sha1string currentid sha1but
8517    if {$sha1string == {}
8518        || ([info exists currentid] && $sha1string == $currentid)} {
8519        set state disabled
8520    } else {
8521        set state normal
8522    }
8523    if {[$sha1but cget -state] == $state} return
8524    if {$state == "normal"} {
8525        $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
8526    } else {
8527        $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
8528    }
8529}
8530
8531proc gotocommit {} {
8532    global sha1string tagids headids curview varcid
8533
8534    if {$sha1string == {}
8535        || ([info exists currentid] && $sha1string == $currentid)} return
8536    if {[info exists tagids($sha1string)]} {
8537        set id $tagids($sha1string)
8538    } elseif {[info exists headids($sha1string)]} {
8539        set id $headids($sha1string)
8540    } else {
8541        set id [string tolower $sha1string]
8542        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
8543            set matches [longid $id]
8544            if {$matches ne {}} {
8545                if {[llength $matches] > 1} {
8546                    error_popup [mc "Short SHA1 id %s is ambiguous" $id]
8547                    return
8548                }
8549                set id [lindex $matches 0]
8550            }
8551        } else {
8552            if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8553                error_popup [mc "Revision %s is not known" $sha1string]
8554                return
8555            }
8556        }
8557    }
8558    if {[commitinview $id $curview]} {
8559        selectline [rowofcommit $id] 1
8560        return
8561    }
8562    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
8563        set msg [mc "SHA1 id %s is not known" $sha1string]
8564    } else {
8565        set msg [mc "Revision %s is not in the current view" $sha1string]
8566    }
8567    error_popup $msg
8568}
8569
8570proc lineenter {x y id} {
8571    global hoverx hovery hoverid hovertimer
8572    global commitinfo canv
8573
8574    if {![info exists commitinfo($id)] && ![getcommit $id]} return
8575    set hoverx $x
8576    set hovery $y
8577    set hoverid $id
8578    if {[info exists hovertimer]} {
8579        after cancel $hovertimer
8580    }
8581    set hovertimer [after 500 linehover]
8582    $canv delete hover
8583}
8584
8585proc linemotion {x y id} {
8586    global hoverx hovery hoverid hovertimer
8587
8588    if {[info exists hoverid] && $id == $hoverid} {
8589        set hoverx $x
8590        set hovery $y
8591        if {[info exists hovertimer]} {
8592            after cancel $hovertimer
8593        }
8594        set hovertimer [after 500 linehover]
8595    }
8596}
8597
8598proc lineleave {id} {
8599    global hoverid hovertimer canv
8600
8601    if {[info exists hoverid] && $id == $hoverid} {
8602        $canv delete hover
8603        if {[info exists hovertimer]} {
8604            after cancel $hovertimer
8605            unset hovertimer
8606        }
8607        unset hoverid
8608    }
8609}
8610
8611proc linehover {} {
8612    global hoverx hovery hoverid hovertimer
8613    global canv linespc lthickness
8614    global linehoverbgcolor linehoverfgcolor linehoveroutlinecolor
8615
8616    global commitinfo
8617
8618    set text [lindex $commitinfo($hoverid) 0]
8619    set ymax [lindex [$canv cget -scrollregion] 3]
8620    if {$ymax == {}} return
8621    set yfrac [lindex [$canv yview] 0]
8622    set x [expr {$hoverx + 2 * $linespc}]
8623    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8624    set x0 [expr {$x - 2 * $lthickness}]
8625    set y0 [expr {$y - 2 * $lthickness}]
8626    set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
8627    set y1 [expr {$y + $linespc + 2 * $lthickness}]
8628    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8629               -fill $linehoverbgcolor -outline $linehoveroutlinecolor \
8630               -width 1 -tags hover]
8631    $canv raise $t
8632    set t [$canv create text $x $y -anchor nw -text $text -tags hover \
8633               -font mainfont -fill $linehoverfgcolor]
8634    $canv raise $t
8635}
8636
8637proc clickisonarrow {id y} {
8638    global lthickness
8639
8640    set ranges [rowranges $id]
8641    set thresh [expr {2 * $lthickness + 6}]
8642    set n [expr {[llength $ranges] - 1}]
8643    for {set i 1} {$i < $n} {incr i} {
8644        set row [lindex $ranges $i]
8645        if {abs([yc $row] - $y) < $thresh} {
8646            return $i
8647        }
8648    }
8649    return {}
8650}
8651
8652proc arrowjump {id n y} {
8653    global canv
8654
8655    # 1 <-> 2, 3 <-> 4, etc...
8656    set n [expr {(($n - 1) ^ 1) + 1}]
8657    set row [lindex [rowranges $id] $n]
8658    set yt [yc $row]
8659    set ymax [lindex [$canv cget -scrollregion] 3]
8660    if {$ymax eq {} || $ymax <= 0} return
8661    set view [$canv yview]
8662    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8663    set yfrac [expr {$yt / $ymax - $yspan / 2}]
8664    if {$yfrac < 0} {
8665        set yfrac 0
8666    }
8667    allcanvs yview moveto $yfrac
8668}
8669
8670proc lineclick {x y id isnew} {
8671    global ctext commitinfo children canv thickerline curview
8672
8673    if {![info exists commitinfo($id)] && ![getcommit $id]} return
8674    unmarkmatches
8675    unselectline
8676    normalline
8677    $canv delete hover
8678    # draw this line thicker than normal
8679    set thickerline $id
8680    drawlines $id
8681    if {$isnew} {
8682        set ymax [lindex [$canv cget -scrollregion] 3]
8683        if {$ymax eq {}} return
8684        set yfrac [lindex [$canv yview] 0]
8685        set y [expr {$y + $yfrac * $ymax}]
8686    }
8687    set dirn [clickisonarrow $id $y]
8688    if {$dirn ne {}} {
8689        arrowjump $id $dirn $y
8690        return
8691    }
8692
8693    if {$isnew} {
8694        addtohistory [list lineclick $x $y $id 0] savectextpos
8695    }
8696    # fill the details pane with info about this line
8697    $ctext conf -state normal
8698    clear_ctext
8699    settabs 0
8700    $ctext insert end "[mc "Parent"]:\t"
8701    $ctext insert end $id link0
8702    setlink $id link0
8703    set info $commitinfo($id)
8704    $ctext insert end "\n\t[lindex $info 0]\n"
8705    $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8706    set date [formatdate [lindex $info 2]]
8707    $ctext insert end "\t[mc "Date"]:\t$date\n"
8708    set kids $children($curview,$id)
8709    if {$kids ne {}} {
8710        $ctext insert end "\n[mc "Children"]:"
8711        set i 0
8712        foreach child $kids {
8713            incr i
8714            if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8715            set info $commitinfo($child)
8716            $ctext insert end "\n\t"
8717            $ctext insert end $child link$i
8718            setlink $child link$i
8719            $ctext insert end "\n\t[lindex $info 0]"
8720            $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8721            set date [formatdate [lindex $info 2]]
8722            $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8723        }
8724    }
8725    maybe_scroll_ctext 1
8726    $ctext conf -state disabled
8727    init_flist {}
8728}
8729
8730proc normalline {} {
8731    global thickerline
8732    if {[info exists thickerline]} {
8733        set id $thickerline
8734        unset thickerline
8735        drawlines $id
8736    }
8737}
8738
8739proc selbyid {id {isnew 1}} {
8740    global curview
8741    if {[commitinview $id $curview]} {
8742        selectline [rowofcommit $id] $isnew
8743    }
8744}
8745
8746proc mstime {} {
8747    global startmstime
8748    if {![info exists startmstime]} {
8749        set startmstime [clock clicks -milliseconds]
8750    }
8751    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8752}
8753
8754proc rowmenu {x y id} {
8755    global rowctxmenu selectedline rowmenuid curview
8756    global nullid nullid2 fakerowmenu mainhead markedid
8757
8758    stopfinding
8759    set rowmenuid $id
8760    if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8761        set state disabled
8762    } else {
8763        set state normal
8764    }
8765    if {[info exists markedid] && $markedid ne $id} {
8766        set mstate normal
8767    } else {
8768        set mstate disabled
8769    }
8770    if {$id ne $nullid && $id ne $nullid2} {
8771        set menu $rowctxmenu
8772        if {$mainhead ne {}} {
8773            $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead] -state normal
8774        } else {
8775            $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8776        }
8777        $menu entryconfigure 9 -state $mstate
8778        $menu entryconfigure 10 -state $mstate
8779        $menu entryconfigure 11 -state $mstate
8780    } else {
8781        set menu $fakerowmenu
8782    }
8783    $menu entryconfigure [mca "Diff this -> selected"] -state $state
8784    $menu entryconfigure [mca "Diff selected -> this"] -state $state
8785    $menu entryconfigure [mca "Make patch"] -state $state
8786    $menu entryconfigure [mca "Diff this -> marked commit"] -state $mstate
8787    $menu entryconfigure [mca "Diff marked commit -> this"] -state $mstate
8788    tk_popup $menu $x $y
8789}
8790
8791proc markhere {} {
8792    global rowmenuid markedid canv
8793
8794    set markedid $rowmenuid
8795    make_idmark $markedid
8796}
8797
8798proc gotomark {} {
8799    global markedid
8800
8801    if {[info exists markedid]} {
8802        selbyid $markedid
8803    }
8804}
8805
8806proc replace_by_kids {l r} {
8807    global curview children
8808
8809    set id [commitonrow $r]
8810    set l [lreplace $l 0 0]
8811    foreach kid $children($curview,$id) {
8812        lappend l [rowofcommit $kid]
8813    }
8814    return [lsort -integer -decreasing -unique $l]
8815}
8816
8817proc find_common_desc {} {
8818    global markedid rowmenuid curview children
8819
8820    if {![info exists markedid]} return
8821    if {![commitinview $markedid $curview] ||
8822        ![commitinview $rowmenuid $curview]} return
8823    #set t1 [clock clicks -milliseconds]
8824    set l1 [list [rowofcommit $markedid]]
8825    set l2 [list [rowofcommit $rowmenuid]]
8826    while 1 {
8827        set r1 [lindex $l1 0]
8828        set r2 [lindex $l2 0]
8829        if {$r1 eq {} || $r2 eq {}} break
8830        if {$r1 == $r2} {
8831            selectline $r1 1
8832            break
8833        }
8834        if {$r1 > $r2} {
8835            set l1 [replace_by_kids $l1 $r1]
8836        } else {
8837            set l2 [replace_by_kids $l2 $r2]
8838        }
8839    }
8840    #set t2 [clock clicks -milliseconds]
8841    #puts "took [expr {$t2-$t1}]ms"
8842}
8843
8844proc compare_commits {} {
8845    global markedid rowmenuid curview children
8846
8847    if {![info exists markedid]} return
8848    if {![commitinview $markedid $curview]} return
8849    addtohistory [list do_cmp_commits $markedid $rowmenuid]
8850    do_cmp_commits $markedid $rowmenuid
8851}
8852
8853proc getpatchid {id} {
8854    global patchids
8855
8856    if {![info exists patchids($id)]} {
8857        set cmd [diffcmd [list $id] {-p --root}]
8858        # trim off the initial "|"
8859        set cmd [lrange $cmd 1 end]
8860        if {[catch {
8861            set x [eval exec $cmd | git patch-id]
8862            set patchids($id) [lindex $x 0]
8863        }]} {
8864            set patchids($id) "error"
8865        }
8866    }
8867    return $patchids($id)
8868}
8869
8870proc do_cmp_commits {a b} {
8871    global ctext curview parents children patchids commitinfo
8872
8873    $ctext conf -state normal
8874    clear_ctext
8875    init_flist {}
8876    for {set i 0} {$i < 100} {incr i} {
8877        set skipa 0
8878        set skipb 0
8879        if {[llength $parents($curview,$a)] > 1} {
8880            appendshortlink $a [mc "Skipping merge commit "] "\n"
8881            set skipa 1
8882        } else {
8883            set patcha [getpatchid $a]
8884        }
8885        if {[llength $parents($curview,$b)] > 1} {
8886            appendshortlink $b [mc "Skipping merge commit "] "\n"
8887            set skipb 1
8888        } else {
8889            set patchb [getpatchid $b]
8890        }
8891        if {!$skipa && !$skipb} {
8892            set heada [lindex $commitinfo($a) 0]
8893            set headb [lindex $commitinfo($b) 0]
8894            if {$patcha eq "error"} {
8895                appendshortlink $a [mc "Error getting patch ID for "] \
8896                    [mc " - stopping\n"]
8897                break
8898            }
8899            if {$patchb eq "error"} {
8900                appendshortlink $b [mc "Error getting patch ID for "] \
8901                    [mc " - stopping\n"]
8902                break
8903            }
8904            if {$patcha eq $patchb} {
8905                if {$heada eq $headb} {
8906                    appendshortlink $a [mc "Commit "]
8907                    appendshortlink $b " == " "  $heada\n"
8908                } else {
8909                    appendshortlink $a [mc "Commit "] "  $heada\n"
8910                    appendshortlink $b [mc " is the same patch as\n       "] \
8911                        "  $headb\n"
8912                }
8913                set skipa 1
8914                set skipb 1
8915            } else {
8916                $ctext insert end "\n"
8917                appendshortlink $a [mc "Commit "] "  $heada\n"
8918                appendshortlink $b [mc " differs from\n       "] \
8919                    "  $headb\n"
8920                $ctext insert end [mc "Diff of commits:\n\n"]
8921                $ctext conf -state disabled
8922                update
8923                diffcommits $a $b
8924                return
8925            }
8926        }
8927        if {$skipa} {
8928            set kids [real_children $curview,$a]
8929            if {[llength $kids] != 1} {
8930                $ctext insert end "\n"
8931                appendshortlink $a [mc "Commit "] \
8932                    [mc " has %s children - stopping\n" [llength $kids]]
8933                break
8934            }
8935            set a [lindex $kids 0]
8936        }
8937        if {$skipb} {
8938            set kids [real_children $curview,$b]
8939            if {[llength $kids] != 1} {
8940                appendshortlink $b [mc "Commit "] \
8941                    [mc " has %s children - stopping\n" [llength $kids]]
8942                break
8943            }
8944            set b [lindex $kids 0]
8945        }
8946    }
8947    $ctext conf -state disabled
8948}
8949
8950proc diffcommits {a b} {
8951    global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
8952
8953    set tmpdir [gitknewtmpdir]
8954    set fna [file join $tmpdir "commit-[string range $a 0 7]"]
8955    set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
8956    if {[catch {
8957        exec git diff-tree -p --pretty $a >$fna
8958        exec git diff-tree -p --pretty $b >$fnb
8959    } err]} {
8960        error_popup [mc "Error writing commit to file: %s" $err]
8961        return
8962    }
8963    if {[catch {
8964        set fd [open "| diff -U$diffcontext $fna $fnb" r]
8965    } err]} {
8966        error_popup [mc "Error diffing commits: %s" $err]
8967        return
8968    }
8969    set diffids [list commits $a $b]
8970    set blobdifffd($diffids) $fd
8971    set diffinhdr 0
8972    set currdiffsubmod ""
8973    filerun $fd [list getblobdiffline $fd $diffids]
8974}
8975
8976proc diffvssel {dirn} {
8977    global rowmenuid selectedline
8978
8979    if {$selectedline eq {}} return
8980    if {$dirn} {
8981        set oldid [commitonrow $selectedline]
8982        set newid $rowmenuid
8983    } else {
8984        set oldid $rowmenuid
8985        set newid [commitonrow $selectedline]
8986    }
8987    addtohistory [list doseldiff $oldid $newid] savectextpos
8988    doseldiff $oldid $newid
8989}
8990
8991proc diffvsmark {dirn} {
8992    global rowmenuid markedid
8993
8994    if {![info exists markedid]} return
8995    if {$dirn} {
8996        set oldid $markedid
8997        set newid $rowmenuid
8998    } else {
8999        set oldid $rowmenuid
9000        set newid $markedid
9001    }
9002    addtohistory [list doseldiff $oldid $newid] savectextpos
9003    doseldiff $oldid $newid
9004}
9005
9006proc doseldiff {oldid newid} {
9007    global ctext
9008    global commitinfo
9009
9010    $ctext conf -state normal
9011    clear_ctext
9012    init_flist [mc "Top"]
9013    $ctext insert end "[mc "From"] "
9014    $ctext insert end $oldid link0
9015    setlink $oldid link0
9016    $ctext insert end "\n     "
9017    $ctext insert end [lindex $commitinfo($oldid) 0]
9018    $ctext insert end "\n\n[mc "To"]   "
9019    $ctext insert end $newid link1
9020    setlink $newid link1
9021    $ctext insert end "\n     "
9022    $ctext insert end [lindex $commitinfo($newid) 0]
9023    $ctext insert end "\n"
9024    $ctext conf -state disabled
9025    $ctext tag remove found 1.0 end
9026    startdiff [list $oldid $newid]
9027}
9028
9029proc mkpatch {} {
9030    global rowmenuid currentid commitinfo patchtop patchnum NS
9031
9032    if {![info exists currentid]} return
9033    set oldid $currentid
9034    set oldhead [lindex $commitinfo($oldid) 0]
9035    set newid $rowmenuid
9036    set newhead [lindex $commitinfo($newid) 0]
9037    set top .patch
9038    set patchtop $top
9039    catch {destroy $top}
9040    ttk_toplevel $top
9041    make_transient $top .
9042    ${NS}::label $top.title -text [mc "Generate patch"]
9043    grid $top.title - -pady 10
9044    ${NS}::label $top.from -text [mc "From:"]
9045    ${NS}::entry $top.fromsha1 -width 40
9046    $top.fromsha1 insert 0 $oldid
9047    $top.fromsha1 conf -state readonly
9048    grid $top.from $top.fromsha1 -sticky w
9049    ${NS}::entry $top.fromhead -width 60
9050    $top.fromhead insert 0 $oldhead
9051    $top.fromhead conf -state readonly
9052    grid x $top.fromhead -sticky w
9053    ${NS}::label $top.to -text [mc "To:"]
9054    ${NS}::entry $top.tosha1 -width 40
9055    $top.tosha1 insert 0 $newid
9056    $top.tosha1 conf -state readonly
9057    grid $top.to $top.tosha1 -sticky w
9058    ${NS}::entry $top.tohead -width 60
9059    $top.tohead insert 0 $newhead
9060    $top.tohead conf -state readonly
9061    grid x $top.tohead -sticky w
9062    ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
9063    grid $top.rev x -pady 10 -padx 5
9064    ${NS}::label $top.flab -text [mc "Output file:"]
9065    ${NS}::entry $top.fname -width 60
9066    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
9067    incr patchnum
9068    grid $top.flab $top.fname -sticky w
9069    ${NS}::frame $top.buts
9070    ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
9071    ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
9072    bind $top <Key-Return> mkpatchgo
9073    bind $top <Key-Escape> mkpatchcan
9074    grid $top.buts.gen $top.buts.can
9075    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9076    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9077    grid $top.buts - -pady 10 -sticky ew
9078    focus $top.fname
9079}
9080
9081proc mkpatchrev {} {
9082    global patchtop
9083
9084    set oldid [$patchtop.fromsha1 get]
9085    set oldhead [$patchtop.fromhead get]
9086    set newid [$patchtop.tosha1 get]
9087    set newhead [$patchtop.tohead get]
9088    foreach e [list fromsha1 fromhead tosha1 tohead] \
9089            v [list $newid $newhead $oldid $oldhead] {
9090        $patchtop.$e conf -state normal
9091        $patchtop.$e delete 0 end
9092        $patchtop.$e insert 0 $v
9093        $patchtop.$e conf -state readonly
9094    }
9095}
9096
9097proc mkpatchgo {} {
9098    global patchtop nullid nullid2
9099
9100    set oldid [$patchtop.fromsha1 get]
9101    set newid [$patchtop.tosha1 get]
9102    set fname [$patchtop.fname get]
9103    set cmd [diffcmd [list $oldid $newid] -p]
9104    # trim off the initial "|"
9105    set cmd [lrange $cmd 1 end]
9106    lappend cmd >$fname &
9107    if {[catch {eval exec $cmd} err]} {
9108        error_popup "[mc "Error creating patch:"] $err" $patchtop
9109    }
9110    catch {destroy $patchtop}
9111    unset patchtop
9112}
9113
9114proc mkpatchcan {} {
9115    global patchtop
9116
9117    catch {destroy $patchtop}
9118    unset patchtop
9119}
9120
9121proc mktag {} {
9122    global rowmenuid mktagtop commitinfo NS
9123
9124    set top .maketag
9125    set mktagtop $top
9126    catch {destroy $top}
9127    ttk_toplevel $top
9128    make_transient $top .
9129    ${NS}::label $top.title -text [mc "Create tag"]
9130    grid $top.title - -pady 10
9131    ${NS}::label $top.id -text [mc "ID:"]
9132    ${NS}::entry $top.sha1 -width 40
9133    $top.sha1 insert 0 $rowmenuid
9134    $top.sha1 conf -state readonly
9135    grid $top.id $top.sha1 -sticky w
9136    ${NS}::entry $top.head -width 60
9137    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9138    $top.head conf -state readonly
9139    grid x $top.head -sticky w
9140    ${NS}::label $top.tlab -text [mc "Tag name:"]
9141    ${NS}::entry $top.tag -width 60
9142    grid $top.tlab $top.tag -sticky w
9143    ${NS}::label $top.op -text [mc "Tag message is optional"]
9144    grid $top.op -columnspan 2 -sticky we
9145    ${NS}::label $top.mlab -text [mc "Tag message:"]
9146    ${NS}::entry $top.msg -width 60
9147    grid $top.mlab $top.msg -sticky w
9148    ${NS}::frame $top.buts
9149    ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
9150    ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
9151    bind $top <Key-Return> mktaggo
9152    bind $top <Key-Escape> mktagcan
9153    grid $top.buts.gen $top.buts.can
9154    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9155    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9156    grid $top.buts - -pady 10 -sticky ew
9157    focus $top.tag
9158}
9159
9160proc domktag {} {
9161    global mktagtop env tagids idtags
9162
9163    set id [$mktagtop.sha1 get]
9164    set tag [$mktagtop.tag get]
9165    set msg [$mktagtop.msg get]
9166    if {$tag == {}} {
9167        error_popup [mc "No tag name specified"] $mktagtop
9168        return 0
9169    }
9170    if {[info exists tagids($tag)]} {
9171        error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
9172        return 0
9173    }
9174    if {[catch {
9175        if {$msg != {}} {
9176            exec git tag -a -m $msg $tag $id
9177        } else {
9178            exec git tag $tag $id
9179        }
9180    } err]} {
9181        error_popup "[mc "Error creating tag:"] $err" $mktagtop
9182        return 0
9183    }
9184
9185    set tagids($tag) $id
9186    lappend idtags($id) $tag
9187    redrawtags $id
9188    addedtag $id
9189    dispneartags 0
9190    run refill_reflist
9191    return 1
9192}
9193
9194proc redrawtags {id} {
9195    global canv linehtag idpos currentid curview cmitlisted markedid
9196    global canvxmax iddrawn circleitem mainheadid circlecolors
9197    global mainheadcirclecolor
9198
9199    if {![commitinview $id $curview]} return
9200    if {![info exists iddrawn($id)]} return
9201    set row [rowofcommit $id]
9202    if {$id eq $mainheadid} {
9203        set ofill $mainheadcirclecolor
9204    } else {
9205        set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
9206    }
9207    $canv itemconf $circleitem($row) -fill $ofill
9208    $canv delete tag.$id
9209    set xt [eval drawtags $id $idpos($id)]
9210    $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
9211    set text [$canv itemcget $linehtag($id) -text]
9212    set font [$canv itemcget $linehtag($id) -font]
9213    set xr [expr {$xt + [font measure $font $text]}]
9214    if {$xr > $canvxmax} {
9215        set canvxmax $xr
9216        setcanvscroll
9217    }
9218    if {[info exists currentid] && $currentid == $id} {
9219        make_secsel $id
9220    }
9221    if {[info exists markedid] && $markedid eq $id} {
9222        make_idmark $id
9223    }
9224}
9225
9226proc mktagcan {} {
9227    global mktagtop
9228
9229    catch {destroy $mktagtop}
9230    unset mktagtop
9231}
9232
9233proc mktaggo {} {
9234    if {![domktag]} return
9235    mktagcan
9236}
9237
9238proc writecommit {} {
9239    global rowmenuid wrcomtop commitinfo wrcomcmd NS
9240
9241    set top .writecommit
9242    set wrcomtop $top
9243    catch {destroy $top}
9244    ttk_toplevel $top
9245    make_transient $top .
9246    ${NS}::label $top.title -text [mc "Write commit to file"]
9247    grid $top.title - -pady 10
9248    ${NS}::label $top.id -text [mc "ID:"]
9249    ${NS}::entry $top.sha1 -width 40
9250    $top.sha1 insert 0 $rowmenuid
9251    $top.sha1 conf -state readonly
9252    grid $top.id $top.sha1 -sticky w
9253    ${NS}::entry $top.head -width 60
9254    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9255    $top.head conf -state readonly
9256    grid x $top.head -sticky w
9257    ${NS}::label $top.clab -text [mc "Command:"]
9258    ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
9259    grid $top.clab $top.cmd -sticky w -pady 10
9260    ${NS}::label $top.flab -text [mc "Output file:"]
9261    ${NS}::entry $top.fname -width 60
9262    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
9263    grid $top.flab $top.fname -sticky w
9264    ${NS}::frame $top.buts
9265    ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
9266    ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
9267    bind $top <Key-Return> wrcomgo
9268    bind $top <Key-Escape> wrcomcan
9269    grid $top.buts.gen $top.buts.can
9270    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9271    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9272    grid $top.buts - -pady 10 -sticky ew
9273    focus $top.fname
9274}
9275
9276proc wrcomgo {} {
9277    global wrcomtop
9278
9279    set id [$wrcomtop.sha1 get]
9280    set cmd "echo $id | [$wrcomtop.cmd get]"
9281    set fname [$wrcomtop.fname get]
9282    if {[catch {exec sh -c $cmd >$fname &} err]} {
9283        error_popup "[mc "Error writing commit:"] $err" $wrcomtop
9284    }
9285    catch {destroy $wrcomtop}
9286    unset wrcomtop
9287}
9288
9289proc wrcomcan {} {
9290    global wrcomtop
9291
9292    catch {destroy $wrcomtop}
9293    unset wrcomtop
9294}
9295
9296proc mkbranch {} {
9297    global rowmenuid mkbrtop NS
9298
9299    set top .makebranch
9300    catch {destroy $top}
9301    ttk_toplevel $top
9302    make_transient $top .
9303    ${NS}::label $top.title -text [mc "Create new branch"]
9304    grid $top.title - -pady 10
9305    ${NS}::label $top.id -text [mc "ID:"]
9306    ${NS}::entry $top.sha1 -width 40
9307    $top.sha1 insert 0 $rowmenuid
9308    $top.sha1 conf -state readonly
9309    grid $top.id $top.sha1 -sticky w
9310    ${NS}::label $top.nlab -text [mc "Name:"]
9311    ${NS}::entry $top.name -width 40
9312    grid $top.nlab $top.name -sticky w
9313    ${NS}::frame $top.buts
9314    ${NS}::button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
9315    ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
9316    bind $top <Key-Return> [list mkbrgo $top]
9317    bind $top <Key-Escape> "catch {destroy $top}"
9318    grid $top.buts.go $top.buts.can
9319    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9320    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9321    grid $top.buts - -pady 10 -sticky ew
9322    focus $top.name
9323}
9324
9325proc mkbrgo {top} {
9326    global headids idheads
9327
9328    set name [$top.name get]
9329    set id [$top.sha1 get]
9330    set cmdargs {}
9331    set old_id {}
9332    if {$name eq {}} {
9333        error_popup [mc "Please specify a name for the new branch"] $top
9334        return
9335    }
9336    if {[info exists headids($name)]} {
9337        if {![confirm_popup [mc \
9338                "Branch '%s' already exists. Overwrite?" $name] $top]} {
9339            return
9340        }
9341        set old_id $headids($name)
9342        lappend cmdargs -f
9343    }
9344    catch {destroy $top}
9345    lappend cmdargs $name $id
9346    nowbusy newbranch
9347    update
9348    if {[catch {
9349        eval exec git branch $cmdargs
9350    } err]} {
9351        notbusy newbranch
9352        error_popup $err
9353    } else {
9354        notbusy newbranch
9355        if {$old_id ne {}} {
9356            movehead $id $name
9357            movedhead $id $name
9358            redrawtags $old_id
9359            redrawtags $id
9360        } else {
9361            set headids($name) $id
9362            lappend idheads($id) $name
9363            addedhead $id $name
9364            redrawtags $id
9365        }
9366        dispneartags 0
9367        run refill_reflist
9368    }
9369}
9370
9371proc exec_citool {tool_args {baseid {}}} {
9372    global commitinfo env
9373
9374    set save_env [array get env GIT_AUTHOR_*]
9375
9376    if {$baseid ne {}} {
9377        if {![info exists commitinfo($baseid)]} {
9378            getcommit $baseid
9379        }
9380        set author [lindex $commitinfo($baseid) 1]
9381        set date [lindex $commitinfo($baseid) 2]
9382        if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9383                    $author author name email]
9384            && $date ne {}} {
9385            set env(GIT_AUTHOR_NAME) $name
9386            set env(GIT_AUTHOR_EMAIL) $email
9387            set env(GIT_AUTHOR_DATE) $date
9388        }
9389    }
9390
9391    eval exec git citool $tool_args &
9392
9393    array unset env GIT_AUTHOR_*
9394    array set env $save_env
9395}
9396
9397proc cherrypick {} {
9398    global rowmenuid curview
9399    global mainhead mainheadid
9400    global gitdir
9401
9402    set oldhead [exec git rev-parse HEAD]
9403    set dheads [descheads $rowmenuid]
9404    if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
9405        set ok [confirm_popup [mc "Commit %s is already\
9406                included in branch %s -- really re-apply it?" \
9407                                   [string range $rowmenuid 0 7] $mainhead]]
9408        if {!$ok} return
9409    }
9410    nowbusy cherrypick [mc "Cherry-picking"]
9411    update
9412    # Unfortunately git-cherry-pick writes stuff to stderr even when
9413    # no error occurs, and exec takes that as an indication of error...
9414    if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9415        notbusy cherrypick
9416        if {[regexp -line \
9417                 {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9418                 $err msg fname]} {
9419            error_popup [mc "Cherry-pick failed because of local changes\
9420                        to file '%s'.\nPlease commit, reset or stash\
9421                        your changes and try again." $fname]
9422        } elseif {[regexp -line \
9423                       {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
9424                       $err]} {
9425            if {[confirm_popup [mc "Cherry-pick failed because of merge\
9426                        conflict.\nDo you wish to run git citool to\
9427                        resolve it?"]]} {
9428                # Force citool to read MERGE_MSG
9429                file delete [file join $gitdir "GITGUI_MSG"]
9430                exec_citool {} $rowmenuid
9431            }
9432        } else {
9433            error_popup $err
9434        }
9435        run updatecommits
9436        return
9437    }
9438    set newhead [exec git rev-parse HEAD]
9439    if {$newhead eq $oldhead} {
9440        notbusy cherrypick
9441        error_popup [mc "No changes committed"]
9442        return
9443    }
9444    addnewchild $newhead $oldhead
9445    if {[commitinview $oldhead $curview]} {
9446        # XXX this isn't right if we have a path limit...
9447        insertrow $newhead $oldhead $curview
9448        if {$mainhead ne {}} {
9449            movehead $newhead $mainhead
9450            movedhead $newhead $mainhead
9451        }
9452        set mainheadid $newhead
9453        redrawtags $oldhead
9454        redrawtags $newhead
9455        selbyid $newhead
9456    }
9457    notbusy cherrypick
9458}
9459
9460proc revert {} {
9461    global rowmenuid curview
9462    global mainhead mainheadid
9463    global gitdir
9464
9465    set oldhead [exec git rev-parse HEAD]
9466    set dheads [descheads $rowmenuid]
9467    if { $dheads eq {} || [lsearch -exact $dheads $oldhead] == -1 } {
9468       set ok [confirm_popup [mc "Commit %s is not\
9469           included in branch %s -- really revert it?" \
9470                      [string range $rowmenuid 0 7] $mainhead]]
9471       if {!$ok} return
9472    }
9473    nowbusy revert [mc "Reverting"]
9474    update
9475
9476    if [catch {exec git revert --no-edit $rowmenuid} err] {
9477        notbusy revert
9478        if [regexp {files would be overwritten by merge:(\n(( |\t)+[^\n]+\n)+)}\
9479                $err match files] {
9480            regsub {\n( |\t)+} $files "\n" files
9481            error_popup [mc "Revert failed because of local changes to\
9482                the following files:%s Please commit, reset or stash \
9483                your changes and try again." $files]
9484        } elseif [regexp {error: could not revert} $err] {
9485            if [confirm_popup [mc "Revert failed because of merge conflict.\n\
9486                Do you wish to run git citool to resolve it?"]] {
9487                # Force citool to read MERGE_MSG
9488                file delete [file join $gitdir "GITGUI_MSG"]
9489                exec_citool {} $rowmenuid
9490            }
9491        } else { error_popup $err }
9492        run updatecommits
9493        return
9494    }
9495
9496    set newhead [exec git rev-parse HEAD]
9497    if { $newhead eq $oldhead } {
9498        notbusy revert
9499        error_popup [mc "No changes committed"]
9500        return
9501    }
9502
9503    addnewchild $newhead $oldhead
9504
9505    if [commitinview $oldhead $curview] {
9506        # XXX this isn't right if we have a path limit...
9507        insertrow $newhead $oldhead $curview
9508        if {$mainhead ne {}} {
9509            movehead $newhead $mainhead
9510            movedhead $newhead $mainhead
9511        }
9512        set mainheadid $newhead
9513        redrawtags $oldhead
9514        redrawtags $newhead
9515        selbyid $newhead
9516    }
9517
9518    notbusy revert
9519}
9520
9521proc resethead {} {
9522    global mainhead rowmenuid confirm_ok resettype NS
9523
9524    set confirm_ok 0
9525    set w ".confirmreset"
9526    ttk_toplevel $w
9527    make_transient $w .
9528    wm title $w [mc "Confirm reset"]
9529    ${NS}::label $w.m -text \
9530        [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
9531    pack $w.m -side top -fill x -padx 20 -pady 20
9532    ${NS}::labelframe $w.f -text [mc "Reset type:"]
9533    set resettype mixed
9534    ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
9535        -text [mc "Soft: Leave working tree and index untouched"]
9536    grid $w.f.soft -sticky w
9537    ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
9538        -text [mc "Mixed: Leave working tree untouched, reset index"]
9539    grid $w.f.mixed -sticky w
9540    ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
9541        -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
9542    grid $w.f.hard -sticky w
9543    pack $w.f -side top -fill x -padx 4
9544    ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
9545    pack $w.ok -side left -fill x -padx 20 -pady 20
9546    ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
9547    bind $w <Key-Escape> [list destroy $w]
9548    pack $w.cancel -side right -fill x -padx 20 -pady 20
9549    bind $w <Visibility> "grab $w; focus $w"
9550    tkwait window $w
9551    if {!$confirm_ok} return
9552    if {[catch {set fd [open \
9553            [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
9554        error_popup $err
9555    } else {
9556        dohidelocalchanges
9557        filerun $fd [list readresetstat $fd]
9558        nowbusy reset [mc "Resetting"]
9559        selbyid $rowmenuid
9560    }
9561}
9562
9563proc readresetstat {fd} {
9564    global mainhead mainheadid showlocalchanges rprogcoord
9565
9566    if {[gets $fd line] >= 0} {
9567        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9568            set rprogcoord [expr {1.0 * $m / $n}]
9569            adjustprogress
9570        }
9571        return 1
9572    }
9573    set rprogcoord 0
9574    adjustprogress
9575    notbusy reset
9576    if {[catch {close $fd} err]} {
9577        error_popup $err
9578    }
9579    set oldhead $mainheadid
9580    set newhead [exec git rev-parse HEAD]
9581    if {$newhead ne $oldhead} {
9582        movehead $newhead $mainhead
9583        movedhead $newhead $mainhead
9584        set mainheadid $newhead
9585        redrawtags $oldhead
9586        redrawtags $newhead
9587    }
9588    if {$showlocalchanges} {
9589        doshowlocalchanges
9590    }
9591    return 0
9592}
9593
9594# context menu for a head
9595proc headmenu {x y id head} {
9596    global headmenuid headmenuhead headctxmenu mainhead
9597
9598    stopfinding
9599    set headmenuid $id
9600    set headmenuhead $head
9601    set state normal
9602    if {[string match "remotes/*" $head]} {
9603        set state disabled
9604    }
9605    if {$head eq $mainhead} {
9606        set state disabled
9607    }
9608    $headctxmenu entryconfigure 0 -state $state
9609    $headctxmenu entryconfigure 1 -state $state
9610    tk_popup $headctxmenu $x $y
9611}
9612
9613proc cobranch {} {
9614    global headmenuid headmenuhead headids
9615    global showlocalchanges
9616
9617    # check the tree is clean first??
9618    nowbusy checkout [mc "Checking out"]
9619    update
9620    dohidelocalchanges
9621    if {[catch {
9622        set fd [open [list | git checkout $headmenuhead 2>@1] r]
9623    } err]} {
9624        notbusy checkout
9625        error_popup $err
9626        if {$showlocalchanges} {
9627            dodiffindex
9628        }
9629    } else {
9630        filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
9631    }
9632}
9633
9634proc readcheckoutstat {fd newhead newheadid} {
9635    global mainhead mainheadid headids showlocalchanges progresscoords
9636    global viewmainheadid curview
9637
9638    if {[gets $fd line] >= 0} {
9639        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9640            set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9641            adjustprogress
9642        }
9643        return 1
9644    }
9645    set progresscoords {0 0}
9646    adjustprogress
9647    notbusy checkout
9648    if {[catch {close $fd} err]} {
9649        error_popup $err
9650    }
9651    set oldmainid $mainheadid
9652    set mainhead $newhead
9653    set mainheadid $newheadid
9654    set viewmainheadid($curview) $newheadid
9655    redrawtags $oldmainid
9656    redrawtags $newheadid
9657    selbyid $newheadid
9658    if {$showlocalchanges} {
9659        dodiffindex
9660    }
9661}
9662
9663proc rmbranch {} {
9664    global headmenuid headmenuhead mainhead
9665    global idheads
9666
9667    set head $headmenuhead
9668    set id $headmenuid
9669    # this check shouldn't be needed any more...
9670    if {$head eq $mainhead} {
9671        error_popup [mc "Cannot delete the currently checked-out branch"]
9672        return
9673    }
9674    set dheads [descheads $id]
9675    if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
9676        # the stuff on this branch isn't on any other branch
9677        if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9678                        branch.\nReally delete branch %s?" $head $head]]} return
9679    }
9680    nowbusy rmbranch
9681    update
9682    if {[catch {exec git branch -D $head} err]} {
9683        notbusy rmbranch
9684        error_popup $err
9685        return
9686    }
9687    removehead $id $head
9688    removedhead $id $head
9689    redrawtags $id
9690    notbusy rmbranch
9691    dispneartags 0
9692    run refill_reflist
9693}
9694
9695# Display a list of tags and heads
9696proc showrefs {} {
9697    global showrefstop bgcolor fgcolor selectbgcolor NS
9698    global bglist fglist reflistfilter reflist maincursor
9699
9700    set top .showrefs
9701    set showrefstop $top
9702    if {[winfo exists $top]} {
9703        raise $top
9704        refill_reflist
9705        return
9706    }
9707    ttk_toplevel $top
9708    wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
9709    make_transient $top .
9710    text $top.list -background $bgcolor -foreground $fgcolor \
9711        -selectbackground $selectbgcolor -font mainfont \
9712        -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
9713        -width 30 -height 20 -cursor $maincursor \
9714        -spacing1 1 -spacing3 1 -state disabled
9715    $top.list tag configure highlight -background $selectbgcolor
9716    lappend bglist $top.list
9717    lappend fglist $top.list
9718    ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
9719    ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
9720    grid $top.list $top.ysb -sticky nsew
9721    grid $top.xsb x -sticky ew
9722    ${NS}::frame $top.f
9723    ${NS}::label $top.f.l -text "[mc "Filter"]: "
9724    ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
9725    set reflistfilter "*"
9726    trace add variable reflistfilter write reflistfilter_change
9727    pack $top.f.e -side right -fill x -expand 1
9728    pack $top.f.l -side left
9729    grid $top.f - -sticky ew -pady 2
9730    ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
9731    bind $top <Key-Escape> [list destroy $top]
9732    grid $top.close -
9733    grid columnconfigure $top 0 -weight 1
9734    grid rowconfigure $top 0 -weight 1
9735    bind $top.list <1> {break}
9736    bind $top.list <B1-Motion> {break}
9737    bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
9738    set reflist {}
9739    refill_reflist
9740}
9741
9742proc sel_reflist {w x y} {
9743    global showrefstop reflist headids tagids otherrefids
9744
9745    if {![winfo exists $showrefstop]} return
9746    set l [lindex [split [$w index "@$x,$y"] "."] 0]
9747    set ref [lindex $reflist [expr {$l-1}]]
9748    set n [lindex $ref 0]
9749    switch -- [lindex $ref 1] {
9750        "H" {selbyid $headids($n)}
9751        "T" {selbyid $tagids($n)}
9752        "o" {selbyid $otherrefids($n)}
9753    }
9754    $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
9755}
9756
9757proc unsel_reflist {} {
9758    global showrefstop
9759
9760    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9761    $showrefstop.list tag remove highlight 0.0 end
9762}
9763
9764proc reflistfilter_change {n1 n2 op} {
9765    global reflistfilter
9766
9767    after cancel refill_reflist
9768    after 200 refill_reflist
9769}
9770
9771proc refill_reflist {} {
9772    global reflist reflistfilter showrefstop headids tagids otherrefids
9773    global curview
9774
9775    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9776    set refs {}
9777    foreach n [array names headids] {
9778        if {[string match $reflistfilter $n]} {
9779            if {[commitinview $headids($n) $curview]} {
9780                lappend refs [list $n H]
9781            } else {
9782                interestedin $headids($n) {run refill_reflist}
9783            }
9784        }
9785    }
9786    foreach n [array names tagids] {
9787        if {[string match $reflistfilter $n]} {
9788            if {[commitinview $tagids($n) $curview]} {
9789                lappend refs [list $n T]
9790            } else {
9791                interestedin $tagids($n) {run refill_reflist}
9792            }
9793        }
9794    }
9795    foreach n [array names otherrefids] {
9796        if {[string match $reflistfilter $n]} {
9797            if {[commitinview $otherrefids($n) $curview]} {
9798                lappend refs [list $n o]
9799            } else {
9800                interestedin $otherrefids($n) {run refill_reflist}
9801            }
9802        }
9803    }
9804    set refs [lsort -index 0 $refs]
9805    if {$refs eq $reflist} return
9806
9807    # Update the contents of $showrefstop.list according to the
9808    # differences between $reflist (old) and $refs (new)
9809    $showrefstop.list conf -state normal
9810    $showrefstop.list insert end "\n"
9811    set i 0
9812    set j 0
9813    while {$i < [llength $reflist] || $j < [llength $refs]} {
9814        if {$i < [llength $reflist]} {
9815            if {$j < [llength $refs]} {
9816                set cmp [string compare [lindex $reflist $i 0] \
9817                             [lindex $refs $j 0]]
9818                if {$cmp == 0} {
9819                    set cmp [string compare [lindex $reflist $i 1] \
9820                                 [lindex $refs $j 1]]
9821                }
9822            } else {
9823                set cmp -1
9824            }
9825        } else {
9826            set cmp 1
9827        }
9828        switch -- $cmp {
9829            -1 {
9830                $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
9831                incr i
9832            }
9833            0 {
9834                incr i
9835                incr j
9836            }
9837            1 {
9838                set l [expr {$j + 1}]
9839                $showrefstop.list image create $l.0 -align baseline \
9840                    -image reficon-[lindex $refs $j 1] -padx 2
9841                $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
9842                incr j
9843            }
9844        }
9845    }
9846    set reflist $refs
9847    # delete last newline
9848    $showrefstop.list delete end-2c end-1c
9849    $showrefstop.list conf -state disabled
9850}
9851
9852# Stuff for finding nearby tags
9853proc getallcommits {} {
9854    global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
9855    global idheads idtags idotherrefs allparents tagobjid
9856    global gitdir
9857
9858    if {![info exists allcommits]} {
9859        set nextarc 0
9860        set allcommits 0
9861        set seeds {}
9862        set allcwait 0
9863        set cachedarcs 0
9864        set allccache [file join $gitdir "gitk.cache"]
9865        if {![catch {
9866            set f [open $allccache r]
9867            set allcwait 1
9868            getcache $f
9869        }]} return
9870    }
9871
9872    if {$allcwait} {
9873        return
9874    }
9875    set cmd [list | git rev-list --parents]
9876    set allcupdate [expr {$seeds ne {}}]
9877    if {!$allcupdate} {
9878        set ids "--all"
9879    } else {
9880        set refs [concat [array names idheads] [array names idtags] \
9881                      [array names idotherrefs]]
9882        set ids {}
9883        set tagobjs {}
9884        foreach name [array names tagobjid] {
9885            lappend tagobjs $tagobjid($name)
9886        }
9887        foreach id [lsort -unique $refs] {
9888            if {![info exists allparents($id)] &&
9889                [lsearch -exact $tagobjs $id] < 0} {
9890                lappend ids $id
9891            }
9892        }
9893        if {$ids ne {}} {
9894            foreach id $seeds {
9895                lappend ids "^$id"
9896            }
9897        }
9898    }
9899    if {$ids ne {}} {
9900        set fd [open [concat $cmd $ids] r]
9901        fconfigure $fd -blocking 0
9902        incr allcommits
9903        nowbusy allcommits
9904        filerun $fd [list getallclines $fd]
9905    } else {
9906        dispneartags 0
9907    }
9908}
9909
9910# Since most commits have 1 parent and 1 child, we group strings of
9911# such commits into "arcs" joining branch/merge points (BMPs), which
9912# are commits that either don't have 1 parent or don't have 1 child.
9913#
9914# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
9915# arcout(id) - outgoing arcs for BMP
9916# arcids(a) - list of IDs on arc including end but not start
9917# arcstart(a) - BMP ID at start of arc
9918# arcend(a) - BMP ID at end of arc
9919# growing(a) - arc a is still growing
9920# arctags(a) - IDs out of arcids (excluding end) that have tags
9921# archeads(a) - IDs out of arcids (excluding end) that have heads
9922# The start of an arc is at the descendent end, so "incoming" means
9923# coming from descendents, and "outgoing" means going towards ancestors.
9924
9925proc getallclines {fd} {
9926    global allparents allchildren idtags idheads nextarc
9927    global arcnos arcids arctags arcout arcend arcstart archeads growing
9928    global seeds allcommits cachedarcs allcupdate
9929
9930    set nid 0
9931    while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
9932        set id [lindex $line 0]
9933        if {[info exists allparents($id)]} {
9934            # seen it already
9935            continue
9936        }
9937        set cachedarcs 0
9938        set olds [lrange $line 1 end]
9939        set allparents($id) $olds
9940        if {![info exists allchildren($id)]} {
9941            set allchildren($id) {}
9942            set arcnos($id) {}
9943            lappend seeds $id
9944        } else {
9945            set a $arcnos($id)
9946            if {[llength $olds] == 1 && [llength $a] == 1} {
9947                lappend arcids($a) $id
9948                if {[info exists idtags($id)]} {
9949                    lappend arctags($a) $id
9950                }
9951                if {[info exists idheads($id)]} {
9952                    lappend archeads($a) $id
9953                }
9954                if {[info exists allparents($olds)]} {
9955                    # seen parent already
9956                    if {![info exists arcout($olds)]} {
9957                        splitarc $olds
9958                    }
9959                    lappend arcids($a) $olds
9960                    set arcend($a) $olds
9961                    unset growing($a)
9962                }
9963                lappend allchildren($olds) $id
9964                lappend arcnos($olds) $a
9965                continue
9966            }
9967        }
9968        foreach a $arcnos($id) {
9969            lappend arcids($a) $id
9970            set arcend($a) $id
9971            unset growing($a)
9972        }
9973
9974        set ao {}
9975        foreach p $olds {
9976            lappend allchildren($p) $id
9977            set a [incr nextarc]
9978            set arcstart($a) $id
9979            set archeads($a) {}
9980            set arctags($a) {}
9981            set archeads($a) {}
9982            set arcids($a) {}
9983            lappend ao $a
9984            set growing($a) 1
9985            if {[info exists allparents($p)]} {
9986                # seen it already, may need to make a new branch
9987                if {![info exists arcout($p)]} {
9988                    splitarc $p
9989                }
9990                lappend arcids($a) $p
9991                set arcend($a) $p
9992                unset growing($a)
9993            }
9994            lappend arcnos($p) $a
9995        }
9996        set arcout($id) $ao
9997    }
9998    if {$nid > 0} {
9999        global cached_dheads cached_dtags cached_atags
10000        catch {unset cached_dheads}
10001        catch {unset cached_dtags}
10002        catch {unset cached_atags}
10003    }
10004    if {![eof $fd]} {
10005        return [expr {$nid >= 1000? 2: 1}]
10006    }
10007    set cacheok 1
10008    if {[catch {
10009        fconfigure $fd -blocking 1
10010        close $fd
10011    } err]} {
10012        # got an error reading the list of commits
10013        # if we were updating, try rereading the whole thing again
10014        if {$allcupdate} {
10015            incr allcommits -1
10016            dropcache $err
10017            return
10018        }
10019        error_popup "[mc "Error reading commit topology information;\
10020                branch and preceding/following tag information\
10021                will be incomplete."]\n($err)"
10022        set cacheok 0
10023    }
10024    if {[incr allcommits -1] == 0} {
10025        notbusy allcommits
10026        if {$cacheok} {
10027            run savecache
10028        }
10029    }
10030    dispneartags 0
10031    return 0
10032}
10033
10034proc recalcarc {a} {
10035    global arctags archeads arcids idtags idheads
10036
10037    set at {}
10038    set ah {}
10039    foreach id [lrange $arcids($a) 0 end-1] {
10040        if {[info exists idtags($id)]} {
10041            lappend at $id
10042        }
10043        if {[info exists idheads($id)]} {
10044            lappend ah $id
10045        }
10046    }
10047    set arctags($a) $at
10048    set archeads($a) $ah
10049}
10050
10051proc splitarc {p} {
10052    global arcnos arcids nextarc arctags archeads idtags idheads
10053    global arcstart arcend arcout allparents growing
10054
10055    set a $arcnos($p)
10056    if {[llength $a] != 1} {
10057        puts "oops splitarc called but [llength $a] arcs already"
10058        return
10059    }
10060    set a [lindex $a 0]
10061    set i [lsearch -exact $arcids($a) $p]
10062    if {$i < 0} {
10063        puts "oops splitarc $p not in arc $a"
10064        return
10065    }
10066    set na [incr nextarc]
10067    if {[info exists arcend($a)]} {
10068        set arcend($na) $arcend($a)
10069    } else {
10070        set l [lindex $allparents([lindex $arcids($a) end]) 0]
10071        set j [lsearch -exact $arcnos($l) $a]
10072        set arcnos($l) [lreplace $arcnos($l) $j $j $na]
10073    }
10074    set tail [lrange $arcids($a) [expr {$i+1}] end]
10075    set arcids($a) [lrange $arcids($a) 0 $i]
10076    set arcend($a) $p
10077    set arcstart($na) $p
10078    set arcout($p) $na
10079    set arcids($na) $tail
10080    if {[info exists growing($a)]} {
10081        set growing($na) 1
10082        unset growing($a)
10083    }
10084
10085    foreach id $tail {
10086        if {[llength $arcnos($id)] == 1} {
10087            set arcnos($id) $na
10088        } else {
10089            set j [lsearch -exact $arcnos($id) $a]
10090            set arcnos($id) [lreplace $arcnos($id) $j $j $na]
10091        }
10092    }
10093
10094    # reconstruct tags and heads lists
10095    if {$arctags($a) ne {} || $archeads($a) ne {}} {
10096        recalcarc $a
10097        recalcarc $na
10098    } else {
10099        set arctags($na) {}
10100        set archeads($na) {}
10101    }
10102}
10103
10104# Update things for a new commit added that is a child of one
10105# existing commit.  Used when cherry-picking.
10106proc addnewchild {id p} {
10107    global allparents allchildren idtags nextarc
10108    global arcnos arcids arctags arcout arcend arcstart archeads growing
10109    global seeds allcommits
10110
10111    if {![info exists allcommits] || ![info exists arcnos($p)]} return
10112    set allparents($id) [list $p]
10113    set allchildren($id) {}
10114    set arcnos($id) {}
10115    lappend seeds $id
10116    lappend allchildren($p) $id
10117    set a [incr nextarc]
10118    set arcstart($a) $id
10119    set archeads($a) {}
10120    set arctags($a) {}
10121    set arcids($a) [list $p]
10122    set arcend($a) $p
10123    if {![info exists arcout($p)]} {
10124        splitarc $p
10125    }
10126    lappend arcnos($p) $a
10127    set arcout($id) [list $a]
10128}
10129
10130# This implements a cache for the topology information.
10131# The cache saves, for each arc, the start and end of the arc,
10132# the ids on the arc, and the outgoing arcs from the end.
10133proc readcache {f} {
10134    global arcnos arcids arcout arcstart arcend arctags archeads nextarc
10135    global idtags idheads allparents cachedarcs possible_seeds seeds growing
10136    global allcwait
10137
10138    set a $nextarc
10139    set lim $cachedarcs
10140    if {$lim - $a > 500} {
10141        set lim [expr {$a + 500}]
10142    }
10143    if {[catch {
10144        if {$a == $lim} {
10145            # finish reading the cache and setting up arctags, etc.
10146            set line [gets $f]
10147            if {$line ne "1"} {error "bad final version"}
10148            close $f
10149            foreach id [array names idtags] {
10150                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10151                    [llength $allparents($id)] == 1} {
10152                    set a [lindex $arcnos($id) 0]
10153                    if {$arctags($a) eq {}} {
10154                        recalcarc $a
10155                    }
10156                }
10157            }
10158            foreach id [array names idheads] {
10159                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10160                    [llength $allparents($id)] == 1} {
10161                    set a [lindex $arcnos($id) 0]
10162                    if {$archeads($a) eq {}} {
10163                        recalcarc $a
10164                    }
10165                }
10166            }
10167            foreach id [lsort -unique $possible_seeds] {
10168                if {$arcnos($id) eq {}} {
10169                    lappend seeds $id
10170                }
10171            }
10172            set allcwait 0
10173        } else {
10174            while {[incr a] <= $lim} {
10175                set line [gets $f]
10176                if {[llength $line] != 3} {error "bad line"}
10177                set s [lindex $line 0]
10178                set arcstart($a) $s
10179                lappend arcout($s) $a
10180                if {![info exists arcnos($s)]} {
10181                    lappend possible_seeds $s
10182                    set arcnos($s) {}
10183                }
10184                set e [lindex $line 1]
10185                if {$e eq {}} {
10186                    set growing($a) 1
10187                } else {
10188                    set arcend($a) $e
10189                    if {![info exists arcout($e)]} {
10190                        set arcout($e) {}
10191                    }
10192                }
10193                set arcids($a) [lindex $line 2]
10194                foreach id $arcids($a) {
10195                    lappend allparents($s) $id
10196                    set s $id
10197                    lappend arcnos($id) $a
10198                }
10199                if {![info exists allparents($s)]} {
10200                    set allparents($s) {}
10201                }
10202                set arctags($a) {}
10203                set archeads($a) {}
10204            }
10205            set nextarc [expr {$a - 1}]
10206        }
10207    } err]} {
10208        dropcache $err
10209        return 0
10210    }
10211    if {!$allcwait} {
10212        getallcommits
10213    }
10214    return $allcwait
10215}
10216
10217proc getcache {f} {
10218    global nextarc cachedarcs possible_seeds
10219
10220    if {[catch {
10221        set line [gets $f]
10222        if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
10223        # make sure it's an integer
10224        set cachedarcs [expr {int([lindex $line 1])}]
10225        if {$cachedarcs < 0} {error "bad number of arcs"}
10226        set nextarc 0
10227        set possible_seeds {}
10228        run readcache $f
10229    } err]} {
10230        dropcache $err
10231    }
10232    return 0
10233}
10234
10235proc dropcache {err} {
10236    global allcwait nextarc cachedarcs seeds
10237
10238    #puts "dropping cache ($err)"
10239    foreach v {arcnos arcout arcids arcstart arcend growing \
10240                   arctags archeads allparents allchildren} {
10241        global $v
10242        catch {unset $v}
10243    }
10244    set allcwait 0
10245    set nextarc 0
10246    set cachedarcs 0
10247    set seeds {}
10248    getallcommits
10249}
10250
10251proc writecache {f} {
10252    global cachearc cachedarcs allccache
10253    global arcstart arcend arcnos arcids arcout
10254
10255    set a $cachearc
10256    set lim $cachedarcs
10257    if {$lim - $a > 1000} {
10258        set lim [expr {$a + 1000}]
10259    }
10260    if {[catch {
10261        while {[incr a] <= $lim} {
10262            if {[info exists arcend($a)]} {
10263                puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
10264            } else {
10265                puts $f [list $arcstart($a) {} $arcids($a)]
10266            }
10267        }
10268    } err]} {
10269        catch {close $f}
10270        catch {file delete $allccache}
10271        #puts "writing cache failed ($err)"
10272        return 0
10273    }
10274    set cachearc [expr {$a - 1}]
10275    if {$a > $cachedarcs} {
10276        puts $f "1"
10277        close $f
10278        return 0
10279    }
10280    return 1
10281}
10282
10283proc savecache {} {
10284    global nextarc cachedarcs cachearc allccache
10285
10286    if {$nextarc == $cachedarcs} return
10287    set cachearc 0
10288    set cachedarcs $nextarc
10289    catch {
10290        set f [open $allccache w]
10291        puts $f [list 1 $cachedarcs]
10292        run writecache $f
10293    }
10294}
10295
10296# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
10297# or 0 if neither is true.
10298proc anc_or_desc {a b} {
10299    global arcout arcstart arcend arcnos cached_isanc
10300
10301    if {$arcnos($a) eq $arcnos($b)} {
10302        # Both are on the same arc(s); either both are the same BMP,
10303        # or if one is not a BMP, the other is also not a BMP or is
10304        # the BMP at end of the arc (and it only has 1 incoming arc).
10305        # Or both can be BMPs with no incoming arcs.
10306        if {$a eq $b || $arcnos($a) eq {}} {
10307            return 0
10308        }
10309        # assert {[llength $arcnos($a)] == 1}
10310        set arc [lindex $arcnos($a) 0]
10311        set i [lsearch -exact $arcids($arc) $a]
10312        set j [lsearch -exact $arcids($arc) $b]
10313        if {$i < 0 || $i > $j} {
10314            return 1
10315        } else {
10316            return -1
10317        }
10318    }
10319
10320    if {![info exists arcout($a)]} {
10321        set arc [lindex $arcnos($a) 0]
10322        if {[info exists arcend($arc)]} {
10323            set aend $arcend($arc)
10324        } else {
10325            set aend {}
10326        }
10327        set a $arcstart($arc)
10328    } else {
10329        set aend $a
10330    }
10331    if {![info exists arcout($b)]} {
10332        set arc [lindex $arcnos($b) 0]
10333        if {[info exists arcend($arc)]} {
10334            set bend $arcend($arc)
10335        } else {
10336            set bend {}
10337        }
10338        set b $arcstart($arc)
10339    } else {
10340        set bend $b
10341    }
10342    if {$a eq $bend} {
10343        return 1
10344    }
10345    if {$b eq $aend} {
10346        return -1
10347    }
10348    if {[info exists cached_isanc($a,$bend)]} {
10349        if {$cached_isanc($a,$bend)} {
10350            return 1
10351        }
10352    }
10353    if {[info exists cached_isanc($b,$aend)]} {
10354        if {$cached_isanc($b,$aend)} {
10355            return -1
10356        }
10357        if {[info exists cached_isanc($a,$bend)]} {
10358            return 0
10359        }
10360    }
10361
10362    set todo [list $a $b]
10363    set anc($a) a
10364    set anc($b) b
10365    for {set i 0} {$i < [llength $todo]} {incr i} {
10366        set x [lindex $todo $i]
10367        if {$anc($x) eq {}} {
10368            continue
10369        }
10370        foreach arc $arcnos($x) {
10371            set xd $arcstart($arc)
10372            if {$xd eq $bend} {
10373                set cached_isanc($a,$bend) 1
10374                set cached_isanc($b,$aend) 0
10375                return 1
10376            } elseif {$xd eq $aend} {
10377                set cached_isanc($b,$aend) 1
10378                set cached_isanc($a,$bend) 0
10379                return -1
10380            }
10381            if {![info exists anc($xd)]} {
10382                set anc($xd) $anc($x)
10383                lappend todo $xd
10384            } elseif {$anc($xd) ne $anc($x)} {
10385                set anc($xd) {}
10386            }
10387        }
10388    }
10389    set cached_isanc($a,$bend) 0
10390    set cached_isanc($b,$aend) 0
10391    return 0
10392}
10393
10394# This identifies whether $desc has an ancestor that is
10395# a growing tip of the graph and which is not an ancestor of $anc
10396# and returns 0 if so and 1 if not.
10397# If we subsequently discover a tag on such a growing tip, and that
10398# turns out to be a descendent of $anc (which it could, since we
10399# don't necessarily see children before parents), then $desc
10400# isn't a good choice to display as a descendent tag of
10401# $anc (since it is the descendent of another tag which is
10402# a descendent of $anc).  Similarly, $anc isn't a good choice to
10403# display as a ancestor tag of $desc.
10404#
10405proc is_certain {desc anc} {
10406    global arcnos arcout arcstart arcend growing problems
10407
10408    set certain {}
10409    if {[llength $arcnos($anc)] == 1} {
10410        # tags on the same arc are certain
10411        if {$arcnos($desc) eq $arcnos($anc)} {
10412            return 1
10413        }
10414        if {![info exists arcout($anc)]} {
10415            # if $anc is partway along an arc, use the start of the arc instead
10416            set a [lindex $arcnos($anc) 0]
10417            set anc $arcstart($a)
10418        }
10419    }
10420    if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
10421        set x $desc
10422    } else {
10423        set a [lindex $arcnos($desc) 0]
10424        set x $arcend($a)
10425    }
10426    if {$x == $anc} {
10427        return 1
10428    }
10429    set anclist [list $x]
10430    set dl($x) 1
10431    set nnh 1
10432    set ngrowanc 0
10433    for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
10434        set x [lindex $anclist $i]
10435        if {$dl($x)} {
10436            incr nnh -1
10437        }
10438        set done($x) 1
10439        foreach a $arcout($x) {
10440            if {[info exists growing($a)]} {
10441                if {![info exists growanc($x)] && $dl($x)} {
10442                    set growanc($x) 1
10443                    incr ngrowanc
10444                }
10445            } else {
10446                set y $arcend($a)
10447                if {[info exists dl($y)]} {
10448                    if {$dl($y)} {
10449                        if {!$dl($x)} {
10450                            set dl($y) 0
10451                            if {![info exists done($y)]} {
10452                                incr nnh -1
10453                            }
10454                            if {[info exists growanc($x)]} {
10455                                incr ngrowanc -1
10456                            }
10457                            set xl [list $y]
10458                            for {set k 0} {$k < [llength $xl]} {incr k} {
10459                                set z [lindex $xl $k]
10460                                foreach c $arcout($z) {
10461                                    if {[info exists arcend($c)]} {
10462                                        set v $arcend($c)
10463                                        if {[info exists dl($v)] && $dl($v)} {
10464                                            set dl($v) 0
10465                                            if {![info exists done($v)]} {
10466                                                incr nnh -1
10467                                            }
10468                                            if {[info exists growanc($v)]} {
10469                                                incr ngrowanc -1
10470                                            }
10471                                            lappend xl $v
10472                                        }
10473                                    }
10474                                }
10475                            }
10476                        }
10477                    }
10478                } elseif {$y eq $anc || !$dl($x)} {
10479                    set dl($y) 0
10480                    lappend anclist $y
10481                } else {
10482                    set dl($y) 1
10483                    lappend anclist $y
10484                    incr nnh
10485                }
10486            }
10487        }
10488    }
10489    foreach x [array names growanc] {
10490        if {$dl($x)} {
10491            return 0
10492        }
10493        return 0
10494    }
10495    return 1
10496}
10497
10498proc validate_arctags {a} {
10499    global arctags idtags
10500
10501    set i -1
10502    set na $arctags($a)
10503    foreach id $arctags($a) {
10504        incr i
10505        if {![info exists idtags($id)]} {
10506            set na [lreplace $na $i $i]
10507            incr i -1
10508        }
10509    }
10510    set arctags($a) $na
10511}
10512
10513proc validate_archeads {a} {
10514    global archeads idheads
10515
10516    set i -1
10517    set na $archeads($a)
10518    foreach id $archeads($a) {
10519        incr i
10520        if {![info exists idheads($id)]} {
10521            set na [lreplace $na $i $i]
10522            incr i -1
10523        }
10524    }
10525    set archeads($a) $na
10526}
10527
10528# Return the list of IDs that have tags that are descendents of id,
10529# ignoring IDs that are descendents of IDs already reported.
10530proc desctags {id} {
10531    global arcnos arcstart arcids arctags idtags allparents
10532    global growing cached_dtags
10533
10534    if {![info exists allparents($id)]} {
10535        return {}
10536    }
10537    set t1 [clock clicks -milliseconds]
10538    set argid $id
10539    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10540        # part-way along an arc; check that arc first
10541        set a [lindex $arcnos($id) 0]
10542        if {$arctags($a) ne {}} {
10543            validate_arctags $a
10544            set i [lsearch -exact $arcids($a) $id]
10545            set tid {}
10546            foreach t $arctags($a) {
10547                set j [lsearch -exact $arcids($a) $t]
10548                if {$j >= $i} break
10549                set tid $t
10550            }
10551            if {$tid ne {}} {
10552                return $tid
10553            }
10554        }
10555        set id $arcstart($a)
10556        if {[info exists idtags($id)]} {
10557            return $id
10558        }
10559    }
10560    if {[info exists cached_dtags($id)]} {
10561        return $cached_dtags($id)
10562    }
10563
10564    set origid $id
10565    set todo [list $id]
10566    set queued($id) 1
10567    set nc 1
10568    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10569        set id [lindex $todo $i]
10570        set done($id) 1
10571        set ta [info exists hastaggedancestor($id)]
10572        if {!$ta} {
10573            incr nc -1
10574        }
10575        # ignore tags on starting node
10576        if {!$ta && $i > 0} {
10577            if {[info exists idtags($id)]} {
10578                set tagloc($id) $id
10579                set ta 1
10580            } elseif {[info exists cached_dtags($id)]} {
10581                set tagloc($id) $cached_dtags($id)
10582                set ta 1
10583            }
10584        }
10585        foreach a $arcnos($id) {
10586            set d $arcstart($a)
10587            if {!$ta && $arctags($a) ne {}} {
10588                validate_arctags $a
10589                if {$arctags($a) ne {}} {
10590                    lappend tagloc($id) [lindex $arctags($a) end]
10591                }
10592            }
10593            if {$ta || $arctags($a) ne {}} {
10594                set tomark [list $d]
10595                for {set j 0} {$j < [llength $tomark]} {incr j} {
10596                    set dd [lindex $tomark $j]
10597                    if {![info exists hastaggedancestor($dd)]} {
10598                        if {[info exists done($dd)]} {
10599                            foreach b $arcnos($dd) {
10600                                lappend tomark $arcstart($b)
10601                            }
10602                            if {[info exists tagloc($dd)]} {
10603                                unset tagloc($dd)
10604                            }
10605                        } elseif {[info exists queued($dd)]} {
10606                            incr nc -1
10607                        }
10608                        set hastaggedancestor($dd) 1
10609                    }
10610                }
10611            }
10612            if {![info exists queued($d)]} {
10613                lappend todo $d
10614                set queued($d) 1
10615                if {![info exists hastaggedancestor($d)]} {
10616                    incr nc
10617                }
10618            }
10619        }
10620    }
10621    set tags {}
10622    foreach id [array names tagloc] {
10623        if {![info exists hastaggedancestor($id)]} {
10624            foreach t $tagloc($id) {
10625                if {[lsearch -exact $tags $t] < 0} {
10626                    lappend tags $t
10627                }
10628            }
10629        }
10630    }
10631    set t2 [clock clicks -milliseconds]
10632    set loopix $i
10633
10634    # remove tags that are descendents of other tags
10635    for {set i 0} {$i < [llength $tags]} {incr i} {
10636        set a [lindex $tags $i]
10637        for {set j 0} {$j < $i} {incr j} {
10638            set b [lindex $tags $j]
10639            set r [anc_or_desc $a $b]
10640            if {$r == 1} {
10641                set tags [lreplace $tags $j $j]
10642                incr j -1
10643                incr i -1
10644            } elseif {$r == -1} {
10645                set tags [lreplace $tags $i $i]
10646                incr i -1
10647                break
10648            }
10649        }
10650    }
10651
10652    if {[array names growing] ne {}} {
10653        # graph isn't finished, need to check if any tag could get
10654        # eclipsed by another tag coming later.  Simply ignore any
10655        # tags that could later get eclipsed.
10656        set ctags {}
10657        foreach t $tags {
10658            if {[is_certain $t $origid]} {
10659                lappend ctags $t
10660            }
10661        }
10662        if {$tags eq $ctags} {
10663            set cached_dtags($origid) $tags
10664        } else {
10665            set tags $ctags
10666        }
10667    } else {
10668        set cached_dtags($origid) $tags
10669    }
10670    set t3 [clock clicks -milliseconds]
10671    if {0 && $t3 - $t1 >= 100} {
10672        puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10673            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10674    }
10675    return $tags
10676}
10677
10678proc anctags {id} {
10679    global arcnos arcids arcout arcend arctags idtags allparents
10680    global growing cached_atags
10681
10682    if {![info exists allparents($id)]} {
10683        return {}
10684    }
10685    set t1 [clock clicks -milliseconds]
10686    set argid $id
10687    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10688        # part-way along an arc; check that arc first
10689        set a [lindex $arcnos($id) 0]
10690        if {$arctags($a) ne {}} {
10691            validate_arctags $a
10692            set i [lsearch -exact $arcids($a) $id]
10693            foreach t $arctags($a) {
10694                set j [lsearch -exact $arcids($a) $t]
10695                if {$j > $i} {
10696                    return $t
10697                }
10698            }
10699        }
10700        if {![info exists arcend($a)]} {
10701            return {}
10702        }
10703        set id $arcend($a)
10704        if {[info exists idtags($id)]} {
10705            return $id
10706        }
10707    }
10708    if {[info exists cached_atags($id)]} {
10709        return $cached_atags($id)
10710    }
10711
10712    set origid $id
10713    set todo [list $id]
10714    set queued($id) 1
10715    set taglist {}
10716    set nc 1
10717    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10718        set id [lindex $todo $i]
10719        set done($id) 1
10720        set td [info exists hastaggeddescendent($id)]
10721        if {!$td} {
10722            incr nc -1
10723        }
10724        # ignore tags on starting node
10725        if {!$td && $i > 0} {
10726            if {[info exists idtags($id)]} {
10727                set tagloc($id) $id
10728                set td 1
10729            } elseif {[info exists cached_atags($id)]} {
10730                set tagloc($id) $cached_atags($id)
10731                set td 1
10732            }
10733        }
10734        foreach a $arcout($id) {
10735            if {!$td && $arctags($a) ne {}} {
10736                validate_arctags $a
10737                if {$arctags($a) ne {}} {
10738                    lappend tagloc($id) [lindex $arctags($a) 0]
10739                }
10740            }
10741            if {![info exists arcend($a)]} continue
10742            set d $arcend($a)
10743            if {$td || $arctags($a) ne {}} {
10744                set tomark [list $d]
10745                for {set j 0} {$j < [llength $tomark]} {incr j} {
10746                    set dd [lindex $tomark $j]
10747                    if {![info exists hastaggeddescendent($dd)]} {
10748                        if {[info exists done($dd)]} {
10749                            foreach b $arcout($dd) {
10750                                if {[info exists arcend($b)]} {
10751                                    lappend tomark $arcend($b)
10752                                }
10753                            }
10754                            if {[info exists tagloc($dd)]} {
10755                                unset tagloc($dd)
10756                            }
10757                        } elseif {[info exists queued($dd)]} {
10758                            incr nc -1
10759                        }
10760                        set hastaggeddescendent($dd) 1
10761                    }
10762                }
10763            }
10764            if {![info exists queued($d)]} {
10765                lappend todo $d
10766                set queued($d) 1
10767                if {![info exists hastaggeddescendent($d)]} {
10768                    incr nc
10769                }
10770            }
10771        }
10772    }
10773    set t2 [clock clicks -milliseconds]
10774    set loopix $i
10775    set tags {}
10776    foreach id [array names tagloc] {
10777        if {![info exists hastaggeddescendent($id)]} {
10778            foreach t $tagloc($id) {
10779                if {[lsearch -exact $tags $t] < 0} {
10780                    lappend tags $t
10781                }
10782            }
10783        }
10784    }
10785
10786    # remove tags that are ancestors of other tags
10787    for {set i 0} {$i < [llength $tags]} {incr i} {
10788        set a [lindex $tags $i]
10789        for {set j 0} {$j < $i} {incr j} {
10790            set b [lindex $tags $j]
10791            set r [anc_or_desc $a $b]
10792            if {$r == -1} {
10793                set tags [lreplace $tags $j $j]
10794                incr j -1
10795                incr i -1
10796            } elseif {$r == 1} {
10797                set tags [lreplace $tags $i $i]
10798                incr i -1
10799                break
10800            }
10801        }
10802    }
10803
10804    if {[array names growing] ne {}} {
10805        # graph isn't finished, need to check if any tag could get
10806        # eclipsed by another tag coming later.  Simply ignore any
10807        # tags that could later get eclipsed.
10808        set ctags {}
10809        foreach t $tags {
10810            if {[is_certain $origid $t]} {
10811                lappend ctags $t
10812            }
10813        }
10814        if {$tags eq $ctags} {
10815            set cached_atags($origid) $tags
10816        } else {
10817            set tags $ctags
10818        }
10819    } else {
10820        set cached_atags($origid) $tags
10821    }
10822    set t3 [clock clicks -milliseconds]
10823    if {0 && $t3 - $t1 >= 100} {
10824        puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
10825            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10826    }
10827    return $tags
10828}
10829
10830# Return the list of IDs that have heads that are descendents of id,
10831# including id itself if it has a head.
10832proc descheads {id} {
10833    global arcnos arcstart arcids archeads idheads cached_dheads
10834    global allparents arcout
10835
10836    if {![info exists allparents($id)]} {
10837        return {}
10838    }
10839    set aret {}
10840    if {![info exists arcout($id)]} {
10841        # part-way along an arc; check it first
10842        set a [lindex $arcnos($id) 0]
10843        if {$archeads($a) ne {}} {
10844            validate_archeads $a
10845            set i [lsearch -exact $arcids($a) $id]
10846            foreach t $archeads($a) {
10847                set j [lsearch -exact $arcids($a) $t]
10848                if {$j > $i} break
10849                lappend aret $t
10850            }
10851        }
10852        set id $arcstart($a)
10853    }
10854    set origid $id
10855    set todo [list $id]
10856    set seen($id) 1
10857    set ret {}
10858    for {set i 0} {$i < [llength $todo]} {incr i} {
10859        set id [lindex $todo $i]
10860        if {[info exists cached_dheads($id)]} {
10861            set ret [concat $ret $cached_dheads($id)]
10862        } else {
10863            if {[info exists idheads($id)]} {
10864                lappend ret $id
10865            }
10866            foreach a $arcnos($id) {
10867                if {$archeads($a) ne {}} {
10868                    validate_archeads $a
10869                    if {$archeads($a) ne {}} {
10870                        set ret [concat $ret $archeads($a)]
10871                    }
10872                }
10873                set d $arcstart($a)
10874                if {![info exists seen($d)]} {
10875                    lappend todo $d
10876                    set seen($d) 1
10877                }
10878            }
10879        }
10880    }
10881    set ret [lsort -unique $ret]
10882    set cached_dheads($origid) $ret
10883    return [concat $ret $aret]
10884}
10885
10886proc addedtag {id} {
10887    global arcnos arcout cached_dtags cached_atags
10888
10889    if {![info exists arcnos($id)]} return
10890    if {![info exists arcout($id)]} {
10891        recalcarc [lindex $arcnos($id) 0]
10892    }
10893    catch {unset cached_dtags}
10894    catch {unset cached_atags}
10895}
10896
10897proc addedhead {hid head} {
10898    global arcnos arcout cached_dheads
10899
10900    if {![info exists arcnos($hid)]} return
10901    if {![info exists arcout($hid)]} {
10902        recalcarc [lindex $arcnos($hid) 0]
10903    }
10904    catch {unset cached_dheads}
10905}
10906
10907proc removedhead {hid head} {
10908    global cached_dheads
10909
10910    catch {unset cached_dheads}
10911}
10912
10913proc movedhead {hid head} {
10914    global arcnos arcout cached_dheads
10915
10916    if {![info exists arcnos($hid)]} return
10917    if {![info exists arcout($hid)]} {
10918        recalcarc [lindex $arcnos($hid) 0]
10919    }
10920    catch {unset cached_dheads}
10921}
10922
10923proc changedrefs {} {
10924    global cached_dheads cached_dtags cached_atags cached_tagcontent
10925    global arctags archeads arcnos arcout idheads idtags
10926
10927    foreach id [concat [array names idheads] [array names idtags]] {
10928        if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
10929            set a [lindex $arcnos($id) 0]
10930            if {![info exists donearc($a)]} {
10931                recalcarc $a
10932                set donearc($a) 1
10933            }
10934        }
10935    }
10936    catch {unset cached_tagcontent}
10937    catch {unset cached_dtags}
10938    catch {unset cached_atags}
10939    catch {unset cached_dheads}
10940}
10941
10942proc rereadrefs {} {
10943    global idtags idheads idotherrefs mainheadid
10944
10945    set refids [concat [array names idtags] \
10946                    [array names idheads] [array names idotherrefs]]
10947    foreach id $refids {
10948        if {![info exists ref($id)]} {
10949            set ref($id) [listrefs $id]
10950        }
10951    }
10952    set oldmainhead $mainheadid
10953    readrefs
10954    changedrefs
10955    set refids [lsort -unique [concat $refids [array names idtags] \
10956                        [array names idheads] [array names idotherrefs]]]
10957    foreach id $refids {
10958        set v [listrefs $id]
10959        if {![info exists ref($id)] || $ref($id) != $v} {
10960            redrawtags $id
10961        }
10962    }
10963    if {$oldmainhead ne $mainheadid} {
10964        redrawtags $oldmainhead
10965        redrawtags $mainheadid
10966    }
10967    run refill_reflist
10968}
10969
10970proc listrefs {id} {
10971    global idtags idheads idotherrefs
10972
10973    set x {}
10974    if {[info exists idtags($id)]} {
10975        set x $idtags($id)
10976    }
10977    set y {}
10978    if {[info exists idheads($id)]} {
10979        set y $idheads($id)
10980    }
10981    set z {}
10982    if {[info exists idotherrefs($id)]} {
10983        set z $idotherrefs($id)
10984    }
10985    return [list $x $y $z]
10986}
10987
10988proc add_tag_ctext {tag} {
10989    global ctext cached_tagcontent tagids
10990
10991    if {![info exists cached_tagcontent($tag)]} {
10992        catch {
10993            set cached_tagcontent($tag) [exec git cat-file -p $tag]
10994        }
10995    }
10996    $ctext insert end "[mc "Tag"]: $tag\n" bold
10997    if {[info exists cached_tagcontent($tag)]} {
10998        set text $cached_tagcontent($tag)
10999    } else {
11000        set text "[mc "Id"]:  $tagids($tag)"
11001    }
11002    appendwithlinks $text {}
11003}
11004
11005proc showtag {tag isnew} {
11006    global ctext cached_tagcontent tagids linknum tagobjid
11007
11008    if {$isnew} {
11009        addtohistory [list showtag $tag 0] savectextpos
11010    }
11011    $ctext conf -state normal
11012    clear_ctext
11013    settabs 0
11014    set linknum 0
11015    add_tag_ctext $tag
11016    maybe_scroll_ctext 1
11017    $ctext conf -state disabled
11018    init_flist {}
11019}
11020
11021proc showtags {id isnew} {
11022    global idtags ctext linknum
11023
11024    if {$isnew} {
11025        addtohistory [list showtags $id 0] savectextpos
11026    }
11027    $ctext conf -state normal
11028    clear_ctext
11029    settabs 0
11030    set linknum 0
11031    set sep {}
11032    foreach tag $idtags($id) {
11033        $ctext insert end $sep
11034        add_tag_ctext $tag
11035        set sep "\n\n"
11036    }
11037    maybe_scroll_ctext 1
11038    $ctext conf -state disabled
11039    init_flist {}
11040}
11041
11042proc doquit {} {
11043    global stopped
11044    global gitktmpdir
11045
11046    set stopped 100
11047    savestuff .
11048    destroy .
11049
11050    if {[info exists gitktmpdir]} {
11051        catch {file delete -force $gitktmpdir}
11052    }
11053}
11054
11055proc mkfontdisp {font top which} {
11056    global fontattr fontpref $font NS use_ttk
11057
11058    set fontpref($font) [set $font]
11059    ${NS}::button $top.${font}but -text $which \
11060        -command [list choosefont $font $which]
11061    ${NS}::label $top.$font -relief flat -font $font \
11062        -text $fontattr($font,family) -justify left
11063    grid x $top.${font}but $top.$font -sticky w
11064}
11065
11066proc choosefont {font which} {
11067    global fontparam fontlist fonttop fontattr
11068    global prefstop NS
11069
11070    set fontparam(which) $which
11071    set fontparam(font) $font
11072    set fontparam(family) [font actual $font -family]
11073    set fontparam(size) $fontattr($font,size)
11074    set fontparam(weight) $fontattr($font,weight)
11075    set fontparam(slant) $fontattr($font,slant)
11076    set top .gitkfont
11077    set fonttop $top
11078    if {![winfo exists $top]} {
11079        font create sample
11080        eval font config sample [font actual $font]
11081        ttk_toplevel $top
11082        make_transient $top $prefstop
11083        wm title $top [mc "Gitk font chooser"]
11084        ${NS}::label $top.l -textvariable fontparam(which)
11085        pack $top.l -side top
11086        set fontlist [lsort [font families]]
11087        ${NS}::frame $top.f
11088        listbox $top.f.fam -listvariable fontlist \
11089            -yscrollcommand [list $top.f.sb set]
11090        bind $top.f.fam <<ListboxSelect>> selfontfam
11091        ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
11092        pack $top.f.sb -side right -fill y
11093        pack $top.f.fam -side left -fill both -expand 1
11094        pack $top.f -side top -fill both -expand 1
11095        ${NS}::frame $top.g
11096        spinbox $top.g.size -from 4 -to 40 -width 4 \
11097            -textvariable fontparam(size) \
11098            -validatecommand {string is integer -strict %s}
11099        checkbutton $top.g.bold -padx 5 \
11100            -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
11101            -variable fontparam(weight) -onvalue bold -offvalue normal
11102        checkbutton $top.g.ital -padx 5 \
11103            -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
11104            -variable fontparam(slant) -onvalue italic -offvalue roman
11105        pack $top.g.size $top.g.bold $top.g.ital -side left
11106        pack $top.g -side top
11107        canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
11108            -background white
11109        $top.c create text 100 25 -anchor center -text $which -font sample \
11110            -fill black -tags text
11111        bind $top.c <Configure> [list centertext $top.c]
11112        pack $top.c -side top -fill x
11113        ${NS}::frame $top.buts
11114        ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
11115        ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
11116        bind $top <Key-Return> fontok
11117        bind $top <Key-Escape> fontcan
11118        grid $top.buts.ok $top.buts.can
11119        grid columnconfigure $top.buts 0 -weight 1 -uniform a
11120        grid columnconfigure $top.buts 1 -weight 1 -uniform a
11121        pack $top.buts -side bottom -fill x
11122        trace add variable fontparam write chg_fontparam
11123    } else {
11124        raise $top
11125        $top.c itemconf text -text $which
11126    }
11127    set i [lsearch -exact $fontlist $fontparam(family)]
11128    if {$i >= 0} {
11129        $top.f.fam selection set $i
11130        $top.f.fam see $i
11131    }
11132}
11133
11134proc centertext {w} {
11135    $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
11136}
11137
11138proc fontok {} {
11139    global fontparam fontpref prefstop
11140
11141    set f $fontparam(font)
11142    set fontpref($f) [list $fontparam(family) $fontparam(size)]
11143    if {$fontparam(weight) eq "bold"} {
11144        lappend fontpref($f) "bold"
11145    }
11146    if {$fontparam(slant) eq "italic"} {
11147        lappend fontpref($f) "italic"
11148    }
11149    set w $prefstop.notebook.fonts.$f
11150    $w conf -text $fontparam(family) -font $fontpref($f)
11151
11152    fontcan
11153}
11154
11155proc fontcan {} {
11156    global fonttop fontparam
11157
11158    if {[info exists fonttop]} {
11159        catch {destroy $fonttop}
11160        catch {font delete sample}
11161        unset fonttop
11162        unset fontparam
11163    }
11164}
11165
11166if {[package vsatisfies [package provide Tk] 8.6]} {
11167    # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
11168    # function to make use of it.
11169    proc choosefont {font which} {
11170        tk fontchooser configure -title $which -font $font \
11171            -command [list on_choosefont $font $which]
11172        tk fontchooser show
11173    }
11174    proc on_choosefont {font which newfont} {
11175        global fontparam
11176        puts stderr "$font $newfont"
11177        array set f [font actual $newfont]
11178        set fontparam(which) $which
11179        set fontparam(font) $font
11180        set fontparam(family) $f(-family)
11181        set fontparam(size) $f(-size)
11182        set fontparam(weight) $f(-weight)
11183        set fontparam(slant) $f(-slant)
11184        fontok
11185    }
11186}
11187
11188proc selfontfam {} {
11189    global fonttop fontparam
11190
11191    set i [$fonttop.f.fam curselection]
11192    if {$i ne {}} {
11193        set fontparam(family) [$fonttop.f.fam get $i]
11194    }
11195}
11196
11197proc chg_fontparam {v sub op} {
11198    global fontparam
11199
11200    font config sample -$sub $fontparam($sub)
11201}
11202
11203# Create a property sheet tab page
11204proc create_prefs_page {w} {
11205    global NS
11206    set parent [join [lrange [split $w .] 0 end-1] .]
11207    if {[winfo class $parent] eq "TNotebook"} {
11208        ${NS}::frame $w
11209    } else {
11210        ${NS}::labelframe $w
11211    }
11212}
11213
11214proc prefspage_general {notebook} {
11215    global NS maxwidth maxgraphpct showneartags showlocalchanges
11216    global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11217    global hideremotes want_ttk have_ttk maxrefs
11218
11219    set page [create_prefs_page $notebook.general]
11220
11221    ${NS}::label $page.ldisp -text [mc "Commit list display options"]
11222    grid $page.ldisp - -sticky w -pady 10
11223    ${NS}::label $page.spacer -text " "
11224    ${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
11225    spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
11226    grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w
11227    ${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
11228    spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
11229    grid x $page.maxpctl $page.maxpct -sticky w
11230    ${NS}::checkbutton $page.showlocal -text [mc "Show local changes"] \
11231        -variable showlocalchanges
11232    grid x $page.showlocal -sticky w
11233    ${NS}::checkbutton $page.autoselect -text [mc "Auto-select SHA1 (length)"] \
11234        -variable autoselect
11235    spinbox $page.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
11236    grid x $page.autoselect $page.autosellen -sticky w
11237    ${NS}::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \
11238        -variable hideremotes
11239    grid x $page.hideremotes -sticky w
11240
11241    ${NS}::label $page.ddisp -text [mc "Diff display options"]
11242    grid $page.ddisp - -sticky w -pady 10
11243    ${NS}::label $page.tabstopl -text [mc "Tab spacing"]
11244    spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
11245    grid x $page.tabstopl $page.tabstop -sticky w
11246    ${NS}::checkbutton $page.ntag -text [mc "Display nearby tags/heads"] \
11247        -variable showneartags
11248    grid x $page.ntag -sticky w
11249    ${NS}::label $page.maxrefsl -text [mc "Maximum # tags/heads to show"]
11250    spinbox $page.maxrefs -from 1 -to 1000 -width 4 -textvariable maxrefs
11251    grid x $page.maxrefsl $page.maxrefs -sticky w
11252    ${NS}::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \
11253        -variable limitdiffs
11254    grid x $page.ldiff -sticky w
11255    ${NS}::checkbutton $page.lattr -text [mc "Support per-file encodings"] \
11256        -variable perfile_attrs
11257    grid x $page.lattr -sticky w
11258
11259    ${NS}::entry $page.extdifft -textvariable extdifftool
11260    ${NS}::frame $page.extdifff
11261    ${NS}::label $page.extdifff.l -text [mc "External diff tool" ]
11262    ${NS}::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff
11263    pack $page.extdifff.l $page.extdifff.b -side left
11264    pack configure $page.extdifff.l -padx 10
11265    grid x $page.extdifff $page.extdifft -sticky ew
11266
11267    ${NS}::label $page.lgen -text [mc "General options"]
11268    grid $page.lgen - -sticky w -pady 10
11269    ${NS}::checkbutton $page.want_ttk -variable want_ttk \
11270        -text [mc "Use themed widgets"]
11271    if {$have_ttk} {
11272        ${NS}::label $page.ttk_note -text [mc "(change requires restart)"]
11273    } else {
11274        ${NS}::label $page.ttk_note -text [mc "(currently unavailable)"]
11275    }
11276    grid x $page.want_ttk $page.ttk_note -sticky w
11277    return $page
11278}
11279
11280proc prefspage_colors {notebook} {
11281    global NS uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11282
11283    set page [create_prefs_page $notebook.colors]
11284
11285    ${NS}::label $page.cdisp -text [mc "Colors: press to choose"]
11286    grid $page.cdisp - -sticky w -pady 10
11287    label $page.ui -padx 40 -relief sunk -background $uicolor
11288    ${NS}::button $page.uibut -text [mc "Interface"] \
11289       -command [list choosecolor uicolor {} $page.ui [mc "interface"] setui]
11290    grid x $page.uibut $page.ui -sticky w
11291    label $page.bg -padx 40 -relief sunk -background $bgcolor
11292    ${NS}::button $page.bgbut -text [mc "Background"] \
11293        -command [list choosecolor bgcolor {} $page.bg [mc "background"] setbg]
11294    grid x $page.bgbut $page.bg -sticky w
11295    label $page.fg -padx 40 -relief sunk -background $fgcolor
11296    ${NS}::button $page.fgbut -text [mc "Foreground"] \
11297        -command [list choosecolor fgcolor {} $page.fg [mc "foreground"] setfg]
11298    grid x $page.fgbut $page.fg -sticky w
11299    label $page.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
11300    ${NS}::button $page.diffoldbut -text [mc "Diff: old lines"] \
11301        -command [list choosecolor diffcolors 0 $page.diffold [mc "diff old lines"] \
11302                      [list $ctext tag conf d0 -foreground]]
11303    grid x $page.diffoldbut $page.diffold -sticky w
11304    label $page.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
11305    ${NS}::button $page.diffnewbut -text [mc "Diff: new lines"] \
11306        -command [list choosecolor diffcolors 1 $page.diffnew [mc "diff new lines"] \
11307                      [list $ctext tag conf dresult -foreground]]
11308    grid x $page.diffnewbut $page.diffnew -sticky w
11309    label $page.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
11310    ${NS}::button $page.hunksepbut -text [mc "Diff: hunk header"] \
11311        -command [list choosecolor diffcolors 2 $page.hunksep \
11312                      [mc "diff hunk header"] \
11313                      [list $ctext tag conf hunksep -foreground]]
11314    grid x $page.hunksepbut $page.hunksep -sticky w
11315    label $page.markbgsep -padx 40 -relief sunk -background $markbgcolor
11316    ${NS}::button $page.markbgbut -text [mc "Marked line bg"] \
11317        -command [list choosecolor markbgcolor {} $page.markbgsep \
11318                      [mc "marked line background"] \
11319                      [list $ctext tag conf omark -background]]
11320    grid x $page.markbgbut $page.markbgsep -sticky w
11321    label $page.selbgsep -padx 40 -relief sunk -background $selectbgcolor
11322    ${NS}::button $page.selbgbut -text [mc "Select bg"] \
11323        -command [list choosecolor selectbgcolor {} $page.selbgsep [mc "background"] setselbg]
11324    grid x $page.selbgbut $page.selbgsep -sticky w
11325    return $page
11326}
11327
11328proc prefspage_fonts {notebook} {
11329    global NS
11330    set page [create_prefs_page $notebook.fonts]
11331    ${NS}::label $page.cfont -text [mc "Fonts: press to choose"]
11332    grid $page.cfont - -sticky w -pady 10
11333    mkfontdisp mainfont $page [mc "Main font"]
11334    mkfontdisp textfont $page [mc "Diff display font"]
11335    mkfontdisp uifont $page [mc "User interface font"]
11336    return $page
11337}
11338
11339proc doprefs {} {
11340    global maxwidth maxgraphpct use_ttk NS
11341    global oldprefs prefstop showneartags showlocalchanges
11342    global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11343    global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11344    global hideremotes want_ttk have_ttk
11345
11346    set top .gitkprefs
11347    set prefstop $top
11348    if {[winfo exists $top]} {
11349        raise $top
11350        return
11351    }
11352    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11353                   limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11354        set oldprefs($v) [set $v]
11355    }
11356    ttk_toplevel $top
11357    wm title $top [mc "Gitk preferences"]
11358    make_transient $top .
11359
11360    if {[set use_notebook [expr {$use_ttk && [info command ::ttk::notebook] ne ""}]]} {
11361        set notebook [ttk::notebook $top.notebook]
11362    } else {
11363        set notebook [${NS}::frame $top.notebook -borderwidth 0 -relief flat]
11364    }
11365
11366    lappend pages [prefspage_general $notebook] [mc "General"]
11367    lappend pages [prefspage_colors $notebook] [mc "Colors"]
11368    lappend pages [prefspage_fonts $notebook] [mc "Fonts"]
11369    set col 0
11370    foreach {page title} $pages {
11371        if {$use_notebook} {
11372            $notebook add $page -text $title
11373        } else {
11374            set btn [${NS}::button $notebook.b_[string map {. X} $page] \
11375                         -text $title -command [list raise $page]]
11376            $page configure -text $title
11377            grid $btn -row 0 -column [incr col] -sticky w
11378            grid $page -row 1 -column 0 -sticky news -columnspan 100
11379        }
11380    }
11381
11382    if {!$use_notebook} {
11383        grid columnconfigure $notebook 0 -weight 1
11384        grid rowconfigure $notebook 1 -weight 1
11385        raise [lindex $pages 0]
11386    }
11387
11388    grid $notebook -sticky news -padx 2 -pady 2
11389    grid rowconfigure $top 0 -weight 1
11390    grid columnconfigure $top 0 -weight 1
11391
11392    ${NS}::frame $top.buts
11393    ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
11394    ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
11395    bind $top <Key-Return> prefsok
11396    bind $top <Key-Escape> prefscan
11397    grid $top.buts.ok $top.buts.can
11398    grid columnconfigure $top.buts 0 -weight 1 -uniform a
11399    grid columnconfigure $top.buts 1 -weight 1 -uniform a
11400    grid $top.buts - - -pady 10 -sticky ew
11401    grid columnconfigure $top 2 -weight 1
11402    bind $top <Visibility> [list focus $top.buts.ok]
11403}
11404
11405proc choose_extdiff {} {
11406    global extdifftool
11407
11408    set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
11409    if {$prog ne {}} {
11410        set extdifftool $prog
11411    }
11412}
11413
11414proc choosecolor {v vi w x cmd} {
11415    global $v
11416
11417    set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
11418               -title [mc "Gitk: choose color for %s" $x]]
11419    if {$c eq {}} return
11420    $w conf -background $c
11421    lset $v $vi $c
11422    eval $cmd $c
11423}
11424
11425proc setselbg {c} {
11426    global bglist cflist
11427    foreach w $bglist {
11428        $w configure -selectbackground $c
11429    }
11430    $cflist tag configure highlight \
11431        -background [$cflist cget -selectbackground]
11432    allcanvs itemconf secsel -fill $c
11433}
11434
11435# This sets the background color and the color scheme for the whole UI.
11436# For some reason, tk_setPalette chooses a nasty dark red for selectColor
11437# if we don't specify one ourselves, which makes the checkbuttons and
11438# radiobuttons look bad.  This chooses white for selectColor if the
11439# background color is light, or black if it is dark.
11440proc setui {c} {
11441    if {[tk windowingsystem] eq "win32"} { return }
11442    set bg [winfo rgb . $c]
11443    set selc black
11444    if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
11445        set selc white
11446    }
11447    tk_setPalette background $c selectColor $selc
11448}
11449
11450proc setbg {c} {
11451    global bglist
11452
11453    foreach w $bglist {
11454        $w conf -background $c
11455    }
11456}
11457
11458proc setfg {c} {
11459    global fglist canv
11460
11461    foreach w $fglist {
11462        $w conf -foreground $c
11463    }
11464    allcanvs itemconf text -fill $c
11465    $canv itemconf circle -outline $c
11466    $canv itemconf markid -outline $c
11467}
11468
11469proc prefscan {} {
11470    global oldprefs prefstop
11471
11472    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11473                   limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11474        global $v
11475        set $v $oldprefs($v)
11476    }
11477    catch {destroy $prefstop}
11478    unset prefstop
11479    fontcan
11480}
11481
11482proc prefsok {} {
11483    global maxwidth maxgraphpct
11484    global oldprefs prefstop showneartags showlocalchanges
11485    global fontpref mainfont textfont uifont
11486    global limitdiffs treediffs perfile_attrs
11487    global hideremotes
11488
11489    catch {destroy $prefstop}
11490    unset prefstop
11491    fontcan
11492    set fontchanged 0
11493    if {$mainfont ne $fontpref(mainfont)} {
11494        set mainfont $fontpref(mainfont)
11495        parsefont mainfont $mainfont
11496        eval font configure mainfont [fontflags mainfont]
11497        eval font configure mainfontbold [fontflags mainfont 1]
11498        setcoords
11499        set fontchanged 1
11500    }
11501    if {$textfont ne $fontpref(textfont)} {
11502        set textfont $fontpref(textfont)
11503        parsefont textfont $textfont
11504        eval font configure textfont [fontflags textfont]
11505        eval font configure textfontbold [fontflags textfont 1]
11506    }
11507    if {$uifont ne $fontpref(uifont)} {
11508        set uifont $fontpref(uifont)
11509        parsefont uifont $uifont
11510        eval font configure uifont [fontflags uifont]
11511    }
11512    settabs
11513    if {$showlocalchanges != $oldprefs(showlocalchanges)} {
11514        if {$showlocalchanges} {
11515            doshowlocalchanges
11516        } else {
11517            dohidelocalchanges
11518        }
11519    }
11520    if {$limitdiffs != $oldprefs(limitdiffs) ||
11521        ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11522        # treediffs elements are limited by path;
11523        # won't have encodings cached if perfile_attrs was just turned on
11524        catch {unset treediffs}
11525    }
11526    if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
11527        || $maxgraphpct != $oldprefs(maxgraphpct)} {
11528        redisplay
11529    } elseif {$showneartags != $oldprefs(showneartags) ||
11530          $limitdiffs != $oldprefs(limitdiffs)} {
11531        reselectline
11532    }
11533    if {$hideremotes != $oldprefs(hideremotes)} {
11534        rereadrefs
11535    }
11536}
11537
11538proc formatdate {d} {
11539    global datetimeformat
11540    if {$d ne {}} {
11541        set d [clock format [lindex $d 0] -format $datetimeformat]
11542    }
11543    return $d
11544}
11545
11546# This list of encoding names and aliases is distilled from
11547# http://www.iana.org/assignments/character-sets.
11548# Not all of them are supported by Tcl.
11549set encoding_aliases {
11550    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11551      ISO646-US US-ASCII us IBM367 cp367 csASCII }
11552    { ISO-10646-UTF-1 csISO10646UTF1 }
11553    { ISO_646.basic:1983 ref csISO646basic1983 }
11554    { INVARIANT csINVARIANT }
11555    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11556    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11557    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11558    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11559    { NATS-DANO iso-ir-9-1 csNATSDANO }
11560    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11561    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11562    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11563    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11564    { ISO-2022-KR csISO2022KR }
11565    { EUC-KR csEUCKR }
11566    { ISO-2022-JP csISO2022JP }
11567    { ISO-2022-JP-2 csISO2022JP2 }
11568    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11569      csISO13JISC6220jp }
11570    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11571    { IT iso-ir-15 ISO646-IT csISO15Italian }
11572    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11573    { ES iso-ir-17 ISO646-ES csISO17Spanish }
11574    { greek7-old iso-ir-18 csISO18Greek7Old }
11575    { latin-greek iso-ir-19 csISO19LatinGreek }
11576    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11577    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11578    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11579    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11580    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11581    { BS_viewdata iso-ir-47 csISO47BSViewdata }
11582    { INIS iso-ir-49 csISO49INIS }
11583    { INIS-8 iso-ir-50 csISO50INIS8 }
11584    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11585    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11586    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11587    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11588    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11589    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11590      csISO60Norwegian1 }
11591    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11592    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11593    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11594    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11595    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11596    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11597    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11598    { greek7 iso-ir-88 csISO88Greek7 }
11599    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11600    { iso-ir-90 csISO90 }
11601    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11602    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11603      csISO92JISC62991984b }
11604    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11605    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11606    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11607      csISO95JIS62291984handadd }
11608    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11609    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11610    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11611    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11612      CP819 csISOLatin1 }
11613    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11614    { T.61-7bit iso-ir-102 csISO102T617bit }
11615    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11616    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
11617    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
11618    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
11619    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
11620    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
11621    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
11622    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
11623      arabic csISOLatinArabic }
11624    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
11625    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
11626    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
11627      greek greek8 csISOLatinGreek }
11628    { T.101-G2 iso-ir-128 csISO128T101G2 }
11629    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
11630      csISOLatinHebrew }
11631    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
11632    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
11633    { CSN_369103 iso-ir-139 csISO139CSN369103 }
11634    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
11635    { ISO_6937-2-add iso-ir-142 csISOTextComm }
11636    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
11637    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
11638      csISOLatinCyrillic }
11639    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
11640    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
11641    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
11642    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
11643    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
11644    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
11645    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
11646    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
11647    { ISO_10367-box iso-ir-155 csISO10367Box }
11648    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
11649    { latin-lap lap iso-ir-158 csISO158Lap }
11650    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
11651    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
11652    { us-dk csUSDK }
11653    { dk-us csDKUS }
11654    { JIS_X0201 X0201 csHalfWidthKatakana }
11655    { KSC5636 ISO646-KR csKSC5636 }
11656    { ISO-10646-UCS-2 csUnicode }
11657    { ISO-10646-UCS-4 csUCS4 }
11658    { DEC-MCS dec csDECMCS }
11659    { hp-roman8 roman8 r8 csHPRoman8 }
11660    { macintosh mac csMacintosh }
11661    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
11662      csIBM037 }
11663    { IBM038 EBCDIC-INT cp038 csIBM038 }
11664    { IBM273 CP273 csIBM273 }
11665    { IBM274 EBCDIC-BE CP274 csIBM274 }
11666    { IBM275 EBCDIC-BR cp275 csIBM275 }
11667    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
11668    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
11669    { IBM280 CP280 ebcdic-cp-it csIBM280 }
11670    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
11671    { IBM284 CP284 ebcdic-cp-es csIBM284 }
11672    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
11673    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
11674    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
11675    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
11676    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
11677    { IBM424 cp424 ebcdic-cp-he csIBM424 }
11678    { IBM437 cp437 437 csPC8CodePage437 }
11679    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
11680    { IBM775 cp775 csPC775Baltic }
11681    { IBM850 cp850 850 csPC850Multilingual }
11682    { IBM851 cp851 851 csIBM851 }
11683    { IBM852 cp852 852 csPCp852 }
11684    { IBM855 cp855 855 csIBM855 }
11685    { IBM857 cp857 857 csIBM857 }
11686    { IBM860 cp860 860 csIBM860 }
11687    { IBM861 cp861 861 cp-is csIBM861 }
11688    { IBM862 cp862 862 csPC862LatinHebrew }
11689    { IBM863 cp863 863 csIBM863 }
11690    { IBM864 cp864 csIBM864 }
11691    { IBM865 cp865 865 csIBM865 }
11692    { IBM866 cp866 866 csIBM866 }
11693    { IBM868 CP868 cp-ar csIBM868 }
11694    { IBM869 cp869 869 cp-gr csIBM869 }
11695    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
11696    { IBM871 CP871 ebcdic-cp-is csIBM871 }
11697    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
11698    { IBM891 cp891 csIBM891 }
11699    { IBM903 cp903 csIBM903 }
11700    { IBM904 cp904 904 csIBBM904 }
11701    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
11702    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
11703    { IBM1026 CP1026 csIBM1026 }
11704    { EBCDIC-AT-DE csIBMEBCDICATDE }
11705    { EBCDIC-AT-DE-A csEBCDICATDEA }
11706    { EBCDIC-CA-FR csEBCDICCAFR }
11707    { EBCDIC-DK-NO csEBCDICDKNO }
11708    { EBCDIC-DK-NO-A csEBCDICDKNOA }
11709    { EBCDIC-FI-SE csEBCDICFISE }
11710    { EBCDIC-FI-SE-A csEBCDICFISEA }
11711    { EBCDIC-FR csEBCDICFR }
11712    { EBCDIC-IT csEBCDICIT }
11713    { EBCDIC-PT csEBCDICPT }
11714    { EBCDIC-ES csEBCDICES }
11715    { EBCDIC-ES-A csEBCDICESA }
11716    { EBCDIC-ES-S csEBCDICESS }
11717    { EBCDIC-UK csEBCDICUK }
11718    { EBCDIC-US csEBCDICUS }
11719    { UNKNOWN-8BIT csUnknown8BiT }
11720    { MNEMONIC csMnemonic }
11721    { MNEM csMnem }
11722    { VISCII csVISCII }
11723    { VIQR csVIQR }
11724    { KOI8-R csKOI8R }
11725    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
11726    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
11727    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
11728    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
11729    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
11730    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
11731    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
11732    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
11733    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
11734    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
11735    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
11736    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
11737    { IBM1047 IBM-1047 }
11738    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
11739    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
11740    { UNICODE-1-1 csUnicode11 }
11741    { CESU-8 csCESU-8 }
11742    { BOCU-1 csBOCU-1 }
11743    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
11744    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
11745      l8 }
11746    { ISO-8859-15 ISO_8859-15 Latin-9 }
11747    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
11748    { GBK CP936 MS936 windows-936 }
11749    { JIS_Encoding csJISEncoding }
11750    { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
11751    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
11752      EUC-JP }
11753    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
11754    { ISO-10646-UCS-Basic csUnicodeASCII }
11755    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
11756    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
11757    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
11758    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
11759    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
11760    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
11761    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
11762    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
11763    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
11764    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
11765    { Adobe-Standard-Encoding csAdobeStandardEncoding }
11766    { Ventura-US csVenturaUS }
11767    { Ventura-International csVenturaInternational }
11768    { PC8-Danish-Norwegian csPC8DanishNorwegian }
11769    { PC8-Turkish csPC8Turkish }
11770    { IBM-Symbols csIBMSymbols }
11771    { IBM-Thai csIBMThai }
11772    { HP-Legal csHPLegal }
11773    { HP-Pi-font csHPPiFont }
11774    { HP-Math8 csHPMath8 }
11775    { Adobe-Symbol-Encoding csHPPSMath }
11776    { HP-DeskTop csHPDesktop }
11777    { Ventura-Math csVenturaMath }
11778    { Microsoft-Publishing csMicrosoftPublishing }
11779    { Windows-31J csWindows31J }
11780    { GB2312 csGB2312 }
11781    { Big5 csBig5 }
11782}
11783
11784proc tcl_encoding {enc} {
11785    global encoding_aliases tcl_encoding_cache
11786    if {[info exists tcl_encoding_cache($enc)]} {
11787        return $tcl_encoding_cache($enc)
11788    }
11789    set names [encoding names]
11790    set lcnames [string tolower $names]
11791    set enc [string tolower $enc]
11792    set i [lsearch -exact $lcnames $enc]
11793    if {$i < 0} {
11794        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
11795        if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
11796            set i [lsearch -exact $lcnames $encx]
11797        }
11798    }
11799    if {$i < 0} {
11800        foreach l $encoding_aliases {
11801            set ll [string tolower $l]
11802            if {[lsearch -exact $ll $enc] < 0} continue
11803            # look through the aliases for one that tcl knows about
11804            foreach e $ll {
11805                set i [lsearch -exact $lcnames $e]
11806                if {$i < 0} {
11807                    if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
11808                        set i [lsearch -exact $lcnames $ex]
11809                    }
11810                }
11811                if {$i >= 0} break
11812            }
11813            break
11814        }
11815    }
11816    set tclenc {}
11817    if {$i >= 0} {
11818        set tclenc [lindex $names $i]
11819    }
11820    set tcl_encoding_cache($enc) $tclenc
11821    return $tclenc
11822}
11823
11824proc gitattr {path attr default} {
11825    global path_attr_cache
11826    if {[info exists path_attr_cache($attr,$path)]} {
11827        set r $path_attr_cache($attr,$path)
11828    } else {
11829        set r "unspecified"
11830        if {![catch {set line [exec git check-attr $attr -- $path]}]} {
11831            regexp "(.*): $attr: (.*)" $line m f r
11832        }
11833        set path_attr_cache($attr,$path) $r
11834    }
11835    if {$r eq "unspecified"} {
11836        return $default
11837    }
11838    return $r
11839}
11840
11841proc cache_gitattr {attr pathlist} {
11842    global path_attr_cache
11843    set newlist {}
11844    foreach path $pathlist {
11845        if {![info exists path_attr_cache($attr,$path)]} {
11846            lappend newlist $path
11847        }
11848    }
11849    set lim 1000
11850    if {[tk windowingsystem] == "win32"} {
11851        # windows has a 32k limit on the arguments to a command...
11852        set lim 30
11853    }
11854    while {$newlist ne {}} {
11855        set head [lrange $newlist 0 [expr {$lim - 1}]]
11856        set newlist [lrange $newlist $lim end]
11857        if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
11858            foreach row [split $rlist "\n"] {
11859                if {[regexp "(.*): $attr: (.*)" $row m path value]} {
11860                    if {[string index $path 0] eq "\""} {
11861                        set path [encoding convertfrom [lindex $path 0]]
11862                    }
11863                    set path_attr_cache($attr,$path) $value
11864                }
11865            }
11866        }
11867    }
11868}
11869
11870proc get_path_encoding {path} {
11871    global gui_encoding perfile_attrs
11872    set tcl_enc $gui_encoding
11873    if {$path ne {} && $perfile_attrs} {
11874        set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
11875        if {$enc2 ne {}} {
11876            set tcl_enc $enc2
11877        }
11878    }
11879    return $tcl_enc
11880}
11881
11882# First check that Tcl/Tk is recent enough
11883if {[catch {package require Tk 8.4} err]} {
11884    show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
11885                     Gitk requires at least Tcl/Tk 8.4." list
11886    exit 1
11887}
11888
11889# on OSX bring the current Wish process window to front
11890if {[tk windowingsystem] eq "aqua"} {
11891    exec osascript -e [format {
11892        tell application "System Events"
11893            set frontmost of processes whose unix id is %d to true
11894        end tell
11895    } [pid] ]
11896}
11897
11898# Unset GIT_TRACE var if set
11899if { [info exists ::env(GIT_TRACE)] } {
11900    unset ::env(GIT_TRACE)
11901}
11902
11903# defaults...
11904set wrcomcmd "git diff-tree --stdin -p --pretty"
11905
11906set gitencoding {}
11907catch {
11908    set gitencoding [exec git config --get i18n.commitencoding]
11909}
11910catch {
11911    set gitencoding [exec git config --get i18n.logoutputencoding]
11912}
11913if {$gitencoding == ""} {
11914    set gitencoding "utf-8"
11915}
11916set tclencoding [tcl_encoding $gitencoding]
11917if {$tclencoding == {}} {
11918    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
11919}
11920
11921set gui_encoding [encoding system]
11922catch {
11923    set enc [exec git config --get gui.encoding]
11924    if {$enc ne {}} {
11925        set tclenc [tcl_encoding $enc]
11926        if {$tclenc ne {}} {
11927            set gui_encoding $tclenc
11928        } else {
11929            puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
11930        }
11931    }
11932}
11933
11934set log_showroot true
11935catch {
11936    set log_showroot [exec git config --bool --get log.showroot]
11937}
11938
11939if {[tk windowingsystem] eq "aqua"} {
11940    set mainfont {{Lucida Grande} 9}
11941    set textfont {Monaco 9}
11942    set uifont {{Lucida Grande} 9 bold}
11943} elseif {![catch {::tk::pkgconfig get fontsystem} xft] && $xft eq "xft"} {
11944    # fontconfig!
11945    set mainfont {sans 9}
11946    set textfont {monospace 9}
11947    set uifont {sans 9 bold}
11948} else {
11949    set mainfont {Helvetica 9}
11950    set textfont {Courier 9}
11951    set uifont {Helvetica 9 bold}
11952}
11953set tabstop 8
11954set findmergefiles 0
11955set maxgraphpct 50
11956set maxwidth 16
11957set revlistorder 0
11958set fastdate 0
11959set uparrowlen 5
11960set downarrowlen 5
11961set mingaplen 100
11962set cmitmode "patch"
11963set wrapcomment "none"
11964set showneartags 1
11965set hideremotes 0
11966set maxrefs 20
11967set maxlinelen 200
11968set showlocalchanges 1
11969set limitdiffs 1
11970set datetimeformat "%Y-%m-%d %H:%M:%S"
11971set autoselect 1
11972set autosellen 40
11973set perfile_attrs 0
11974set want_ttk 1
11975
11976if {[tk windowingsystem] eq "aqua"} {
11977    set extdifftool "opendiff"
11978} else {
11979    set extdifftool "meld"
11980}
11981
11982set colors {green red blue magenta darkgrey brown orange}
11983if {[tk windowingsystem] eq "win32"} {
11984    set uicolor SystemButtonFace
11985    set uifgcolor SystemButtonText
11986    set uifgdisabledcolor SystemDisabledText
11987    set bgcolor SystemWindow
11988    set fgcolor SystemWindowText
11989    set selectbgcolor SystemHighlight
11990} else {
11991    set uicolor grey85
11992    set uifgcolor black
11993    set uifgdisabledcolor "#999"
11994    set bgcolor white
11995    set fgcolor black
11996    set selectbgcolor gray85
11997}
11998set diffcolors {red "#00a000" blue}
11999set diffcontext 3
12000set mergecolors {red blue green purple brown "#009090" magenta "#808000" "#009000" "#ff0080" cyan "#b07070" "#70b0f0" "#70f0b0" "#f0b070" "#ff70b0"}
12001set ignorespace 0
12002set worddiff ""
12003set markbgcolor "#e0e0ff"
12004
12005set headbgcolor green
12006set headfgcolor black
12007set headoutlinecolor black
12008set remotebgcolor #ffddaa
12009set tagbgcolor yellow
12010set tagfgcolor black
12011set tagoutlinecolor black
12012set reflinecolor black
12013set filesepbgcolor #aaaaaa
12014set filesepfgcolor black
12015set linehoverbgcolor #ffff80
12016set linehoverfgcolor black
12017set linehoveroutlinecolor black
12018set mainheadcirclecolor yellow
12019set workingfilescirclecolor red
12020set indexcirclecolor green
12021set circlecolors {white blue gray blue blue}
12022set linkfgcolor blue
12023set circleoutlinecolor $fgcolor
12024set foundbgcolor yellow
12025set currentsearchhitbgcolor orange
12026
12027# button for popping up context menus
12028if {[tk windowingsystem] eq "aqua"} {
12029    set ctxbut <Button-2>
12030} else {
12031    set ctxbut <Button-3>
12032}
12033
12034## For msgcat loading, first locate the installation location.
12035if { [info exists ::env(GITK_MSGSDIR)] } {
12036    ## Msgsdir was manually set in the environment.
12037    set gitk_msgsdir $::env(GITK_MSGSDIR)
12038} else {
12039    ## Let's guess the prefix from argv0.
12040    set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
12041    set gitk_libdir [file join $gitk_prefix share gitk lib]
12042    set gitk_msgsdir [file join $gitk_libdir msgs]
12043    unset gitk_prefix
12044}
12045
12046## Internationalization (i18n) through msgcat and gettext. See
12047## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
12048package require msgcat
12049namespace import ::msgcat::mc
12050## And eventually load the actual message catalog
12051::msgcat::mcload $gitk_msgsdir
12052
12053catch {source ~/.gitk}
12054
12055parsefont mainfont $mainfont
12056eval font create mainfont [fontflags mainfont]
12057eval font create mainfontbold [fontflags mainfont 1]
12058
12059parsefont textfont $textfont
12060eval font create textfont [fontflags textfont]
12061eval font create textfontbold [fontflags textfont 1]
12062
12063parsefont uifont $uifont
12064eval font create uifont [fontflags uifont]
12065
12066setui $uicolor
12067
12068setoptions
12069
12070# check that we can find a .git directory somewhere...
12071if {[catch {set gitdir [exec git rev-parse --git-dir]}]} {
12072    show_error {} . [mc "Cannot find a git repository here."]
12073    exit 1
12074}
12075
12076set selecthead {}
12077set selectheadid {}
12078
12079set revtreeargs {}
12080set cmdline_files {}
12081set i 0
12082set revtreeargscmd {}
12083foreach arg $argv {
12084    switch -glob -- $arg {
12085        "" { }
12086        "--" {
12087            set cmdline_files [lrange $argv [expr {$i + 1}] end]
12088            break
12089        }
12090        "--select-commit=*" {
12091            set selecthead [string range $arg 16 end]
12092        }
12093        "--argscmd=*" {
12094            set revtreeargscmd [string range $arg 10 end]
12095        }
12096        default {
12097            lappend revtreeargs $arg
12098        }
12099    }
12100    incr i
12101}
12102
12103if {$selecthead eq "HEAD"} {
12104    set selecthead {}
12105}
12106
12107if {$i >= [llength $argv] && $revtreeargs ne {}} {
12108    # no -- on command line, but some arguments (other than --argscmd)
12109    if {[catch {
12110        set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
12111        set cmdline_files [split $f "\n"]
12112        set n [llength $cmdline_files]
12113        set revtreeargs [lrange $revtreeargs 0 end-$n]
12114        # Unfortunately git rev-parse doesn't produce an error when
12115        # something is both a revision and a filename.  To be consistent
12116        # with git log and git rev-list, check revtreeargs for filenames.
12117        foreach arg $revtreeargs {
12118            if {[file exists $arg]} {
12119                show_error {} . [mc "Ambiguous argument '%s': both revision\
12120                                 and filename" $arg]
12121                exit 1
12122            }
12123        }
12124    } err]} {
12125        # unfortunately we get both stdout and stderr in $err,
12126        # so look for "fatal:".
12127        set i [string first "fatal:" $err]
12128        if {$i > 0} {
12129            set err [string range $err [expr {$i + 6}] end]
12130        }
12131        show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
12132        exit 1
12133    }
12134}
12135
12136set nullid "0000000000000000000000000000000000000000"
12137set nullid2 "0000000000000000000000000000000000000001"
12138set nullfile "/dev/null"
12139
12140set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
12141if {![info exists have_ttk]} {
12142    set have_ttk [llength [info commands ::ttk::style]]
12143}
12144set use_ttk [expr {$have_ttk && $want_ttk}]
12145set NS [expr {$use_ttk ? "ttk" : ""}]
12146
12147regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
12148
12149set show_notes {}
12150if {[package vcompare $git_version "1.6.6.2"] >= 0} {
12151    set show_notes "--show-notes"
12152}
12153
12154set appname "gitk"
12155
12156set runq {}
12157set history {}
12158set historyindex 0
12159set fh_serial 0
12160set nhl_names {}
12161set highlight_paths {}
12162set findpattern {}
12163set searchdirn -forwards
12164set boldids {}
12165set boldnameids {}
12166set diffelide {0 0}
12167set markingmatches 0
12168set linkentercount 0
12169set need_redisplay 0
12170set nrows_drawn 0
12171set firsttabstop 0
12172
12173set nextviewnum 1
12174set curview 0
12175set selectedview 0
12176set selectedhlview [mc "None"]
12177set highlight_related [mc "None"]
12178set highlight_files {}
12179set viewfiles(0) {}
12180set viewperm(0) 0
12181set viewargs(0) {}
12182set viewargscmd(0) {}
12183
12184set selectedline {}
12185set numcommits 0
12186set loginstance 0
12187set cmdlineok 0
12188set stopped 0
12189set stuffsaved 0
12190set patchnum 0
12191set lserial 0
12192set hasworktree [hasworktree]
12193set cdup {}
12194if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} {
12195    set cdup [exec git rev-parse --show-cdup]
12196}
12197set worktree [exec git rev-parse --show-toplevel]
12198setcoords
12199makewindow
12200catch {
12201    image create photo gitlogo      -width 16 -height 16
12202
12203    image create photo gitlogominus -width  4 -height  2
12204    gitlogominus put #C00000 -to 0 0 4 2
12205    gitlogo copy gitlogominus -to  1 5
12206    gitlogo copy gitlogominus -to  6 5
12207    gitlogo copy gitlogominus -to 11 5
12208    image delete gitlogominus
12209
12210    image create photo gitlogoplus  -width  4 -height  4
12211    gitlogoplus  put #008000 -to 1 0 3 4
12212    gitlogoplus  put #008000 -to 0 1 4 3
12213    gitlogo copy gitlogoplus  -to  1 9
12214    gitlogo copy gitlogoplus  -to  6 9
12215    gitlogo copy gitlogoplus  -to 11 9
12216    image delete gitlogoplus
12217
12218    image create photo gitlogo32    -width 32 -height 32
12219    gitlogo32 copy gitlogo -zoom 2 2
12220
12221    wm iconphoto . -default gitlogo gitlogo32
12222}
12223# wait for the window to become visible
12224tkwait visibility .
12225wm title . "$appname: [reponame]"
12226update
12227readrefs
12228
12229if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
12230    # create a view for the files/dirs specified on the command line
12231    set curview 1
12232    set selectedview 1
12233    set nextviewnum 2
12234    set viewname(1) [mc "Command line"]
12235    set viewfiles(1) $cmdline_files
12236    set viewargs(1) $revtreeargs
12237    set viewargscmd(1) $revtreeargscmd
12238    set viewperm(1) 0
12239    set vdatemode(1) 0
12240    addviewmenu 1
12241    .bar.view entryconf [mca "Edit view..."] -state normal
12242    .bar.view entryconf [mca "Delete view"] -state normal
12243}
12244
12245if {[info exists permviews]} {
12246    foreach v $permviews {
12247        set n $nextviewnum
12248        incr nextviewnum
12249        set viewname($n) [lindex $v 0]
12250        set viewfiles($n) [lindex $v 1]
12251        set viewargs($n) [lindex $v 2]
12252        set viewargscmd($n) [lindex $v 3]
12253        set viewperm($n) 1
12254        addviewmenu $n
12255    }
12256}
12257
12258if {[tk windowingsystem] eq "win32"} {
12259    focus -force .
12260}
12261
12262getcommits {}
12263
12264# Local variables:
12265# mode: tcl
12266# indent-tabs-mode: t
12267# tab-width: 8
12268# End: