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