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