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