gitkon commit gitk: Improve display of list of nearby tags and heads (d34835c)
   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
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    if {[llength $tags] > $maxrefs} {
6896        $ctext insert $pos "[mc "many"] ([llength $tags])"
6897    } else {
6898        set tags [lsort -index 0 -decreasing $tags]
6899        set sep {}
6900        foreach ti $tags {
6901            set id [lindex $ti 1]
6902            set lk link$linknum
6903            incr linknum
6904            $ctext tag delete $lk
6905            $ctext insert $pos $sep
6906            $ctext insert $pos [lindex $ti 0] $lk
6907            setlink $id $lk
6908            set sep ", "
6909        }
6910    }
6911    $ctext tag add wwrap "$pos linestart" "$pos lineend"
6912    $ctext conf -state disabled
6913    return [llength $tags]
6914}
6915
6916# called when we have finished computing the nearby tags
6917proc dispneartags {delay} {
6918    global selectedline currentid showneartags tagphase
6919
6920    if {$selectedline eq {} || !$showneartags} return
6921    after cancel dispnexttag
6922    if {$delay} {
6923        after 200 dispnexttag
6924        set tagphase -1
6925    } else {
6926        after idle dispnexttag
6927        set tagphase 0
6928    }
6929}
6930
6931proc dispnexttag {} {
6932    global selectedline currentid showneartags tagphase ctext
6933
6934    if {$selectedline eq {} || !$showneartags} return
6935    switch -- $tagphase {
6936        0 {
6937            set dtags [desctags $currentid]
6938            if {$dtags ne {}} {
6939                appendrefs precedes $dtags idtags
6940            }
6941        }
6942        1 {
6943            set atags [anctags $currentid]
6944            if {$atags ne {}} {
6945                appendrefs follows $atags idtags
6946            }
6947        }
6948        2 {
6949            set dheads [descheads $currentid]
6950            if {$dheads ne {}} {
6951                if {[appendrefs branch $dheads idheads] > 1
6952                    && [$ctext get "branch -3c"] eq "h"} {
6953                    # turn "Branch" into "Branches"
6954                    $ctext conf -state normal
6955                    $ctext insert "branch -2c" "es"
6956                    $ctext conf -state disabled
6957                }
6958            }
6959        }
6960    }
6961    if {[incr tagphase] <= 2} {
6962        after idle dispnexttag
6963    }
6964}
6965
6966proc make_secsel {id} {
6967    global linehtag linentag linedtag canv canv2 canv3
6968
6969    if {![info exists linehtag($id)]} return
6970    $canv delete secsel
6971    set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
6972               -tags secsel -fill [$canv cget -selectbackground]]
6973    $canv lower $t
6974    $canv2 delete secsel
6975    set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
6976               -tags secsel -fill [$canv2 cget -selectbackground]]
6977    $canv2 lower $t
6978    $canv3 delete secsel
6979    set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
6980               -tags secsel -fill [$canv3 cget -selectbackground]]
6981    $canv3 lower $t
6982}
6983
6984proc make_idmark {id} {
6985    global linehtag canv fgcolor
6986
6987    if {![info exists linehtag($id)]} return
6988    $canv delete markid
6989    set t [eval $canv create rect [$canv bbox $linehtag($id)] \
6990               -tags markid -outline $fgcolor]
6991    $canv raise $t
6992}
6993
6994proc selectline {l isnew {desired_loc {}}} {
6995    global canv ctext commitinfo selectedline
6996    global canvy0 linespc parents children curview
6997    global currentid sha1entry
6998    global commentend idtags linknum
6999    global mergemax numcommits pending_select
7000    global cmitmode showneartags allcommits
7001    global targetrow targetid lastscrollrows
7002    global autoselect autosellen jump_to_here
7003
7004    catch {unset pending_select}
7005    $canv delete hover
7006    normalline
7007    unsel_reflist
7008    stopfinding
7009    if {$l < 0 || $l >= $numcommits} return
7010    set id [commitonrow $l]
7011    set targetid $id
7012    set targetrow $l
7013    set selectedline $l
7014    set currentid $id
7015    if {$lastscrollrows < $numcommits} {
7016        setcanvscroll
7017    }
7018
7019    set y [expr {$canvy0 + $l * $linespc}]
7020    set ymax [lindex [$canv cget -scrollregion] 3]
7021    set ytop [expr {$y - $linespc - 1}]
7022    set ybot [expr {$y + $linespc + 1}]
7023    set wnow [$canv yview]
7024    set wtop [expr {[lindex $wnow 0] * $ymax}]
7025    set wbot [expr {[lindex $wnow 1] * $ymax}]
7026    set wh [expr {$wbot - $wtop}]
7027    set newtop $wtop
7028    if {$ytop < $wtop} {
7029        if {$ybot < $wtop} {
7030            set newtop [expr {$y - $wh / 2.0}]
7031        } else {
7032            set newtop $ytop
7033            if {$newtop > $wtop - $linespc} {
7034                set newtop [expr {$wtop - $linespc}]
7035            }
7036        }
7037    } elseif {$ybot > $wbot} {
7038        if {$ytop > $wbot} {
7039            set newtop [expr {$y - $wh / 2.0}]
7040        } else {
7041            set newtop [expr {$ybot - $wh}]
7042            if {$newtop < $wtop + $linespc} {
7043                set newtop [expr {$wtop + $linespc}]
7044            }
7045        }
7046    }
7047    if {$newtop != $wtop} {
7048        if {$newtop < 0} {
7049            set newtop 0
7050        }
7051        allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7052        drawvisible
7053    }
7054
7055    make_secsel $id
7056
7057    if {$isnew} {
7058        addtohistory [list selbyid $id 0] savecmitpos
7059    }
7060
7061    $sha1entry delete 0 end
7062    $sha1entry insert 0 $id
7063    if {$autoselect} {
7064        $sha1entry selection range 0 $autosellen
7065    }
7066    rhighlight_sel $id
7067
7068    $ctext conf -state normal
7069    clear_ctext
7070    set linknum 0
7071    if {![info exists commitinfo($id)]} {
7072        getcommit $id
7073    }
7074    set info $commitinfo($id)
7075    set date [formatdate [lindex $info 2]]
7076    $ctext insert end "[mc "Author"]: [lindex $info 1]  $date\n"
7077    set date [formatdate [lindex $info 4]]
7078    $ctext insert end "[mc "Committer"]: [lindex $info 3]  $date\n"
7079    if {[info exists idtags($id)]} {
7080        $ctext insert end [mc "Tags:"]
7081        foreach tag $idtags($id) {
7082            $ctext insert end " $tag"
7083        }
7084        $ctext insert end "\n"
7085    }
7086
7087    set headers {}
7088    set olds $parents($curview,$id)
7089    if {[llength $olds] > 1} {
7090        set np 0
7091        foreach p $olds {
7092            if {$np >= $mergemax} {
7093                set tag mmax
7094            } else {
7095                set tag m$np
7096            }
7097            $ctext insert end "[mc "Parent"]: " $tag
7098            appendwithlinks [commit_descriptor $p] {}
7099            incr np
7100        }
7101    } else {
7102        foreach p $olds {
7103            append headers "[mc "Parent"]: [commit_descriptor $p]"
7104        }
7105    }
7106
7107    foreach c $children($curview,$id) {
7108        append headers "[mc "Child"]:  [commit_descriptor $c]"
7109    }
7110
7111    # make anything that looks like a SHA1 ID be a clickable link
7112    appendwithlinks $headers {}
7113    if {$showneartags} {
7114        if {![info exists allcommits]} {
7115            getallcommits
7116        }
7117        $ctext insert end "[mc "Branch"]: "
7118        $ctext mark set branch "end -1c"
7119        $ctext mark gravity branch left
7120        $ctext insert end "\n[mc "Follows"]: "
7121        $ctext mark set follows "end -1c"
7122        $ctext mark gravity follows left
7123        $ctext insert end "\n[mc "Precedes"]: "
7124        $ctext mark set precedes "end -1c"
7125        $ctext mark gravity precedes left
7126        $ctext insert end "\n"
7127        dispneartags 1
7128    }
7129    $ctext insert end "\n"
7130    set comment [lindex $info 5]
7131    if {[string first "\r" $comment] >= 0} {
7132        set comment [string map {"\r" "\n    "} $comment]
7133    }
7134    appendwithlinks $comment {comment}
7135
7136    $ctext tag remove found 1.0 end
7137    $ctext conf -state disabled
7138    set commentend [$ctext index "end - 1c"]
7139
7140    set jump_to_here $desired_loc
7141    init_flist [mc "Comments"]
7142    if {$cmitmode eq "tree"} {
7143        gettree $id
7144    } elseif {[llength $olds] <= 1} {
7145        startdiff $id
7146    } else {
7147        mergediff $id
7148    }
7149}
7150
7151proc selfirstline {} {
7152    unmarkmatches
7153    selectline 0 1
7154}
7155
7156proc sellastline {} {
7157    global numcommits
7158    unmarkmatches
7159    set l [expr {$numcommits - 1}]
7160    selectline $l 1
7161}
7162
7163proc selnextline {dir} {
7164    global selectedline
7165    focus .
7166    if {$selectedline eq {}} return
7167    set l [expr {$selectedline + $dir}]
7168    unmarkmatches
7169    selectline $l 1
7170}
7171
7172proc selnextpage {dir} {
7173    global canv linespc selectedline numcommits
7174
7175    set lpp [expr {([winfo height $canv] - 2) / $linespc}]
7176    if {$lpp < 1} {
7177        set lpp 1
7178    }
7179    allcanvs yview scroll [expr {$dir * $lpp}] units
7180    drawvisible
7181    if {$selectedline eq {}} return
7182    set l [expr {$selectedline + $dir * $lpp}]
7183    if {$l < 0} {
7184        set l 0
7185    } elseif {$l >= $numcommits} {
7186        set l [expr $numcommits - 1]
7187    }
7188    unmarkmatches
7189    selectline $l 1
7190}
7191
7192proc unselectline {} {
7193    global selectedline currentid
7194
7195    set selectedline {}
7196    catch {unset currentid}
7197    allcanvs delete secsel
7198    rhighlight_none
7199}
7200
7201proc reselectline {} {
7202    global selectedline
7203
7204    if {$selectedline ne {}} {
7205        selectline $selectedline 0
7206    }
7207}
7208
7209proc addtohistory {cmd {saveproc {}}} {
7210    global history historyindex curview
7211
7212    unset_posvars
7213    save_position
7214    set elt [list $curview $cmd $saveproc {}]
7215    if {$historyindex > 0
7216        && [lindex $history [expr {$historyindex - 1}]] == $elt} {
7217        return
7218    }
7219
7220    if {$historyindex < [llength $history]} {
7221        set history [lreplace $history $historyindex end $elt]
7222    } else {
7223        lappend history $elt
7224    }
7225    incr historyindex
7226    if {$historyindex > 1} {
7227        .tf.bar.leftbut conf -state normal
7228    } else {
7229        .tf.bar.leftbut conf -state disabled
7230    }
7231    .tf.bar.rightbut conf -state disabled
7232}
7233
7234# save the scrolling position of the diff display pane
7235proc save_position {} {
7236    global historyindex history
7237
7238    if {$historyindex < 1} return
7239    set hi [expr {$historyindex - 1}]
7240    set fn [lindex $history $hi 2]
7241    if {$fn ne {}} {
7242        lset history $hi 3 [eval $fn]
7243    }
7244}
7245
7246proc unset_posvars {} {
7247    global last_posvars
7248
7249    if {[info exists last_posvars]} {
7250        foreach {var val} $last_posvars {
7251            global $var
7252            catch {unset $var}
7253        }
7254        unset last_posvars
7255    }
7256}
7257
7258proc godo {elt} {
7259    global curview last_posvars
7260
7261    set view [lindex $elt 0]
7262    set cmd [lindex $elt 1]
7263    set pv [lindex $elt 3]
7264    if {$curview != $view} {
7265        showview $view
7266    }
7267    unset_posvars
7268    foreach {var val} $pv {
7269        global $var
7270        set $var $val
7271    }
7272    set last_posvars $pv
7273    eval $cmd
7274}
7275
7276proc goback {} {
7277    global history historyindex
7278    focus .
7279
7280    if {$historyindex > 1} {
7281        save_position
7282        incr historyindex -1
7283        godo [lindex $history [expr {$historyindex - 1}]]
7284        .tf.bar.rightbut conf -state normal
7285    }
7286    if {$historyindex <= 1} {
7287        .tf.bar.leftbut conf -state disabled
7288    }
7289}
7290
7291proc goforw {} {
7292    global history historyindex
7293    focus .
7294
7295    if {$historyindex < [llength $history]} {
7296        save_position
7297        set cmd [lindex $history $historyindex]
7298        incr historyindex
7299        godo $cmd
7300        .tf.bar.leftbut conf -state normal
7301    }
7302    if {$historyindex >= [llength $history]} {
7303        .tf.bar.rightbut conf -state disabled
7304    }
7305}
7306
7307proc gettree {id} {
7308    global treefilelist treeidlist diffids diffmergeid treepending
7309    global nullid nullid2
7310
7311    set diffids $id
7312    catch {unset diffmergeid}
7313    if {![info exists treefilelist($id)]} {
7314        if {![info exists treepending]} {
7315            if {$id eq $nullid} {
7316                set cmd [list | git ls-files]
7317            } elseif {$id eq $nullid2} {
7318                set cmd [list | git ls-files --stage -t]
7319            } else {
7320                set cmd [list | git ls-tree -r $id]
7321            }
7322            if {[catch {set gtf [open $cmd r]}]} {
7323                return
7324            }
7325            set treepending $id
7326            set treefilelist($id) {}
7327            set treeidlist($id) {}
7328            fconfigure $gtf -blocking 0 -encoding binary
7329            filerun $gtf [list gettreeline $gtf $id]
7330        }
7331    } else {
7332        setfilelist $id
7333    }
7334}
7335
7336proc gettreeline {gtf id} {
7337    global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
7338
7339    set nl 0
7340    while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
7341        if {$diffids eq $nullid} {
7342            set fname $line
7343        } else {
7344            set i [string first "\t" $line]
7345            if {$i < 0} continue
7346            set fname [string range $line [expr {$i+1}] end]
7347            set line [string range $line 0 [expr {$i-1}]]
7348            if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7349            set sha1 [lindex $line 2]
7350            lappend treeidlist($id) $sha1
7351        }
7352        if {[string index $fname 0] eq "\""} {
7353            set fname [lindex $fname 0]
7354        }
7355        set fname [encoding convertfrom $fname]
7356        lappend treefilelist($id) $fname
7357    }
7358    if {![eof $gtf]} {
7359        return [expr {$nl >= 1000? 2: 1}]
7360    }
7361    close $gtf
7362    unset treepending
7363    if {$cmitmode ne "tree"} {
7364        if {![info exists diffmergeid]} {
7365            gettreediffs $diffids
7366        }
7367    } elseif {$id ne $diffids} {
7368        gettree $diffids
7369    } else {
7370        setfilelist $id
7371    }
7372    return 0
7373}
7374
7375proc showfile {f} {
7376    global treefilelist treeidlist diffids nullid nullid2
7377    global ctext_file_names ctext_file_lines
7378    global ctext commentend
7379
7380    set i [lsearch -exact $treefilelist($diffids) $f]
7381    if {$i < 0} {
7382        puts "oops, $f not in list for id $diffids"
7383        return
7384    }
7385    if {$diffids eq $nullid} {
7386        if {[catch {set bf [open $f r]} err]} {
7387            puts "oops, can't read $f: $err"
7388            return
7389        }
7390    } else {
7391        set blob [lindex $treeidlist($diffids) $i]
7392        if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7393            puts "oops, error reading blob $blob: $err"
7394            return
7395        }
7396    }
7397    fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7398    filerun $bf [list getblobline $bf $diffids]
7399    $ctext config -state normal
7400    clear_ctext $commentend
7401    lappend ctext_file_names $f
7402    lappend ctext_file_lines [lindex [split $commentend "."] 0]
7403    $ctext insert end "\n"
7404    $ctext insert end "$f\n" filesep
7405    $ctext config -state disabled
7406    $ctext yview $commentend
7407    settabs 0
7408}
7409
7410proc getblobline {bf id} {
7411    global diffids cmitmode ctext
7412
7413    if {$id ne $diffids || $cmitmode ne "tree"} {
7414        catch {close $bf}
7415        return 0
7416    }
7417    $ctext config -state normal
7418    set nl 0
7419    while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7420        $ctext insert end "$line\n"
7421    }
7422    if {[eof $bf]} {
7423        global jump_to_here ctext_file_names commentend
7424
7425        # delete last newline
7426        $ctext delete "end - 2c" "end - 1c"
7427        close $bf
7428        if {$jump_to_here ne {} &&
7429            [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7430            set lnum [expr {[lindex $jump_to_here 1] +
7431                            [lindex [split $commentend .] 0]}]
7432            mark_ctext_line $lnum
7433        }
7434        $ctext config -state disabled
7435        return 0
7436    }
7437    $ctext config -state disabled
7438    return [expr {$nl >= 1000? 2: 1}]
7439}
7440
7441proc mark_ctext_line {lnum} {
7442    global ctext markbgcolor
7443
7444    $ctext tag delete omark
7445    $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7446    $ctext tag conf omark -background $markbgcolor
7447    $ctext see $lnum.0
7448}
7449
7450proc mergediff {id} {
7451    global diffmergeid
7452    global diffids treediffs
7453    global parents curview
7454
7455    set diffmergeid $id
7456    set diffids $id
7457    set treediffs($id) {}
7458    set np [llength $parents($curview,$id)]
7459    settabs $np
7460    getblobdiffs $id
7461}
7462
7463proc startdiff {ids} {
7464    global treediffs diffids treepending diffmergeid nullid nullid2
7465
7466    settabs 1
7467    set diffids $ids
7468    catch {unset diffmergeid}
7469    if {![info exists treediffs($ids)] ||
7470        [lsearch -exact $ids $nullid] >= 0 ||
7471        [lsearch -exact $ids $nullid2] >= 0} {
7472        if {![info exists treepending]} {
7473            gettreediffs $ids
7474        }
7475    } else {
7476        addtocflist $ids
7477    }
7478}
7479
7480# If the filename (name) is under any of the passed filter paths
7481# then return true to include the file in the listing.
7482proc path_filter {filter name} {
7483    set worktree [gitworktree]
7484    foreach p $filter {
7485        set fq_p [file normalize $p]
7486        set fq_n [file normalize [file join $worktree $name]]
7487        if {[string match [file normalize $fq_p]* $fq_n]} {
7488            return 1
7489        }
7490    }
7491    return 0
7492}
7493
7494proc addtocflist {ids} {
7495    global treediffs
7496
7497    add_flist $treediffs($ids)
7498    getblobdiffs $ids
7499}
7500
7501proc diffcmd {ids flags} {
7502    global log_showroot nullid nullid2
7503
7504    set i [lsearch -exact $ids $nullid]
7505    set j [lsearch -exact $ids $nullid2]
7506    if {$i >= 0} {
7507        if {[llength $ids] > 1 && $j < 0} {
7508            # comparing working directory with some specific revision
7509            set cmd [concat | git diff-index $flags]
7510            if {$i == 0} {
7511                lappend cmd -R [lindex $ids 1]
7512            } else {
7513                lappend cmd [lindex $ids 0]
7514            }
7515        } else {
7516            # comparing working directory with index
7517            set cmd [concat | git diff-files $flags]
7518            if {$j == 1} {
7519                lappend cmd -R
7520            }
7521        }
7522    } elseif {$j >= 0} {
7523        set cmd [concat | git diff-index --cached $flags]
7524        if {[llength $ids] > 1} {
7525            # comparing index with specific revision
7526            if {$j == 0} {
7527                lappend cmd -R [lindex $ids 1]
7528            } else {
7529                lappend cmd [lindex $ids 0]
7530            }
7531        } else {
7532            # comparing index with HEAD
7533            lappend cmd HEAD
7534        }
7535    } else {
7536        if {$log_showroot} {
7537            lappend flags --root
7538        }
7539        set cmd [concat | git diff-tree -r $flags $ids]
7540    }
7541    return $cmd
7542}
7543
7544proc gettreediffs {ids} {
7545    global treediff treepending
7546
7547    if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
7548
7549    set treepending $ids
7550    set treediff {}
7551    fconfigure $gdtf -blocking 0 -encoding binary
7552    filerun $gdtf [list gettreediffline $gdtf $ids]
7553}
7554
7555proc gettreediffline {gdtf ids} {
7556    global treediff treediffs treepending diffids diffmergeid
7557    global cmitmode vfilelimit curview limitdiffs perfile_attrs
7558
7559    set nr 0
7560    set sublist {}
7561    set max 1000
7562    if {$perfile_attrs} {
7563        # cache_gitattr is slow, and even slower on win32 where we
7564        # have to invoke it for only about 30 paths at a time
7565        set max 500
7566        if {[tk windowingsystem] == "win32"} {
7567            set max 120
7568        }
7569    }
7570    while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7571        set i [string first "\t" $line]
7572        if {$i >= 0} {
7573            set file [string range $line [expr {$i+1}] end]
7574            if {[string index $file 0] eq "\""} {
7575                set file [lindex $file 0]
7576            }
7577            set file [encoding convertfrom $file]
7578            if {$file ne [lindex $treediff end]} {
7579                lappend treediff $file
7580                lappend sublist $file
7581            }
7582        }
7583    }
7584    if {$perfile_attrs} {
7585        cache_gitattr encoding $sublist
7586    }
7587    if {![eof $gdtf]} {
7588        return [expr {$nr >= $max? 2: 1}]
7589    }
7590    close $gdtf
7591    if {$limitdiffs && $vfilelimit($curview) ne {}} {
7592        set flist {}
7593        foreach f $treediff {
7594            if {[path_filter $vfilelimit($curview) $f]} {
7595                lappend flist $f
7596            }
7597        }
7598        set treediffs($ids) $flist
7599    } else {
7600        set treediffs($ids) $treediff
7601    }
7602    unset treepending
7603    if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7604        gettree $diffids
7605    } elseif {$ids != $diffids} {
7606        if {![info exists diffmergeid]} {
7607            gettreediffs $diffids
7608        }
7609    } else {
7610        addtocflist $ids
7611    }
7612    return 0
7613}
7614
7615# empty string or positive integer
7616proc diffcontextvalidate {v} {
7617    return [regexp {^(|[1-9][0-9]*)$} $v]
7618}
7619
7620proc diffcontextchange {n1 n2 op} {
7621    global diffcontextstring diffcontext
7622
7623    if {[string is integer -strict $diffcontextstring]} {
7624        if {$diffcontextstring >= 0} {
7625            set diffcontext $diffcontextstring
7626            reselectline
7627        }
7628    }
7629}
7630
7631proc changeignorespace {} {
7632    reselectline
7633}
7634
7635proc changeworddiff {name ix op} {
7636    reselectline
7637}
7638
7639proc getblobdiffs {ids} {
7640    global blobdifffd diffids env
7641    global diffinhdr treediffs
7642    global diffcontext
7643    global ignorespace
7644    global worddiff
7645    global limitdiffs vfilelimit curview
7646    global diffencoding targetline diffnparents
7647    global git_version currdiffsubmod
7648
7649    set textconv {}
7650    if {[package vcompare $git_version "1.6.1"] >= 0} {
7651        set textconv "--textconv"
7652    }
7653    set submodule {}
7654    if {[package vcompare $git_version "1.6.6"] >= 0} {
7655        set submodule "--submodule"
7656    }
7657    set cmd [diffcmd $ids "-p $textconv $submodule  -C --cc --no-commit-id -U$diffcontext"]
7658    if {$ignorespace} {
7659        append cmd " -w"
7660    }
7661    if {$worddiff ne [mc "Line diff"]} {
7662        append cmd " --word-diff=porcelain"
7663    }
7664    if {$limitdiffs && $vfilelimit($curview) ne {}} {
7665        set cmd [concat $cmd -- $vfilelimit($curview)]
7666    }
7667    if {[catch {set bdf [open $cmd r]} err]} {
7668        error_popup [mc "Error getting diffs: %s" $err]
7669        return
7670    }
7671    set targetline {}
7672    set diffnparents 0
7673    set diffinhdr 0
7674    set diffencoding [get_path_encoding {}]
7675    fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
7676    set blobdifffd($ids) $bdf
7677    set currdiffsubmod ""
7678    filerun $bdf [list getblobdiffline $bdf $diffids]
7679}
7680
7681proc savecmitpos {} {
7682    global ctext cmitmode
7683
7684    if {$cmitmode eq "tree"} {
7685        return {}
7686    }
7687    return [list target_scrollpos [$ctext index @0,0]]
7688}
7689
7690proc savectextpos {} {
7691    global ctext
7692
7693    return [list target_scrollpos [$ctext index @0,0]]
7694}
7695
7696proc maybe_scroll_ctext {ateof} {
7697    global ctext target_scrollpos
7698
7699    if {![info exists target_scrollpos]} return
7700    if {!$ateof} {
7701        set nlines [expr {[winfo height $ctext]
7702                          / [font metrics textfont -linespace]}]
7703        if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
7704    }
7705    $ctext yview $target_scrollpos
7706    unset target_scrollpos
7707}
7708
7709proc setinlist {var i val} {
7710    global $var
7711
7712    while {[llength [set $var]] < $i} {
7713        lappend $var {}
7714    }
7715    if {[llength [set $var]] == $i} {
7716        lappend $var $val
7717    } else {
7718        lset $var $i $val
7719    }
7720}
7721
7722proc makediffhdr {fname ids} {
7723    global ctext curdiffstart treediffs diffencoding
7724    global ctext_file_names jump_to_here targetline diffline
7725
7726    set fname [encoding convertfrom $fname]
7727    set diffencoding [get_path_encoding $fname]
7728    set i [lsearch -exact $treediffs($ids) $fname]
7729    if {$i >= 0} {
7730        setinlist difffilestart $i $curdiffstart
7731    }
7732    lset ctext_file_names end $fname
7733    set l [expr {(78 - [string length $fname]) / 2}]
7734    set pad [string range "----------------------------------------" 1 $l]
7735    $ctext insert $curdiffstart "$pad $fname $pad" filesep
7736    set targetline {}
7737    if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
7738        set targetline [lindex $jump_to_here 1]
7739    }
7740    set diffline 0
7741}
7742
7743proc getblobdiffline {bdf ids} {
7744    global diffids blobdifffd ctext curdiffstart
7745    global diffnexthead diffnextnote difffilestart
7746    global ctext_file_names ctext_file_lines
7747    global diffinhdr treediffs mergemax diffnparents
7748    global diffencoding jump_to_here targetline diffline currdiffsubmod
7749    global worddiff
7750
7751    set nr 0
7752    $ctext conf -state normal
7753    while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
7754        if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
7755            catch {close $bdf}
7756            return 0
7757        }
7758        if {![string compare -length 5 "diff " $line]} {
7759            if {![regexp {^diff (--cc|--git) } $line m type]} {
7760                set line [encoding convertfrom $line]
7761                $ctext insert end "$line\n" hunksep
7762                continue
7763            }
7764            # start of a new file
7765            set diffinhdr 1
7766            $ctext insert end "\n"
7767            set curdiffstart [$ctext index "end - 1c"]
7768            lappend ctext_file_names ""
7769            lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7770            $ctext insert end "\n" filesep
7771
7772            if {$type eq "--cc"} {
7773                # start of a new file in a merge diff
7774                set fname [string range $line 10 end]
7775                if {[lsearch -exact $treediffs($ids) $fname] < 0} {
7776                    lappend treediffs($ids) $fname
7777                    add_flist [list $fname]
7778                }
7779
7780            } else {
7781                set line [string range $line 11 end]
7782                # If the name hasn't changed the length will be odd,
7783                # the middle char will be a space, and the two bits either
7784                # side will be a/name and b/name, or "a/name" and "b/name".
7785                # If the name has changed we'll get "rename from" and
7786                # "rename to" or "copy from" and "copy to" lines following
7787                # this, and we'll use them to get the filenames.
7788                # This complexity is necessary because spaces in the
7789                # filename(s) don't get escaped.
7790                set l [string length $line]
7791                set i [expr {$l / 2}]
7792                if {!(($l & 1) && [string index $line $i] eq " " &&
7793                      [string range $line 2 [expr {$i - 1}]] eq \
7794                          [string range $line [expr {$i + 3}] end])} {
7795                    continue
7796                }
7797                # unescape if quoted and chop off the a/ from the front
7798                if {[string index $line 0] eq "\""} {
7799                    set fname [string range [lindex $line 0] 2 end]
7800                } else {
7801                    set fname [string range $line 2 [expr {$i - 1}]]
7802                }
7803            }
7804            makediffhdr $fname $ids
7805
7806        } elseif {![string compare -length 16 "* Unmerged path " $line]} {
7807            set fname [encoding convertfrom [string range $line 16 end]]
7808            $ctext insert end "\n"
7809            set curdiffstart [$ctext index "end - 1c"]
7810            lappend ctext_file_names $fname
7811            lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7812            $ctext insert end "$line\n" filesep
7813            set i [lsearch -exact $treediffs($ids) $fname]
7814            if {$i >= 0} {
7815                setinlist difffilestart $i $curdiffstart
7816            }
7817
7818        } elseif {![string compare -length 2 "@@" $line]} {
7819            regexp {^@@+} $line ats
7820            set line [encoding convertfrom $diffencoding $line]
7821            $ctext insert end "$line\n" hunksep
7822            if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
7823                set diffline $nl
7824            }
7825            set diffnparents [expr {[string length $ats] - 1}]
7826            set diffinhdr 0
7827
7828        } elseif {![string compare -length 10 "Submodule " $line]} {
7829            # start of a new submodule
7830            if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
7831                set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
7832            } else {
7833                set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
7834            }
7835            if {$currdiffsubmod != $fname} {
7836                $ctext insert end "\n";     # Add newline after commit message
7837            }
7838            set curdiffstart [$ctext index "end - 1c"]
7839            lappend ctext_file_names ""
7840            if {$currdiffsubmod != $fname} {
7841                lappend ctext_file_lines $fname
7842                makediffhdr $fname $ids
7843                set currdiffsubmod $fname
7844                $ctext insert end "\n$line\n" filesep
7845            } else {
7846                $ctext insert end "$line\n" filesep
7847            }
7848        } elseif {![string compare -length 3 "  >" $line]} {
7849            set $currdiffsubmod ""
7850            set line [encoding convertfrom $diffencoding $line]
7851            $ctext insert end "$line\n" dresult
7852        } elseif {![string compare -length 3 "  <" $line]} {
7853            set $currdiffsubmod ""
7854            set line [encoding convertfrom $diffencoding $line]
7855            $ctext insert end "$line\n" d0
7856        } elseif {$diffinhdr} {
7857            if {![string compare -length 12 "rename from " $line]} {
7858                set fname [string range $line [expr 6 + [string first " from " $line] ] end]
7859                if {[string index $fname 0] eq "\""} {
7860                    set fname [lindex $fname 0]
7861                }
7862                set fname [encoding convertfrom $fname]
7863                set i [lsearch -exact $treediffs($ids) $fname]
7864                if {$i >= 0} {
7865                    setinlist difffilestart $i $curdiffstart
7866                }
7867            } elseif {![string compare -length 10 $line "rename to "] ||
7868                      ![string compare -length 8 $line "copy to "]} {
7869                set fname [string range $line [expr 4 + [string first " to " $line] ] end]
7870                if {[string index $fname 0] eq "\""} {
7871                    set fname [lindex $fname 0]
7872                }
7873                makediffhdr $fname $ids
7874            } elseif {[string compare -length 3 $line "---"] == 0} {
7875                # do nothing
7876                continue
7877            } elseif {[string compare -length 3 $line "+++"] == 0} {
7878                set diffinhdr 0
7879                continue
7880            }
7881            $ctext insert end "$line\n" filesep
7882
7883        } else {
7884            set line [string map {\x1A ^Z} \
7885                          [encoding convertfrom $diffencoding $line]]
7886            # parse the prefix - one ' ', '-' or '+' for each parent
7887            set prefix [string range $line 0 [expr {$diffnparents - 1}]]
7888            set tag [expr {$diffnparents > 1? "m": "d"}]
7889            set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
7890            set words_pre_markup ""
7891            set words_post_markup ""
7892            if {[string trim $prefix " -+"] eq {}} {
7893                # prefix only has " ", "-" and "+" in it: normal diff line
7894                set num [string first "-" $prefix]
7895                if {$dowords} {
7896                    set line [string range $line 1 end]
7897                }
7898                if {$num >= 0} {
7899                    # removed line, first parent with line is $num
7900                    if {$num >= $mergemax} {
7901                        set num "max"
7902                    }
7903                    if {$dowords && $worddiff eq [mc "Markup words"]} {
7904                        $ctext insert end "\[-$line-\]" $tag$num
7905                    } else {
7906                        $ctext insert end "$line" $tag$num
7907                    }
7908                    if {!$dowords} {
7909                        $ctext insert end "\n" $tag$num
7910                    }
7911                } else {
7912                    set tags {}
7913                    if {[string first "+" $prefix] >= 0} {
7914                        # added line
7915                        lappend tags ${tag}result
7916                        if {$diffnparents > 1} {
7917                            set num [string first " " $prefix]
7918                            if {$num >= 0} {
7919                                if {$num >= $mergemax} {
7920                                    set num "max"
7921                                }
7922                                lappend tags m$num
7923                            }
7924                        }
7925                        set words_pre_markup "{+"
7926                        set words_post_markup "+}"
7927                    }
7928                    if {$targetline ne {}} {
7929                        if {$diffline == $targetline} {
7930                            set seehere [$ctext index "end - 1 chars"]
7931                            set targetline {}
7932                        } else {
7933                            incr diffline
7934                        }
7935                    }
7936                    if {$dowords && $worddiff eq [mc "Markup words"]} {
7937                        $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
7938                    } else {
7939                        $ctext insert end "$line" $tags
7940                    }
7941                    if {!$dowords} {
7942                        $ctext insert end "\n" $tags
7943                    }
7944                }
7945            } elseif {$dowords && $prefix eq "~"} {
7946                $ctext insert end "\n" {}
7947            } else {
7948                # "\ No newline at end of file",
7949                # or something else we don't recognize
7950                $ctext insert end "$line\n" hunksep
7951            }
7952        }
7953    }
7954    if {[info exists seehere]} {
7955        mark_ctext_line [lindex [split $seehere .] 0]
7956    }
7957    maybe_scroll_ctext [eof $bdf]
7958    $ctext conf -state disabled
7959    if {[eof $bdf]} {
7960        catch {close $bdf}
7961        return 0
7962    }
7963    return [expr {$nr >= 1000? 2: 1}]
7964}
7965
7966proc changediffdisp {} {
7967    global ctext diffelide
7968
7969    $ctext tag conf d0 -elide [lindex $diffelide 0]
7970    $ctext tag conf dresult -elide [lindex $diffelide 1]
7971}
7972
7973proc highlightfile {cline} {
7974    global cflist cflist_top
7975
7976    if {![info exists cflist_top]} return
7977
7978    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
7979    $cflist tag add highlight $cline.0 "$cline.0 lineend"
7980    $cflist see $cline.0
7981    set cflist_top $cline
7982}
7983
7984proc highlightfile_for_scrollpos {topidx} {
7985    global cmitmode difffilestart
7986
7987    if {$cmitmode eq "tree"} return
7988    if {![info exists difffilestart]} return
7989
7990    set top [lindex [split $topidx .] 0]
7991    if {$difffilestart eq {} || $top < [lindex $difffilestart 0]} {
7992        highlightfile 0
7993    } else {
7994        highlightfile [expr {[bsearch $difffilestart $top] + 2}]
7995    }
7996}
7997
7998proc prevfile {} {
7999    global difffilestart ctext cmitmode
8000
8001    if {$cmitmode eq "tree"} return
8002    set prev 0.0
8003    set here [$ctext index @0,0]
8004    foreach loc $difffilestart {
8005        if {[$ctext compare $loc >= $here]} {
8006            $ctext yview $prev
8007            return
8008        }
8009        set prev $loc
8010    }
8011    $ctext yview $prev
8012}
8013
8014proc nextfile {} {
8015    global difffilestart ctext cmitmode
8016
8017    if {$cmitmode eq "tree"} return
8018    set here [$ctext index @0,0]
8019    foreach loc $difffilestart {
8020        if {[$ctext compare $loc > $here]} {
8021            $ctext yview $loc
8022            return
8023        }
8024    }
8025}
8026
8027proc clear_ctext {{first 1.0}} {
8028    global ctext smarktop smarkbot
8029    global ctext_file_names ctext_file_lines
8030    global pendinglinks
8031
8032    set l [lindex [split $first .] 0]
8033    if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
8034        set smarktop $l
8035    }
8036    if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
8037        set smarkbot $l
8038    }
8039    $ctext delete $first end
8040    if {$first eq "1.0"} {
8041        catch {unset pendinglinks}
8042    }
8043    set ctext_file_names {}
8044    set ctext_file_lines {}
8045}
8046
8047proc settabs {{firstab {}}} {
8048    global firsttabstop tabstop ctext have_tk85
8049
8050    if {$firstab ne {} && $have_tk85} {
8051        set firsttabstop $firstab
8052    }
8053    set w [font measure textfont "0"]
8054    if {$firsttabstop != 0} {
8055        $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
8056                               [expr {($firsttabstop + 2 * $tabstop) * $w}]]
8057    } elseif {$have_tk85 || $tabstop != 8} {
8058        $ctext conf -tabs [expr {$tabstop * $w}]
8059    } else {
8060        $ctext conf -tabs {}
8061    }
8062}
8063
8064proc incrsearch {name ix op} {
8065    global ctext searchstring searchdirn
8066
8067    if {[catch {$ctext index anchor}]} {
8068        # no anchor set, use start of selection, or of visible area
8069        set sel [$ctext tag ranges sel]
8070        if {$sel ne {}} {
8071            $ctext mark set anchor [lindex $sel 0]
8072        } elseif {$searchdirn eq "-forwards"} {
8073            $ctext mark set anchor @0,0
8074        } else {
8075            $ctext mark set anchor @0,[winfo height $ctext]
8076        }
8077    }
8078    if {$searchstring ne {}} {
8079        set here [$ctext search -count mlen $searchdirn -- $searchstring anchor]
8080        if {$here ne {}} {
8081            $ctext see $here
8082            set mend "$here + $mlen c"
8083            $ctext tag remove sel 1.0 end
8084            $ctext tag add sel $here $mend
8085            suppress_highlighting_file_for_current_scrollpos
8086            highlightfile_for_scrollpos $here
8087        }
8088    }
8089    rehighlight_search_results
8090}
8091
8092proc dosearch {} {
8093    global sstring ctext searchstring searchdirn
8094
8095    focus $sstring
8096    $sstring icursor end
8097    set searchdirn -forwards
8098    if {$searchstring ne {}} {
8099        set sel [$ctext tag ranges sel]
8100        if {$sel ne {}} {
8101            set start "[lindex $sel 0] + 1c"
8102        } elseif {[catch {set start [$ctext index anchor]}]} {
8103            set start "@0,0"
8104        }
8105        set match [$ctext search -count mlen -- $searchstring $start]
8106        $ctext tag remove sel 1.0 end
8107        if {$match eq {}} {
8108            bell
8109            return
8110        }
8111        $ctext see $match
8112        suppress_highlighting_file_for_current_scrollpos
8113        highlightfile_for_scrollpos $match
8114        set mend "$match + $mlen c"
8115        $ctext tag add sel $match $mend
8116        $ctext mark unset anchor
8117        rehighlight_search_results
8118    }
8119}
8120
8121proc dosearchback {} {
8122    global sstring ctext searchstring searchdirn
8123
8124    focus $sstring
8125    $sstring icursor end
8126    set searchdirn -backwards
8127    if {$searchstring ne {}} {
8128        set sel [$ctext tag ranges sel]
8129        if {$sel ne {}} {
8130            set start [lindex $sel 0]
8131        } elseif {[catch {set start [$ctext index anchor]}]} {
8132            set start @0,[winfo height $ctext]
8133        }
8134        set match [$ctext search -backwards -count ml -- $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 + $ml c"
8144        $ctext tag add sel $match $mend
8145        $ctext mark unset anchor
8146        rehighlight_search_results
8147    }
8148}
8149
8150proc rehighlight_search_results {} {
8151    global ctext searchstring
8152
8153    $ctext tag remove found 1.0 end
8154    $ctext tag remove currentsearchhit 1.0 end
8155
8156    if {$searchstring ne {}} {
8157        searchmarkvisible 1
8158    }
8159}
8160
8161proc searchmark {first last} {
8162    global ctext searchstring
8163
8164    set sel [$ctext tag ranges sel]
8165
8166    set mend $first.0
8167    while {1} {
8168        set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8169        if {$match eq {}} break
8170        set mend "$match + $mlen c"
8171        if {$sel ne {} && [$ctext compare $match == [lindex $sel 0]]} {
8172            $ctext tag add currentsearchhit $match $mend
8173        } else {
8174            $ctext tag add found $match $mend
8175        }
8176    }
8177}
8178
8179proc searchmarkvisible {doall} {
8180    global ctext smarktop smarkbot
8181
8182    set topline [lindex [split [$ctext index @0,0] .] 0]
8183    set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8184    if {$doall || $botline < $smarktop || $topline > $smarkbot} {
8185        # no overlap with previous
8186        searchmark $topline $botline
8187        set smarktop $topline
8188        set smarkbot $botline
8189    } else {
8190        if {$topline < $smarktop} {
8191            searchmark $topline [expr {$smarktop-1}]
8192            set smarktop $topline
8193        }
8194        if {$botline > $smarkbot} {
8195            searchmark [expr {$smarkbot+1}] $botline
8196            set smarkbot $botline
8197        }
8198    }
8199}
8200
8201proc suppress_highlighting_file_for_current_scrollpos {} {
8202    global ctext suppress_highlighting_file_for_this_scrollpos
8203
8204    set suppress_highlighting_file_for_this_scrollpos [$ctext index @0,0]
8205}
8206
8207proc scrolltext {f0 f1} {
8208    global searchstring cmitmode ctext
8209    global suppress_highlighting_file_for_this_scrollpos
8210
8211    set topidx [$ctext index @0,0]
8212    if {![info exists suppress_highlighting_file_for_this_scrollpos]
8213        || $topidx ne $suppress_highlighting_file_for_this_scrollpos} {
8214        highlightfile_for_scrollpos $topidx
8215    }
8216
8217    catch {unset suppress_highlighting_file_for_this_scrollpos}
8218
8219    .bleft.bottom.sb set $f0 $f1
8220    if {$searchstring ne {}} {
8221        searchmarkvisible 0
8222    }
8223}
8224
8225proc setcoords {} {
8226    global linespc charspc canvx0 canvy0
8227    global xspc1 xspc2 lthickness
8228
8229    set linespc [font metrics mainfont -linespace]
8230    set charspc [font measure mainfont "m"]
8231    set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8232    set canvx0 [expr {int(3 + 0.5 * $linespc)}]
8233    set lthickness [expr {int($linespc / 9) + 1}]
8234    set xspc1(0) $linespc
8235    set xspc2 $linespc
8236}
8237
8238proc redisplay {} {
8239    global canv
8240    global selectedline
8241
8242    set ymax [lindex [$canv cget -scrollregion] 3]
8243    if {$ymax eq {} || $ymax == 0} return
8244    set span [$canv yview]
8245    clear_display
8246    setcanvscroll
8247    allcanvs yview moveto [lindex $span 0]
8248    drawvisible
8249    if {$selectedline ne {}} {
8250        selectline $selectedline 0
8251        allcanvs yview moveto [lindex $span 0]
8252    }
8253}
8254
8255proc parsefont {f n} {
8256    global fontattr
8257
8258    set fontattr($f,family) [lindex $n 0]
8259    set s [lindex $n 1]
8260    if {$s eq {} || $s == 0} {
8261        set s 10
8262    } elseif {$s < 0} {
8263        set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
8264    }
8265    set fontattr($f,size) $s
8266    set fontattr($f,weight) normal
8267    set fontattr($f,slant) roman
8268    foreach style [lrange $n 2 end] {
8269        switch -- $style {
8270            "normal" -
8271            "bold"   {set fontattr($f,weight) $style}
8272            "roman" -
8273            "italic" {set fontattr($f,slant) $style}
8274        }
8275    }
8276}
8277
8278proc fontflags {f {isbold 0}} {
8279    global fontattr
8280
8281    return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8282                -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8283                -slant $fontattr($f,slant)]
8284}
8285
8286proc fontname {f} {
8287    global fontattr
8288
8289    set n [list $fontattr($f,family) $fontattr($f,size)]
8290    if {$fontattr($f,weight) eq "bold"} {
8291        lappend n "bold"
8292    }
8293    if {$fontattr($f,slant) eq "italic"} {
8294        lappend n "italic"
8295    }
8296    return $n
8297}
8298
8299proc incrfont {inc} {
8300    global mainfont textfont ctext canv cflist showrefstop
8301    global stopped entries fontattr
8302
8303    unmarkmatches
8304    set s $fontattr(mainfont,size)
8305    incr s $inc
8306    if {$s < 1} {
8307        set s 1
8308    }
8309    set fontattr(mainfont,size) $s
8310    font config mainfont -size $s
8311    font config mainfontbold -size $s
8312    set mainfont [fontname mainfont]
8313    set s $fontattr(textfont,size)
8314    incr s $inc
8315    if {$s < 1} {
8316        set s 1
8317    }
8318    set fontattr(textfont,size) $s
8319    font config textfont -size $s
8320    font config textfontbold -size $s
8321    set textfont [fontname textfont]
8322    setcoords
8323    settabs
8324    redisplay
8325}
8326
8327proc clearsha1 {} {
8328    global sha1entry sha1string
8329    if {[string length $sha1string] == 40} {
8330        $sha1entry delete 0 end
8331    }
8332}
8333
8334proc sha1change {n1 n2 op} {
8335    global sha1string currentid sha1but
8336    if {$sha1string == {}
8337        || ([info exists currentid] && $sha1string == $currentid)} {
8338        set state disabled
8339    } else {
8340        set state normal
8341    }
8342    if {[$sha1but cget -state] == $state} return
8343    if {$state == "normal"} {
8344        $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
8345    } else {
8346        $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
8347    }
8348}
8349
8350proc gotocommit {} {
8351    global sha1string tagids headids curview varcid
8352
8353    if {$sha1string == {}
8354        || ([info exists currentid] && $sha1string == $currentid)} return
8355    if {[info exists tagids($sha1string)]} {
8356        set id $tagids($sha1string)
8357    } elseif {[info exists headids($sha1string)]} {
8358        set id $headids($sha1string)
8359    } else {
8360        set id [string tolower $sha1string]
8361        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
8362            set matches [longid $id]
8363            if {$matches ne {}} {
8364                if {[llength $matches] > 1} {
8365                    error_popup [mc "Short SHA1 id %s is ambiguous" $id]
8366                    return
8367                }
8368                set id [lindex $matches 0]
8369            }
8370        } else {
8371            if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8372                error_popup [mc "Revision %s is not known" $sha1string]
8373                return
8374            }
8375        }
8376    }
8377    if {[commitinview $id $curview]} {
8378        selectline [rowofcommit $id] 1
8379        return
8380    }
8381    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
8382        set msg [mc "SHA1 id %s is not known" $sha1string]
8383    } else {
8384        set msg [mc "Revision %s is not in the current view" $sha1string]
8385    }
8386    error_popup $msg
8387}
8388
8389proc lineenter {x y id} {
8390    global hoverx hovery hoverid hovertimer
8391    global commitinfo canv
8392
8393    if {![info exists commitinfo($id)] && ![getcommit $id]} return
8394    set hoverx $x
8395    set hovery $y
8396    set hoverid $id
8397    if {[info exists hovertimer]} {
8398        after cancel $hovertimer
8399    }
8400    set hovertimer [after 500 linehover]
8401    $canv delete hover
8402}
8403
8404proc linemotion {x y id} {
8405    global hoverx hovery hoverid hovertimer
8406
8407    if {[info exists hoverid] && $id == $hoverid} {
8408        set hoverx $x
8409        set hovery $y
8410        if {[info exists hovertimer]} {
8411            after cancel $hovertimer
8412        }
8413        set hovertimer [after 500 linehover]
8414    }
8415}
8416
8417proc lineleave {id} {
8418    global hoverid hovertimer canv
8419
8420    if {[info exists hoverid] && $id == $hoverid} {
8421        $canv delete hover
8422        if {[info exists hovertimer]} {
8423            after cancel $hovertimer
8424            unset hovertimer
8425        }
8426        unset hoverid
8427    }
8428}
8429
8430proc linehover {} {
8431    global hoverx hovery hoverid hovertimer
8432    global canv linespc lthickness
8433    global commitinfo
8434
8435    set text [lindex $commitinfo($hoverid) 0]
8436    set ymax [lindex [$canv cget -scrollregion] 3]
8437    if {$ymax == {}} return
8438    set yfrac [lindex [$canv yview] 0]
8439    set x [expr {$hoverx + 2 * $linespc}]
8440    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8441    set x0 [expr {$x - 2 * $lthickness}]
8442    set y0 [expr {$y - 2 * $lthickness}]
8443    set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
8444    set y1 [expr {$y + $linespc + 2 * $lthickness}]
8445    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8446               -fill \#ffff80 -outline black -width 1 -tags hover]
8447    $canv raise $t
8448    set t [$canv create text $x $y -anchor nw -text $text -tags hover \
8449               -font mainfont]
8450    $canv raise $t
8451}
8452
8453proc clickisonarrow {id y} {
8454    global lthickness
8455
8456    set ranges [rowranges $id]
8457    set thresh [expr {2 * $lthickness + 6}]
8458    set n [expr {[llength $ranges] - 1}]
8459    for {set i 1} {$i < $n} {incr i} {
8460        set row [lindex $ranges $i]
8461        if {abs([yc $row] - $y) < $thresh} {
8462            return $i
8463        }
8464    }
8465    return {}
8466}
8467
8468proc arrowjump {id n y} {
8469    global canv
8470
8471    # 1 <-> 2, 3 <-> 4, etc...
8472    set n [expr {(($n - 1) ^ 1) + 1}]
8473    set row [lindex [rowranges $id] $n]
8474    set yt [yc $row]
8475    set ymax [lindex [$canv cget -scrollregion] 3]
8476    if {$ymax eq {} || $ymax <= 0} return
8477    set view [$canv yview]
8478    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8479    set yfrac [expr {$yt / $ymax - $yspan / 2}]
8480    if {$yfrac < 0} {
8481        set yfrac 0
8482    }
8483    allcanvs yview moveto $yfrac
8484}
8485
8486proc lineclick {x y id isnew} {
8487    global ctext commitinfo children canv thickerline curview
8488
8489    if {![info exists commitinfo($id)] && ![getcommit $id]} return
8490    unmarkmatches
8491    unselectline
8492    normalline
8493    $canv delete hover
8494    # draw this line thicker than normal
8495    set thickerline $id
8496    drawlines $id
8497    if {$isnew} {
8498        set ymax [lindex [$canv cget -scrollregion] 3]
8499        if {$ymax eq {}} return
8500        set yfrac [lindex [$canv yview] 0]
8501        set y [expr {$y + $yfrac * $ymax}]
8502    }
8503    set dirn [clickisonarrow $id $y]
8504    if {$dirn ne {}} {
8505        arrowjump $id $dirn $y
8506        return
8507    }
8508
8509    if {$isnew} {
8510        addtohistory [list lineclick $x $y $id 0] savectextpos
8511    }
8512    # fill the details pane with info about this line
8513    $ctext conf -state normal
8514    clear_ctext
8515    settabs 0
8516    $ctext insert end "[mc "Parent"]:\t"
8517    $ctext insert end $id link0
8518    setlink $id link0
8519    set info $commitinfo($id)
8520    $ctext insert end "\n\t[lindex $info 0]\n"
8521    $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8522    set date [formatdate [lindex $info 2]]
8523    $ctext insert end "\t[mc "Date"]:\t$date\n"
8524    set kids $children($curview,$id)
8525    if {$kids ne {}} {
8526        $ctext insert end "\n[mc "Children"]:"
8527        set i 0
8528        foreach child $kids {
8529            incr i
8530            if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8531            set info $commitinfo($child)
8532            $ctext insert end "\n\t"
8533            $ctext insert end $child link$i
8534            setlink $child link$i
8535            $ctext insert end "\n\t[lindex $info 0]"
8536            $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8537            set date [formatdate [lindex $info 2]]
8538            $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8539        }
8540    }
8541    maybe_scroll_ctext 1
8542    $ctext conf -state disabled
8543    init_flist {}
8544}
8545
8546proc normalline {} {
8547    global thickerline
8548    if {[info exists thickerline]} {
8549        set id $thickerline
8550        unset thickerline
8551        drawlines $id
8552    }
8553}
8554
8555proc selbyid {id {isnew 1}} {
8556    global curview
8557    if {[commitinview $id $curview]} {
8558        selectline [rowofcommit $id] $isnew
8559    }
8560}
8561
8562proc mstime {} {
8563    global startmstime
8564    if {![info exists startmstime]} {
8565        set startmstime [clock clicks -milliseconds]
8566    }
8567    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8568}
8569
8570proc rowmenu {x y id} {
8571    global rowctxmenu selectedline rowmenuid curview
8572    global nullid nullid2 fakerowmenu mainhead markedid
8573
8574    stopfinding
8575    set rowmenuid $id
8576    if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8577        set state disabled
8578    } else {
8579        set state normal
8580    }
8581    if {[info exists markedid] && $markedid ne $id} {
8582        set mstate normal
8583    } else {
8584        set mstate disabled
8585    }
8586    if {$id ne $nullid && $id ne $nullid2} {
8587        set menu $rowctxmenu
8588        if {$mainhead ne {}} {
8589            $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead] -state normal
8590        } else {
8591            $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8592        }
8593        $menu entryconfigure 9 -state $mstate
8594        $menu entryconfigure 10 -state $mstate
8595        $menu entryconfigure 11 -state $mstate
8596    } else {
8597        set menu $fakerowmenu
8598    }
8599    $menu entryconfigure [mca "Diff this -> selected"] -state $state
8600    $menu entryconfigure [mca "Diff selected -> this"] -state $state
8601    $menu entryconfigure [mca "Make patch"] -state $state
8602    $menu entryconfigure [mca "Diff this -> marked commit"] -state $mstate
8603    $menu entryconfigure [mca "Diff marked commit -> this"] -state $mstate
8604    tk_popup $menu $x $y
8605}
8606
8607proc markhere {} {
8608    global rowmenuid markedid canv
8609
8610    set markedid $rowmenuid
8611    make_idmark $markedid
8612}
8613
8614proc gotomark {} {
8615    global markedid
8616
8617    if {[info exists markedid]} {
8618        selbyid $markedid
8619    }
8620}
8621
8622proc replace_by_kids {l r} {
8623    global curview children
8624
8625    set id [commitonrow $r]
8626    set l [lreplace $l 0 0]
8627    foreach kid $children($curview,$id) {
8628        lappend l [rowofcommit $kid]
8629    }
8630    return [lsort -integer -decreasing -unique $l]
8631}
8632
8633proc find_common_desc {} {
8634    global markedid rowmenuid curview children
8635
8636    if {![info exists markedid]} return
8637    if {![commitinview $markedid $curview] ||
8638        ![commitinview $rowmenuid $curview]} return
8639    #set t1 [clock clicks -milliseconds]
8640    set l1 [list [rowofcommit $markedid]]
8641    set l2 [list [rowofcommit $rowmenuid]]
8642    while 1 {
8643        set r1 [lindex $l1 0]
8644        set r2 [lindex $l2 0]
8645        if {$r1 eq {} || $r2 eq {}} break
8646        if {$r1 == $r2} {
8647            selectline $r1 1
8648            break
8649        }
8650        if {$r1 > $r2} {
8651            set l1 [replace_by_kids $l1 $r1]
8652        } else {
8653            set l2 [replace_by_kids $l2 $r2]
8654        }
8655    }
8656    #set t2 [clock clicks -milliseconds]
8657    #puts "took [expr {$t2-$t1}]ms"
8658}
8659
8660proc compare_commits {} {
8661    global markedid rowmenuid curview children
8662
8663    if {![info exists markedid]} return
8664    if {![commitinview $markedid $curview]} return
8665    addtohistory [list do_cmp_commits $markedid $rowmenuid]
8666    do_cmp_commits $markedid $rowmenuid
8667}
8668
8669proc getpatchid {id} {
8670    global patchids
8671
8672    if {![info exists patchids($id)]} {
8673        set cmd [diffcmd [list $id] {-p --root}]
8674        # trim off the initial "|"
8675        set cmd [lrange $cmd 1 end]
8676        if {[catch {
8677            set x [eval exec $cmd | git patch-id]
8678            set patchids($id) [lindex $x 0]
8679        }]} {
8680            set patchids($id) "error"
8681        }
8682    }
8683    return $patchids($id)
8684}
8685
8686proc do_cmp_commits {a b} {
8687    global ctext curview parents children patchids commitinfo
8688
8689    $ctext conf -state normal
8690    clear_ctext
8691    init_flist {}
8692    for {set i 0} {$i < 100} {incr i} {
8693        set skipa 0
8694        set skipb 0
8695        if {[llength $parents($curview,$a)] > 1} {
8696            appendshortlink $a [mc "Skipping merge commit "] "\n"
8697            set skipa 1
8698        } else {
8699            set patcha [getpatchid $a]
8700        }
8701        if {[llength $parents($curview,$b)] > 1} {
8702            appendshortlink $b [mc "Skipping merge commit "] "\n"
8703            set skipb 1
8704        } else {
8705            set patchb [getpatchid $b]
8706        }
8707        if {!$skipa && !$skipb} {
8708            set heada [lindex $commitinfo($a) 0]
8709            set headb [lindex $commitinfo($b) 0]
8710            if {$patcha eq "error"} {
8711                appendshortlink $a [mc "Error getting patch ID for "] \
8712                    [mc " - stopping\n"]
8713                break
8714            }
8715            if {$patchb eq "error"} {
8716                appendshortlink $b [mc "Error getting patch ID for "] \
8717                    [mc " - stopping\n"]
8718                break
8719            }
8720            if {$patcha eq $patchb} {
8721                if {$heada eq $headb} {
8722                    appendshortlink $a [mc "Commit "]
8723                    appendshortlink $b " == " "  $heada\n"
8724                } else {
8725                    appendshortlink $a [mc "Commit "] "  $heada\n"
8726                    appendshortlink $b [mc " is the same patch as\n       "] \
8727                        "  $headb\n"
8728                }
8729                set skipa 1
8730                set skipb 1
8731            } else {
8732                $ctext insert end "\n"
8733                appendshortlink $a [mc "Commit "] "  $heada\n"
8734                appendshortlink $b [mc " differs from\n       "] \
8735                    "  $headb\n"
8736                $ctext insert end [mc "Diff of commits:\n\n"]
8737                $ctext conf -state disabled
8738                update
8739                diffcommits $a $b
8740                return
8741            }
8742        }
8743        if {$skipa} {
8744            set kids [real_children $curview,$a]
8745            if {[llength $kids] != 1} {
8746                $ctext insert end "\n"
8747                appendshortlink $a [mc "Commit "] \
8748                    [mc " has %s children - stopping\n" [llength $kids]]
8749                break
8750            }
8751            set a [lindex $kids 0]
8752        }
8753        if {$skipb} {
8754            set kids [real_children $curview,$b]
8755            if {[llength $kids] != 1} {
8756                appendshortlink $b [mc "Commit "] \
8757                    [mc " has %s children - stopping\n" [llength $kids]]
8758                break
8759            }
8760            set b [lindex $kids 0]
8761        }
8762    }
8763    $ctext conf -state disabled
8764}
8765
8766proc diffcommits {a b} {
8767    global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
8768
8769    set tmpdir [gitknewtmpdir]
8770    set fna [file join $tmpdir "commit-[string range $a 0 7]"]
8771    set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
8772    if {[catch {
8773        exec git diff-tree -p --pretty $a >$fna
8774        exec git diff-tree -p --pretty $b >$fnb
8775    } err]} {
8776        error_popup [mc "Error writing commit to file: %s" $err]
8777        return
8778    }
8779    if {[catch {
8780        set fd [open "| diff -U$diffcontext $fna $fnb" r]
8781    } err]} {
8782        error_popup [mc "Error diffing commits: %s" $err]
8783        return
8784    }
8785    set diffids [list commits $a $b]
8786    set blobdifffd($diffids) $fd
8787    set diffinhdr 0
8788    set currdiffsubmod ""
8789    filerun $fd [list getblobdiffline $fd $diffids]
8790}
8791
8792proc diffvssel {dirn} {
8793    global rowmenuid selectedline
8794
8795    if {$selectedline eq {}} return
8796    if {$dirn} {
8797        set oldid [commitonrow $selectedline]
8798        set newid $rowmenuid
8799    } else {
8800        set oldid $rowmenuid
8801        set newid [commitonrow $selectedline]
8802    }
8803    addtohistory [list doseldiff $oldid $newid] savectextpos
8804    doseldiff $oldid $newid
8805}
8806
8807proc diffvsmark {dirn} {
8808    global rowmenuid markedid
8809
8810    if {![info exists markedid]} return
8811    if {$dirn} {
8812        set oldid $markedid
8813        set newid $rowmenuid
8814    } else {
8815        set oldid $rowmenuid
8816        set newid $markedid
8817    }
8818    addtohistory [list doseldiff $oldid $newid] savectextpos
8819    doseldiff $oldid $newid
8820}
8821
8822proc doseldiff {oldid newid} {
8823    global ctext
8824    global commitinfo
8825
8826    $ctext conf -state normal
8827    clear_ctext
8828    init_flist [mc "Top"]
8829    $ctext insert end "[mc "From"] "
8830    $ctext insert end $oldid link0
8831    setlink $oldid link0
8832    $ctext insert end "\n     "
8833    $ctext insert end [lindex $commitinfo($oldid) 0]
8834    $ctext insert end "\n\n[mc "To"]   "
8835    $ctext insert end $newid link1
8836    setlink $newid link1
8837    $ctext insert end "\n     "
8838    $ctext insert end [lindex $commitinfo($newid) 0]
8839    $ctext insert end "\n"
8840    $ctext conf -state disabled
8841    $ctext tag remove found 1.0 end
8842    startdiff [list $oldid $newid]
8843}
8844
8845proc mkpatch {} {
8846    global rowmenuid currentid commitinfo patchtop patchnum NS
8847
8848    if {![info exists currentid]} return
8849    set oldid $currentid
8850    set oldhead [lindex $commitinfo($oldid) 0]
8851    set newid $rowmenuid
8852    set newhead [lindex $commitinfo($newid) 0]
8853    set top .patch
8854    set patchtop $top
8855    catch {destroy $top}
8856    ttk_toplevel $top
8857    make_transient $top .
8858    ${NS}::label $top.title -text [mc "Generate patch"]
8859    grid $top.title - -pady 10
8860    ${NS}::label $top.from -text [mc "From:"]
8861    ${NS}::entry $top.fromsha1 -width 40
8862    $top.fromsha1 insert 0 $oldid
8863    $top.fromsha1 conf -state readonly
8864    grid $top.from $top.fromsha1 -sticky w
8865    ${NS}::entry $top.fromhead -width 60
8866    $top.fromhead insert 0 $oldhead
8867    $top.fromhead conf -state readonly
8868    grid x $top.fromhead -sticky w
8869    ${NS}::label $top.to -text [mc "To:"]
8870    ${NS}::entry $top.tosha1 -width 40
8871    $top.tosha1 insert 0 $newid
8872    $top.tosha1 conf -state readonly
8873    grid $top.to $top.tosha1 -sticky w
8874    ${NS}::entry $top.tohead -width 60
8875    $top.tohead insert 0 $newhead
8876    $top.tohead conf -state readonly
8877    grid x $top.tohead -sticky w
8878    ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
8879    grid $top.rev x -pady 10 -padx 5
8880    ${NS}::label $top.flab -text [mc "Output file:"]
8881    ${NS}::entry $top.fname -width 60
8882    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
8883    incr patchnum
8884    grid $top.flab $top.fname -sticky w
8885    ${NS}::frame $top.buts
8886    ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
8887    ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
8888    bind $top <Key-Return> mkpatchgo
8889    bind $top <Key-Escape> mkpatchcan
8890    grid $top.buts.gen $top.buts.can
8891    grid columnconfigure $top.buts 0 -weight 1 -uniform a
8892    grid columnconfigure $top.buts 1 -weight 1 -uniform a
8893    grid $top.buts - -pady 10 -sticky ew
8894    focus $top.fname
8895}
8896
8897proc mkpatchrev {} {
8898    global patchtop
8899
8900    set oldid [$patchtop.fromsha1 get]
8901    set oldhead [$patchtop.fromhead get]
8902    set newid [$patchtop.tosha1 get]
8903    set newhead [$patchtop.tohead get]
8904    foreach e [list fromsha1 fromhead tosha1 tohead] \
8905            v [list $newid $newhead $oldid $oldhead] {
8906        $patchtop.$e conf -state normal
8907        $patchtop.$e delete 0 end
8908        $patchtop.$e insert 0 $v
8909        $patchtop.$e conf -state readonly
8910    }
8911}
8912
8913proc mkpatchgo {} {
8914    global patchtop nullid nullid2
8915
8916    set oldid [$patchtop.fromsha1 get]
8917    set newid [$patchtop.tosha1 get]
8918    set fname [$patchtop.fname get]
8919    set cmd [diffcmd [list $oldid $newid] -p]
8920    # trim off the initial "|"
8921    set cmd [lrange $cmd 1 end]
8922    lappend cmd >$fname &
8923    if {[catch {eval exec $cmd} err]} {
8924        error_popup "[mc "Error creating patch:"] $err" $patchtop
8925    }
8926    catch {destroy $patchtop}
8927    unset patchtop
8928}
8929
8930proc mkpatchcan {} {
8931    global patchtop
8932
8933    catch {destroy $patchtop}
8934    unset patchtop
8935}
8936
8937proc mktag {} {
8938    global rowmenuid mktagtop commitinfo NS
8939
8940    set top .maketag
8941    set mktagtop $top
8942    catch {destroy $top}
8943    ttk_toplevel $top
8944    make_transient $top .
8945    ${NS}::label $top.title -text [mc "Create tag"]
8946    grid $top.title - -pady 10
8947    ${NS}::label $top.id -text [mc "ID:"]
8948    ${NS}::entry $top.sha1 -width 40
8949    $top.sha1 insert 0 $rowmenuid
8950    $top.sha1 conf -state readonly
8951    grid $top.id $top.sha1 -sticky w
8952    ${NS}::entry $top.head -width 60
8953    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8954    $top.head conf -state readonly
8955    grid x $top.head -sticky w
8956    ${NS}::label $top.tlab -text [mc "Tag name:"]
8957    ${NS}::entry $top.tag -width 60
8958    grid $top.tlab $top.tag -sticky w
8959    ${NS}::label $top.op -text [mc "Tag message is optional"]
8960    grid $top.op -columnspan 2 -sticky we
8961    ${NS}::label $top.mlab -text [mc "Tag message:"]
8962    ${NS}::entry $top.msg -width 60
8963    grid $top.mlab $top.msg -sticky w
8964    ${NS}::frame $top.buts
8965    ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
8966    ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
8967    bind $top <Key-Return> mktaggo
8968    bind $top <Key-Escape> mktagcan
8969    grid $top.buts.gen $top.buts.can
8970    grid columnconfigure $top.buts 0 -weight 1 -uniform a
8971    grid columnconfigure $top.buts 1 -weight 1 -uniform a
8972    grid $top.buts - -pady 10 -sticky ew
8973    focus $top.tag
8974}
8975
8976proc domktag {} {
8977    global mktagtop env tagids idtags
8978
8979    set id [$mktagtop.sha1 get]
8980    set tag [$mktagtop.tag get]
8981    set msg [$mktagtop.msg get]
8982    if {$tag == {}} {
8983        error_popup [mc "No tag name specified"] $mktagtop
8984        return 0
8985    }
8986    if {[info exists tagids($tag)]} {
8987        error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
8988        return 0
8989    }
8990    if {[catch {
8991        if {$msg != {}} {
8992            exec git tag -a -m $msg $tag $id
8993        } else {
8994            exec git tag $tag $id
8995        }
8996    } err]} {
8997        error_popup "[mc "Error creating tag:"] $err" $mktagtop
8998        return 0
8999    }
9000
9001    set tagids($tag) $id
9002    lappend idtags($id) $tag
9003    redrawtags $id
9004    addedtag $id
9005    dispneartags 0
9006    run refill_reflist
9007    return 1
9008}
9009
9010proc redrawtags {id} {
9011    global canv linehtag idpos currentid curview cmitlisted markedid
9012    global canvxmax iddrawn circleitem mainheadid circlecolors
9013
9014    if {![commitinview $id $curview]} return
9015    if {![info exists iddrawn($id)]} return
9016    set row [rowofcommit $id]
9017    if {$id eq $mainheadid} {
9018        set ofill yellow
9019    } else {
9020        set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
9021    }
9022    $canv itemconf $circleitem($row) -fill $ofill
9023    $canv delete tag.$id
9024    set xt [eval drawtags $id $idpos($id)]
9025    $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
9026    set text [$canv itemcget $linehtag($id) -text]
9027    set font [$canv itemcget $linehtag($id) -font]
9028    set xr [expr {$xt + [font measure $font $text]}]
9029    if {$xr > $canvxmax} {
9030        set canvxmax $xr
9031        setcanvscroll
9032    }
9033    if {[info exists currentid] && $currentid == $id} {
9034        make_secsel $id
9035    }
9036    if {[info exists markedid] && $markedid eq $id} {
9037        make_idmark $id
9038    }
9039}
9040
9041proc mktagcan {} {
9042    global mktagtop
9043
9044    catch {destroy $mktagtop}
9045    unset mktagtop
9046}
9047
9048proc mktaggo {} {
9049    if {![domktag]} return
9050    mktagcan
9051}
9052
9053proc writecommit {} {
9054    global rowmenuid wrcomtop commitinfo wrcomcmd NS
9055
9056    set top .writecommit
9057    set wrcomtop $top
9058    catch {destroy $top}
9059    ttk_toplevel $top
9060    make_transient $top .
9061    ${NS}::label $top.title -text [mc "Write commit to file"]
9062    grid $top.title - -pady 10
9063    ${NS}::label $top.id -text [mc "ID:"]
9064    ${NS}::entry $top.sha1 -width 40
9065    $top.sha1 insert 0 $rowmenuid
9066    $top.sha1 conf -state readonly
9067    grid $top.id $top.sha1 -sticky w
9068    ${NS}::entry $top.head -width 60
9069    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9070    $top.head conf -state readonly
9071    grid x $top.head -sticky w
9072    ${NS}::label $top.clab -text [mc "Command:"]
9073    ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
9074    grid $top.clab $top.cmd -sticky w -pady 10
9075    ${NS}::label $top.flab -text [mc "Output file:"]
9076    ${NS}::entry $top.fname -width 60
9077    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
9078    grid $top.flab $top.fname -sticky w
9079    ${NS}::frame $top.buts
9080    ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
9081    ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
9082    bind $top <Key-Return> wrcomgo
9083    bind $top <Key-Escape> wrcomcan
9084    grid $top.buts.gen $top.buts.can
9085    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9086    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9087    grid $top.buts - -pady 10 -sticky ew
9088    focus $top.fname
9089}
9090
9091proc wrcomgo {} {
9092    global wrcomtop
9093
9094    set id [$wrcomtop.sha1 get]
9095    set cmd "echo $id | [$wrcomtop.cmd get]"
9096    set fname [$wrcomtop.fname get]
9097    if {[catch {exec sh -c $cmd >$fname &} err]} {
9098        error_popup "[mc "Error writing commit:"] $err" $wrcomtop
9099    }
9100    catch {destroy $wrcomtop}
9101    unset wrcomtop
9102}
9103
9104proc wrcomcan {} {
9105    global wrcomtop
9106
9107    catch {destroy $wrcomtop}
9108    unset wrcomtop
9109}
9110
9111proc mkbranch {} {
9112    global rowmenuid mkbrtop NS
9113
9114    set top .makebranch
9115    catch {destroy $top}
9116    ttk_toplevel $top
9117    make_transient $top .
9118    ${NS}::label $top.title -text [mc "Create new branch"]
9119    grid $top.title - -pady 10
9120    ${NS}::label $top.id -text [mc "ID:"]
9121    ${NS}::entry $top.sha1 -width 40
9122    $top.sha1 insert 0 $rowmenuid
9123    $top.sha1 conf -state readonly
9124    grid $top.id $top.sha1 -sticky w
9125    ${NS}::label $top.nlab -text [mc "Name:"]
9126    ${NS}::entry $top.name -width 40
9127    grid $top.nlab $top.name -sticky w
9128    ${NS}::frame $top.buts
9129    ${NS}::button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
9130    ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
9131    bind $top <Key-Return> [list mkbrgo $top]
9132    bind $top <Key-Escape> "catch {destroy $top}"
9133    grid $top.buts.go $top.buts.can
9134    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9135    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9136    grid $top.buts - -pady 10 -sticky ew
9137    focus $top.name
9138}
9139
9140proc mkbrgo {top} {
9141    global headids idheads
9142
9143    set name [$top.name get]
9144    set id [$top.sha1 get]
9145    set cmdargs {}
9146    set old_id {}
9147    if {$name eq {}} {
9148        error_popup [mc "Please specify a name for the new branch"] $top
9149        return
9150    }
9151    if {[info exists headids($name)]} {
9152        if {![confirm_popup [mc \
9153                "Branch '%s' already exists. Overwrite?" $name] $top]} {
9154            return
9155        }
9156        set old_id $headids($name)
9157        lappend cmdargs -f
9158    }
9159    catch {destroy $top}
9160    lappend cmdargs $name $id
9161    nowbusy newbranch
9162    update
9163    if {[catch {
9164        eval exec git branch $cmdargs
9165    } err]} {
9166        notbusy newbranch
9167        error_popup $err
9168    } else {
9169        notbusy newbranch
9170        if {$old_id ne {}} {
9171            movehead $id $name
9172            movedhead $id $name
9173            redrawtags $old_id
9174            redrawtags $id
9175        } else {
9176            set headids($name) $id
9177            lappend idheads($id) $name
9178            addedhead $id $name
9179            redrawtags $id
9180        }
9181        dispneartags 0
9182        run refill_reflist
9183    }
9184}
9185
9186proc exec_citool {tool_args {baseid {}}} {
9187    global commitinfo env
9188
9189    set save_env [array get env GIT_AUTHOR_*]
9190
9191    if {$baseid ne {}} {
9192        if {![info exists commitinfo($baseid)]} {
9193            getcommit $baseid
9194        }
9195        set author [lindex $commitinfo($baseid) 1]
9196        set date [lindex $commitinfo($baseid) 2]
9197        if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9198                    $author author name email]
9199            && $date ne {}} {
9200            set env(GIT_AUTHOR_NAME) $name
9201            set env(GIT_AUTHOR_EMAIL) $email
9202            set env(GIT_AUTHOR_DATE) $date
9203        }
9204    }
9205
9206    eval exec git citool $tool_args &
9207
9208    array unset env GIT_AUTHOR_*
9209    array set env $save_env
9210}
9211
9212proc cherrypick {} {
9213    global rowmenuid curview
9214    global mainhead mainheadid
9215    global gitdir
9216
9217    set oldhead [exec git rev-parse HEAD]
9218    set dheads [descheads $rowmenuid]
9219    if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
9220        set ok [confirm_popup [mc "Commit %s is already\
9221                included in branch %s -- really re-apply it?" \
9222                                   [string range $rowmenuid 0 7] $mainhead]]
9223        if {!$ok} return
9224    }
9225    nowbusy cherrypick [mc "Cherry-picking"]
9226    update
9227    # Unfortunately git-cherry-pick writes stuff to stderr even when
9228    # no error occurs, and exec takes that as an indication of error...
9229    if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9230        notbusy cherrypick
9231        if {[regexp -line \
9232                 {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9233                 $err msg fname]} {
9234            error_popup [mc "Cherry-pick failed because of local changes\
9235                        to file '%s'.\nPlease commit, reset or stash\
9236                        your changes and try again." $fname]
9237        } elseif {[regexp -line \
9238                       {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
9239                       $err]} {
9240            if {[confirm_popup [mc "Cherry-pick failed because of merge\
9241                        conflict.\nDo you wish to run git citool to\
9242                        resolve it?"]]} {
9243                # Force citool to read MERGE_MSG
9244                file delete [file join $gitdir "GITGUI_MSG"]
9245                exec_citool {} $rowmenuid
9246            }
9247        } else {
9248            error_popup $err
9249        }
9250        run updatecommits
9251        return
9252    }
9253    set newhead [exec git rev-parse HEAD]
9254    if {$newhead eq $oldhead} {
9255        notbusy cherrypick
9256        error_popup [mc "No changes committed"]
9257        return
9258    }
9259    addnewchild $newhead $oldhead
9260    if {[commitinview $oldhead $curview]} {
9261        # XXX this isn't right if we have a path limit...
9262        insertrow $newhead $oldhead $curview
9263        if {$mainhead ne {}} {
9264            movehead $newhead $mainhead
9265            movedhead $newhead $mainhead
9266        }
9267        set mainheadid $newhead
9268        redrawtags $oldhead
9269        redrawtags $newhead
9270        selbyid $newhead
9271    }
9272    notbusy cherrypick
9273}
9274
9275proc resethead {} {
9276    global mainhead rowmenuid confirm_ok resettype NS
9277
9278    set confirm_ok 0
9279    set w ".confirmreset"
9280    ttk_toplevel $w
9281    make_transient $w .
9282    wm title $w [mc "Confirm reset"]
9283    ${NS}::label $w.m -text \
9284        [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
9285    pack $w.m -side top -fill x -padx 20 -pady 20
9286    ${NS}::labelframe $w.f -text [mc "Reset type:"]
9287    set resettype mixed
9288    ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
9289        -text [mc "Soft: Leave working tree and index untouched"]
9290    grid $w.f.soft -sticky w
9291    ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
9292        -text [mc "Mixed: Leave working tree untouched, reset index"]
9293    grid $w.f.mixed -sticky w
9294    ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
9295        -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
9296    grid $w.f.hard -sticky w
9297    pack $w.f -side top -fill x -padx 4
9298    ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
9299    pack $w.ok -side left -fill x -padx 20 -pady 20
9300    ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
9301    bind $w <Key-Escape> [list destroy $w]
9302    pack $w.cancel -side right -fill x -padx 20 -pady 20
9303    bind $w <Visibility> "grab $w; focus $w"
9304    tkwait window $w
9305    if {!$confirm_ok} return
9306    if {[catch {set fd [open \
9307            [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
9308        error_popup $err
9309    } else {
9310        dohidelocalchanges
9311        filerun $fd [list readresetstat $fd]
9312        nowbusy reset [mc "Resetting"]
9313        selbyid $rowmenuid
9314    }
9315}
9316
9317proc readresetstat {fd} {
9318    global mainhead mainheadid showlocalchanges rprogcoord
9319
9320    if {[gets $fd line] >= 0} {
9321        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9322            set rprogcoord [expr {1.0 * $m / $n}]
9323            adjustprogress
9324        }
9325        return 1
9326    }
9327    set rprogcoord 0
9328    adjustprogress
9329    notbusy reset
9330    if {[catch {close $fd} err]} {
9331        error_popup $err
9332    }
9333    set oldhead $mainheadid
9334    set newhead [exec git rev-parse HEAD]
9335    if {$newhead ne $oldhead} {
9336        movehead $newhead $mainhead
9337        movedhead $newhead $mainhead
9338        set mainheadid $newhead
9339        redrawtags $oldhead
9340        redrawtags $newhead
9341    }
9342    if {$showlocalchanges} {
9343        doshowlocalchanges
9344    }
9345    return 0
9346}
9347
9348# context menu for a head
9349proc headmenu {x y id head} {
9350    global headmenuid headmenuhead headctxmenu mainhead
9351
9352    stopfinding
9353    set headmenuid $id
9354    set headmenuhead $head
9355    set state normal
9356    if {[string match "remotes/*" $head]} {
9357        set state disabled
9358    }
9359    if {$head eq $mainhead} {
9360        set state disabled
9361    }
9362    $headctxmenu entryconfigure 0 -state $state
9363    $headctxmenu entryconfigure 1 -state $state
9364    tk_popup $headctxmenu $x $y
9365}
9366
9367proc cobranch {} {
9368    global headmenuid headmenuhead headids
9369    global showlocalchanges
9370
9371    # check the tree is clean first??
9372    nowbusy checkout [mc "Checking out"]
9373    update
9374    dohidelocalchanges
9375    if {[catch {
9376        set fd [open [list | git checkout $headmenuhead 2>@1] r]
9377    } err]} {
9378        notbusy checkout
9379        error_popup $err
9380        if {$showlocalchanges} {
9381            dodiffindex
9382        }
9383    } else {
9384        filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
9385    }
9386}
9387
9388proc readcheckoutstat {fd newhead newheadid} {
9389    global mainhead mainheadid headids showlocalchanges progresscoords
9390    global viewmainheadid curview
9391
9392    if {[gets $fd line] >= 0} {
9393        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9394            set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9395            adjustprogress
9396        }
9397        return 1
9398    }
9399    set progresscoords {0 0}
9400    adjustprogress
9401    notbusy checkout
9402    if {[catch {close $fd} err]} {
9403        error_popup $err
9404    }
9405    set oldmainid $mainheadid
9406    set mainhead $newhead
9407    set mainheadid $newheadid
9408    set viewmainheadid($curview) $newheadid
9409    redrawtags $oldmainid
9410    redrawtags $newheadid
9411    selbyid $newheadid
9412    if {$showlocalchanges} {
9413        dodiffindex
9414    }
9415}
9416
9417proc rmbranch {} {
9418    global headmenuid headmenuhead mainhead
9419    global idheads
9420
9421    set head $headmenuhead
9422    set id $headmenuid
9423    # this check shouldn't be needed any more...
9424    if {$head eq $mainhead} {
9425        error_popup [mc "Cannot delete the currently checked-out branch"]
9426        return
9427    }
9428    set dheads [descheads $id]
9429    if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
9430        # the stuff on this branch isn't on any other branch
9431        if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9432                        branch.\nReally delete branch %s?" $head $head]]} return
9433    }
9434    nowbusy rmbranch
9435    update
9436    if {[catch {exec git branch -D $head} err]} {
9437        notbusy rmbranch
9438        error_popup $err
9439        return
9440    }
9441    removehead $id $head
9442    removedhead $id $head
9443    redrawtags $id
9444    notbusy rmbranch
9445    dispneartags 0
9446    run refill_reflist
9447}
9448
9449# Display a list of tags and heads
9450proc showrefs {} {
9451    global showrefstop bgcolor fgcolor selectbgcolor NS
9452    global bglist fglist reflistfilter reflist maincursor
9453
9454    set top .showrefs
9455    set showrefstop $top
9456    if {[winfo exists $top]} {
9457        raise $top
9458        refill_reflist
9459        return
9460    }
9461    ttk_toplevel $top
9462    wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
9463    make_transient $top .
9464    text $top.list -background $bgcolor -foreground $fgcolor \
9465        -selectbackground $selectbgcolor -font mainfont \
9466        -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
9467        -width 30 -height 20 -cursor $maincursor \
9468        -spacing1 1 -spacing3 1 -state disabled
9469    $top.list tag configure highlight -background $selectbgcolor
9470    lappend bglist $top.list
9471    lappend fglist $top.list
9472    ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
9473    ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
9474    grid $top.list $top.ysb -sticky nsew
9475    grid $top.xsb x -sticky ew
9476    ${NS}::frame $top.f
9477    ${NS}::label $top.f.l -text "[mc "Filter"]: "
9478    ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
9479    set reflistfilter "*"
9480    trace add variable reflistfilter write reflistfilter_change
9481    pack $top.f.e -side right -fill x -expand 1
9482    pack $top.f.l -side left
9483    grid $top.f - -sticky ew -pady 2
9484    ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
9485    bind $top <Key-Escape> [list destroy $top]
9486    grid $top.close -
9487    grid columnconfigure $top 0 -weight 1
9488    grid rowconfigure $top 0 -weight 1
9489    bind $top.list <1> {break}
9490    bind $top.list <B1-Motion> {break}
9491    bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
9492    set reflist {}
9493    refill_reflist
9494}
9495
9496proc sel_reflist {w x y} {
9497    global showrefstop reflist headids tagids otherrefids
9498
9499    if {![winfo exists $showrefstop]} return
9500    set l [lindex [split [$w index "@$x,$y"] "."] 0]
9501    set ref [lindex $reflist [expr {$l-1}]]
9502    set n [lindex $ref 0]
9503    switch -- [lindex $ref 1] {
9504        "H" {selbyid $headids($n)}
9505        "T" {selbyid $tagids($n)}
9506        "o" {selbyid $otherrefids($n)}
9507    }
9508    $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
9509}
9510
9511proc unsel_reflist {} {
9512    global showrefstop
9513
9514    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9515    $showrefstop.list tag remove highlight 0.0 end
9516}
9517
9518proc reflistfilter_change {n1 n2 op} {
9519    global reflistfilter
9520
9521    after cancel refill_reflist
9522    after 200 refill_reflist
9523}
9524
9525proc refill_reflist {} {
9526    global reflist reflistfilter showrefstop headids tagids otherrefids
9527    global curview
9528
9529    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9530    set refs {}
9531    foreach n [array names headids] {
9532        if {[string match $reflistfilter $n]} {
9533            if {[commitinview $headids($n) $curview]} {
9534                lappend refs [list $n H]
9535            } else {
9536                interestedin $headids($n) {run refill_reflist}
9537            }
9538        }
9539    }
9540    foreach n [array names tagids] {
9541        if {[string match $reflistfilter $n]} {
9542            if {[commitinview $tagids($n) $curview]} {
9543                lappend refs [list $n T]
9544            } else {
9545                interestedin $tagids($n) {run refill_reflist}
9546            }
9547        }
9548    }
9549    foreach n [array names otherrefids] {
9550        if {[string match $reflistfilter $n]} {
9551            if {[commitinview $otherrefids($n) $curview]} {
9552                lappend refs [list $n o]
9553            } else {
9554                interestedin $otherrefids($n) {run refill_reflist}
9555            }
9556        }
9557    }
9558    set refs [lsort -index 0 $refs]
9559    if {$refs eq $reflist} return
9560
9561    # Update the contents of $showrefstop.list according to the
9562    # differences between $reflist (old) and $refs (new)
9563    $showrefstop.list conf -state normal
9564    $showrefstop.list insert end "\n"
9565    set i 0
9566    set j 0
9567    while {$i < [llength $reflist] || $j < [llength $refs]} {
9568        if {$i < [llength $reflist]} {
9569            if {$j < [llength $refs]} {
9570                set cmp [string compare [lindex $reflist $i 0] \
9571                             [lindex $refs $j 0]]
9572                if {$cmp == 0} {
9573                    set cmp [string compare [lindex $reflist $i 1] \
9574                                 [lindex $refs $j 1]]
9575                }
9576            } else {
9577                set cmp -1
9578            }
9579        } else {
9580            set cmp 1
9581        }
9582        switch -- $cmp {
9583            -1 {
9584                $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
9585                incr i
9586            }
9587            0 {
9588                incr i
9589                incr j
9590            }
9591            1 {
9592                set l [expr {$j + 1}]
9593                $showrefstop.list image create $l.0 -align baseline \
9594                    -image reficon-[lindex $refs $j 1] -padx 2
9595                $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
9596                incr j
9597            }
9598        }
9599    }
9600    set reflist $refs
9601    # delete last newline
9602    $showrefstop.list delete end-2c end-1c
9603    $showrefstop.list conf -state disabled
9604}
9605
9606# Stuff for finding nearby tags
9607proc getallcommits {} {
9608    global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
9609    global idheads idtags idotherrefs allparents tagobjid
9610    global gitdir
9611
9612    if {![info exists allcommits]} {
9613        set nextarc 0
9614        set allcommits 0
9615        set seeds {}
9616        set allcwait 0
9617        set cachedarcs 0
9618        set allccache [file join $gitdir "gitk.cache"]
9619        if {![catch {
9620            set f [open $allccache r]
9621            set allcwait 1
9622            getcache $f
9623        }]} return
9624    }
9625
9626    if {$allcwait} {
9627        return
9628    }
9629    set cmd [list | git rev-list --parents]
9630    set allcupdate [expr {$seeds ne {}}]
9631    if {!$allcupdate} {
9632        set ids "--all"
9633    } else {
9634        set refs [concat [array names idheads] [array names idtags] \
9635                      [array names idotherrefs]]
9636        set ids {}
9637        set tagobjs {}
9638        foreach name [array names tagobjid] {
9639            lappend tagobjs $tagobjid($name)
9640        }
9641        foreach id [lsort -unique $refs] {
9642            if {![info exists allparents($id)] &&
9643                [lsearch -exact $tagobjs $id] < 0} {
9644                lappend ids $id
9645            }
9646        }
9647        if {$ids ne {}} {
9648            foreach id $seeds {
9649                lappend ids "^$id"
9650            }
9651        }
9652    }
9653    if {$ids ne {}} {
9654        set fd [open [concat $cmd $ids] r]
9655        fconfigure $fd -blocking 0
9656        incr allcommits
9657        nowbusy allcommits
9658        filerun $fd [list getallclines $fd]
9659    } else {
9660        dispneartags 0
9661    }
9662}
9663
9664# Since most commits have 1 parent and 1 child, we group strings of
9665# such commits into "arcs" joining branch/merge points (BMPs), which
9666# are commits that either don't have 1 parent or don't have 1 child.
9667#
9668# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
9669# arcout(id) - outgoing arcs for BMP
9670# arcids(a) - list of IDs on arc including end but not start
9671# arcstart(a) - BMP ID at start of arc
9672# arcend(a) - BMP ID at end of arc
9673# growing(a) - arc a is still growing
9674# arctags(a) - IDs out of arcids (excluding end) that have tags
9675# archeads(a) - IDs out of arcids (excluding end) that have heads
9676# The start of an arc is at the descendent end, so "incoming" means
9677# coming from descendents, and "outgoing" means going towards ancestors.
9678
9679proc getallclines {fd} {
9680    global allparents allchildren idtags idheads nextarc
9681    global arcnos arcids arctags arcout arcend arcstart archeads growing
9682    global seeds allcommits cachedarcs allcupdate
9683
9684    set nid 0
9685    while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
9686        set id [lindex $line 0]
9687        if {[info exists allparents($id)]} {
9688            # seen it already
9689            continue
9690        }
9691        set cachedarcs 0
9692        set olds [lrange $line 1 end]
9693        set allparents($id) $olds
9694        if {![info exists allchildren($id)]} {
9695            set allchildren($id) {}
9696            set arcnos($id) {}
9697            lappend seeds $id
9698        } else {
9699            set a $arcnos($id)
9700            if {[llength $olds] == 1 && [llength $a] == 1} {
9701                lappend arcids($a) $id
9702                if {[info exists idtags($id)]} {
9703                    lappend arctags($a) $id
9704                }
9705                if {[info exists idheads($id)]} {
9706                    lappend archeads($a) $id
9707                }
9708                if {[info exists allparents($olds)]} {
9709                    # seen parent already
9710                    if {![info exists arcout($olds)]} {
9711                        splitarc $olds
9712                    }
9713                    lappend arcids($a) $olds
9714                    set arcend($a) $olds
9715                    unset growing($a)
9716                }
9717                lappend allchildren($olds) $id
9718                lappend arcnos($olds) $a
9719                continue
9720            }
9721        }
9722        foreach a $arcnos($id) {
9723            lappend arcids($a) $id
9724            set arcend($a) $id
9725            unset growing($a)
9726        }
9727
9728        set ao {}
9729        foreach p $olds {
9730            lappend allchildren($p) $id
9731            set a [incr nextarc]
9732            set arcstart($a) $id
9733            set archeads($a) {}
9734            set arctags($a) {}
9735            set archeads($a) {}
9736            set arcids($a) {}
9737            lappend ao $a
9738            set growing($a) 1
9739            if {[info exists allparents($p)]} {
9740                # seen it already, may need to make a new branch
9741                if {![info exists arcout($p)]} {
9742                    splitarc $p
9743                }
9744                lappend arcids($a) $p
9745                set arcend($a) $p
9746                unset growing($a)
9747            }
9748            lappend arcnos($p) $a
9749        }
9750        set arcout($id) $ao
9751    }
9752    if {$nid > 0} {
9753        global cached_dheads cached_dtags cached_atags
9754        catch {unset cached_dheads}
9755        catch {unset cached_dtags}
9756        catch {unset cached_atags}
9757    }
9758    if {![eof $fd]} {
9759        return [expr {$nid >= 1000? 2: 1}]
9760    }
9761    set cacheok 1
9762    if {[catch {
9763        fconfigure $fd -blocking 1
9764        close $fd
9765    } err]} {
9766        # got an error reading the list of commits
9767        # if we were updating, try rereading the whole thing again
9768        if {$allcupdate} {
9769            incr allcommits -1
9770            dropcache $err
9771            return
9772        }
9773        error_popup "[mc "Error reading commit topology information;\
9774                branch and preceding/following tag information\
9775                will be incomplete."]\n($err)"
9776        set cacheok 0
9777    }
9778    if {[incr allcommits -1] == 0} {
9779        notbusy allcommits
9780        if {$cacheok} {
9781            run savecache
9782        }
9783    }
9784    dispneartags 0
9785    return 0
9786}
9787
9788proc recalcarc {a} {
9789    global arctags archeads arcids idtags idheads
9790
9791    set at {}
9792    set ah {}
9793    foreach id [lrange $arcids($a) 0 end-1] {
9794        if {[info exists idtags($id)]} {
9795            lappend at $id
9796        }
9797        if {[info exists idheads($id)]} {
9798            lappend ah $id
9799        }
9800    }
9801    set arctags($a) $at
9802    set archeads($a) $ah
9803}
9804
9805proc splitarc {p} {
9806    global arcnos arcids nextarc arctags archeads idtags idheads
9807    global arcstart arcend arcout allparents growing
9808
9809    set a $arcnos($p)
9810    if {[llength $a] != 1} {
9811        puts "oops splitarc called but [llength $a] arcs already"
9812        return
9813    }
9814    set a [lindex $a 0]
9815    set i [lsearch -exact $arcids($a) $p]
9816    if {$i < 0} {
9817        puts "oops splitarc $p not in arc $a"
9818        return
9819    }
9820    set na [incr nextarc]
9821    if {[info exists arcend($a)]} {
9822        set arcend($na) $arcend($a)
9823    } else {
9824        set l [lindex $allparents([lindex $arcids($a) end]) 0]
9825        set j [lsearch -exact $arcnos($l) $a]
9826        set arcnos($l) [lreplace $arcnos($l) $j $j $na]
9827    }
9828    set tail [lrange $arcids($a) [expr {$i+1}] end]
9829    set arcids($a) [lrange $arcids($a) 0 $i]
9830    set arcend($a) $p
9831    set arcstart($na) $p
9832    set arcout($p) $na
9833    set arcids($na) $tail
9834    if {[info exists growing($a)]} {
9835        set growing($na) 1
9836        unset growing($a)
9837    }
9838
9839    foreach id $tail {
9840        if {[llength $arcnos($id)] == 1} {
9841            set arcnos($id) $na
9842        } else {
9843            set j [lsearch -exact $arcnos($id) $a]
9844            set arcnos($id) [lreplace $arcnos($id) $j $j $na]
9845        }
9846    }
9847
9848    # reconstruct tags and heads lists
9849    if {$arctags($a) ne {} || $archeads($a) ne {}} {
9850        recalcarc $a
9851        recalcarc $na
9852    } else {
9853        set arctags($na) {}
9854        set archeads($na) {}
9855    }
9856}
9857
9858# Update things for a new commit added that is a child of one
9859# existing commit.  Used when cherry-picking.
9860proc addnewchild {id p} {
9861    global allparents allchildren idtags nextarc
9862    global arcnos arcids arctags arcout arcend arcstart archeads growing
9863    global seeds allcommits
9864
9865    if {![info exists allcommits] || ![info exists arcnos($p)]} return
9866    set allparents($id) [list $p]
9867    set allchildren($id) {}
9868    set arcnos($id) {}
9869    lappend seeds $id
9870    lappend allchildren($p) $id
9871    set a [incr nextarc]
9872    set arcstart($a) $id
9873    set archeads($a) {}
9874    set arctags($a) {}
9875    set arcids($a) [list $p]
9876    set arcend($a) $p
9877    if {![info exists arcout($p)]} {
9878        splitarc $p
9879    }
9880    lappend arcnos($p) $a
9881    set arcout($id) [list $a]
9882}
9883
9884# This implements a cache for the topology information.
9885# The cache saves, for each arc, the start and end of the arc,
9886# the ids on the arc, and the outgoing arcs from the end.
9887proc readcache {f} {
9888    global arcnos arcids arcout arcstart arcend arctags archeads nextarc
9889    global idtags idheads allparents cachedarcs possible_seeds seeds growing
9890    global allcwait
9891
9892    set a $nextarc
9893    set lim $cachedarcs
9894    if {$lim - $a > 500} {
9895        set lim [expr {$a + 500}]
9896    }
9897    if {[catch {
9898        if {$a == $lim} {
9899            # finish reading the cache and setting up arctags, etc.
9900            set line [gets $f]
9901            if {$line ne "1"} {error "bad final version"}
9902            close $f
9903            foreach id [array names idtags] {
9904                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9905                    [llength $allparents($id)] == 1} {
9906                    set a [lindex $arcnos($id) 0]
9907                    if {$arctags($a) eq {}} {
9908                        recalcarc $a
9909                    }
9910                }
9911            }
9912            foreach id [array names idheads] {
9913                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9914                    [llength $allparents($id)] == 1} {
9915                    set a [lindex $arcnos($id) 0]
9916                    if {$archeads($a) eq {}} {
9917                        recalcarc $a
9918                    }
9919                }
9920            }
9921            foreach id [lsort -unique $possible_seeds] {
9922                if {$arcnos($id) eq {}} {
9923                    lappend seeds $id
9924                }
9925            }
9926            set allcwait 0
9927        } else {
9928            while {[incr a] <= $lim} {
9929                set line [gets $f]
9930                if {[llength $line] != 3} {error "bad line"}
9931                set s [lindex $line 0]
9932                set arcstart($a) $s
9933                lappend arcout($s) $a
9934                if {![info exists arcnos($s)]} {
9935                    lappend possible_seeds $s
9936                    set arcnos($s) {}
9937                }
9938                set e [lindex $line 1]
9939                if {$e eq {}} {
9940                    set growing($a) 1
9941                } else {
9942                    set arcend($a) $e
9943                    if {![info exists arcout($e)]} {
9944                        set arcout($e) {}
9945                    }
9946                }
9947                set arcids($a) [lindex $line 2]
9948                foreach id $arcids($a) {
9949                    lappend allparents($s) $id
9950                    set s $id
9951                    lappend arcnos($id) $a
9952                }
9953                if {![info exists allparents($s)]} {
9954                    set allparents($s) {}
9955                }
9956                set arctags($a) {}
9957                set archeads($a) {}
9958            }
9959            set nextarc [expr {$a - 1}]
9960        }
9961    } err]} {
9962        dropcache $err
9963        return 0
9964    }
9965    if {!$allcwait} {
9966        getallcommits
9967    }
9968    return $allcwait
9969}
9970
9971proc getcache {f} {
9972    global nextarc cachedarcs possible_seeds
9973
9974    if {[catch {
9975        set line [gets $f]
9976        if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
9977        # make sure it's an integer
9978        set cachedarcs [expr {int([lindex $line 1])}]
9979        if {$cachedarcs < 0} {error "bad number of arcs"}
9980        set nextarc 0
9981        set possible_seeds {}
9982        run readcache $f
9983    } err]} {
9984        dropcache $err
9985    }
9986    return 0
9987}
9988
9989proc dropcache {err} {
9990    global allcwait nextarc cachedarcs seeds
9991
9992    #puts "dropping cache ($err)"
9993    foreach v {arcnos arcout arcids arcstart arcend growing \
9994                   arctags archeads allparents allchildren} {
9995        global $v
9996        catch {unset $v}
9997    }
9998    set allcwait 0
9999    set nextarc 0
10000    set cachedarcs 0
10001    set seeds {}
10002    getallcommits
10003}
10004
10005proc writecache {f} {
10006    global cachearc cachedarcs allccache
10007    global arcstart arcend arcnos arcids arcout
10008
10009    set a $cachearc
10010    set lim $cachedarcs
10011    if {$lim - $a > 1000} {
10012        set lim [expr {$a + 1000}]
10013    }
10014    if {[catch {
10015        while {[incr a] <= $lim} {
10016            if {[info exists arcend($a)]} {
10017                puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
10018            } else {
10019                puts $f [list $arcstart($a) {} $arcids($a)]
10020            }
10021        }
10022    } err]} {
10023        catch {close $f}
10024        catch {file delete $allccache}
10025        #puts "writing cache failed ($err)"
10026        return 0
10027    }
10028    set cachearc [expr {$a - 1}]
10029    if {$a > $cachedarcs} {
10030        puts $f "1"
10031        close $f
10032        return 0
10033    }
10034    return 1
10035}
10036
10037proc savecache {} {
10038    global nextarc cachedarcs cachearc allccache
10039
10040    if {$nextarc == $cachedarcs} return
10041    set cachearc 0
10042    set cachedarcs $nextarc
10043    catch {
10044        set f [open $allccache w]
10045        puts $f [list 1 $cachedarcs]
10046        run writecache $f
10047    }
10048}
10049
10050# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
10051# or 0 if neither is true.
10052proc anc_or_desc {a b} {
10053    global arcout arcstart arcend arcnos cached_isanc
10054
10055    if {$arcnos($a) eq $arcnos($b)} {
10056        # Both are on the same arc(s); either both are the same BMP,
10057        # or if one is not a BMP, the other is also not a BMP or is
10058        # the BMP at end of the arc (and it only has 1 incoming arc).
10059        # Or both can be BMPs with no incoming arcs.
10060        if {$a eq $b || $arcnos($a) eq {}} {
10061            return 0
10062        }
10063        # assert {[llength $arcnos($a)] == 1}
10064        set arc [lindex $arcnos($a) 0]
10065        set i [lsearch -exact $arcids($arc) $a]
10066        set j [lsearch -exact $arcids($arc) $b]
10067        if {$i < 0 || $i > $j} {
10068            return 1
10069        } else {
10070            return -1
10071        }
10072    }
10073
10074    if {![info exists arcout($a)]} {
10075        set arc [lindex $arcnos($a) 0]
10076        if {[info exists arcend($arc)]} {
10077            set aend $arcend($arc)
10078        } else {
10079            set aend {}
10080        }
10081        set a $arcstart($arc)
10082    } else {
10083        set aend $a
10084    }
10085    if {![info exists arcout($b)]} {
10086        set arc [lindex $arcnos($b) 0]
10087        if {[info exists arcend($arc)]} {
10088            set bend $arcend($arc)
10089        } else {
10090            set bend {}
10091        }
10092        set b $arcstart($arc)
10093    } else {
10094        set bend $b
10095    }
10096    if {$a eq $bend} {
10097        return 1
10098    }
10099    if {$b eq $aend} {
10100        return -1
10101    }
10102    if {[info exists cached_isanc($a,$bend)]} {
10103        if {$cached_isanc($a,$bend)} {
10104            return 1
10105        }
10106    }
10107    if {[info exists cached_isanc($b,$aend)]} {
10108        if {$cached_isanc($b,$aend)} {
10109            return -1
10110        }
10111        if {[info exists cached_isanc($a,$bend)]} {
10112            return 0
10113        }
10114    }
10115
10116    set todo [list $a $b]
10117    set anc($a) a
10118    set anc($b) b
10119    for {set i 0} {$i < [llength $todo]} {incr i} {
10120        set x [lindex $todo $i]
10121        if {$anc($x) eq {}} {
10122            continue
10123        }
10124        foreach arc $arcnos($x) {
10125            set xd $arcstart($arc)
10126            if {$xd eq $bend} {
10127                set cached_isanc($a,$bend) 1
10128                set cached_isanc($b,$aend) 0
10129                return 1
10130            } elseif {$xd eq $aend} {
10131                set cached_isanc($b,$aend) 1
10132                set cached_isanc($a,$bend) 0
10133                return -1
10134            }
10135            if {![info exists anc($xd)]} {
10136                set anc($xd) $anc($x)
10137                lappend todo $xd
10138            } elseif {$anc($xd) ne $anc($x)} {
10139                set anc($xd) {}
10140            }
10141        }
10142    }
10143    set cached_isanc($a,$bend) 0
10144    set cached_isanc($b,$aend) 0
10145    return 0
10146}
10147
10148# This identifies whether $desc has an ancestor that is
10149# a growing tip of the graph and which is not an ancestor of $anc
10150# and returns 0 if so and 1 if not.
10151# If we subsequently discover a tag on such a growing tip, and that
10152# turns out to be a descendent of $anc (which it could, since we
10153# don't necessarily see children before parents), then $desc
10154# isn't a good choice to display as a descendent tag of
10155# $anc (since it is the descendent of another tag which is
10156# a descendent of $anc).  Similarly, $anc isn't a good choice to
10157# display as a ancestor tag of $desc.
10158#
10159proc is_certain {desc anc} {
10160    global arcnos arcout arcstart arcend growing problems
10161
10162    set certain {}
10163    if {[llength $arcnos($anc)] == 1} {
10164        # tags on the same arc are certain
10165        if {$arcnos($desc) eq $arcnos($anc)} {
10166            return 1
10167        }
10168        if {![info exists arcout($anc)]} {
10169            # if $anc is partway along an arc, use the start of the arc instead
10170            set a [lindex $arcnos($anc) 0]
10171            set anc $arcstart($a)
10172        }
10173    }
10174    if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
10175        set x $desc
10176    } else {
10177        set a [lindex $arcnos($desc) 0]
10178        set x $arcend($a)
10179    }
10180    if {$x == $anc} {
10181        return 1
10182    }
10183    set anclist [list $x]
10184    set dl($x) 1
10185    set nnh 1
10186    set ngrowanc 0
10187    for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
10188        set x [lindex $anclist $i]
10189        if {$dl($x)} {
10190            incr nnh -1
10191        }
10192        set done($x) 1
10193        foreach a $arcout($x) {
10194            if {[info exists growing($a)]} {
10195                if {![info exists growanc($x)] && $dl($x)} {
10196                    set growanc($x) 1
10197                    incr ngrowanc
10198                }
10199            } else {
10200                set y $arcend($a)
10201                if {[info exists dl($y)]} {
10202                    if {$dl($y)} {
10203                        if {!$dl($x)} {
10204                            set dl($y) 0
10205                            if {![info exists done($y)]} {
10206                                incr nnh -1
10207                            }
10208                            if {[info exists growanc($x)]} {
10209                                incr ngrowanc -1
10210                            }
10211                            set xl [list $y]
10212                            for {set k 0} {$k < [llength $xl]} {incr k} {
10213                                set z [lindex $xl $k]
10214                                foreach c $arcout($z) {
10215                                    if {[info exists arcend($c)]} {
10216                                        set v $arcend($c)
10217                                        if {[info exists dl($v)] && $dl($v)} {
10218                                            set dl($v) 0
10219                                            if {![info exists done($v)]} {
10220                                                incr nnh -1
10221                                            }
10222                                            if {[info exists growanc($v)]} {
10223                                                incr ngrowanc -1
10224                                            }
10225                                            lappend xl $v
10226                                        }
10227                                    }
10228                                }
10229                            }
10230                        }
10231                    }
10232                } elseif {$y eq $anc || !$dl($x)} {
10233                    set dl($y) 0
10234                    lappend anclist $y
10235                } else {
10236                    set dl($y) 1
10237                    lappend anclist $y
10238                    incr nnh
10239                }
10240            }
10241        }
10242    }
10243    foreach x [array names growanc] {
10244        if {$dl($x)} {
10245            return 0
10246        }
10247        return 0
10248    }
10249    return 1
10250}
10251
10252proc validate_arctags {a} {
10253    global arctags idtags
10254
10255    set i -1
10256    set na $arctags($a)
10257    foreach id $arctags($a) {
10258        incr i
10259        if {![info exists idtags($id)]} {
10260            set na [lreplace $na $i $i]
10261            incr i -1
10262        }
10263    }
10264    set arctags($a) $na
10265}
10266
10267proc validate_archeads {a} {
10268    global archeads idheads
10269
10270    set i -1
10271    set na $archeads($a)
10272    foreach id $archeads($a) {
10273        incr i
10274        if {![info exists idheads($id)]} {
10275            set na [lreplace $na $i $i]
10276            incr i -1
10277        }
10278    }
10279    set archeads($a) $na
10280}
10281
10282# Return the list of IDs that have tags that are descendents of id,
10283# ignoring IDs that are descendents of IDs already reported.
10284proc desctags {id} {
10285    global arcnos arcstart arcids arctags idtags allparents
10286    global growing cached_dtags
10287
10288    if {![info exists allparents($id)]} {
10289        return {}
10290    }
10291    set t1 [clock clicks -milliseconds]
10292    set argid $id
10293    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10294        # part-way along an arc; check that arc first
10295        set a [lindex $arcnos($id) 0]
10296        if {$arctags($a) ne {}} {
10297            validate_arctags $a
10298            set i [lsearch -exact $arcids($a) $id]
10299            set tid {}
10300            foreach t $arctags($a) {
10301                set j [lsearch -exact $arcids($a) $t]
10302                if {$j >= $i} break
10303                set tid $t
10304            }
10305            if {$tid ne {}} {
10306                return $tid
10307            }
10308        }
10309        set id $arcstart($a)
10310        if {[info exists idtags($id)]} {
10311            return $id
10312        }
10313    }
10314    if {[info exists cached_dtags($id)]} {
10315        return $cached_dtags($id)
10316    }
10317
10318    set origid $id
10319    set todo [list $id]
10320    set queued($id) 1
10321    set nc 1
10322    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10323        set id [lindex $todo $i]
10324        set done($id) 1
10325        set ta [info exists hastaggedancestor($id)]
10326        if {!$ta} {
10327            incr nc -1
10328        }
10329        # ignore tags on starting node
10330        if {!$ta && $i > 0} {
10331            if {[info exists idtags($id)]} {
10332                set tagloc($id) $id
10333                set ta 1
10334            } elseif {[info exists cached_dtags($id)]} {
10335                set tagloc($id) $cached_dtags($id)
10336                set ta 1
10337            }
10338        }
10339        foreach a $arcnos($id) {
10340            set d $arcstart($a)
10341            if {!$ta && $arctags($a) ne {}} {
10342                validate_arctags $a
10343                if {$arctags($a) ne {}} {
10344                    lappend tagloc($id) [lindex $arctags($a) end]
10345                }
10346            }
10347            if {$ta || $arctags($a) ne {}} {
10348                set tomark [list $d]
10349                for {set j 0} {$j < [llength $tomark]} {incr j} {
10350                    set dd [lindex $tomark $j]
10351                    if {![info exists hastaggedancestor($dd)]} {
10352                        if {[info exists done($dd)]} {
10353                            foreach b $arcnos($dd) {
10354                                lappend tomark $arcstart($b)
10355                            }
10356                            if {[info exists tagloc($dd)]} {
10357                                unset tagloc($dd)
10358                            }
10359                        } elseif {[info exists queued($dd)]} {
10360                            incr nc -1
10361                        }
10362                        set hastaggedancestor($dd) 1
10363                    }
10364                }
10365            }
10366            if {![info exists queued($d)]} {
10367                lappend todo $d
10368                set queued($d) 1
10369                if {![info exists hastaggedancestor($d)]} {
10370                    incr nc
10371                }
10372            }
10373        }
10374    }
10375    set tags {}
10376    foreach id [array names tagloc] {
10377        if {![info exists hastaggedancestor($id)]} {
10378            foreach t $tagloc($id) {
10379                if {[lsearch -exact $tags $t] < 0} {
10380                    lappend tags $t
10381                }
10382            }
10383        }
10384    }
10385    set t2 [clock clicks -milliseconds]
10386    set loopix $i
10387
10388    # remove tags that are descendents of other tags
10389    for {set i 0} {$i < [llength $tags]} {incr i} {
10390        set a [lindex $tags $i]
10391        for {set j 0} {$j < $i} {incr j} {
10392            set b [lindex $tags $j]
10393            set r [anc_or_desc $a $b]
10394            if {$r == 1} {
10395                set tags [lreplace $tags $j $j]
10396                incr j -1
10397                incr i -1
10398            } elseif {$r == -1} {
10399                set tags [lreplace $tags $i $i]
10400                incr i -1
10401                break
10402            }
10403        }
10404    }
10405
10406    if {[array names growing] ne {}} {
10407        # graph isn't finished, need to check if any tag could get
10408        # eclipsed by another tag coming later.  Simply ignore any
10409        # tags that could later get eclipsed.
10410        set ctags {}
10411        foreach t $tags {
10412            if {[is_certain $t $origid]} {
10413                lappend ctags $t
10414            }
10415        }
10416        if {$tags eq $ctags} {
10417            set cached_dtags($origid) $tags
10418        } else {
10419            set tags $ctags
10420        }
10421    } else {
10422        set cached_dtags($origid) $tags
10423    }
10424    set t3 [clock clicks -milliseconds]
10425    if {0 && $t3 - $t1 >= 100} {
10426        puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10427            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10428    }
10429    return $tags
10430}
10431
10432proc anctags {id} {
10433    global arcnos arcids arcout arcend arctags idtags allparents
10434    global growing cached_atags
10435
10436    if {![info exists allparents($id)]} {
10437        return {}
10438    }
10439    set t1 [clock clicks -milliseconds]
10440    set argid $id
10441    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10442        # part-way along an arc; check that arc first
10443        set a [lindex $arcnos($id) 0]
10444        if {$arctags($a) ne {}} {
10445            validate_arctags $a
10446            set i [lsearch -exact $arcids($a) $id]
10447            foreach t $arctags($a) {
10448                set j [lsearch -exact $arcids($a) $t]
10449                if {$j > $i} {
10450                    return $t
10451                }
10452            }
10453        }
10454        if {![info exists arcend($a)]} {
10455            return {}
10456        }
10457        set id $arcend($a)
10458        if {[info exists idtags($id)]} {
10459            return $id
10460        }
10461    }
10462    if {[info exists cached_atags($id)]} {
10463        return $cached_atags($id)
10464    }
10465
10466    set origid $id
10467    set todo [list $id]
10468    set queued($id) 1
10469    set taglist {}
10470    set nc 1
10471    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10472        set id [lindex $todo $i]
10473        set done($id) 1
10474        set td [info exists hastaggeddescendent($id)]
10475        if {!$td} {
10476            incr nc -1
10477        }
10478        # ignore tags on starting node
10479        if {!$td && $i > 0} {
10480            if {[info exists idtags($id)]} {
10481                set tagloc($id) $id
10482                set td 1
10483            } elseif {[info exists cached_atags($id)]} {
10484                set tagloc($id) $cached_atags($id)
10485                set td 1
10486            }
10487        }
10488        foreach a $arcout($id) {
10489            if {!$td && $arctags($a) ne {}} {
10490                validate_arctags $a
10491                if {$arctags($a) ne {}} {
10492                    lappend tagloc($id) [lindex $arctags($a) 0]
10493                }
10494            }
10495            if {![info exists arcend($a)]} continue
10496            set d $arcend($a)
10497            if {$td || $arctags($a) ne {}} {
10498                set tomark [list $d]
10499                for {set j 0} {$j < [llength $tomark]} {incr j} {
10500                    set dd [lindex $tomark $j]
10501                    if {![info exists hastaggeddescendent($dd)]} {
10502                        if {[info exists done($dd)]} {
10503                            foreach b $arcout($dd) {
10504                                if {[info exists arcend($b)]} {
10505                                    lappend tomark $arcend($b)
10506                                }
10507                            }
10508                            if {[info exists tagloc($dd)]} {
10509                                unset tagloc($dd)
10510                            }
10511                        } elseif {[info exists queued($dd)]} {
10512                            incr nc -1
10513                        }
10514                        set hastaggeddescendent($dd) 1
10515                    }
10516                }
10517            }
10518            if {![info exists queued($d)]} {
10519                lappend todo $d
10520                set queued($d) 1
10521                if {![info exists hastaggeddescendent($d)]} {
10522                    incr nc
10523                }
10524            }
10525        }
10526    }
10527    set t2 [clock clicks -milliseconds]
10528    set loopix $i
10529    set tags {}
10530    foreach id [array names tagloc] {
10531        if {![info exists hastaggeddescendent($id)]} {
10532            foreach t $tagloc($id) {
10533                if {[lsearch -exact $tags $t] < 0} {
10534                    lappend tags $t
10535                }
10536            }
10537        }
10538    }
10539
10540    # remove tags that are ancestors of other tags
10541    for {set i 0} {$i < [llength $tags]} {incr i} {
10542        set a [lindex $tags $i]
10543        for {set j 0} {$j < $i} {incr j} {
10544            set b [lindex $tags $j]
10545            set r [anc_or_desc $a $b]
10546            if {$r == -1} {
10547                set tags [lreplace $tags $j $j]
10548                incr j -1
10549                incr i -1
10550            } elseif {$r == 1} {
10551                set tags [lreplace $tags $i $i]
10552                incr i -1
10553                break
10554            }
10555        }
10556    }
10557
10558    if {[array names growing] ne {}} {
10559        # graph isn't finished, need to check if any tag could get
10560        # eclipsed by another tag coming later.  Simply ignore any
10561        # tags that could later get eclipsed.
10562        set ctags {}
10563        foreach t $tags {
10564            if {[is_certain $origid $t]} {
10565                lappend ctags $t
10566            }
10567        }
10568        if {$tags eq $ctags} {
10569            set cached_atags($origid) $tags
10570        } else {
10571            set tags $ctags
10572        }
10573    } else {
10574        set cached_atags($origid) $tags
10575    }
10576    set t3 [clock clicks -milliseconds]
10577    if {0 && $t3 - $t1 >= 100} {
10578        puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
10579            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10580    }
10581    return $tags
10582}
10583
10584# Return the list of IDs that have heads that are descendents of id,
10585# including id itself if it has a head.
10586proc descheads {id} {
10587    global arcnos arcstart arcids archeads idheads cached_dheads
10588    global allparents arcout
10589
10590    if {![info exists allparents($id)]} {
10591        return {}
10592    }
10593    set aret {}
10594    if {![info exists arcout($id)]} {
10595        # part-way along an arc; check it first
10596        set a [lindex $arcnos($id) 0]
10597        if {$archeads($a) ne {}} {
10598            validate_archeads $a
10599            set i [lsearch -exact $arcids($a) $id]
10600            foreach t $archeads($a) {
10601                set j [lsearch -exact $arcids($a) $t]
10602                if {$j > $i} break
10603                lappend aret $t
10604            }
10605        }
10606        set id $arcstart($a)
10607    }
10608    set origid $id
10609    set todo [list $id]
10610    set seen($id) 1
10611    set ret {}
10612    for {set i 0} {$i < [llength $todo]} {incr i} {
10613        set id [lindex $todo $i]
10614        if {[info exists cached_dheads($id)]} {
10615            set ret [concat $ret $cached_dheads($id)]
10616        } else {
10617            if {[info exists idheads($id)]} {
10618                lappend ret $id
10619            }
10620            foreach a $arcnos($id) {
10621                if {$archeads($a) ne {}} {
10622                    validate_archeads $a
10623                    if {$archeads($a) ne {}} {
10624                        set ret [concat $ret $archeads($a)]
10625                    }
10626                }
10627                set d $arcstart($a)
10628                if {![info exists seen($d)]} {
10629                    lappend todo $d
10630                    set seen($d) 1
10631                }
10632            }
10633        }
10634    }
10635    set ret [lsort -unique $ret]
10636    set cached_dheads($origid) $ret
10637    return [concat $ret $aret]
10638}
10639
10640proc addedtag {id} {
10641    global arcnos arcout cached_dtags cached_atags
10642
10643    if {![info exists arcnos($id)]} return
10644    if {![info exists arcout($id)]} {
10645        recalcarc [lindex $arcnos($id) 0]
10646    }
10647    catch {unset cached_dtags}
10648    catch {unset cached_atags}
10649}
10650
10651proc addedhead {hid head} {
10652    global arcnos arcout cached_dheads
10653
10654    if {![info exists arcnos($hid)]} return
10655    if {![info exists arcout($hid)]} {
10656        recalcarc [lindex $arcnos($hid) 0]
10657    }
10658    catch {unset cached_dheads}
10659}
10660
10661proc removedhead {hid head} {
10662    global cached_dheads
10663
10664    catch {unset cached_dheads}
10665}
10666
10667proc movedhead {hid head} {
10668    global arcnos arcout cached_dheads
10669
10670    if {![info exists arcnos($hid)]} return
10671    if {![info exists arcout($hid)]} {
10672        recalcarc [lindex $arcnos($hid) 0]
10673    }
10674    catch {unset cached_dheads}
10675}
10676
10677proc changedrefs {} {
10678    global cached_dheads cached_dtags cached_atags cached_tagcontent
10679    global arctags archeads arcnos arcout idheads idtags
10680
10681    foreach id [concat [array names idheads] [array names idtags]] {
10682        if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
10683            set a [lindex $arcnos($id) 0]
10684            if {![info exists donearc($a)]} {
10685                recalcarc $a
10686                set donearc($a) 1
10687            }
10688        }
10689    }
10690    catch {unset cached_tagcontent}
10691    catch {unset cached_dtags}
10692    catch {unset cached_atags}
10693    catch {unset cached_dheads}
10694}
10695
10696proc rereadrefs {} {
10697    global idtags idheads idotherrefs mainheadid
10698
10699    set refids [concat [array names idtags] \
10700                    [array names idheads] [array names idotherrefs]]
10701    foreach id $refids {
10702        if {![info exists ref($id)]} {
10703            set ref($id) [listrefs $id]
10704        }
10705    }
10706    set oldmainhead $mainheadid
10707    readrefs
10708    changedrefs
10709    set refids [lsort -unique [concat $refids [array names idtags] \
10710                        [array names idheads] [array names idotherrefs]]]
10711    foreach id $refids {
10712        set v [listrefs $id]
10713        if {![info exists ref($id)] || $ref($id) != $v} {
10714            redrawtags $id
10715        }
10716    }
10717    if {$oldmainhead ne $mainheadid} {
10718        redrawtags $oldmainhead
10719        redrawtags $mainheadid
10720    }
10721    run refill_reflist
10722}
10723
10724proc listrefs {id} {
10725    global idtags idheads idotherrefs
10726
10727    set x {}
10728    if {[info exists idtags($id)]} {
10729        set x $idtags($id)
10730    }
10731    set y {}
10732    if {[info exists idheads($id)]} {
10733        set y $idheads($id)
10734    }
10735    set z {}
10736    if {[info exists idotherrefs($id)]} {
10737        set z $idotherrefs($id)
10738    }
10739    return [list $x $y $z]
10740}
10741
10742proc showtag {tag isnew} {
10743    global ctext cached_tagcontent tagids linknum tagobjid
10744
10745    if {$isnew} {
10746        addtohistory [list showtag $tag 0] savectextpos
10747    }
10748    $ctext conf -state normal
10749    clear_ctext
10750    settabs 0
10751    set linknum 0
10752    if {![info exists cached_tagcontent($tag)]} {
10753        catch {
10754           set cached_tagcontent($tag) [exec git cat-file tag $tag]
10755        }
10756    }
10757    if {[info exists cached_tagcontent($tag)]} {
10758        set text $cached_tagcontent($tag)
10759    } else {
10760        set text "[mc "Tag"]: $tag\n[mc "Id"]:  $tagids($tag)"
10761    }
10762    appendwithlinks $text {}
10763    maybe_scroll_ctext 1
10764    $ctext conf -state disabled
10765    init_flist {}
10766}
10767
10768proc doquit {} {
10769    global stopped
10770    global gitktmpdir
10771
10772    set stopped 100
10773    savestuff .
10774    destroy .
10775
10776    if {[info exists gitktmpdir]} {
10777        catch {file delete -force $gitktmpdir}
10778    }
10779}
10780
10781proc mkfontdisp {font top which} {
10782    global fontattr fontpref $font NS use_ttk
10783
10784    set fontpref($font) [set $font]
10785    ${NS}::button $top.${font}but -text $which \
10786        -command [list choosefont $font $which]
10787    ${NS}::label $top.$font -relief flat -font $font \
10788        -text $fontattr($font,family) -justify left
10789    grid x $top.${font}but $top.$font -sticky w
10790}
10791
10792proc choosefont {font which} {
10793    global fontparam fontlist fonttop fontattr
10794    global prefstop NS
10795
10796    set fontparam(which) $which
10797    set fontparam(font) $font
10798    set fontparam(family) [font actual $font -family]
10799    set fontparam(size) $fontattr($font,size)
10800    set fontparam(weight) $fontattr($font,weight)
10801    set fontparam(slant) $fontattr($font,slant)
10802    set top .gitkfont
10803    set fonttop $top
10804    if {![winfo exists $top]} {
10805        font create sample
10806        eval font config sample [font actual $font]
10807        ttk_toplevel $top
10808        make_transient $top $prefstop
10809        wm title $top [mc "Gitk font chooser"]
10810        ${NS}::label $top.l -textvariable fontparam(which)
10811        pack $top.l -side top
10812        set fontlist [lsort [font families]]
10813        ${NS}::frame $top.f
10814        listbox $top.f.fam -listvariable fontlist \
10815            -yscrollcommand [list $top.f.sb set]
10816        bind $top.f.fam <<ListboxSelect>> selfontfam
10817        ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
10818        pack $top.f.sb -side right -fill y
10819        pack $top.f.fam -side left -fill both -expand 1
10820        pack $top.f -side top -fill both -expand 1
10821        ${NS}::frame $top.g
10822        spinbox $top.g.size -from 4 -to 40 -width 4 \
10823            -textvariable fontparam(size) \
10824            -validatecommand {string is integer -strict %s}
10825        checkbutton $top.g.bold -padx 5 \
10826            -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
10827            -variable fontparam(weight) -onvalue bold -offvalue normal
10828        checkbutton $top.g.ital -padx 5 \
10829            -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
10830            -variable fontparam(slant) -onvalue italic -offvalue roman
10831        pack $top.g.size $top.g.bold $top.g.ital -side left
10832        pack $top.g -side top
10833        canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
10834            -background white
10835        $top.c create text 100 25 -anchor center -text $which -font sample \
10836            -fill black -tags text
10837        bind $top.c <Configure> [list centertext $top.c]
10838        pack $top.c -side top -fill x
10839        ${NS}::frame $top.buts
10840        ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
10841        ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
10842        bind $top <Key-Return> fontok
10843        bind $top <Key-Escape> fontcan
10844        grid $top.buts.ok $top.buts.can
10845        grid columnconfigure $top.buts 0 -weight 1 -uniform a
10846        grid columnconfigure $top.buts 1 -weight 1 -uniform a
10847        pack $top.buts -side bottom -fill x
10848        trace add variable fontparam write chg_fontparam
10849    } else {
10850        raise $top
10851        $top.c itemconf text -text $which
10852    }
10853    set i [lsearch -exact $fontlist $fontparam(family)]
10854    if {$i >= 0} {
10855        $top.f.fam selection set $i
10856        $top.f.fam see $i
10857    }
10858}
10859
10860proc centertext {w} {
10861    $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
10862}
10863
10864proc fontok {} {
10865    global fontparam fontpref prefstop
10866
10867    set f $fontparam(font)
10868    set fontpref($f) [list $fontparam(family) $fontparam(size)]
10869    if {$fontparam(weight) eq "bold"} {
10870        lappend fontpref($f) "bold"
10871    }
10872    if {$fontparam(slant) eq "italic"} {
10873        lappend fontpref($f) "italic"
10874    }
10875    set w $prefstop.notebook.fonts.$f
10876    $w conf -text $fontparam(family) -font $fontpref($f)
10877
10878    fontcan
10879}
10880
10881proc fontcan {} {
10882    global fonttop fontparam
10883
10884    if {[info exists fonttop]} {
10885        catch {destroy $fonttop}
10886        catch {font delete sample}
10887        unset fonttop
10888        unset fontparam
10889    }
10890}
10891
10892if {[package vsatisfies [package provide Tk] 8.6]} {
10893    # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
10894    # function to make use of it.
10895    proc choosefont {font which} {
10896        tk fontchooser configure -title $which -font $font \
10897            -command [list on_choosefont $font $which]
10898        tk fontchooser show
10899    }
10900    proc on_choosefont {font which newfont} {
10901        global fontparam
10902        puts stderr "$font $newfont"
10903        array set f [font actual $newfont]
10904        set fontparam(which) $which
10905        set fontparam(font) $font
10906        set fontparam(family) $f(-family)
10907        set fontparam(size) $f(-size)
10908        set fontparam(weight) $f(-weight)
10909        set fontparam(slant) $f(-slant)
10910        fontok
10911    }
10912}
10913
10914proc selfontfam {} {
10915    global fonttop fontparam
10916
10917    set i [$fonttop.f.fam curselection]
10918    if {$i ne {}} {
10919        set fontparam(family) [$fonttop.f.fam get $i]
10920    }
10921}
10922
10923proc chg_fontparam {v sub op} {
10924    global fontparam
10925
10926    font config sample -$sub $fontparam($sub)
10927}
10928
10929# Create a property sheet tab page
10930proc create_prefs_page {w} {
10931    global NS
10932    set parent [join [lrange [split $w .] 0 end-1] .]
10933    if {[winfo class $parent] eq "TNotebook"} {
10934        ${NS}::frame $w
10935    } else {
10936        ${NS}::labelframe $w
10937    }
10938}
10939
10940proc prefspage_general {notebook} {
10941    global NS maxwidth maxgraphpct showneartags showlocalchanges
10942    global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
10943    global hideremotes want_ttk have_ttk maxrefs
10944
10945    set page [create_prefs_page $notebook.general]
10946
10947    ${NS}::label $page.ldisp -text [mc "Commit list display options"]
10948    grid $page.ldisp - -sticky w -pady 10
10949    ${NS}::label $page.spacer -text " "
10950    ${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
10951    spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
10952    grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w
10953    ${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
10954    spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
10955    grid x $page.maxpctl $page.maxpct -sticky w
10956    ${NS}::checkbutton $page.showlocal -text [mc "Show local changes"] \
10957        -variable showlocalchanges
10958    grid x $page.showlocal -sticky w
10959    ${NS}::checkbutton $page.autoselect -text [mc "Auto-select SHA1 (length)"] \
10960        -variable autoselect
10961    spinbox $page.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
10962    grid x $page.autoselect $page.autosellen -sticky w
10963    ${NS}::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \
10964        -variable hideremotes
10965    grid x $page.hideremotes -sticky w
10966
10967    ${NS}::label $page.ddisp -text [mc "Diff display options"]
10968    grid $page.ddisp - -sticky w -pady 10
10969    ${NS}::label $page.tabstopl -text [mc "Tab spacing"]
10970    spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
10971    grid x $page.tabstopl $page.tabstop -sticky w
10972    ${NS}::checkbutton $page.ntag -text [mc "Display nearby tags/heads"] \
10973        -variable showneartags
10974    grid x $page.ntag -sticky w
10975    ${NS}::label $page.maxrefsl -text [mc "Maximum # tags/heads to show"]
10976    spinbox $page.maxrefs -from 1 -to 1000 -width 4 -textvariable maxrefs
10977    grid x $page.maxrefsl $page.maxrefs -sticky w
10978    ${NS}::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \
10979        -variable limitdiffs
10980    grid x $page.ldiff -sticky w
10981    ${NS}::checkbutton $page.lattr -text [mc "Support per-file encodings"] \
10982        -variable perfile_attrs
10983    grid x $page.lattr -sticky w
10984
10985    ${NS}::entry $page.extdifft -textvariable extdifftool
10986    ${NS}::frame $page.extdifff
10987    ${NS}::label $page.extdifff.l -text [mc "External diff tool" ]
10988    ${NS}::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff
10989    pack $page.extdifff.l $page.extdifff.b -side left
10990    pack configure $page.extdifff.l -padx 10
10991    grid x $page.extdifff $page.extdifft -sticky ew
10992
10993    ${NS}::label $page.lgen -text [mc "General options"]
10994    grid $page.lgen - -sticky w -pady 10
10995    ${NS}::checkbutton $page.want_ttk -variable want_ttk \
10996        -text [mc "Use themed widgets"]
10997    if {$have_ttk} {
10998        ${NS}::label $page.ttk_note -text [mc "(change requires restart)"]
10999    } else {
11000        ${NS}::label $page.ttk_note -text [mc "(currently unavailable)"]
11001    }
11002    grid x $page.want_ttk $page.ttk_note -sticky w
11003    return $page
11004}
11005
11006proc prefspage_colors {notebook} {
11007    global NS uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11008
11009    set page [create_prefs_page $notebook.colors]
11010
11011    ${NS}::label $page.cdisp -text [mc "Colors: press to choose"]
11012    grid $page.cdisp - -sticky w -pady 10
11013    label $page.ui -padx 40 -relief sunk -background $uicolor
11014    ${NS}::button $page.uibut -text [mc "Interface"] \
11015       -command [list choosecolor uicolor {} $page.ui [mc "interface"] setui]
11016    grid x $page.uibut $page.ui -sticky w
11017    label $page.bg -padx 40 -relief sunk -background $bgcolor
11018    ${NS}::button $page.bgbut -text [mc "Background"] \
11019        -command [list choosecolor bgcolor {} $page.bg [mc "background"] setbg]
11020    grid x $page.bgbut $page.bg -sticky w
11021    label $page.fg -padx 40 -relief sunk -background $fgcolor
11022    ${NS}::button $page.fgbut -text [mc "Foreground"] \
11023        -command [list choosecolor fgcolor {} $page.fg [mc "foreground"] setfg]
11024    grid x $page.fgbut $page.fg -sticky w
11025    label $page.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
11026    ${NS}::button $page.diffoldbut -text [mc "Diff: old lines"] \
11027        -command [list choosecolor diffcolors 0 $page.diffold [mc "diff old lines"] \
11028                      [list $ctext tag conf d0 -foreground]]
11029    grid x $page.diffoldbut $page.diffold -sticky w
11030    label $page.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
11031    ${NS}::button $page.diffnewbut -text [mc "Diff: new lines"] \
11032        -command [list choosecolor diffcolors 1 $page.diffnew [mc "diff new lines"] \
11033                      [list $ctext tag conf dresult -foreground]]
11034    grid x $page.diffnewbut $page.diffnew -sticky w
11035    label $page.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
11036    ${NS}::button $page.hunksepbut -text [mc "Diff: hunk header"] \
11037        -command [list choosecolor diffcolors 2 $page.hunksep \
11038                      [mc "diff hunk header"] \
11039                      [list $ctext tag conf hunksep -foreground]]
11040    grid x $page.hunksepbut $page.hunksep -sticky w
11041    label $page.markbgsep -padx 40 -relief sunk -background $markbgcolor
11042    ${NS}::button $page.markbgbut -text [mc "Marked line bg"] \
11043        -command [list choosecolor markbgcolor {} $page.markbgsep \
11044                      [mc "marked line background"] \
11045                      [list $ctext tag conf omark -background]]
11046    grid x $page.markbgbut $page.markbgsep -sticky w
11047    label $page.selbgsep -padx 40 -relief sunk -background $selectbgcolor
11048    ${NS}::button $page.selbgbut -text [mc "Select bg"] \
11049        -command [list choosecolor selectbgcolor {} $page.selbgsep [mc "background"] setselbg]
11050    grid x $page.selbgbut $page.selbgsep -sticky w
11051    return $page
11052}
11053
11054proc prefspage_fonts {notebook} {
11055    global NS
11056    set page [create_prefs_page $notebook.fonts]
11057    ${NS}::label $page.cfont -text [mc "Fonts: press to choose"]
11058    grid $page.cfont - -sticky w -pady 10
11059    mkfontdisp mainfont $page [mc "Main font"]
11060    mkfontdisp textfont $page [mc "Diff display font"]
11061    mkfontdisp uifont $page [mc "User interface font"]
11062    return $page
11063}
11064
11065proc doprefs {} {
11066    global maxwidth maxgraphpct use_ttk NS
11067    global oldprefs prefstop showneartags showlocalchanges
11068    global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11069    global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11070    global hideremotes want_ttk have_ttk
11071
11072    set top .gitkprefs
11073    set prefstop $top
11074    if {[winfo exists $top]} {
11075        raise $top
11076        return
11077    }
11078    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11079                   limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11080        set oldprefs($v) [set $v]
11081    }
11082    ttk_toplevel $top
11083    wm title $top [mc "Gitk preferences"]
11084    make_transient $top .
11085
11086    if {[set use_notebook [expr {$use_ttk && [info command ::ttk::notebook] ne ""}]]} {
11087        set notebook [ttk::notebook $top.notebook]
11088    } else {
11089        set notebook [${NS}::frame $top.notebook -borderwidth 0 -relief flat]
11090    }
11091
11092    lappend pages [prefspage_general $notebook] [mc "General"]
11093    lappend pages [prefspage_colors $notebook] [mc "Colors"]
11094    lappend pages [prefspage_fonts $notebook] [mc "Fonts"]
11095    set col 0
11096    foreach {page title} $pages {
11097        if {$use_notebook} {
11098            $notebook add $page -text $title
11099        } else {
11100            set btn [${NS}::button $notebook.b_[string map {. X} $page] \
11101                         -text $title -command [list raise $page]]
11102            $page configure -text $title
11103            grid $btn -row 0 -column [incr col] -sticky w
11104            grid $page -row 1 -column 0 -sticky news -columnspan 100
11105        }
11106    }
11107
11108    if {!$use_notebook} {
11109        grid columnconfigure $notebook 0 -weight 1
11110        grid rowconfigure $notebook 1 -weight 1
11111        raise [lindex $pages 0]
11112    }
11113
11114    grid $notebook -sticky news -padx 2 -pady 2
11115    grid rowconfigure $top 0 -weight 1
11116    grid columnconfigure $top 0 -weight 1
11117
11118    ${NS}::frame $top.buts
11119    ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
11120    ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
11121    bind $top <Key-Return> prefsok
11122    bind $top <Key-Escape> prefscan
11123    grid $top.buts.ok $top.buts.can
11124    grid columnconfigure $top.buts 0 -weight 1 -uniform a
11125    grid columnconfigure $top.buts 1 -weight 1 -uniform a
11126    grid $top.buts - - -pady 10 -sticky ew
11127    grid columnconfigure $top 2 -weight 1
11128    bind $top <Visibility> [list focus $top.buts.ok]
11129}
11130
11131proc choose_extdiff {} {
11132    global extdifftool
11133
11134    set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
11135    if {$prog ne {}} {
11136        set extdifftool $prog
11137    }
11138}
11139
11140proc choosecolor {v vi w x cmd} {
11141    global $v
11142
11143    set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
11144               -title [mc "Gitk: choose color for %s" $x]]
11145    if {$c eq {}} return
11146    $w conf -background $c
11147    lset $v $vi $c
11148    eval $cmd $c
11149}
11150
11151proc setselbg {c} {
11152    global bglist cflist
11153    foreach w $bglist {
11154        $w configure -selectbackground $c
11155    }
11156    $cflist tag configure highlight \
11157        -background [$cflist cget -selectbackground]
11158    allcanvs itemconf secsel -fill $c
11159}
11160
11161# This sets the background color and the color scheme for the whole UI.
11162# For some reason, tk_setPalette chooses a nasty dark red for selectColor
11163# if we don't specify one ourselves, which makes the checkbuttons and
11164# radiobuttons look bad.  This chooses white for selectColor if the
11165# background color is light, or black if it is dark.
11166proc setui {c} {
11167    if {[tk windowingsystem] eq "win32"} { return }
11168    set bg [winfo rgb . $c]
11169    set selc black
11170    if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
11171        set selc white
11172    }
11173    tk_setPalette background $c selectColor $selc
11174}
11175
11176proc setbg {c} {
11177    global bglist
11178
11179    foreach w $bglist {
11180        $w conf -background $c
11181    }
11182}
11183
11184proc setfg {c} {
11185    global fglist canv
11186
11187    foreach w $fglist {
11188        $w conf -foreground $c
11189    }
11190    allcanvs itemconf text -fill $c
11191    $canv itemconf circle -outline $c
11192    $canv itemconf markid -outline $c
11193}
11194
11195proc prefscan {} {
11196    global oldprefs prefstop
11197
11198    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11199                   limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11200        global $v
11201        set $v $oldprefs($v)
11202    }
11203    catch {destroy $prefstop}
11204    unset prefstop
11205    fontcan
11206}
11207
11208proc prefsok {} {
11209    global maxwidth maxgraphpct
11210    global oldprefs prefstop showneartags showlocalchanges
11211    global fontpref mainfont textfont uifont
11212    global limitdiffs treediffs perfile_attrs
11213    global hideremotes
11214
11215    catch {destroy $prefstop}
11216    unset prefstop
11217    fontcan
11218    set fontchanged 0
11219    if {$mainfont ne $fontpref(mainfont)} {
11220        set mainfont $fontpref(mainfont)
11221        parsefont mainfont $mainfont
11222        eval font configure mainfont [fontflags mainfont]
11223        eval font configure mainfontbold [fontflags mainfont 1]
11224        setcoords
11225        set fontchanged 1
11226    }
11227    if {$textfont ne $fontpref(textfont)} {
11228        set textfont $fontpref(textfont)
11229        parsefont textfont $textfont
11230        eval font configure textfont [fontflags textfont]
11231        eval font configure textfontbold [fontflags textfont 1]
11232    }
11233    if {$uifont ne $fontpref(uifont)} {
11234        set uifont $fontpref(uifont)
11235        parsefont uifont $uifont
11236        eval font configure uifont [fontflags uifont]
11237    }
11238    settabs
11239    if {$showlocalchanges != $oldprefs(showlocalchanges)} {
11240        if {$showlocalchanges} {
11241            doshowlocalchanges
11242        } else {
11243            dohidelocalchanges
11244        }
11245    }
11246    if {$limitdiffs != $oldprefs(limitdiffs) ||
11247        ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11248        # treediffs elements are limited by path;
11249        # won't have encodings cached if perfile_attrs was just turned on
11250        catch {unset treediffs}
11251    }
11252    if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
11253        || $maxgraphpct != $oldprefs(maxgraphpct)} {
11254        redisplay
11255    } elseif {$showneartags != $oldprefs(showneartags) ||
11256          $limitdiffs != $oldprefs(limitdiffs)} {
11257        reselectline
11258    }
11259    if {$hideremotes != $oldprefs(hideremotes)} {
11260        rereadrefs
11261    }
11262}
11263
11264proc formatdate {d} {
11265    global datetimeformat
11266    if {$d ne {}} {
11267        set d [clock format [lindex $d 0] -format $datetimeformat]
11268    }
11269    return $d
11270}
11271
11272# This list of encoding names and aliases is distilled from
11273# http://www.iana.org/assignments/character-sets.
11274# Not all of them are supported by Tcl.
11275set encoding_aliases {
11276    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11277      ISO646-US US-ASCII us IBM367 cp367 csASCII }
11278    { ISO-10646-UTF-1 csISO10646UTF1 }
11279    { ISO_646.basic:1983 ref csISO646basic1983 }
11280    { INVARIANT csINVARIANT }
11281    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11282    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11283    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11284    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11285    { NATS-DANO iso-ir-9-1 csNATSDANO }
11286    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11287    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11288    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11289    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11290    { ISO-2022-KR csISO2022KR }
11291    { EUC-KR csEUCKR }
11292    { ISO-2022-JP csISO2022JP }
11293    { ISO-2022-JP-2 csISO2022JP2 }
11294    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11295      csISO13JISC6220jp }
11296    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11297    { IT iso-ir-15 ISO646-IT csISO15Italian }
11298    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11299    { ES iso-ir-17 ISO646-ES csISO17Spanish }
11300    { greek7-old iso-ir-18 csISO18Greek7Old }
11301    { latin-greek iso-ir-19 csISO19LatinGreek }
11302    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11303    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11304    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11305    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11306    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11307    { BS_viewdata iso-ir-47 csISO47BSViewdata }
11308    { INIS iso-ir-49 csISO49INIS }
11309    { INIS-8 iso-ir-50 csISO50INIS8 }
11310    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11311    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11312    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11313    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11314    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11315    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11316      csISO60Norwegian1 }
11317    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11318    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11319    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11320    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11321    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11322    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11323    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11324    { greek7 iso-ir-88 csISO88Greek7 }
11325    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11326    { iso-ir-90 csISO90 }
11327    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11328    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11329      csISO92JISC62991984b }
11330    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11331    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11332    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11333      csISO95JIS62291984handadd }
11334    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11335    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11336    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11337    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11338      CP819 csISOLatin1 }
11339    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11340    { T.61-7bit iso-ir-102 csISO102T617bit }
11341    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11342    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
11343    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
11344    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
11345    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
11346    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
11347    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
11348    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
11349      arabic csISOLatinArabic }
11350    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
11351    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
11352    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
11353      greek greek8 csISOLatinGreek }
11354    { T.101-G2 iso-ir-128 csISO128T101G2 }
11355    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
11356      csISOLatinHebrew }
11357    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
11358    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
11359    { CSN_369103 iso-ir-139 csISO139CSN369103 }
11360    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
11361    { ISO_6937-2-add iso-ir-142 csISOTextComm }
11362    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
11363    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
11364      csISOLatinCyrillic }
11365    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
11366    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
11367    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
11368    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
11369    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
11370    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
11371    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
11372    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
11373    { ISO_10367-box iso-ir-155 csISO10367Box }
11374    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
11375    { latin-lap lap iso-ir-158 csISO158Lap }
11376    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
11377    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
11378    { us-dk csUSDK }
11379    { dk-us csDKUS }
11380    { JIS_X0201 X0201 csHalfWidthKatakana }
11381    { KSC5636 ISO646-KR csKSC5636 }
11382    { ISO-10646-UCS-2 csUnicode }
11383    { ISO-10646-UCS-4 csUCS4 }
11384    { DEC-MCS dec csDECMCS }
11385    { hp-roman8 roman8 r8 csHPRoman8 }
11386    { macintosh mac csMacintosh }
11387    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
11388      csIBM037 }
11389    { IBM038 EBCDIC-INT cp038 csIBM038 }
11390    { IBM273 CP273 csIBM273 }
11391    { IBM274 EBCDIC-BE CP274 csIBM274 }
11392    { IBM275 EBCDIC-BR cp275 csIBM275 }
11393    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
11394    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
11395    { IBM280 CP280 ebcdic-cp-it csIBM280 }
11396    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
11397    { IBM284 CP284 ebcdic-cp-es csIBM284 }
11398    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
11399    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
11400    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
11401    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
11402    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
11403    { IBM424 cp424 ebcdic-cp-he csIBM424 }
11404    { IBM437 cp437 437 csPC8CodePage437 }
11405    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
11406    { IBM775 cp775 csPC775Baltic }
11407    { IBM850 cp850 850 csPC850Multilingual }
11408    { IBM851 cp851 851 csIBM851 }
11409    { IBM852 cp852 852 csPCp852 }
11410    { IBM855 cp855 855 csIBM855 }
11411    { IBM857 cp857 857 csIBM857 }
11412    { IBM860 cp860 860 csIBM860 }
11413    { IBM861 cp861 861 cp-is csIBM861 }
11414    { IBM862 cp862 862 csPC862LatinHebrew }
11415    { IBM863 cp863 863 csIBM863 }
11416    { IBM864 cp864 csIBM864 }
11417    { IBM865 cp865 865 csIBM865 }
11418    { IBM866 cp866 866 csIBM866 }
11419    { IBM868 CP868 cp-ar csIBM868 }
11420    { IBM869 cp869 869 cp-gr csIBM869 }
11421    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
11422    { IBM871 CP871 ebcdic-cp-is csIBM871 }
11423    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
11424    { IBM891 cp891 csIBM891 }
11425    { IBM903 cp903 csIBM903 }
11426    { IBM904 cp904 904 csIBBM904 }
11427    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
11428    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
11429    { IBM1026 CP1026 csIBM1026 }
11430    { EBCDIC-AT-DE csIBMEBCDICATDE }
11431    { EBCDIC-AT-DE-A csEBCDICATDEA }
11432    { EBCDIC-CA-FR csEBCDICCAFR }
11433    { EBCDIC-DK-NO csEBCDICDKNO }
11434    { EBCDIC-DK-NO-A csEBCDICDKNOA }
11435    { EBCDIC-FI-SE csEBCDICFISE }
11436    { EBCDIC-FI-SE-A csEBCDICFISEA }
11437    { EBCDIC-FR csEBCDICFR }
11438    { EBCDIC-IT csEBCDICIT }
11439    { EBCDIC-PT csEBCDICPT }
11440    { EBCDIC-ES csEBCDICES }
11441    { EBCDIC-ES-A csEBCDICESA }
11442    { EBCDIC-ES-S csEBCDICESS }
11443    { EBCDIC-UK csEBCDICUK }
11444    { EBCDIC-US csEBCDICUS }
11445    { UNKNOWN-8BIT csUnknown8BiT }
11446    { MNEMONIC csMnemonic }
11447    { MNEM csMnem }
11448    { VISCII csVISCII }
11449    { VIQR csVIQR }
11450    { KOI8-R csKOI8R }
11451    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
11452    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
11453    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
11454    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
11455    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
11456    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
11457    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
11458    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
11459    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
11460    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
11461    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
11462    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
11463    { IBM1047 IBM-1047 }
11464    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
11465    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
11466    { UNICODE-1-1 csUnicode11 }
11467    { CESU-8 csCESU-8 }
11468    { BOCU-1 csBOCU-1 }
11469    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
11470    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
11471      l8 }
11472    { ISO-8859-15 ISO_8859-15 Latin-9 }
11473    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
11474    { GBK CP936 MS936 windows-936 }
11475    { JIS_Encoding csJISEncoding }
11476    { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
11477    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
11478      EUC-JP }
11479    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
11480    { ISO-10646-UCS-Basic csUnicodeASCII }
11481    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
11482    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
11483    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
11484    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
11485    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
11486    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
11487    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
11488    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
11489    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
11490    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
11491    { Adobe-Standard-Encoding csAdobeStandardEncoding }
11492    { Ventura-US csVenturaUS }
11493    { Ventura-International csVenturaInternational }
11494    { PC8-Danish-Norwegian csPC8DanishNorwegian }
11495    { PC8-Turkish csPC8Turkish }
11496    { IBM-Symbols csIBMSymbols }
11497    { IBM-Thai csIBMThai }
11498    { HP-Legal csHPLegal }
11499    { HP-Pi-font csHPPiFont }
11500    { HP-Math8 csHPMath8 }
11501    { Adobe-Symbol-Encoding csHPPSMath }
11502    { HP-DeskTop csHPDesktop }
11503    { Ventura-Math csVenturaMath }
11504    { Microsoft-Publishing csMicrosoftPublishing }
11505    { Windows-31J csWindows31J }
11506    { GB2312 csGB2312 }
11507    { Big5 csBig5 }
11508}
11509
11510proc tcl_encoding {enc} {
11511    global encoding_aliases tcl_encoding_cache
11512    if {[info exists tcl_encoding_cache($enc)]} {
11513        return $tcl_encoding_cache($enc)
11514    }
11515    set names [encoding names]
11516    set lcnames [string tolower $names]
11517    set enc [string tolower $enc]
11518    set i [lsearch -exact $lcnames $enc]
11519    if {$i < 0} {
11520        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
11521        if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
11522            set i [lsearch -exact $lcnames $encx]
11523        }
11524    }
11525    if {$i < 0} {
11526        foreach l $encoding_aliases {
11527            set ll [string tolower $l]
11528            if {[lsearch -exact $ll $enc] < 0} continue
11529            # look through the aliases for one that tcl knows about
11530            foreach e $ll {
11531                set i [lsearch -exact $lcnames $e]
11532                if {$i < 0} {
11533                    if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
11534                        set i [lsearch -exact $lcnames $ex]
11535                    }
11536                }
11537                if {$i >= 0} break
11538            }
11539            break
11540        }
11541    }
11542    set tclenc {}
11543    if {$i >= 0} {
11544        set tclenc [lindex $names $i]
11545    }
11546    set tcl_encoding_cache($enc) $tclenc
11547    return $tclenc
11548}
11549
11550proc gitattr {path attr default} {
11551    global path_attr_cache
11552    if {[info exists path_attr_cache($attr,$path)]} {
11553        set r $path_attr_cache($attr,$path)
11554    } else {
11555        set r "unspecified"
11556        if {![catch {set line [exec git check-attr $attr -- $path]}]} {
11557            regexp "(.*): $attr: (.*)" $line m f r
11558        }
11559        set path_attr_cache($attr,$path) $r
11560    }
11561    if {$r eq "unspecified"} {
11562        return $default
11563    }
11564    return $r
11565}
11566
11567proc cache_gitattr {attr pathlist} {
11568    global path_attr_cache
11569    set newlist {}
11570    foreach path $pathlist {
11571        if {![info exists path_attr_cache($attr,$path)]} {
11572            lappend newlist $path
11573        }
11574    }
11575    set lim 1000
11576    if {[tk windowingsystem] == "win32"} {
11577        # windows has a 32k limit on the arguments to a command...
11578        set lim 30
11579    }
11580    while {$newlist ne {}} {
11581        set head [lrange $newlist 0 [expr {$lim - 1}]]
11582        set newlist [lrange $newlist $lim end]
11583        if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
11584            foreach row [split $rlist "\n"] {
11585                if {[regexp "(.*): $attr: (.*)" $row m path value]} {
11586                    if {[string index $path 0] eq "\""} {
11587                        set path [encoding convertfrom [lindex $path 0]]
11588                    }
11589                    set path_attr_cache($attr,$path) $value
11590                }
11591            }
11592        }
11593    }
11594}
11595
11596proc get_path_encoding {path} {
11597    global gui_encoding perfile_attrs
11598    set tcl_enc $gui_encoding
11599    if {$path ne {} && $perfile_attrs} {
11600        set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
11601        if {$enc2 ne {}} {
11602            set tcl_enc $enc2
11603        }
11604    }
11605    return $tcl_enc
11606}
11607
11608# First check that Tcl/Tk is recent enough
11609if {[catch {package require Tk 8.4} err]} {
11610    show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
11611                     Gitk requires at least Tcl/Tk 8.4." list
11612    exit 1
11613}
11614
11615# Unset GIT_TRACE var if set
11616if { [info exists ::env(GIT_TRACE)] } {
11617    unset ::env(GIT_TRACE)
11618}
11619
11620# defaults...
11621set wrcomcmd "git diff-tree --stdin -p --pretty"
11622
11623set gitencoding {}
11624catch {
11625    set gitencoding [exec git config --get i18n.commitencoding]
11626}
11627catch {
11628    set gitencoding [exec git config --get i18n.logoutputencoding]
11629}
11630if {$gitencoding == ""} {
11631    set gitencoding "utf-8"
11632}
11633set tclencoding [tcl_encoding $gitencoding]
11634if {$tclencoding == {}} {
11635    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
11636}
11637
11638set gui_encoding [encoding system]
11639catch {
11640    set enc [exec git config --get gui.encoding]
11641    if {$enc ne {}} {
11642        set tclenc [tcl_encoding $enc]
11643        if {$tclenc ne {}} {
11644            set gui_encoding $tclenc
11645        } else {
11646            puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
11647        }
11648    }
11649}
11650
11651set log_showroot true
11652catch {
11653    set log_showroot [exec git config --bool --get log.showroot]
11654}
11655
11656if {[tk windowingsystem] eq "aqua"} {
11657    set mainfont {{Lucida Grande} 9}
11658    set textfont {Monaco 9}
11659    set uifont {{Lucida Grande} 9 bold}
11660} elseif {![catch {::tk::pkgconfig get fontsystem} xft] && $xft eq "xft"} {
11661    # fontconfig!
11662    set mainfont {sans 9}
11663    set textfont {monospace 9}
11664    set uifont {sans 9 bold}
11665} else {
11666    set mainfont {Helvetica 9}
11667    set textfont {Courier 9}
11668    set uifont {Helvetica 9 bold}
11669}
11670set tabstop 8
11671set findmergefiles 0
11672set maxgraphpct 50
11673set maxwidth 16
11674set revlistorder 0
11675set fastdate 0
11676set uparrowlen 5
11677set downarrowlen 5
11678set mingaplen 100
11679set cmitmode "patch"
11680set wrapcomment "none"
11681set showneartags 1
11682set hideremotes 0
11683set maxrefs 20
11684set maxlinelen 200
11685set showlocalchanges 1
11686set limitdiffs 1
11687set datetimeformat "%Y-%m-%d %H:%M:%S"
11688set autoselect 1
11689set autosellen 40
11690set perfile_attrs 0
11691set want_ttk 1
11692
11693if {[tk windowingsystem] eq "aqua"} {
11694    set extdifftool "opendiff"
11695} else {
11696    set extdifftool "meld"
11697}
11698
11699set colors {green red blue magenta darkgrey brown orange}
11700if {[tk windowingsystem] eq "win32"} {
11701    set uicolor SystemButtonFace
11702    set bgcolor SystemWindow
11703    set fgcolor SystemButtonText
11704    set selectbgcolor SystemHighlight
11705} else {
11706    set uicolor grey85
11707    set bgcolor white
11708    set fgcolor black
11709    set selectbgcolor gray85
11710}
11711set diffcolors {red "#00a000" blue}
11712set diffcontext 3
11713set ignorespace 0
11714set worddiff ""
11715set markbgcolor "#e0e0ff"
11716
11717set circlecolors {white blue gray blue blue}
11718
11719# button for popping up context menus
11720if {[tk windowingsystem] eq "aqua"} {
11721    set ctxbut <Button-2>
11722} else {
11723    set ctxbut <Button-3>
11724}
11725
11726## For msgcat loading, first locate the installation location.
11727if { [info exists ::env(GITK_MSGSDIR)] } {
11728    ## Msgsdir was manually set in the environment.
11729    set gitk_msgsdir $::env(GITK_MSGSDIR)
11730} else {
11731    ## Let's guess the prefix from argv0.
11732    set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
11733    set gitk_libdir [file join $gitk_prefix share gitk lib]
11734    set gitk_msgsdir [file join $gitk_libdir msgs]
11735    unset gitk_prefix
11736}
11737
11738## Internationalization (i18n) through msgcat and gettext. See
11739## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
11740package require msgcat
11741namespace import ::msgcat::mc
11742## And eventually load the actual message catalog
11743::msgcat::mcload $gitk_msgsdir
11744
11745catch {source ~/.gitk}
11746
11747parsefont mainfont $mainfont
11748eval font create mainfont [fontflags mainfont]
11749eval font create mainfontbold [fontflags mainfont 1]
11750
11751parsefont textfont $textfont
11752eval font create textfont [fontflags textfont]
11753eval font create textfontbold [fontflags textfont 1]
11754
11755parsefont uifont $uifont
11756eval font create uifont [fontflags uifont]
11757
11758setui $uicolor
11759
11760setoptions
11761
11762# check that we can find a .git directory somewhere...
11763if {[catch {set gitdir [exec git rev-parse --git-dir]}]} {
11764    show_error {} . [mc "Cannot find a git repository here."]
11765    exit 1
11766}
11767
11768set selecthead {}
11769set selectheadid {}
11770
11771set revtreeargs {}
11772set cmdline_files {}
11773set i 0
11774set revtreeargscmd {}
11775foreach arg $argv {
11776    switch -glob -- $arg {
11777        "" { }
11778        "--" {
11779            set cmdline_files [lrange $argv [expr {$i + 1}] end]
11780            break
11781        }
11782        "--select-commit=*" {
11783            set selecthead [string range $arg 16 end]
11784        }
11785        "--argscmd=*" {
11786            set revtreeargscmd [string range $arg 10 end]
11787        }
11788        default {
11789            lappend revtreeargs $arg
11790        }
11791    }
11792    incr i
11793}
11794
11795if {$selecthead eq "HEAD"} {
11796    set selecthead {}
11797}
11798
11799if {$i >= [llength $argv] && $revtreeargs ne {}} {
11800    # no -- on command line, but some arguments (other than --argscmd)
11801    if {[catch {
11802        set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
11803        set cmdline_files [split $f "\n"]
11804        set n [llength $cmdline_files]
11805        set revtreeargs [lrange $revtreeargs 0 end-$n]
11806        # Unfortunately git rev-parse doesn't produce an error when
11807        # something is both a revision and a filename.  To be consistent
11808        # with git log and git rev-list, check revtreeargs for filenames.
11809        foreach arg $revtreeargs {
11810            if {[file exists $arg]} {
11811                show_error {} . [mc "Ambiguous argument '%s': both revision\
11812                                 and filename" $arg]
11813                exit 1
11814            }
11815        }
11816    } err]} {
11817        # unfortunately we get both stdout and stderr in $err,
11818        # so look for "fatal:".
11819        set i [string first "fatal:" $err]
11820        if {$i > 0} {
11821            set err [string range $err [expr {$i + 6}] end]
11822        }
11823        show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
11824        exit 1
11825    }
11826}
11827
11828set nullid "0000000000000000000000000000000000000000"
11829set nullid2 "0000000000000000000000000000000000000001"
11830set nullfile "/dev/null"
11831
11832set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
11833if {![info exists have_ttk]} {
11834    set have_ttk [llength [info commands ::ttk::style]]
11835}
11836set use_ttk [expr {$have_ttk && $want_ttk}]
11837set NS [expr {$use_ttk ? "ttk" : ""}]
11838
11839regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
11840
11841set show_notes {}
11842if {[package vcompare $git_version "1.6.6.2"] >= 0} {
11843    set show_notes "--show-notes"
11844}
11845
11846set appname "gitk"
11847
11848set runq {}
11849set history {}
11850set historyindex 0
11851set fh_serial 0
11852set nhl_names {}
11853set highlight_paths {}
11854set findpattern {}
11855set searchdirn -forwards
11856set boldids {}
11857set boldnameids {}
11858set diffelide {0 0}
11859set markingmatches 0
11860set linkentercount 0
11861set need_redisplay 0
11862set nrows_drawn 0
11863set firsttabstop 0
11864
11865set nextviewnum 1
11866set curview 0
11867set selectedview 0
11868set selectedhlview [mc "None"]
11869set highlight_related [mc "None"]
11870set highlight_files {}
11871set viewfiles(0) {}
11872set viewperm(0) 0
11873set viewargs(0) {}
11874set viewargscmd(0) {}
11875
11876set selectedline {}
11877set numcommits 0
11878set loginstance 0
11879set cmdlineok 0
11880set stopped 0
11881set stuffsaved 0
11882set patchnum 0
11883set lserial 0
11884set hasworktree [hasworktree]
11885set cdup {}
11886if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} {
11887    set cdup [exec git rev-parse --show-cdup]
11888}
11889set worktree [exec git rev-parse --show-toplevel]
11890setcoords
11891makewindow
11892catch {
11893    image create photo gitlogo      -width 16 -height 16
11894
11895    image create photo gitlogominus -width  4 -height  2
11896    gitlogominus put #C00000 -to 0 0 4 2
11897    gitlogo copy gitlogominus -to  1 5
11898    gitlogo copy gitlogominus -to  6 5
11899    gitlogo copy gitlogominus -to 11 5
11900    image delete gitlogominus
11901
11902    image create photo gitlogoplus  -width  4 -height  4
11903    gitlogoplus  put #008000 -to 1 0 3 4
11904    gitlogoplus  put #008000 -to 0 1 4 3
11905    gitlogo copy gitlogoplus  -to  1 9
11906    gitlogo copy gitlogoplus  -to  6 9
11907    gitlogo copy gitlogoplus  -to 11 9
11908    image delete gitlogoplus
11909
11910    image create photo gitlogo32    -width 32 -height 32
11911    gitlogo32 copy gitlogo -zoom 2 2
11912
11913    wm iconphoto . -default gitlogo gitlogo32
11914}
11915# wait for the window to become visible
11916tkwait visibility .
11917wm title . "$appname: [reponame]"
11918update
11919readrefs
11920
11921if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
11922    # create a view for the files/dirs specified on the command line
11923    set curview 1
11924    set selectedview 1
11925    set nextviewnum 2
11926    set viewname(1) [mc "Command line"]
11927    set viewfiles(1) $cmdline_files
11928    set viewargs(1) $revtreeargs
11929    set viewargscmd(1) $revtreeargscmd
11930    set viewperm(1) 0
11931    set vdatemode(1) 0
11932    addviewmenu 1
11933    .bar.view entryconf [mca "Edit view..."] -state normal
11934    .bar.view entryconf [mca "Delete view"] -state normal
11935}
11936
11937if {[info exists permviews]} {
11938    foreach v $permviews {
11939        set n $nextviewnum
11940        incr nextviewnum
11941        set viewname($n) [lindex $v 0]
11942        set viewfiles($n) [lindex $v 1]
11943        set viewargs($n) [lindex $v 2]
11944        set viewargscmd($n) [lindex $v 3]
11945        set viewperm($n) 1
11946        addviewmenu $n
11947    }
11948}
11949
11950if {[tk windowingsystem] eq "win32"} {
11951    focus -force .
11952}
11953
11954getcommits {}
11955
11956# Local variables:
11957# mode: tcl
11958# indent-tabs-mode: t
11959# tab-width: 8
11960# End: