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