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