a124822626fa3c80231985552564675ff5e2ea81
   1#!/bin/sh
   2# Tcl ignores the next line -*- tcl -*- \
   3exec wish "$0" -- "$@"
   4
   5# Copyright © 2005-2011 Paul Mackerras.  All rights reserved.
   6# This program is free software; it may be used, copied, modified
   7# and distributed under the terms of the GNU General Public Licence,
   8# either version 2, or (at your option) any later version.
   9
  10package require Tk
  11
  12proc hasworktree {} {
  13    return [expr {[exec git rev-parse --is-bare-repository] == "false" &&
  14                  [exec git rev-parse --is-inside-git-dir] == "false"}]
  15}
  16
  17proc reponame {} {
  18    global gitdir
  19    set n [file normalize $gitdir]
  20    if {[string match "*/.git" $n]} {
  21        set n [string range $n 0 end-5]
  22    }
  23    return [file tail $n]
  24}
  25
  26proc gitworktree {} {
  27    variable _gitworktree
  28    if {[info exists _gitworktree]} {
  29        return $_gitworktree
  30    }
  31    # v1.7.0 introduced --show-toplevel to return the canonical work-tree
  32    if {[catch {set _gitworktree [exec git rev-parse --show-toplevel]}]} {
  33        # try to set work tree from environment, core.worktree or use
  34        # cdup to obtain a relative path to the top of the worktree. If
  35        # run from the top, the ./ prefix ensures normalize expands pwd.
  36        if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
  37            catch {set _gitworktree [exec git config --get core.worktree]}
  38            if {$_gitworktree eq ""} {
  39                set _gitworktree [file normalize ./[exec git rev-parse --show-cdup]]
  40            }
  41        }
  42    }
  43    return $_gitworktree
  44}
  45
  46# A simple scheduler for compute-intensive stuff.
  47# The aim is to make sure that event handlers for GUI actions can
  48# run at least every 50-100 ms.  Unfortunately fileevent handlers are
  49# run before X event handlers, so reading from a fast source can
  50# make the GUI completely unresponsive.
  51proc run args {
  52    global isonrunq runq currunq
  53
  54    set script $args
  55    if {[info exists isonrunq($script)]} return
  56    if {$runq eq {} && ![info exists currunq]} {
  57        after idle dorunq
  58    }
  59    lappend runq [list {} $script]
  60    set isonrunq($script) 1
  61}
  62
  63proc filerun {fd script} {
  64    fileevent $fd readable [list filereadable $fd $script]
  65}
  66
  67proc filereadable {fd script} {
  68    global runq currunq
  69
  70    fileevent $fd readable {}
  71    if {$runq eq {} && ![info exists currunq]} {
  72        after idle dorunq
  73    }
  74    lappend runq [list $fd $script]
  75}
  76
  77proc nukefile {fd} {
  78    global runq
  79
  80    for {set i 0} {$i < [llength $runq]} {} {
  81        if {[lindex $runq $i 0] eq $fd} {
  82            set runq [lreplace $runq $i $i]
  83        } else {
  84            incr i
  85        }
  86    }
  87}
  88
  89proc dorunq {} {
  90    global isonrunq runq currunq
  91
  92    set tstart [clock clicks -milliseconds]
  93    set t0 $tstart
  94    while {[llength $runq] > 0} {
  95        set fd [lindex $runq 0 0]
  96        set script [lindex $runq 0 1]
  97        set currunq [lindex $runq 0]
  98        set runq [lrange $runq 1 end]
  99        set repeat [eval $script]
 100        unset currunq
 101        set t1 [clock clicks -milliseconds]
 102        set t [expr {$t1 - $t0}]
 103        if {$repeat ne {} && $repeat} {
 104            if {$fd eq {} || $repeat == 2} {
 105                # script returns 1 if it wants to be readded
 106                # file readers return 2 if they could do more straight away
 107                lappend runq [list $fd $script]
 108            } else {
 109                fileevent $fd readable [list filereadable $fd $script]
 110            }
 111        } elseif {$fd eq {}} {
 112            unset isonrunq($script)
 113        }
 114        set t0 $t1
 115        if {$t1 - $tstart >= 80} break
 116    }
 117    if {$runq ne {}} {
 118        after idle dorunq
 119    }
 120}
 121
 122proc reg_instance {fd} {
 123    global commfd leftover loginstance
 124
 125    set i [incr loginstance]
 126    set commfd($i) $fd
 127    set leftover($i) {}
 128    return $i
 129}
 130
 131proc unmerged_files {files} {
 132    global nr_unmerged
 133
 134    # find the list of unmerged files
 135    set mlist {}
 136    set nr_unmerged 0
 137    if {[catch {
 138        set fd [open "| git ls-files -u" r]
 139    } err]} {
 140        show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
 141        exit 1
 142    }
 143    while {[gets $fd line] >= 0} {
 144        set i [string first "\t" $line]
 145        if {$i < 0} continue
 146        set fname [string range $line [expr {$i+1}] end]
 147        if {[lsearch -exact $mlist $fname] >= 0} continue
 148        incr nr_unmerged
 149        if {$files eq {} || [path_filter $files $fname]} {
 150            lappend mlist $fname
 151        }
 152    }
 153    catch {close $fd}
 154    return $mlist
 155}
 156
 157proc parseviewargs {n arglist} {
 158    global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs env
 159    global worddiff git_version
 160
 161    set vdatemode($n) 0
 162    set vmergeonly($n) 0
 163    set glflags {}
 164    set diffargs {}
 165    set nextisval 0
 166    set revargs {}
 167    set origargs $arglist
 168    set allknown 1
 169    set filtered 0
 170    set i -1
 171    foreach arg $arglist {
 172        incr i
 173        if {$nextisval} {
 174            lappend glflags $arg
 175            set nextisval 0
 176            continue
 177        }
 178        switch -glob -- $arg {
 179            "-d" -
 180            "--date-order" {
 181                set vdatemode($n) 1
 182                # remove from origargs in case we hit an unknown option
 183                set origargs [lreplace $origargs $i $i]
 184                incr i -1
 185            }
 186            "-[puabwcrRBMC]" -
 187            "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
 188            "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
 189            "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
 190            "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
 191            "--ignore-space-change" - "-U*" - "--unified=*" {
 192                # These request or affect diff output, which we don't want.
 193                # Some could be used to set our defaults for diff display.
 194                lappend diffargs $arg
 195            }
 196            "--raw" - "--patch-with-raw" - "--patch-with-stat" -
 197            "--name-only" - "--name-status" - "--color" -
 198            "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
 199            "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
 200            "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
 201            "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
 202            "--objects" - "--objects-edge" - "--reverse" {
 203                # These cause our parsing of git log's output to fail, or else
 204                # they're options we want to set ourselves, so ignore them.
 205            }
 206            "--color-words*" - "--word-diff=color" {
 207                # These trigger a word diff in the console interface,
 208                # so help the user by enabling our own support
 209                if {[package vcompare $git_version "1.7.2"] >= 0} {
 210                    set worddiff [mc "Color words"]
 211                }
 212            }
 213            "--word-diff*" {
 214                if {[package vcompare $git_version "1.7.2"] >= 0} {
 215                    set worddiff [mc "Markup words"]
 216                }
 217            }
 218            "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
 219            "--check" - "--exit-code" - "--quiet" - "--topo-order" -
 220            "--full-history" - "--dense" - "--sparse" -
 221            "--follow" - "--left-right" - "--encoding=*" {
 222                # These are harmless, and some are even useful
 223                lappend glflags $arg
 224            }
 225            "--diff-filter=*" - "--no-merges" - "--unpacked" -
 226            "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
 227            "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
 228            "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
 229            "--remove-empty" - "--first-parent" - "--cherry-pick" -
 230            "-S*" - "--pickaxe-all" - "--pickaxe-regex" -
 231            "--simplify-by-decoration" {
 232                # These mean that we get a subset of the commits
 233                set filtered 1
 234                lappend glflags $arg
 235            }
 236            "-n" {
 237                # This appears to be the only one that has a value as a
 238                # separate word following it
 239                set filtered 1
 240                set nextisval 1
 241                lappend glflags $arg
 242            }
 243            "--not" - "--all" {
 244                lappend revargs $arg
 245            }
 246            "--merge" {
 247                set vmergeonly($n) 1
 248                # git rev-parse doesn't understand --merge
 249                lappend revargs --gitk-symmetric-diff-marker MERGE_HEAD...HEAD
 250            }
 251            "--no-replace-objects" {
 252                set env(GIT_NO_REPLACE_OBJECTS) "1"
 253            }
 254            "-*" {
 255                # Other flag arguments including -<n>
 256                if {[string is digit -strict [string range $arg 1 end]]} {
 257                    set filtered 1
 258                } else {
 259                    # a flag argument that we don't recognize;
 260                    # that means we can't optimize
 261                    set allknown 0
 262                }
 263                lappend glflags $arg
 264            }
 265            default {
 266                # Non-flag arguments specify commits or ranges of commits
 267                if {[string match "*...*" $arg]} {
 268                    lappend revargs --gitk-symmetric-diff-marker
 269                }
 270                lappend revargs $arg
 271            }
 272        }
 273    }
 274    set vdflags($n) $diffargs
 275    set vflags($n) $glflags
 276    set vrevs($n) $revargs
 277    set vfiltered($n) $filtered
 278    set vorigargs($n) $origargs
 279    return $allknown
 280}
 281
 282proc parseviewrevs {view revs} {
 283    global vposids vnegids
 284
 285    if {$revs eq {}} {
 286        set revs HEAD
 287    }
 288    if {[catch {set ids [eval exec git rev-parse $revs]} err]} {
 289        # we get stdout followed by stderr in $err
 290        # for an unknown rev, git rev-parse echoes it and then errors out
 291        set errlines [split $err "\n"]
 292        set badrev {}
 293        for {set l 0} {$l < [llength $errlines]} {incr l} {
 294            set line [lindex $errlines $l]
 295            if {!([string length $line] == 40 && [string is xdigit $line])} {
 296                if {[string match "fatal:*" $line]} {
 297                    if {[string match "fatal: ambiguous argument*" $line]
 298                        && $badrev ne {}} {
 299                        if {[llength $badrev] == 1} {
 300                            set err "unknown revision $badrev"
 301                        } else {
 302                            set err "unknown revisions: [join $badrev ", "]"
 303                        }
 304                    } else {
 305                        set err [join [lrange $errlines $l end] "\n"]
 306                    }
 307                    break
 308                }
 309                lappend badrev $line
 310            }
 311        }
 312        error_popup "[mc "Error parsing revisions:"] $err"
 313        return {}
 314    }
 315    set ret {}
 316    set pos {}
 317    set neg {}
 318    set sdm 0
 319    foreach id [split $ids "\n"] {
 320        if {$id eq "--gitk-symmetric-diff-marker"} {
 321            set sdm 4
 322        } elseif {[string match "^*" $id]} {
 323            if {$sdm != 1} {
 324                lappend ret $id
 325                if {$sdm == 3} {
 326                    set sdm 0
 327                }
 328            }
 329            lappend neg [string range $id 1 end]
 330        } else {
 331            if {$sdm != 2} {
 332                lappend ret $id
 333            } else {
 334                lset ret end $id...[lindex $ret end]
 335            }
 336            lappend pos $id
 337        }
 338        incr sdm -1
 339    }
 340    set vposids($view) $pos
 341    set vnegids($view) $neg
 342    return $ret
 343}
 344
 345# Start off a git log process and arrange to read its output
 346proc start_rev_list {view} {
 347    global startmsecs commitidx viewcomplete curview
 348    global tclencoding
 349    global viewargs viewargscmd viewfiles vfilelimit
 350    global showlocalchanges
 351    global viewactive viewinstances vmergeonly
 352    global mainheadid viewmainheadid viewmainheadid_orig
 353    global vcanopt vflags vrevs vorigargs
 354    global show_notes
 355
 356    set startmsecs [clock clicks -milliseconds]
 357    set commitidx($view) 0
 358    # these are set this way for the error exits
 359    set viewcomplete($view) 1
 360    set viewactive($view) 0
 361    varcinit $view
 362
 363    set args $viewargs($view)
 364    if {$viewargscmd($view) ne {}} {
 365        if {[catch {
 366            set str [exec sh -c $viewargscmd($view)]
 367        } err]} {
 368            error_popup "[mc "Error executing --argscmd command:"] $err"
 369            return 0
 370        }
 371        set args [concat $args [split $str "\n"]]
 372    }
 373    set vcanopt($view) [parseviewargs $view $args]
 374
 375    set files $viewfiles($view)
 376    if {$vmergeonly($view)} {
 377        set files [unmerged_files $files]
 378        if {$files eq {}} {
 379            global nr_unmerged
 380            if {$nr_unmerged == 0} {
 381                error_popup [mc "No files selected: --merge specified but\
 382                             no files are unmerged."]
 383            } else {
 384                error_popup [mc "No files selected: --merge specified but\
 385                             no unmerged files are within file limit."]
 386            }
 387            return 0
 388        }
 389    }
 390    set vfilelimit($view) $files
 391
 392    if {$vcanopt($view)} {
 393        set revs [parseviewrevs $view $vrevs($view)]
 394        if {$revs eq {}} {
 395            return 0
 396        }
 397        set args [concat $vflags($view) $revs]
 398    } else {
 399        set args $vorigargs($view)
 400    }
 401
 402    if {[catch {
 403        set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
 404                        --parents --boundary $args "--" $files] r]
 405    } err]} {
 406        error_popup "[mc "Error executing git log:"] $err"
 407        return 0
 408    }
 409    set i [reg_instance $fd]
 410    set viewinstances($view) [list $i]
 411    set viewmainheadid($view) $mainheadid
 412    set viewmainheadid_orig($view) $mainheadid
 413    if {$files ne {} && $mainheadid ne {}} {
 414        get_viewmainhead $view
 415    }
 416    if {$showlocalchanges && $viewmainheadid($view) ne {}} {
 417        interestedin $viewmainheadid($view) dodiffindex
 418    }
 419    fconfigure $fd -blocking 0 -translation lf -eofchar {}
 420    if {$tclencoding != {}} {
 421        fconfigure $fd -encoding $tclencoding
 422    }
 423    filerun $fd [list getcommitlines $fd $i $view 0]
 424    nowbusy $view [mc "Reading"]
 425    set viewcomplete($view) 0
 426    set viewactive($view) 1
 427    return 1
 428}
 429
 430proc stop_instance {inst} {
 431    global commfd leftover
 432
 433    set fd $commfd($inst)
 434    catch {
 435        set pid [pid $fd]
 436
 437        if {$::tcl_platform(platform) eq {windows}} {
 438            exec kill -f $pid
 439        } else {
 440            exec kill $pid
 441        }
 442    }
 443    catch {close $fd}
 444    nukefile $fd
 445    unset commfd($inst)
 446    unset leftover($inst)
 447}
 448
 449proc stop_backends {} {
 450    global commfd
 451
 452    foreach inst [array names commfd] {
 453        stop_instance $inst
 454    }
 455}
 456
 457proc stop_rev_list {view} {
 458    global viewinstances
 459
 460    foreach inst $viewinstances($view) {
 461        stop_instance $inst
 462    }
 463    set viewinstances($view) {}
 464}
 465
 466proc reset_pending_select {selid} {
 467    global pending_select mainheadid selectheadid
 468
 469    if {$selid ne {}} {
 470        set pending_select $selid
 471    } elseif {$selectheadid ne {}} {
 472        set pending_select $selectheadid
 473    } else {
 474        set pending_select $mainheadid
 475    }
 476}
 477
 478proc getcommits {selid} {
 479    global canv curview need_redisplay viewactive
 480
 481    initlayout
 482    if {[start_rev_list $curview]} {
 483        reset_pending_select $selid
 484        show_status [mc "Reading commits..."]
 485        set need_redisplay 1
 486    } else {
 487        show_status [mc "No commits selected"]
 488    }
 489}
 490
 491proc updatecommits {} {
 492    global curview vcanopt vorigargs vfilelimit viewinstances
 493    global viewactive viewcomplete tclencoding
 494    global startmsecs showneartags showlocalchanges
 495    global mainheadid viewmainheadid viewmainheadid_orig pending_select
 496    global hasworktree
 497    global varcid vposids vnegids vflags vrevs
 498    global show_notes
 499
 500    set hasworktree [hasworktree]
 501    rereadrefs
 502    set view $curview
 503    if {$mainheadid ne $viewmainheadid_orig($view)} {
 504        if {$showlocalchanges} {
 505            dohidelocalchanges
 506        }
 507        set viewmainheadid($view) $mainheadid
 508        set viewmainheadid_orig($view) $mainheadid
 509        if {$vfilelimit($view) ne {}} {
 510            get_viewmainhead $view
 511        }
 512    }
 513    if {$showlocalchanges} {
 514        doshowlocalchanges
 515    }
 516    if {$vcanopt($view)} {
 517        set oldpos $vposids($view)
 518        set oldneg $vnegids($view)
 519        set revs [parseviewrevs $view $vrevs($view)]
 520        if {$revs eq {}} {
 521            return
 522        }
 523        # note: getting the delta when negative refs change is hard,
 524        # and could require multiple git log invocations, so in that
 525        # case we ask git log for all the commits (not just the delta)
 526        if {$oldneg eq $vnegids($view)} {
 527            set newrevs {}
 528            set npos 0
 529            # take out positive refs that we asked for before or
 530            # that we have already seen
 531            foreach rev $revs {
 532                if {[string length $rev] == 40} {
 533                    if {[lsearch -exact $oldpos $rev] < 0
 534                        && ![info exists varcid($view,$rev)]} {
 535                        lappend newrevs $rev
 536                        incr npos
 537                    }
 538                } else {
 539                    lappend $newrevs $rev
 540                }
 541            }
 542            if {$npos == 0} return
 543            set revs $newrevs
 544            set vposids($view) [lsort -unique [concat $oldpos $vposids($view)]]
 545        }
 546        set args [concat $vflags($view) $revs --not $oldpos]
 547    } else {
 548        set args $vorigargs($view)
 549    }
 550    if {[catch {
 551        set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
 552                        --parents --boundary $args "--" $vfilelimit($view)] r]
 553    } err]} {
 554        error_popup "[mc "Error executing git log:"] $err"
 555        return
 556    }
 557    if {$viewactive($view) == 0} {
 558        set startmsecs [clock clicks -milliseconds]
 559    }
 560    set i [reg_instance $fd]
 561    lappend viewinstances($view) $i
 562    fconfigure $fd -blocking 0 -translation lf -eofchar {}
 563    if {$tclencoding != {}} {
 564        fconfigure $fd -encoding $tclencoding
 565    }
 566    filerun $fd [list getcommitlines $fd $i $view 1]
 567    incr viewactive($view)
 568    set viewcomplete($view) 0
 569    reset_pending_select {}
 570    nowbusy $view [mc "Reading"]
 571    if {$showneartags} {
 572        getallcommits
 573    }
 574}
 575
 576proc reloadcommits {} {
 577    global curview viewcomplete selectedline currentid thickerline
 578    global showneartags treediffs commitinterest cached_commitrow
 579    global targetid
 580
 581    set selid {}
 582    if {$selectedline ne {}} {
 583        set selid $currentid
 584    }
 585
 586    if {!$viewcomplete($curview)} {
 587        stop_rev_list $curview
 588    }
 589    resetvarcs $curview
 590    set selectedline {}
 591    catch {unset currentid}
 592    catch {unset thickerline}
 593    catch {unset treediffs}
 594    readrefs
 595    changedrefs
 596    if {$showneartags} {
 597        getallcommits
 598    }
 599    clear_display
 600    catch {unset commitinterest}
 601    catch {unset cached_commitrow}
 602    catch {unset targetid}
 603    setcanvscroll
 604    getcommits $selid
 605    return 0
 606}
 607
 608# This makes a string representation of a positive integer which
 609# sorts as a string in numerical order
 610proc strrep {n} {
 611    if {$n < 16} {
 612        return [format "%x" $n]
 613    } elseif {$n < 256} {
 614        return [format "x%.2x" $n]
 615    } elseif {$n < 65536} {
 616        return [format "y%.4x" $n]
 617    }
 618    return [format "z%.8x" $n]
 619}
 620
 621# Procedures used in reordering commits from git log (without
 622# --topo-order) into the order for display.
 623
 624proc varcinit {view} {
 625    global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
 626    global vtokmod varcmod vrowmod varcix vlastins
 627
 628    set varcstart($view) {{}}
 629    set vupptr($view) {0}
 630    set vdownptr($view) {0}
 631    set vleftptr($view) {0}
 632    set vbackptr($view) {0}
 633    set varctok($view) {{}}
 634    set varcrow($view) {{}}
 635    set vtokmod($view) {}
 636    set varcmod($view) 0
 637    set vrowmod($view) 0
 638    set varcix($view) {{}}
 639    set vlastins($view) {0}
 640}
 641
 642proc resetvarcs {view} {
 643    global varcid varccommits parents children vseedcount ordertok
 644    global vshortids
 645
 646    foreach vid [array names varcid $view,*] {
 647        unset varcid($vid)
 648        unset children($vid)
 649        unset parents($vid)
 650    }
 651    foreach vid [array names vshortids $view,*] {
 652        unset vshortids($vid)
 653    }
 654    # some commits might have children but haven't been seen yet
 655    foreach vid [array names children $view,*] {
 656        unset children($vid)
 657    }
 658    foreach va [array names varccommits $view,*] {
 659        unset varccommits($va)
 660    }
 661    foreach vd [array names vseedcount $view,*] {
 662        unset vseedcount($vd)
 663    }
 664    catch {unset ordertok}
 665}
 666
 667# returns a list of the commits with no children
 668proc seeds {v} {
 669    global vdownptr vleftptr varcstart
 670
 671    set ret {}
 672    set a [lindex $vdownptr($v) 0]
 673    while {$a != 0} {
 674        lappend ret [lindex $varcstart($v) $a]
 675        set a [lindex $vleftptr($v) $a]
 676    }
 677    return $ret
 678}
 679
 680proc newvarc {view id} {
 681    global varcid varctok parents children vdatemode
 682    global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
 683    global commitdata commitinfo vseedcount varccommits vlastins
 684
 685    set a [llength $varctok($view)]
 686    set vid $view,$id
 687    if {[llength $children($vid)] == 0 || $vdatemode($view)} {
 688        if {![info exists commitinfo($id)]} {
 689            parsecommit $id $commitdata($id) 1
 690        }
 691        set cdate [lindex [lindex $commitinfo($id) 4] 0]
 692        if {![string is integer -strict $cdate]} {
 693            set cdate 0
 694        }
 695        if {![info exists vseedcount($view,$cdate)]} {
 696            set vseedcount($view,$cdate) -1
 697        }
 698        set c [incr vseedcount($view,$cdate)]
 699        set cdate [expr {$cdate ^ 0xffffffff}]
 700        set tok "s[strrep $cdate][strrep $c]"
 701    } else {
 702        set tok {}
 703    }
 704    set ka 0
 705    if {[llength $children($vid)] > 0} {
 706        set kid [lindex $children($vid) end]
 707        set k $varcid($view,$kid)
 708        if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
 709            set ki $kid
 710            set ka $k
 711            set tok [lindex $varctok($view) $k]
 712        }
 713    }
 714    if {$ka != 0} {
 715        set i [lsearch -exact $parents($view,$ki) $id]
 716        set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
 717        append tok [strrep $j]
 718    }
 719    set c [lindex $vlastins($view) $ka]
 720    if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
 721        set c $ka
 722        set b [lindex $vdownptr($view) $ka]
 723    } else {
 724        set b [lindex $vleftptr($view) $c]
 725    }
 726    while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
 727        set c $b
 728        set b [lindex $vleftptr($view) $c]
 729    }
 730    if {$c == $ka} {
 731        lset vdownptr($view) $ka $a
 732        lappend vbackptr($view) 0
 733    } else {
 734        lset vleftptr($view) $c $a
 735        lappend vbackptr($view) $c
 736    }
 737    lset vlastins($view) $ka $a
 738    lappend vupptr($view) $ka
 739    lappend vleftptr($view) $b
 740    if {$b != 0} {
 741        lset vbackptr($view) $b $a
 742    }
 743    lappend varctok($view) $tok
 744    lappend varcstart($view) $id
 745    lappend vdownptr($view) 0
 746    lappend varcrow($view) {}
 747    lappend varcix($view) {}
 748    set varccommits($view,$a) {}
 749    lappend vlastins($view) 0
 750    return $a
 751}
 752
 753proc splitvarc {p v} {
 754    global varcid varcstart varccommits varctok vtokmod
 755    global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
 756
 757    set oa $varcid($v,$p)
 758    set otok [lindex $varctok($v) $oa]
 759    set ac $varccommits($v,$oa)
 760    set i [lsearch -exact $varccommits($v,$oa) $p]
 761    if {$i <= 0} return
 762    set na [llength $varctok($v)]
 763    # "%" sorts before "0"...
 764    set tok "$otok%[strrep $i]"
 765    lappend varctok($v) $tok
 766    lappend varcrow($v) {}
 767    lappend varcix($v) {}
 768    set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
 769    set varccommits($v,$na) [lrange $ac $i end]
 770    lappend varcstart($v) $p
 771    foreach id $varccommits($v,$na) {
 772        set varcid($v,$id) $na
 773    }
 774    lappend vdownptr($v) [lindex $vdownptr($v) $oa]
 775    lappend vlastins($v) [lindex $vlastins($v) $oa]
 776    lset vdownptr($v) $oa $na
 777    lset vlastins($v) $oa 0
 778    lappend vupptr($v) $oa
 779    lappend vleftptr($v) 0
 780    lappend vbackptr($v) 0
 781    for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
 782        lset vupptr($v) $b $na
 783    }
 784    if {[string compare $otok $vtokmod($v)] <= 0} {
 785        modify_arc $v $oa
 786    }
 787}
 788
 789proc renumbervarc {a v} {
 790    global parents children varctok varcstart varccommits
 791    global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
 792
 793    set t1 [clock clicks -milliseconds]
 794    set todo {}
 795    set isrelated($a) 1
 796    set kidchanged($a) 1
 797    set ntot 0
 798    while {$a != 0} {
 799        if {[info exists isrelated($a)]} {
 800            lappend todo $a
 801            set id [lindex $varccommits($v,$a) end]
 802            foreach p $parents($v,$id) {
 803                if {[info exists varcid($v,$p)]} {
 804                    set isrelated($varcid($v,$p)) 1
 805                }
 806            }
 807        }
 808        incr ntot
 809        set b [lindex $vdownptr($v) $a]
 810        if {$b == 0} {
 811            while {$a != 0} {
 812                set b [lindex $vleftptr($v) $a]
 813                if {$b != 0} break
 814                set a [lindex $vupptr($v) $a]
 815            }
 816        }
 817        set a $b
 818    }
 819    foreach a $todo {
 820        if {![info exists kidchanged($a)]} continue
 821        set id [lindex $varcstart($v) $a]
 822        if {[llength $children($v,$id)] > 1} {
 823            set children($v,$id) [lsort -command [list vtokcmp $v] \
 824                                      $children($v,$id)]
 825        }
 826        set oldtok [lindex $varctok($v) $a]
 827        if {!$vdatemode($v)} {
 828            set tok {}
 829        } else {
 830            set tok $oldtok
 831        }
 832        set ka 0
 833        set kid [last_real_child $v,$id]
 834        if {$kid ne {}} {
 835            set k $varcid($v,$kid)
 836            if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
 837                set ki $kid
 838                set ka $k
 839                set tok [lindex $varctok($v) $k]
 840            }
 841        }
 842        if {$ka != 0} {
 843            set i [lsearch -exact $parents($v,$ki) $id]
 844            set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
 845            append tok [strrep $j]
 846        }
 847        if {$tok eq $oldtok} {
 848            continue
 849        }
 850        set id [lindex $varccommits($v,$a) end]
 851        foreach p $parents($v,$id) {
 852            if {[info exists varcid($v,$p)]} {
 853                set kidchanged($varcid($v,$p)) 1
 854            } else {
 855                set sortkids($p) 1
 856            }
 857        }
 858        lset varctok($v) $a $tok
 859        set b [lindex $vupptr($v) $a]
 860        if {$b != $ka} {
 861            if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
 862                modify_arc $v $ka
 863            }
 864            if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
 865                modify_arc $v $b
 866            }
 867            set c [lindex $vbackptr($v) $a]
 868            set d [lindex $vleftptr($v) $a]
 869            if {$c == 0} {
 870                lset vdownptr($v) $b $d
 871            } else {
 872                lset vleftptr($v) $c $d
 873            }
 874            if {$d != 0} {
 875                lset vbackptr($v) $d $c
 876            }
 877            if {[lindex $vlastins($v) $b] == $a} {
 878                lset vlastins($v) $b $c
 879            }
 880            lset vupptr($v) $a $ka
 881            set c [lindex $vlastins($v) $ka]
 882            if {$c == 0 || \
 883                    [string compare $tok [lindex $varctok($v) $c]] < 0} {
 884                set c $ka
 885                set b [lindex $vdownptr($v) $ka]
 886            } else {
 887                set b [lindex $vleftptr($v) $c]
 888            }
 889            while {$b != 0 && \
 890                      [string compare $tok [lindex $varctok($v) $b]] >= 0} {
 891                set c $b
 892                set b [lindex $vleftptr($v) $c]
 893            }
 894            if {$c == $ka} {
 895                lset vdownptr($v) $ka $a
 896                lset vbackptr($v) $a 0
 897            } else {
 898                lset vleftptr($v) $c $a
 899                lset vbackptr($v) $a $c
 900            }
 901            lset vleftptr($v) $a $b
 902            if {$b != 0} {
 903                lset vbackptr($v) $b $a
 904            }
 905            lset vlastins($v) $ka $a
 906        }
 907    }
 908    foreach id [array names sortkids] {
 909        if {[llength $children($v,$id)] > 1} {
 910            set children($v,$id) [lsort -command [list vtokcmp $v] \
 911                                      $children($v,$id)]
 912        }
 913    }
 914    set t2 [clock clicks -milliseconds]
 915    #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
 916}
 917
 918# Fix up the graph after we have found out that in view $v,
 919# $p (a commit that we have already seen) is actually the parent
 920# of the last commit in arc $a.
 921proc fix_reversal {p a v} {
 922    global varcid varcstart varctok vupptr
 923
 924    set pa $varcid($v,$p)
 925    if {$p ne [lindex $varcstart($v) $pa]} {
 926        splitvarc $p $v
 927        set pa $varcid($v,$p)
 928    }
 929    # seeds always need to be renumbered
 930    if {[lindex $vupptr($v) $pa] == 0 ||
 931        [string compare [lindex $varctok($v) $a] \
 932             [lindex $varctok($v) $pa]] > 0} {
 933        renumbervarc $pa $v
 934    }
 935}
 936
 937proc insertrow {id p v} {
 938    global cmitlisted children parents varcid varctok vtokmod
 939    global varccommits ordertok commitidx numcommits curview
 940    global targetid targetrow vshortids
 941
 942    readcommit $id
 943    set vid $v,$id
 944    set cmitlisted($vid) 1
 945    set children($vid) {}
 946    set parents($vid) [list $p]
 947    set a [newvarc $v $id]
 948    set varcid($vid) $a
 949    lappend vshortids($v,[string range $id 0 3]) $id
 950    if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
 951        modify_arc $v $a
 952    }
 953    lappend varccommits($v,$a) $id
 954    set vp $v,$p
 955    if {[llength [lappend children($vp) $id]] > 1} {
 956        set children($vp) [lsort -command [list vtokcmp $v] $children($vp)]
 957        catch {unset ordertok}
 958    }
 959    fix_reversal $p $a $v
 960    incr commitidx($v)
 961    if {$v == $curview} {
 962        set numcommits $commitidx($v)
 963        setcanvscroll
 964        if {[info exists targetid]} {
 965            if {![comes_before $targetid $p]} {
 966                incr targetrow
 967            }
 968        }
 969    }
 970}
 971
 972proc insertfakerow {id p} {
 973    global varcid varccommits parents children cmitlisted
 974    global commitidx varctok vtokmod targetid targetrow curview numcommits
 975
 976    set v $curview
 977    set a $varcid($v,$p)
 978    set i [lsearch -exact $varccommits($v,$a) $p]
 979    if {$i < 0} {
 980        puts "oops: insertfakerow can't find [shortids $p] on arc $a"
 981        return
 982    }
 983    set children($v,$id) {}
 984    set parents($v,$id) [list $p]
 985    set varcid($v,$id) $a
 986    lappend children($v,$p) $id
 987    set cmitlisted($v,$id) 1
 988    set numcommits [incr commitidx($v)]
 989    # note we deliberately don't update varcstart($v) even if $i == 0
 990    set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
 991    modify_arc $v $a $i
 992    if {[info exists targetid]} {
 993        if {![comes_before $targetid $p]} {
 994            incr targetrow
 995        }
 996    }
 997    setcanvscroll
 998    drawvisible
 999}
1000
1001proc removefakerow {id} {
1002    global varcid varccommits parents children commitidx
1003    global varctok vtokmod cmitlisted currentid selectedline
1004    global targetid curview numcommits
1005
1006    set v $curview
1007    if {[llength $parents($v,$id)] != 1} {
1008        puts "oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
1009        return
1010    }
1011    set p [lindex $parents($v,$id) 0]
1012    set a $varcid($v,$id)
1013    set i [lsearch -exact $varccommits($v,$a) $id]
1014    if {$i < 0} {
1015        puts "oops: removefakerow can't find [shortids $id] on arc $a"
1016        return
1017    }
1018    unset varcid($v,$id)
1019    set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
1020    unset parents($v,$id)
1021    unset children($v,$id)
1022    unset cmitlisted($v,$id)
1023    set numcommits [incr commitidx($v) -1]
1024    set j [lsearch -exact $children($v,$p) $id]
1025    if {$j >= 0} {
1026        set children($v,$p) [lreplace $children($v,$p) $j $j]
1027    }
1028    modify_arc $v $a $i
1029    if {[info exist currentid] && $id eq $currentid} {
1030        unset currentid
1031        set selectedline {}
1032    }
1033    if {[info exists targetid] && $targetid eq $id} {
1034        set targetid $p
1035    }
1036    setcanvscroll
1037    drawvisible
1038}
1039
1040proc real_children {vp} {
1041    global children nullid nullid2
1042
1043    set kids {}
1044    foreach id $children($vp) {
1045        if {$id ne $nullid && $id ne $nullid2} {
1046            lappend kids $id
1047        }
1048    }
1049    return $kids
1050}
1051
1052proc first_real_child {vp} {
1053    global children nullid nullid2
1054
1055    foreach id $children($vp) {
1056        if {$id ne $nullid && $id ne $nullid2} {
1057            return $id
1058        }
1059    }
1060    return {}
1061}
1062
1063proc last_real_child {vp} {
1064    global children nullid nullid2
1065
1066    set kids $children($vp)
1067    for {set i [llength $kids]} {[incr i -1] >= 0} {} {
1068        set id [lindex $kids $i]
1069        if {$id ne $nullid && $id ne $nullid2} {
1070            return $id
1071        }
1072    }
1073    return {}
1074}
1075
1076proc vtokcmp {v a b} {
1077    global varctok varcid
1078
1079    return [string compare [lindex $varctok($v) $varcid($v,$a)] \
1080                [lindex $varctok($v) $varcid($v,$b)]]
1081}
1082
1083# This assumes that if lim is not given, the caller has checked that
1084# arc a's token is less than $vtokmod($v)
1085proc modify_arc {v a {lim {}}} {
1086    global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
1087
1088    if {$lim ne {}} {
1089        set c [string compare [lindex $varctok($v) $a] $vtokmod($v)]
1090        if {$c > 0} return
1091        if {$c == 0} {
1092            set r [lindex $varcrow($v) $a]
1093            if {$r ne {} && $vrowmod($v) <= $r + $lim} return
1094        }
1095    }
1096    set vtokmod($v) [lindex $varctok($v) $a]
1097    set varcmod($v) $a
1098    if {$v == $curview} {
1099        while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
1100            set a [lindex $vupptr($v) $a]
1101            set lim {}
1102        }
1103        set r 0
1104        if {$a != 0} {
1105            if {$lim eq {}} {
1106                set lim [llength $varccommits($v,$a)]
1107            }
1108            set r [expr {[lindex $varcrow($v) $a] + $lim}]
1109        }
1110        set vrowmod($v) $r
1111        undolayout $r
1112    }
1113}
1114
1115proc update_arcrows {v} {
1116    global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
1117    global varcid vrownum varcorder varcix varccommits
1118    global vupptr vdownptr vleftptr varctok
1119    global displayorder parentlist curview cached_commitrow
1120
1121    if {$vrowmod($v) == $commitidx($v)} return
1122    if {$v == $curview} {
1123        if {[llength $displayorder] > $vrowmod($v)} {
1124            set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
1125            set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
1126        }
1127        catch {unset cached_commitrow}
1128    }
1129    set narctot [expr {[llength $varctok($v)] - 1}]
1130    set a $varcmod($v)
1131    while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
1132        # go up the tree until we find something that has a row number,
1133        # or we get to a seed
1134        set a [lindex $vupptr($v) $a]
1135    }
1136    if {$a == 0} {
1137        set a [lindex $vdownptr($v) 0]
1138        if {$a == 0} return
1139        set vrownum($v) {0}
1140        set varcorder($v) [list $a]
1141        lset varcix($v) $a 0
1142        lset varcrow($v) $a 0
1143        set arcn 0
1144        set row 0
1145    } else {
1146        set arcn [lindex $varcix($v) $a]
1147        if {[llength $vrownum($v)] > $arcn + 1} {
1148            set vrownum($v) [lrange $vrownum($v) 0 $arcn]
1149            set varcorder($v) [lrange $varcorder($v) 0 $arcn]
1150        }
1151        set row [lindex $varcrow($v) $a]
1152    }
1153    while {1} {
1154        set p $a
1155        incr row [llength $varccommits($v,$a)]
1156        # go down if possible
1157        set b [lindex $vdownptr($v) $a]
1158        if {$b == 0} {
1159            # if not, go left, or go up until we can go left
1160            while {$a != 0} {
1161                set b [lindex $vleftptr($v) $a]
1162                if {$b != 0} break
1163                set a [lindex $vupptr($v) $a]
1164            }
1165            if {$a == 0} break
1166        }
1167        set a $b
1168        incr arcn
1169        lappend vrownum($v) $row
1170        lappend varcorder($v) $a
1171        lset varcix($v) $a $arcn
1172        lset varcrow($v) $a $row
1173    }
1174    set vtokmod($v) [lindex $varctok($v) $p]
1175    set varcmod($v) $p
1176    set vrowmod($v) $row
1177    if {[info exists currentid]} {
1178        set selectedline [rowofcommit $currentid]
1179    }
1180}
1181
1182# Test whether view $v contains commit $id
1183proc commitinview {id v} {
1184    global varcid
1185
1186    return [info exists varcid($v,$id)]
1187}
1188
1189# Return the row number for commit $id in the current view
1190proc rowofcommit {id} {
1191    global varcid varccommits varcrow curview cached_commitrow
1192    global varctok vtokmod
1193
1194    set v $curview
1195    if {![info exists varcid($v,$id)]} {
1196        puts "oops rowofcommit no arc for [shortids $id]"
1197        return {}
1198    }
1199    set a $varcid($v,$id)
1200    if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
1201        update_arcrows $v
1202    }
1203    if {[info exists cached_commitrow($id)]} {
1204        return $cached_commitrow($id)
1205    }
1206    set i [lsearch -exact $varccommits($v,$a) $id]
1207    if {$i < 0} {
1208        puts "oops didn't find commit [shortids $id] in arc $a"
1209        return {}
1210    }
1211    incr i [lindex $varcrow($v) $a]
1212    set cached_commitrow($id) $i
1213    return $i
1214}
1215
1216# Returns 1 if a is on an earlier row than b, otherwise 0
1217proc comes_before {a b} {
1218    global varcid varctok curview
1219
1220    set v $curview
1221    if {$a eq $b || ![info exists varcid($v,$a)] || \
1222            ![info exists varcid($v,$b)]} {
1223        return 0
1224    }
1225    if {$varcid($v,$a) != $varcid($v,$b)} {
1226        return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
1227                           [lindex $varctok($v) $varcid($v,$b)]] < 0}]
1228    }
1229    return [expr {[rowofcommit $a] < [rowofcommit $b]}]
1230}
1231
1232proc bsearch {l elt} {
1233    if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
1234        return 0
1235    }
1236    set lo 0
1237    set hi [llength $l]
1238    while {$hi - $lo > 1} {
1239        set mid [expr {int(($lo + $hi) / 2)}]
1240        set t [lindex $l $mid]
1241        if {$elt < $t} {
1242            set hi $mid
1243        } elseif {$elt > $t} {
1244            set lo $mid
1245        } else {
1246            return $mid
1247        }
1248    }
1249    return $lo
1250}
1251
1252# Make sure rows $start..$end-1 are valid in displayorder and parentlist
1253proc make_disporder {start end} {
1254    global vrownum curview commitidx displayorder parentlist
1255    global varccommits varcorder parents vrowmod varcrow
1256    global d_valid_start d_valid_end
1257
1258    if {$end > $vrowmod($curview)} {
1259        update_arcrows $curview
1260    }
1261    set ai [bsearch $vrownum($curview) $start]
1262    set start [lindex $vrownum($curview) $ai]
1263    set narc [llength $vrownum($curview)]
1264    for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
1265        set a [lindex $varcorder($curview) $ai]
1266        set l [llength $displayorder]
1267        set al [llength $varccommits($curview,$a)]
1268        if {$l < $r + $al} {
1269            if {$l < $r} {
1270                set pad [ntimes [expr {$r - $l}] {}]
1271                set displayorder [concat $displayorder $pad]
1272                set parentlist [concat $parentlist $pad]
1273            } elseif {$l > $r} {
1274                set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
1275                set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
1276            }
1277            foreach id $varccommits($curview,$a) {
1278                lappend displayorder $id
1279                lappend parentlist $parents($curview,$id)
1280            }
1281        } elseif {[lindex $displayorder [expr {$r + $al - 1}]] eq {}} {
1282            set i $r
1283            foreach id $varccommits($curview,$a) {
1284                lset displayorder $i $id
1285                lset parentlist $i $parents($curview,$id)
1286                incr i
1287            }
1288        }
1289        incr r $al
1290    }
1291}
1292
1293proc commitonrow {row} {
1294    global displayorder
1295
1296    set id [lindex $displayorder $row]
1297    if {$id eq {}} {
1298        make_disporder $row [expr {$row + 1}]
1299        set id [lindex $displayorder $row]
1300    }
1301    return $id
1302}
1303
1304proc closevarcs {v} {
1305    global varctok varccommits varcid parents children
1306    global cmitlisted commitidx vtokmod
1307
1308    set missing_parents 0
1309    set scripts {}
1310    set narcs [llength $varctok($v)]
1311    for {set a 1} {$a < $narcs} {incr a} {
1312        set id [lindex $varccommits($v,$a) end]
1313        foreach p $parents($v,$id) {
1314            if {[info exists varcid($v,$p)]} continue
1315            # add p as a new commit
1316            incr missing_parents
1317            set cmitlisted($v,$p) 0
1318            set parents($v,$p) {}
1319            if {[llength $children($v,$p)] == 1 &&
1320                [llength $parents($v,$id)] == 1} {
1321                set b $a
1322            } else {
1323                set b [newvarc $v $p]
1324            }
1325            set varcid($v,$p) $b
1326            if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
1327                modify_arc $v $b
1328            }
1329            lappend varccommits($v,$b) $p
1330            incr commitidx($v)
1331            set scripts [check_interest $p $scripts]
1332        }
1333    }
1334    if {$missing_parents > 0} {
1335        foreach s $scripts {
1336            eval $s
1337        }
1338    }
1339}
1340
1341# Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1342# Assumes we already have an arc for $rwid.
1343proc rewrite_commit {v id rwid} {
1344    global children parents varcid varctok vtokmod varccommits
1345
1346    foreach ch $children($v,$id) {
1347        # make $rwid be $ch's parent in place of $id
1348        set i [lsearch -exact $parents($v,$ch) $id]
1349        if {$i < 0} {
1350            puts "oops rewrite_commit didn't find $id in parent list for $ch"
1351        }
1352        set parents($v,$ch) [lreplace $parents($v,$ch) $i $i $rwid]
1353        # add $ch to $rwid's children and sort the list if necessary
1354        if {[llength [lappend children($v,$rwid) $ch]] > 1} {
1355            set children($v,$rwid) [lsort -command [list vtokcmp $v] \
1356                                        $children($v,$rwid)]
1357        }
1358        # fix the graph after joining $id to $rwid
1359        set a $varcid($v,$ch)
1360        fix_reversal $rwid $a $v
1361        # parentlist is wrong for the last element of arc $a
1362        # even if displayorder is right, hence the 3rd arg here
1363        modify_arc $v $a [expr {[llength $varccommits($v,$a)] - 1}]
1364    }
1365}
1366
1367# Mechanism for registering a command to be executed when we come
1368# across a particular commit.  To handle the case when only the
1369# prefix of the commit is known, the commitinterest array is now
1370# indexed by the first 4 characters of the ID.  Each element is a
1371# list of id, cmd pairs.
1372proc interestedin {id cmd} {
1373    global commitinterest
1374
1375    lappend commitinterest([string range $id 0 3]) $id $cmd
1376}
1377
1378proc check_interest {id scripts} {
1379    global commitinterest
1380
1381    set prefix [string range $id 0 3]
1382    if {[info exists commitinterest($prefix)]} {
1383        set newlist {}
1384        foreach {i script} $commitinterest($prefix) {
1385            if {[string match "$i*" $id]} {
1386                lappend scripts [string map [list "%I" $id "%P" $i] $script]
1387            } else {
1388                lappend newlist $i $script
1389            }
1390        }
1391        if {$newlist ne {}} {
1392            set commitinterest($prefix) $newlist
1393        } else {
1394            unset commitinterest($prefix)
1395        }
1396    }
1397    return $scripts
1398}
1399
1400proc getcommitlines {fd inst view updating}  {
1401    global cmitlisted leftover
1402    global commitidx commitdata vdatemode
1403    global parents children curview hlview
1404    global idpending ordertok
1405    global varccommits varcid varctok vtokmod vfilelimit vshortids
1406
1407    set stuff [read $fd 500000]
1408    # git log doesn't terminate the last commit with a null...
1409    if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
1410        set stuff "\0"
1411    }
1412    if {$stuff == {}} {
1413        if {![eof $fd]} {
1414            return 1
1415        }
1416        global commfd viewcomplete viewactive viewname
1417        global viewinstances
1418        unset commfd($inst)
1419        set i [lsearch -exact $viewinstances($view) $inst]
1420        if {$i >= 0} {
1421            set viewinstances($view) [lreplace $viewinstances($view) $i $i]
1422        }
1423        # set it blocking so we wait for the process to terminate
1424        fconfigure $fd -blocking 1
1425        if {[catch {close $fd} err]} {
1426            set fv {}
1427            if {$view != $curview} {
1428                set fv " for the \"$viewname($view)\" view"
1429            }
1430            if {[string range $err 0 4] == "usage"} {
1431                set err "Gitk: error reading commits$fv:\
1432                        bad arguments to git log."
1433                if {$viewname($view) eq "Command line"} {
1434                    append err \
1435                        "  (Note: arguments to gitk are passed to git log\
1436                         to allow selection of commits to be displayed.)"
1437                }
1438            } else {
1439                set err "Error reading commits$fv: $err"
1440            }
1441            error_popup $err
1442        }
1443        if {[incr viewactive($view) -1] <= 0} {
1444            set viewcomplete($view) 1
1445            # Check if we have seen any ids listed as parents that haven't
1446            # appeared in the list
1447            closevarcs $view
1448            notbusy $view
1449        }
1450        if {$view == $curview} {
1451            run chewcommits
1452        }
1453        return 0
1454    }
1455    set start 0
1456    set gotsome 0
1457    set scripts {}
1458    while 1 {
1459        set i [string first "\0" $stuff $start]
1460        if {$i < 0} {
1461            append leftover($inst) [string range $stuff $start end]
1462            break
1463        }
1464        if {$start == 0} {
1465            set cmit $leftover($inst)
1466            append cmit [string range $stuff 0 [expr {$i - 1}]]
1467            set leftover($inst) {}
1468        } else {
1469            set cmit [string range $stuff $start [expr {$i - 1}]]
1470        }
1471        set start [expr {$i + 1}]
1472        set j [string first "\n" $cmit]
1473        set ok 0
1474        set listed 1
1475        if {$j >= 0 && [string match "commit *" $cmit]} {
1476            set ids [string range $cmit 7 [expr {$j - 1}]]
1477            if {[string match {[-^<>]*} $ids]} {
1478                switch -- [string index $ids 0] {
1479                    "-" {set listed 0}
1480                    "^" {set listed 2}
1481                    "<" {set listed 3}
1482                    ">" {set listed 4}
1483                }
1484                set ids [string range $ids 1 end]
1485            }
1486            set ok 1
1487            foreach id $ids {
1488                if {[string length $id] != 40} {
1489                    set ok 0
1490                    break
1491                }
1492            }
1493        }
1494        if {!$ok} {
1495            set shortcmit $cmit
1496            if {[string length $shortcmit] > 80} {
1497                set shortcmit "[string range $shortcmit 0 80]..."
1498            }
1499            error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
1500            exit 1
1501        }
1502        set id [lindex $ids 0]
1503        set vid $view,$id
1504
1505        lappend vshortids($view,[string range $id 0 3]) $id
1506
1507        if {!$listed && $updating && ![info exists varcid($vid)] &&
1508            $vfilelimit($view) ne {}} {
1509            # git log doesn't rewrite parents for unlisted commits
1510            # when doing path limiting, so work around that here
1511            # by working out the rewritten parent with git rev-list
1512            # and if we already know about it, using the rewritten
1513            # parent as a substitute parent for $id's children.
1514            if {![catch {
1515                set rwid [exec git rev-list --first-parent --max-count=1 \
1516                              $id -- $vfilelimit($view)]
1517            }]} {
1518                if {$rwid ne {} && [info exists varcid($view,$rwid)]} {
1519                    # use $rwid in place of $id
1520                    rewrite_commit $view $id $rwid
1521                    continue
1522                }
1523            }
1524        }
1525
1526        set a 0
1527        if {[info exists varcid($vid)]} {
1528            if {$cmitlisted($vid) || !$listed} continue
1529            set a $varcid($vid)
1530        }
1531        if {$listed} {
1532            set olds [lrange $ids 1 end]
1533        } else {
1534            set olds {}
1535        }
1536        set commitdata($id) [string range $cmit [expr {$j + 1}] end]
1537        set cmitlisted($vid) $listed
1538        set parents($vid) $olds
1539        if {![info exists children($vid)]} {
1540            set children($vid) {}
1541        } elseif {$a == 0 && [llength $children($vid)] == 1} {
1542            set k [lindex $children($vid) 0]
1543            if {[llength $parents($view,$k)] == 1 &&
1544                (!$vdatemode($view) ||
1545                 $varcid($view,$k) == [llength $varctok($view)] - 1)} {
1546                set a $varcid($view,$k)
1547            }
1548        }
1549        if {$a == 0} {
1550            # new arc
1551            set a [newvarc $view $id]
1552        }
1553        if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
1554            modify_arc $view $a
1555        }
1556        if {![info exists varcid($vid)]} {
1557            set varcid($vid) $a
1558            lappend varccommits($view,$a) $id
1559            incr commitidx($view)
1560        }
1561
1562        set i 0
1563        foreach p $olds {
1564            if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
1565                set vp $view,$p
1566                if {[llength [lappend children($vp) $id]] > 1 &&
1567                    [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
1568                    set children($vp) [lsort -command [list vtokcmp $view] \
1569                                           $children($vp)]
1570                    catch {unset ordertok}
1571                }
1572                if {[info exists varcid($view,$p)]} {
1573                    fix_reversal $p $a $view
1574                }
1575            }
1576            incr i
1577        }
1578
1579        set scripts [check_interest $id $scripts]
1580        set gotsome 1
1581    }
1582    if {$gotsome} {
1583        global numcommits hlview
1584
1585        if {$view == $curview} {
1586            set numcommits $commitidx($view)
1587            run chewcommits
1588        }
1589        if {[info exists hlview] && $view == $hlview} {
1590            # we never actually get here...
1591            run vhighlightmore
1592        }
1593        foreach s $scripts {
1594            eval $s
1595        }
1596    }
1597    return 2
1598}
1599
1600proc chewcommits {} {
1601    global curview hlview viewcomplete
1602    global pending_select
1603
1604    layoutmore
1605    if {$viewcomplete($curview)} {
1606        global commitidx varctok
1607        global numcommits startmsecs
1608
1609        if {[info exists pending_select]} {
1610            update
1611            reset_pending_select {}
1612
1613            if {[commitinview $pending_select $curview]} {
1614                selectline [rowofcommit $pending_select] 1
1615            } else {
1616                set row [first_real_row]
1617                selectline $row 1
1618            }
1619        }
1620        if {$commitidx($curview) > 0} {
1621            #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1622            #puts "overall $ms ms for $numcommits commits"
1623            #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1624        } else {
1625            show_status [mc "No commits selected"]
1626        }
1627        notbusy layout
1628    }
1629    return 0
1630}
1631
1632proc do_readcommit {id} {
1633    global tclencoding
1634
1635    # Invoke git-log to handle automatic encoding conversion
1636    set fd [open [concat | git log --no-color --pretty=raw -1 $id] r]
1637    # Read the results using i18n.logoutputencoding
1638    fconfigure $fd -translation lf -eofchar {}
1639    if {$tclencoding != {}} {
1640        fconfigure $fd -encoding $tclencoding
1641    }
1642    set contents [read $fd]
1643    close $fd
1644    # Remove the heading line
1645    regsub {^commit [0-9a-f]+\n} $contents {} contents
1646
1647    return $contents
1648}
1649
1650proc readcommit {id} {
1651    if {[catch {set contents [do_readcommit $id]}]} return
1652    parsecommit $id $contents 1
1653}
1654
1655proc parsecommit {id contents listed} {
1656    global commitinfo
1657
1658    set inhdr 1
1659    set comment {}
1660    set headline {}
1661    set auname {}
1662    set audate {}
1663    set comname {}
1664    set comdate {}
1665    set hdrend [string first "\n\n" $contents]
1666    if {$hdrend < 0} {
1667        # should never happen...
1668        set hdrend [string length $contents]
1669    }
1670    set header [string range $contents 0 [expr {$hdrend - 1}]]
1671    set comment [string range $contents [expr {$hdrend + 2}] end]
1672    foreach line [split $header "\n"] {
1673        set line [split $line " "]
1674        set tag [lindex $line 0]
1675        if {$tag == "author"} {
1676            set audate [lrange $line end-1 end]
1677            set auname [join [lrange $line 1 end-2] " "]
1678        } elseif {$tag == "committer"} {
1679            set comdate [lrange $line end-1 end]
1680            set comname [join [lrange $line 1 end-2] " "]
1681        }
1682    }
1683    set headline {}
1684    # take the first non-blank line of the comment as the headline
1685    set headline [string trimleft $comment]
1686    set i [string first "\n" $headline]
1687    if {$i >= 0} {
1688        set headline [string range $headline 0 $i]
1689    }
1690    set headline [string trimright $headline]
1691    set i [string first "\r" $headline]
1692    if {$i >= 0} {
1693        set headline [string trimright [string range $headline 0 $i]]
1694    }
1695    if {!$listed} {
1696        # git log indents the comment by 4 spaces;
1697        # if we got this via git cat-file, add the indentation
1698        set newcomment {}
1699        foreach line [split $comment "\n"] {
1700            append newcomment "    "
1701            append newcomment $line
1702            append newcomment "\n"
1703        }
1704        set comment $newcomment
1705    }
1706    set hasnote [string first "\nNotes:\n" $contents]
1707    set commitinfo($id) [list $headline $auname $audate \
1708                             $comname $comdate $comment $hasnote]
1709}
1710
1711proc getcommit {id} {
1712    global commitdata commitinfo
1713
1714    if {[info exists commitdata($id)]} {
1715        parsecommit $id $commitdata($id) 1
1716    } else {
1717        readcommit $id
1718        if {![info exists commitinfo($id)]} {
1719            set commitinfo($id) [list [mc "No commit information available"]]
1720        }
1721    }
1722    return 1
1723}
1724
1725# Expand an abbreviated commit ID to a list of full 40-char IDs that match
1726# and are present in the current view.
1727# This is fairly slow...
1728proc longid {prefix} {
1729    global varcid curview vshortids
1730
1731    set ids {}
1732    if {[string length $prefix] >= 4} {
1733        set vshortid $curview,[string range $prefix 0 3]
1734        if {[info exists vshortids($vshortid)]} {
1735            foreach id $vshortids($vshortid) {
1736                if {[string match "$prefix*" $id]} {
1737                    if {[lsearch -exact $ids $id] < 0} {
1738                        lappend ids $id
1739                        if {[llength $ids] >= 2} break
1740                    }
1741                }
1742            }
1743        }
1744    } else {
1745        foreach match [array names varcid "$curview,$prefix*"] {
1746            lappend ids [lindex [split $match ","] 1]
1747            if {[llength $ids] >= 2} break
1748        }
1749    }
1750    return $ids
1751}
1752
1753proc readrefs {} {
1754    global tagids idtags headids idheads tagobjid
1755    global otherrefids idotherrefs mainhead mainheadid
1756    global selecthead selectheadid
1757    global hideremotes
1758
1759    foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
1760        catch {unset $v}
1761    }
1762    set refd [open [list | git show-ref -d] r]
1763    while {[gets $refd line] >= 0} {
1764        if {[string index $line 40] ne " "} continue
1765        set id [string range $line 0 39]
1766        set ref [string range $line 41 end]
1767        if {![string match "refs/*" $ref]} continue
1768        set name [string range $ref 5 end]
1769        if {[string match "remotes/*" $name]} {
1770            if {![string match "*/HEAD" $name] && !$hideremotes} {
1771                set headids($name) $id
1772                lappend idheads($id) $name
1773            }
1774        } elseif {[string match "heads/*" $name]} {
1775            set name [string range $name 6 end]
1776            set headids($name) $id
1777            lappend idheads($id) $name
1778        } elseif {[string match "tags/*" $name]} {
1779            # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1780            # which is what we want since the former is the commit ID
1781            set name [string range $name 5 end]
1782            if {[string match "*^{}" $name]} {
1783                set name [string range $name 0 end-3]
1784            } else {
1785                set tagobjid($name) $id
1786            }
1787            set tagids($name) $id
1788            lappend idtags($id) $name
1789        } else {
1790            set otherrefids($name) $id
1791            lappend idotherrefs($id) $name
1792        }
1793    }
1794    catch {close $refd}
1795    set mainhead {}
1796    set mainheadid {}
1797    catch {
1798        set mainheadid [exec git rev-parse HEAD]
1799        set thehead [exec git symbolic-ref HEAD]
1800        if {[string match "refs/heads/*" $thehead]} {
1801            set mainhead [string range $thehead 11 end]
1802        }
1803    }
1804    set selectheadid {}
1805    if {$selecthead ne {}} {
1806        catch {
1807            set selectheadid [exec git rev-parse --verify $selecthead]
1808        }
1809    }
1810}
1811
1812# skip over fake commits
1813proc first_real_row {} {
1814    global nullid nullid2 numcommits
1815
1816    for {set row 0} {$row < $numcommits} {incr row} {
1817        set id [commitonrow $row]
1818        if {$id ne $nullid && $id ne $nullid2} {
1819            break
1820        }
1821    }
1822    return $row
1823}
1824
1825# update things for a head moved to a child of its previous location
1826proc movehead {id name} {
1827    global headids idheads
1828
1829    removehead $headids($name) $name
1830    set headids($name) $id
1831    lappend idheads($id) $name
1832}
1833
1834# update things when a head has been removed
1835proc removehead {id name} {
1836    global headids idheads
1837
1838    if {$idheads($id) eq $name} {
1839        unset idheads($id)
1840    } else {
1841        set i [lsearch -exact $idheads($id) $name]
1842        if {$i >= 0} {
1843            set idheads($id) [lreplace $idheads($id) $i $i]
1844        }
1845    }
1846    unset headids($name)
1847}
1848
1849proc ttk_toplevel {w args} {
1850    global use_ttk
1851    eval [linsert $args 0 ::toplevel $w]
1852    if {$use_ttk} {
1853        place [ttk::frame $w._toplevel_background] -x 0 -y 0 -relwidth 1 -relheight 1
1854    }
1855    return $w
1856}
1857
1858proc make_transient {window origin} {
1859    global have_tk85
1860
1861    # In MacOS Tk 8.4 transient appears to work by setting
1862    # overrideredirect, which is utterly useless, since the
1863    # windows get no border, and are not even kept above
1864    # the parent.
1865    if {!$have_tk85 && [tk windowingsystem] eq {aqua}} return
1866
1867    wm transient $window $origin
1868
1869    # Windows fails to place transient windows normally, so
1870    # schedule a callback to center them on the parent.
1871    if {[tk windowingsystem] eq {win32}} {
1872        after idle [list tk::PlaceWindow $window widget $origin]
1873    }
1874}
1875
1876proc show_error {w top msg {mc mc}} {
1877    global NS
1878    if {![info exists NS]} {set NS ""}
1879    if {[wm state $top] eq "withdrawn"} { wm deiconify $top }
1880    message $w.m -text $msg -justify center -aspect 400
1881    pack $w.m -side top -fill x -padx 20 -pady 20
1882    ${NS}::button $w.ok -default active -text [$mc OK] -command "destroy $top"
1883    pack $w.ok -side bottom -fill x
1884    bind $top <Visibility> "grab $top; focus $top"
1885    bind $top <Key-Return> "destroy $top"
1886    bind $top <Key-space>  "destroy $top"
1887    bind $top <Key-Escape> "destroy $top"
1888    tkwait window $top
1889}
1890
1891proc error_popup {msg {owner .}} {
1892    if {[tk windowingsystem] eq "win32"} {
1893        tk_messageBox -icon error -type ok -title [wm title .] \
1894            -parent $owner -message $msg
1895    } else {
1896        set w .error
1897        ttk_toplevel $w
1898        make_transient $w $owner
1899        show_error $w $w $msg
1900    }
1901}
1902
1903proc confirm_popup {msg {owner .}} {
1904    global confirm_ok NS
1905    set confirm_ok 0
1906    set w .confirm
1907    ttk_toplevel $w
1908    make_transient $w $owner
1909    message $w.m -text $msg -justify center -aspect 400
1910    pack $w.m -side top -fill x -padx 20 -pady 20
1911    ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
1912    pack $w.ok -side left -fill x
1913    ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
1914    pack $w.cancel -side right -fill x
1915    bind $w <Visibility> "grab $w; focus $w"
1916    bind $w <Key-Return> "set confirm_ok 1; destroy $w"
1917    bind $w <Key-space>  "set confirm_ok 1; destroy $w"
1918    bind $w <Key-Escape> "destroy $w"
1919    tk::PlaceWindow $w widget $owner
1920    tkwait window $w
1921    return $confirm_ok
1922}
1923
1924proc setoptions {} {
1925    if {[tk windowingsystem] ne "win32"} {
1926        option add *Panedwindow.showHandle 1 startupFile
1927        option add *Panedwindow.sashRelief raised startupFile
1928        if {[tk windowingsystem] ne "aqua"} {
1929            option add *Menu.font uifont startupFile
1930        }
1931    } else {
1932        option add *Menu.TearOff 0 startupFile
1933    }
1934    option add *Button.font uifont startupFile
1935    option add *Checkbutton.font uifont startupFile
1936    option add *Radiobutton.font uifont startupFile
1937    option add *Menubutton.font uifont startupFile
1938    option add *Label.font uifont startupFile
1939    option add *Message.font uifont startupFile
1940    option add *Entry.font textfont startupFile
1941    option add *Text.font textfont startupFile
1942    option add *Labelframe.font uifont startupFile
1943    option add *Spinbox.font textfont startupFile
1944    option add *Listbox.font mainfont startupFile
1945}
1946
1947# Make a menu and submenus.
1948# m is the window name for the menu, items is the list of menu items to add.
1949# Each item is a list {mc label type description options...}
1950# mc is ignored; it's so we can put mc there to alert xgettext
1951# label is the string that appears in the menu
1952# type is cascade, command or radiobutton (should add checkbutton)
1953# description depends on type; it's the sublist for cascade, the
1954# command to invoke for command, or {variable value} for radiobutton
1955proc makemenu {m items} {
1956    menu $m
1957    if {[tk windowingsystem] eq {aqua}} {
1958        set Meta1 Cmd
1959    } else {
1960        set Meta1 Ctrl
1961    }
1962    foreach i $items {
1963        set name [mc [lindex $i 1]]
1964        set type [lindex $i 2]
1965        set thing [lindex $i 3]
1966        set params [list $type]
1967        if {$name ne {}} {
1968            set u [string first "&" [string map {&& x} $name]]
1969            lappend params -label [string map {&& & & {}} $name]
1970            if {$u >= 0} {
1971                lappend params -underline $u
1972            }
1973        }
1974        switch -- $type {
1975            "cascade" {
1976                set submenu [string tolower [string map {& ""} [lindex $i 1]]]
1977                lappend params -menu $m.$submenu
1978            }
1979            "command" {
1980                lappend params -command $thing
1981            }
1982            "radiobutton" {
1983                lappend params -variable [lindex $thing 0] \
1984                    -value [lindex $thing 1]
1985            }
1986        }
1987        set tail [lrange $i 4 end]
1988        regsub -all {\yMeta1\y} $tail $Meta1 tail
1989        eval $m add $params $tail
1990        if {$type eq "cascade"} {
1991            makemenu $m.$submenu $thing
1992        }
1993    }
1994}
1995
1996# translate string and remove ampersands
1997proc mca {str} {
1998    return [string map {&& & & {}} [mc $str]]
1999}
2000
2001proc makedroplist {w varname args} {
2002    global use_ttk
2003    if {$use_ttk} {
2004        set width 0
2005        foreach label $args {
2006            set cx [string length $label]
2007            if {$cx > $width} {set width $cx}
2008        }
2009        set gm [ttk::combobox $w -width $width -state readonly\
2010                    -textvariable $varname -values $args]
2011    } else {
2012        set gm [eval [linsert $args 0 tk_optionMenu $w $varname]]
2013    }
2014    return $gm
2015}
2016
2017proc makewindow {} {
2018    global canv canv2 canv3 linespc charspc ctext cflist cscroll
2019    global tabstop
2020    global findtype findtypemenu findloc findstring fstring geometry
2021    global entries sha1entry sha1string sha1but
2022    global diffcontextstring diffcontext
2023    global ignorespace
2024    global maincursor textcursor curtextcursor
2025    global rowctxmenu fakerowmenu mergemax wrapcomment
2026    global highlight_files gdttype
2027    global searchstring sstring
2028    global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
2029    global headctxmenu progresscanv progressitem progresscoords statusw
2030    global fprogitem fprogcoord lastprogupdate progupdatepending
2031    global rprogitem rprogcoord rownumsel numcommits
2032    global have_tk85 use_ttk NS
2033    global git_version
2034    global worddiff
2035
2036    # The "mc" arguments here are purely so that xgettext
2037    # sees the following string as needing to be translated
2038    set file {
2039        mc "File" cascade {
2040            {mc "Update" command updatecommits -accelerator F5}
2041            {mc "Reload" command reloadcommits -accelerator Shift-F5}
2042            {mc "Reread references" command rereadrefs}
2043            {mc "List references" command showrefs -accelerator F2}
2044            {xx "" separator}
2045            {mc "Start git gui" command {exec git gui &}}
2046            {xx "" separator}
2047            {mc "Quit" command doquit -accelerator Meta1-Q}
2048        }}
2049    set edit {
2050        mc "Edit" cascade {
2051            {mc "Preferences" command doprefs}
2052        }}
2053    set view {
2054        mc "View" cascade {
2055            {mc "New view..." command {newview 0} -accelerator Shift-F4}
2056            {mc "Edit view..." command editview -state disabled -accelerator F4}
2057            {mc "Delete view" command delview -state disabled}
2058            {xx "" separator}
2059            {mc "All files" radiobutton {selectedview 0} -command {showview 0}}
2060        }}
2061    if {[tk windowingsystem] ne "aqua"} {
2062        set help {
2063        mc "Help" cascade {
2064            {mc "About gitk" command about}
2065            {mc "Key bindings" command keys}
2066        }}
2067        set bar [list $file $edit $view $help]
2068    } else {
2069        proc ::tk::mac::ShowPreferences {} {doprefs}
2070        proc ::tk::mac::Quit {} {doquit}
2071        lset file end [lreplace [lindex $file end] end-1 end]
2072        set apple {
2073        xx "Apple" cascade {
2074            {mc "About gitk" command about}
2075            {xx "" separator}
2076        }}
2077        set help {
2078        mc "Help" cascade {
2079            {mc "Key bindings" command keys}
2080        }}
2081        set bar [list $apple $file $view $help]
2082    }
2083    makemenu .bar $bar
2084    . configure -menu .bar
2085
2086    if {$use_ttk} {
2087        # cover the non-themed toplevel with a themed frame.
2088        place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1
2089    }
2090
2091    # the gui has upper and lower half, parts of a paned window.
2092    ${NS}::panedwindow .ctop -orient vertical
2093
2094    # possibly use assumed geometry
2095    if {![info exists geometry(pwsash0)]} {
2096        set geometry(topheight) [expr {15 * $linespc}]
2097        set geometry(topwidth) [expr {80 * $charspc}]
2098        set geometry(botheight) [expr {15 * $linespc}]
2099        set geometry(botwidth) [expr {50 * $charspc}]
2100        set geometry(pwsash0) [list [expr {40 * $charspc}] 2]
2101        set geometry(pwsash1) [list [expr {60 * $charspc}] 2]
2102    }
2103
2104    # the upper half will have a paned window, a scroll bar to the right, and some stuff below
2105    ${NS}::frame .tf -height $geometry(topheight) -width $geometry(topwidth)
2106    ${NS}::frame .tf.histframe
2107    ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal
2108    if {!$use_ttk} {
2109        .tf.histframe.pwclist configure -sashpad 0 -handlesize 4
2110    }
2111
2112    # create three canvases
2113    set cscroll .tf.histframe.csb
2114    set canv .tf.histframe.pwclist.canv
2115    canvas $canv \
2116        -selectbackground $selectbgcolor \
2117        -background $bgcolor -bd 0 \
2118        -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
2119    .tf.histframe.pwclist add $canv
2120    set canv2 .tf.histframe.pwclist.canv2
2121    canvas $canv2 \
2122        -selectbackground $selectbgcolor \
2123        -background $bgcolor -bd 0 -yscrollincr $linespc
2124    .tf.histframe.pwclist add $canv2
2125    set canv3 .tf.histframe.pwclist.canv3
2126    canvas $canv3 \
2127        -selectbackground $selectbgcolor \
2128        -background $bgcolor -bd 0 -yscrollincr $linespc
2129    .tf.histframe.pwclist add $canv3
2130    if {$use_ttk} {
2131        bind .tf.histframe.pwclist <Map> {
2132            bind %W <Map> {}
2133            .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0]
2134            .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0]
2135        }
2136    } else {
2137        eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
2138        eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
2139    }
2140
2141    # a scroll bar to rule them
2142    ${NS}::scrollbar $cscroll -command {allcanvs yview}
2143    if {!$use_ttk} {$cscroll configure -highlightthickness 0}
2144    pack $cscroll -side right -fill y
2145    bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
2146    lappend bglist $canv $canv2 $canv3
2147    pack .tf.histframe.pwclist -fill both -expand 1 -side left
2148
2149    # we have two button bars at bottom of top frame. Bar 1
2150    ${NS}::frame .tf.bar
2151    ${NS}::frame .tf.lbar -height 15
2152
2153    set sha1entry .tf.bar.sha1
2154    set entries $sha1entry
2155    set sha1but .tf.bar.sha1label
2156    button $sha1but -text "[mc "SHA1 ID:"] " -state disabled -relief flat \
2157        -command gotocommit -width 8
2158    $sha1but conf -disabledforeground [$sha1but cget -foreground]
2159    pack .tf.bar.sha1label -side left
2160    ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string
2161    trace add variable sha1string write sha1change
2162    pack $sha1entry -side left -pady 2
2163
2164    image create bitmap bm-left -data {
2165        #define left_width 16
2166        #define left_height 16
2167        static unsigned char left_bits[] = {
2168        0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
2169        0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
2170        0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
2171    }
2172    image create bitmap bm-right -data {
2173        #define right_width 16
2174        #define right_height 16
2175        static unsigned char right_bits[] = {
2176        0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
2177        0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
2178        0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
2179    }
2180    ${NS}::button .tf.bar.leftbut -image bm-left -command goback \
2181        -state disabled -width 26
2182    pack .tf.bar.leftbut -side left -fill y
2183    ${NS}::button .tf.bar.rightbut -image bm-right -command goforw \
2184        -state disabled -width 26
2185    pack .tf.bar.rightbut -side left -fill y
2186
2187    ${NS}::label .tf.bar.rowlabel -text [mc "Row"]
2188    set rownumsel {}
2189    ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \
2190        -relief sunken -anchor e
2191    ${NS}::label .tf.bar.rowlabel2 -text "/"
2192    ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \
2193        -relief sunken -anchor e
2194    pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
2195        -side left
2196    if {!$use_ttk} {
2197        foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont}
2198    }
2199    global selectedline
2200    trace add variable selectedline write selectedline_change
2201
2202    # Status label and progress bar
2203    set statusw .tf.bar.status
2204    ${NS}::label $statusw -width 15 -relief sunken
2205    pack $statusw -side left -padx 5
2206    if {$use_ttk} {
2207        set progresscanv [ttk::progressbar .tf.bar.progress]
2208    } else {
2209        set h [expr {[font metrics uifont -linespace] + 2}]
2210        set progresscanv .tf.bar.progress
2211        canvas $progresscanv -relief sunken -height $h -borderwidth 2
2212        set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
2213        set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
2214        set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
2215    }
2216    pack $progresscanv -side right -expand 1 -fill x -padx {0 2}
2217    set progresscoords {0 0}
2218    set fprogcoord 0
2219    set rprogcoord 0
2220    bind $progresscanv <Configure> adjustprogress
2221    set lastprogupdate [clock clicks -milliseconds]
2222    set progupdatepending 0
2223
2224    # build up the bottom bar of upper window
2225    ${NS}::label .tf.lbar.flabel -text "[mc "Find"] "
2226    ${NS}::button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1}
2227    ${NS}::button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1}
2228    ${NS}::label .tf.lbar.flab2 -text " [mc "commit"] "
2229    pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
2230        -side left -fill y
2231    set gdttype [mc "containing:"]
2232    set gm [makedroplist .tf.lbar.gdttype gdttype \
2233                [mc "containing:"] \
2234                [mc "touching paths:"] \
2235                [mc "adding/removing string:"]]
2236    trace add variable gdttype write gdttype_change
2237    pack .tf.lbar.gdttype -side left -fill y
2238
2239    set findstring {}
2240    set fstring .tf.lbar.findstring
2241    lappend entries $fstring
2242    ${NS}::entry $fstring -width 30 -textvariable findstring
2243    trace add variable findstring write find_change
2244    set findtype [mc "Exact"]
2245    set findtypemenu [makedroplist .tf.lbar.findtype \
2246                          findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
2247    trace add variable findtype write findcom_change
2248    set findloc [mc "All fields"]
2249    makedroplist .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
2250        [mc "Comments"] [mc "Author"] [mc "Committer"]
2251    trace add variable findloc write find_change
2252    pack .tf.lbar.findloc -side right
2253    pack .tf.lbar.findtype -side right
2254    pack $fstring -side left -expand 1 -fill x
2255
2256    # Finish putting the upper half of the viewer together
2257    pack .tf.lbar -in .tf -side bottom -fill x
2258    pack .tf.bar -in .tf -side bottom -fill x
2259    pack .tf.histframe -fill both -side top -expand 1
2260    .ctop add .tf
2261    if {!$use_ttk} {
2262        .ctop paneconfigure .tf -height $geometry(topheight)
2263        .ctop paneconfigure .tf -width $geometry(topwidth)
2264    }
2265
2266    # now build up the bottom
2267    ${NS}::panedwindow .pwbottom -orient horizontal
2268
2269    # lower left, a text box over search bar, scroll bar to the right
2270    # if we know window height, then that will set the lower text height, otherwise
2271    # we set lower text height which will drive window height
2272    if {[info exists geometry(main)]} {
2273        ${NS}::frame .bleft -width $geometry(botwidth)
2274    } else {
2275        ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
2276    }
2277    ${NS}::frame .bleft.top
2278    ${NS}::frame .bleft.mid
2279    ${NS}::frame .bleft.bottom
2280
2281    ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch
2282    pack .bleft.top.search -side left -padx 5
2283    set sstring .bleft.top.sstring
2284    set searchstring ""
2285    ${NS}::entry $sstring -width 20 -textvariable searchstring
2286    lappend entries $sstring
2287    trace add variable searchstring write incrsearch
2288    pack $sstring -side left -expand 1 -fill x
2289    ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \
2290        -command changediffdisp -variable diffelide -value {0 0}
2291    ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \
2292        -command changediffdisp -variable diffelide -value {0 1}
2293    ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \
2294        -command changediffdisp -variable diffelide -value {1 0}
2295    ${NS}::label .bleft.mid.labeldiffcontext -text "      [mc "Lines of context"]: "
2296    pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
2297    spinbox .bleft.mid.diffcontext -width 5 \
2298        -from 0 -increment 1 -to 10000000 \
2299        -validate all -validatecommand "diffcontextvalidate %P" \
2300        -textvariable diffcontextstring
2301    .bleft.mid.diffcontext set $diffcontext
2302    trace add variable diffcontextstring write diffcontextchange
2303    lappend entries .bleft.mid.diffcontext
2304    pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
2305    ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
2306        -command changeignorespace -variable ignorespace
2307    pack .bleft.mid.ignspace -side left -padx 5
2308
2309    set worddiff [mc "Line diff"]
2310    if {[package vcompare $git_version "1.7.2"] >= 0} {
2311        makedroplist .bleft.mid.worddiff worddiff [mc "Line diff"] \
2312            [mc "Markup words"] [mc "Color words"]
2313        trace add variable worddiff write changeworddiff
2314        pack .bleft.mid.worddiff -side left -padx 5
2315    }
2316
2317    set ctext .bleft.bottom.ctext
2318    text $ctext -background $bgcolor -foreground $fgcolor \
2319        -state disabled -font textfont \
2320        -yscrollcommand scrolltext -wrap none \
2321        -xscrollcommand ".bleft.bottom.sbhorizontal set"
2322    if {$have_tk85} {
2323        $ctext conf -tabstyle wordprocessor
2324    }
2325    ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview"
2326    ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h
2327    pack .bleft.top -side top -fill x
2328    pack .bleft.mid -side top -fill x
2329    grid $ctext .bleft.bottom.sb -sticky nsew
2330    grid .bleft.bottom.sbhorizontal -sticky ew
2331    grid columnconfigure .bleft.bottom 0 -weight 1
2332    grid rowconfigure .bleft.bottom 0 -weight 1
2333    grid rowconfigure .bleft.bottom 1 -weight 0
2334    pack .bleft.bottom -side top -fill both -expand 1
2335    lappend bglist $ctext
2336    lappend fglist $ctext
2337
2338    $ctext tag conf comment -wrap $wrapcomment
2339    $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
2340    $ctext tag conf hunksep -fore [lindex $diffcolors 2]
2341    $ctext tag conf d0 -fore [lindex $diffcolors 0]
2342    $ctext tag conf dresult -fore [lindex $diffcolors 1]
2343    $ctext tag conf m0 -fore red
2344    $ctext tag conf m1 -fore blue
2345    $ctext tag conf m2 -fore green
2346    $ctext tag conf m3 -fore purple
2347    $ctext tag conf m4 -fore brown
2348    $ctext tag conf m5 -fore "#009090"
2349    $ctext tag conf m6 -fore magenta
2350    $ctext tag conf m7 -fore "#808000"
2351    $ctext tag conf m8 -fore "#009000"
2352    $ctext tag conf m9 -fore "#ff0080"
2353    $ctext tag conf m10 -fore cyan
2354    $ctext tag conf m11 -fore "#b07070"
2355    $ctext tag conf m12 -fore "#70b0f0"
2356    $ctext tag conf m13 -fore "#70f0b0"
2357    $ctext tag conf m14 -fore "#f0b070"
2358    $ctext tag conf m15 -fore "#ff70b0"
2359    $ctext tag conf mmax -fore darkgrey
2360    set mergemax 16
2361    $ctext tag conf mresult -font textfontbold
2362    $ctext tag conf msep -font textfontbold
2363    $ctext tag conf found -back yellow
2364
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 . <Shift-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 log_showroot 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        if {$log_showroot} {
7514            lappend flags --root
7515        }
7516        set cmd [concat | git diff-tree -r $flags $ids]
7517    }
7518    return $cmd
7519}
7520
7521proc gettreediffs {ids} {
7522    global treediff treepending
7523
7524    if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
7525
7526    set treepending $ids
7527    set treediff {}
7528    fconfigure $gdtf -blocking 0 -encoding binary
7529    filerun $gdtf [list gettreediffline $gdtf $ids]
7530}
7531
7532proc gettreediffline {gdtf ids} {
7533    global treediff treediffs treepending diffids diffmergeid
7534    global cmitmode vfilelimit curview limitdiffs perfile_attrs
7535
7536    set nr 0
7537    set sublist {}
7538    set max 1000
7539    if {$perfile_attrs} {
7540        # cache_gitattr is slow, and even slower on win32 where we
7541        # have to invoke it for only about 30 paths at a time
7542        set max 500
7543        if {[tk windowingsystem] == "win32"} {
7544            set max 120
7545        }
7546    }
7547    while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7548        set i [string first "\t" $line]
7549        if {$i >= 0} {
7550            set file [string range $line [expr {$i+1}] end]
7551            if {[string index $file 0] eq "\""} {
7552                set file [lindex $file 0]
7553            }
7554            set file [encoding convertfrom $file]
7555            if {$file ne [lindex $treediff end]} {
7556                lappend treediff $file
7557                lappend sublist $file
7558            }
7559        }
7560    }
7561    if {$perfile_attrs} {
7562        cache_gitattr encoding $sublist
7563    }
7564    if {![eof $gdtf]} {
7565        return [expr {$nr >= $max? 2: 1}]
7566    }
7567    close $gdtf
7568    if {$limitdiffs && $vfilelimit($curview) ne {}} {
7569        set flist {}
7570        foreach f $treediff {
7571            if {[path_filter $vfilelimit($curview) $f]} {
7572                lappend flist $f
7573            }
7574        }
7575        set treediffs($ids) $flist
7576    } else {
7577        set treediffs($ids) $treediff
7578    }
7579    unset treepending
7580    if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7581        gettree $diffids
7582    } elseif {$ids != $diffids} {
7583        if {![info exists diffmergeid]} {
7584            gettreediffs $diffids
7585        }
7586    } else {
7587        addtocflist $ids
7588    }
7589    return 0
7590}
7591
7592# empty string or positive integer
7593proc diffcontextvalidate {v} {
7594    return [regexp {^(|[1-9][0-9]*)$} $v]
7595}
7596
7597proc diffcontextchange {n1 n2 op} {
7598    global diffcontextstring diffcontext
7599
7600    if {[string is integer -strict $diffcontextstring]} {
7601        if {$diffcontextstring >= 0} {
7602            set diffcontext $diffcontextstring
7603            reselectline
7604        }
7605    }
7606}
7607
7608proc changeignorespace {} {
7609    reselectline
7610}
7611
7612proc changeworddiff {name ix op} {
7613    reselectline
7614}
7615
7616proc getblobdiffs {ids} {
7617    global blobdifffd diffids env
7618    global diffinhdr treediffs
7619    global diffcontext
7620    global ignorespace
7621    global worddiff
7622    global limitdiffs vfilelimit curview
7623    global diffencoding targetline diffnparents
7624    global git_version currdiffsubmod
7625
7626    set textconv {}
7627    if {[package vcompare $git_version "1.6.1"] >= 0} {
7628        set textconv "--textconv"
7629    }
7630    set submodule {}
7631    if {[package vcompare $git_version "1.6.6"] >= 0} {
7632        set submodule "--submodule"
7633    }
7634    set cmd [diffcmd $ids "-p $textconv $submodule  -C --cc --no-commit-id -U$diffcontext"]
7635    if {$ignorespace} {
7636        append cmd " -w"
7637    }
7638    if {$worddiff ne [mc "Line diff"]} {
7639        append cmd " --word-diff=porcelain"
7640    }
7641    if {$limitdiffs && $vfilelimit($curview) ne {}} {
7642        set cmd [concat $cmd -- $vfilelimit($curview)]
7643    }
7644    if {[catch {set bdf [open $cmd r]} err]} {
7645        error_popup [mc "Error getting diffs: %s" $err]
7646        return
7647    }
7648    set targetline {}
7649    set diffnparents 0
7650    set diffinhdr 0
7651    set diffencoding [get_path_encoding {}]
7652    fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
7653    set blobdifffd($ids) $bdf
7654    set currdiffsubmod ""
7655    filerun $bdf [list getblobdiffline $bdf $diffids]
7656}
7657
7658proc savecmitpos {} {
7659    global ctext cmitmode
7660
7661    if {$cmitmode eq "tree"} {
7662        return {}
7663    }
7664    return [list target_scrollpos [$ctext index @0,0]]
7665}
7666
7667proc savectextpos {} {
7668    global ctext
7669
7670    return [list target_scrollpos [$ctext index @0,0]]
7671}
7672
7673proc maybe_scroll_ctext {ateof} {
7674    global ctext target_scrollpos
7675
7676    if {![info exists target_scrollpos]} return
7677    if {!$ateof} {
7678        set nlines [expr {[winfo height $ctext]
7679                          / [font metrics textfont -linespace]}]
7680        if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
7681    }
7682    $ctext yview $target_scrollpos
7683    unset target_scrollpos
7684}
7685
7686proc setinlist {var i val} {
7687    global $var
7688
7689    while {[llength [set $var]] < $i} {
7690        lappend $var {}
7691    }
7692    if {[llength [set $var]] == $i} {
7693        lappend $var $val
7694    } else {
7695        lset $var $i $val
7696    }
7697}
7698
7699proc makediffhdr {fname ids} {
7700    global ctext curdiffstart treediffs diffencoding
7701    global ctext_file_names jump_to_here targetline diffline
7702
7703    set fname [encoding convertfrom $fname]
7704    set diffencoding [get_path_encoding $fname]
7705    set i [lsearch -exact $treediffs($ids) $fname]
7706    if {$i >= 0} {
7707        setinlist difffilestart $i $curdiffstart
7708    }
7709    lset ctext_file_names end $fname
7710    set l [expr {(78 - [string length $fname]) / 2}]
7711    set pad [string range "----------------------------------------" 1 $l]
7712    $ctext insert $curdiffstart "$pad $fname $pad" filesep
7713    set targetline {}
7714    if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
7715        set targetline [lindex $jump_to_here 1]
7716    }
7717    set diffline 0
7718}
7719
7720proc getblobdiffline {bdf ids} {
7721    global diffids blobdifffd ctext curdiffstart
7722    global diffnexthead diffnextnote difffilestart
7723    global ctext_file_names ctext_file_lines
7724    global diffinhdr treediffs mergemax diffnparents
7725    global diffencoding jump_to_here targetline diffline currdiffsubmod
7726    global worddiff
7727
7728    set nr 0
7729    $ctext conf -state normal
7730    while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
7731        if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
7732            catch {close $bdf}
7733            return 0
7734        }
7735        if {![string compare -length 5 "diff " $line]} {
7736            if {![regexp {^diff (--cc|--git) } $line m type]} {
7737                set line [encoding convertfrom $line]
7738                $ctext insert end "$line\n" hunksep
7739                continue
7740            }
7741            # start of a new file
7742            set diffinhdr 1
7743            $ctext insert end "\n"
7744            set curdiffstart [$ctext index "end - 1c"]
7745            lappend ctext_file_names ""
7746            lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7747            $ctext insert end "\n" filesep
7748
7749            if {$type eq "--cc"} {
7750                # start of a new file in a merge diff
7751                set fname [string range $line 10 end]
7752                if {[lsearch -exact $treediffs($ids) $fname] < 0} {
7753                    lappend treediffs($ids) $fname
7754                    add_flist [list $fname]
7755                }
7756
7757            } else {
7758                set line [string range $line 11 end]
7759                # If the name hasn't changed the length will be odd,
7760                # the middle char will be a space, and the two bits either
7761                # side will be a/name and b/name, or "a/name" and "b/name".
7762                # If the name has changed we'll get "rename from" and
7763                # "rename to" or "copy from" and "copy to" lines following
7764                # this, and we'll use them to get the filenames.
7765                # This complexity is necessary because spaces in the
7766                # filename(s) don't get escaped.
7767                set l [string length $line]
7768                set i [expr {$l / 2}]
7769                if {!(($l & 1) && [string index $line $i] eq " " &&
7770                      [string range $line 2 [expr {$i - 1}]] eq \
7771                          [string range $line [expr {$i + 3}] end])} {
7772                    continue
7773                }
7774                # unescape if quoted and chop off the a/ from the front
7775                if {[string index $line 0] eq "\""} {
7776                    set fname [string range [lindex $line 0] 2 end]
7777                } else {
7778                    set fname [string range $line 2 [expr {$i - 1}]]
7779                }
7780            }
7781            makediffhdr $fname $ids
7782
7783        } elseif {![string compare -length 16 "* Unmerged path " $line]} {
7784            set fname [encoding convertfrom [string range $line 16 end]]
7785            $ctext insert end "\n"
7786            set curdiffstart [$ctext index "end - 1c"]
7787            lappend ctext_file_names $fname
7788            lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7789            $ctext insert end "$line\n" filesep
7790            set i [lsearch -exact $treediffs($ids) $fname]
7791            if {$i >= 0} {
7792                setinlist difffilestart $i $curdiffstart
7793            }
7794
7795        } elseif {![string compare -length 2 "@@" $line]} {
7796            regexp {^@@+} $line ats
7797            set line [encoding convertfrom $diffencoding $line]
7798            $ctext insert end "$line\n" hunksep
7799            if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
7800                set diffline $nl
7801            }
7802            set diffnparents [expr {[string length $ats] - 1}]
7803            set diffinhdr 0
7804
7805        } elseif {![string compare -length 10 "Submodule " $line]} {
7806            # start of a new submodule
7807            if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
7808                set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
7809            } else {
7810                set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
7811            }
7812            if {$currdiffsubmod != $fname} {
7813                $ctext insert end "\n";     # Add newline after commit message
7814            }
7815            set curdiffstart [$ctext index "end - 1c"]
7816            lappend ctext_file_names ""
7817            if {$currdiffsubmod != $fname} {
7818                lappend ctext_file_lines $fname
7819                makediffhdr $fname $ids
7820                set currdiffsubmod $fname
7821                $ctext insert end "\n$line\n" filesep
7822            } else {
7823                $ctext insert end "$line\n" filesep
7824            }
7825        } elseif {![string compare -length 3 "  >" $line]} {
7826            set $currdiffsubmod ""
7827            set line [encoding convertfrom $diffencoding $line]
7828            $ctext insert end "$line\n" dresult
7829        } elseif {![string compare -length 3 "  <" $line]} {
7830            set $currdiffsubmod ""
7831            set line [encoding convertfrom $diffencoding $line]
7832            $ctext insert end "$line\n" d0
7833        } elseif {$diffinhdr} {
7834            if {![string compare -length 12 "rename from " $line]} {
7835                set fname [string range $line [expr 6 + [string first " from " $line] ] end]
7836                if {[string index $fname 0] eq "\""} {
7837                    set fname [lindex $fname 0]
7838                }
7839                set fname [encoding convertfrom $fname]
7840                set i [lsearch -exact $treediffs($ids) $fname]
7841                if {$i >= 0} {
7842                    setinlist difffilestart $i $curdiffstart
7843                }
7844            } elseif {![string compare -length 10 $line "rename to "] ||
7845                      ![string compare -length 8 $line "copy to "]} {
7846                set fname [string range $line [expr 4 + [string first " to " $line] ] end]
7847                if {[string index $fname 0] eq "\""} {
7848                    set fname [lindex $fname 0]
7849                }
7850                makediffhdr $fname $ids
7851            } elseif {[string compare -length 3 $line "---"] == 0} {
7852                # do nothing
7853                continue
7854            } elseif {[string compare -length 3 $line "+++"] == 0} {
7855                set diffinhdr 0
7856                continue
7857            }
7858            $ctext insert end "$line\n" filesep
7859
7860        } else {
7861            set line [string map {\x1A ^Z} \
7862                          [encoding convertfrom $diffencoding $line]]
7863            # parse the prefix - one ' ', '-' or '+' for each parent
7864            set prefix [string range $line 0 [expr {$diffnparents - 1}]]
7865            set tag [expr {$diffnparents > 1? "m": "d"}]
7866            set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
7867            set words_pre_markup ""
7868            set words_post_markup ""
7869            if {[string trim $prefix " -+"] eq {}} {
7870                # prefix only has " ", "-" and "+" in it: normal diff line
7871                set num [string first "-" $prefix]
7872                if {$dowords} {
7873                    set line [string range $line 1 end]
7874                }
7875                if {$num >= 0} {
7876                    # removed line, first parent with line is $num
7877                    if {$num >= $mergemax} {
7878                        set num "max"
7879                    }
7880                    if {$dowords && $worddiff eq [mc "Markup words"]} {
7881                        $ctext insert end "\[-$line-\]" $tag$num
7882                    } else {
7883                        $ctext insert end "$line" $tag$num
7884                    }
7885                    if {!$dowords} {
7886                        $ctext insert end "\n" $tag$num
7887                    }
7888                } else {
7889                    set tags {}
7890                    if {[string first "+" $prefix] >= 0} {
7891                        # added line
7892                        lappend tags ${tag}result
7893                        if {$diffnparents > 1} {
7894                            set num [string first " " $prefix]
7895                            if {$num >= 0} {
7896                                if {$num >= $mergemax} {
7897                                    set num "max"
7898                                }
7899                                lappend tags m$num
7900                            }
7901                        }
7902                        set words_pre_markup "{+"
7903                        set words_post_markup "+}"
7904                    }
7905                    if {$targetline ne {}} {
7906                        if {$diffline == $targetline} {
7907                            set seehere [$ctext index "end - 1 chars"]
7908                            set targetline {}
7909                        } else {
7910                            incr diffline
7911                        }
7912                    }
7913                    if {$dowords && $worddiff eq [mc "Markup words"]} {
7914                        $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
7915                    } else {
7916                        $ctext insert end "$line" $tags
7917                    }
7918                    if {!$dowords} {
7919                        $ctext insert end "\n" $tags
7920                    }
7921                }
7922            } elseif {$dowords && $prefix eq "~"} {
7923                $ctext insert end "\n" {}
7924            } else {
7925                # "\ No newline at end of file",
7926                # or something else we don't recognize
7927                $ctext insert end "$line\n" hunksep
7928            }
7929        }
7930    }
7931    if {[info exists seehere]} {
7932        mark_ctext_line [lindex [split $seehere .] 0]
7933    }
7934    maybe_scroll_ctext [eof $bdf]
7935    $ctext conf -state disabled
7936    if {[eof $bdf]} {
7937        catch {close $bdf}
7938        return 0
7939    }
7940    return [expr {$nr >= 1000? 2: 1}]
7941}
7942
7943proc changediffdisp {} {
7944    global ctext diffelide
7945
7946    $ctext tag conf d0 -elide [lindex $diffelide 0]
7947    $ctext tag conf dresult -elide [lindex $diffelide 1]
7948}
7949
7950proc highlightfile {loc cline} {
7951    global ctext cflist cflist_top
7952
7953    $ctext yview $loc
7954    $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
7955    $cflist tag add highlight $cline.0 "$cline.0 lineend"
7956    $cflist see $cline.0
7957    set cflist_top $cline
7958}
7959
7960proc prevfile {} {
7961    global difffilestart ctext cmitmode
7962
7963    if {$cmitmode eq "tree"} return
7964    set prev 0.0
7965    set prevline 1
7966    set here [$ctext index @0,0]
7967    foreach loc $difffilestart {
7968        if {[$ctext compare $loc >= $here]} {
7969            highlightfile $prev $prevline
7970            return
7971        }
7972        set prev $loc
7973        incr prevline
7974    }
7975    highlightfile $prev $prevline
7976}
7977
7978proc nextfile {} {
7979    global difffilestart ctext cmitmode
7980
7981    if {$cmitmode eq "tree"} return
7982    set here [$ctext index @0,0]
7983    set line 1
7984    foreach loc $difffilestart {
7985        incr line
7986        if {[$ctext compare $loc > $here]} {
7987            highlightfile $loc $line
7988            return
7989        }
7990    }
7991}
7992
7993proc clear_ctext {{first 1.0}} {
7994    global ctext smarktop smarkbot
7995    global ctext_file_names ctext_file_lines
7996    global pendinglinks
7997
7998    set l [lindex [split $first .] 0]
7999    if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
8000        set smarktop $l
8001    }
8002    if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
8003        set smarkbot $l
8004    }
8005    $ctext delete $first end
8006    if {$first eq "1.0"} {
8007        catch {unset pendinglinks}
8008    }
8009    set ctext_file_names {}
8010    set ctext_file_lines {}
8011}
8012
8013proc settabs {{firstab {}}} {
8014    global firsttabstop tabstop ctext have_tk85
8015
8016    if {$firstab ne {} && $have_tk85} {
8017        set firsttabstop $firstab
8018    }
8019    set w [font measure textfont "0"]
8020    if {$firsttabstop != 0} {
8021        $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
8022                               [expr {($firsttabstop + 2 * $tabstop) * $w}]]
8023    } elseif {$have_tk85 || $tabstop != 8} {
8024        $ctext conf -tabs [expr {$tabstop * $w}]
8025    } else {
8026        $ctext conf -tabs {}
8027    }
8028}
8029
8030proc incrsearch {name ix op} {
8031    global ctext searchstring searchdirn
8032
8033    $ctext tag remove found 1.0 end
8034    if {[catch {$ctext index anchor}]} {
8035        # no anchor set, use start of selection, or of visible area
8036        set sel [$ctext tag ranges sel]
8037        if {$sel ne {}} {
8038            $ctext mark set anchor [lindex $sel 0]
8039        } elseif {$searchdirn eq "-forwards"} {
8040            $ctext mark set anchor @0,0
8041        } else {
8042            $ctext mark set anchor @0,[winfo height $ctext]
8043        }
8044    }
8045    if {$searchstring ne {}} {
8046        set here [$ctext search $searchdirn -- $searchstring anchor]
8047        if {$here ne {}} {
8048            $ctext see $here
8049        }
8050        searchmarkvisible 1
8051    }
8052}
8053
8054proc dosearch {} {
8055    global sstring ctext searchstring searchdirn
8056
8057    focus $sstring
8058    $sstring icursor end
8059    set searchdirn -forwards
8060    if {$searchstring ne {}} {
8061        set sel [$ctext tag ranges sel]
8062        if {$sel ne {}} {
8063            set start "[lindex $sel 0] + 1c"
8064        } elseif {[catch {set start [$ctext index anchor]}]} {
8065            set start "@0,0"
8066        }
8067        set match [$ctext search -count mlen -- $searchstring $start]
8068        $ctext tag remove sel 1.0 end
8069        if {$match eq {}} {
8070            bell
8071            return
8072        }
8073        $ctext see $match
8074        set mend "$match + $mlen c"
8075        $ctext tag add sel $match $mend
8076        $ctext mark unset anchor
8077    }
8078}
8079
8080proc dosearchback {} {
8081    global sstring ctext searchstring searchdirn
8082
8083    focus $sstring
8084    $sstring icursor end
8085    set searchdirn -backwards
8086    if {$searchstring ne {}} {
8087        set sel [$ctext tag ranges sel]
8088        if {$sel ne {}} {
8089            set start [lindex $sel 0]
8090        } elseif {[catch {set start [$ctext index anchor]}]} {
8091            set start @0,[winfo height $ctext]
8092        }
8093        set match [$ctext search -backwards -count ml -- $searchstring $start]
8094        $ctext tag remove sel 1.0 end
8095        if {$match eq {}} {
8096            bell
8097            return
8098        }
8099        $ctext see $match
8100        set mend "$match + $ml c"
8101        $ctext tag add sel $match $mend
8102        $ctext mark unset anchor
8103    }
8104}
8105
8106proc searchmark {first last} {
8107    global ctext searchstring
8108
8109    set mend $first.0
8110    while {1} {
8111        set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8112        if {$match eq {}} break
8113        set mend "$match + $mlen c"
8114        $ctext tag add found $match $mend
8115    }
8116}
8117
8118proc searchmarkvisible {doall} {
8119    global ctext smarktop smarkbot
8120
8121    set topline [lindex [split [$ctext index @0,0] .] 0]
8122    set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8123    if {$doall || $botline < $smarktop || $topline > $smarkbot} {
8124        # no overlap with previous
8125        searchmark $topline $botline
8126        set smarktop $topline
8127        set smarkbot $botline
8128    } else {
8129        if {$topline < $smarktop} {
8130            searchmark $topline [expr {$smarktop-1}]
8131            set smarktop $topline
8132        }
8133        if {$botline > $smarkbot} {
8134            searchmark [expr {$smarkbot+1}] $botline
8135            set smarkbot $botline
8136        }
8137    }
8138}
8139
8140proc scrolltext {f0 f1} {
8141    global searchstring
8142
8143    .bleft.bottom.sb set $f0 $f1
8144    if {$searchstring ne {}} {
8145        searchmarkvisible 0
8146    }
8147}
8148
8149proc setcoords {} {
8150    global linespc charspc canvx0 canvy0
8151    global xspc1 xspc2 lthickness
8152
8153    set linespc [font metrics mainfont -linespace]
8154    set charspc [font measure mainfont "m"]
8155    set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8156    set canvx0 [expr {int(3 + 0.5 * $linespc)}]
8157    set lthickness [expr {int($linespc / 9) + 1}]
8158    set xspc1(0) $linespc
8159    set xspc2 $linespc
8160}
8161
8162proc redisplay {} {
8163    global canv
8164    global selectedline
8165
8166    set ymax [lindex [$canv cget -scrollregion] 3]
8167    if {$ymax eq {} || $ymax == 0} return
8168    set span [$canv yview]
8169    clear_display
8170    setcanvscroll
8171    allcanvs yview moveto [lindex $span 0]
8172    drawvisible
8173    if {$selectedline ne {}} {
8174        selectline $selectedline 0
8175        allcanvs yview moveto [lindex $span 0]
8176    }
8177}
8178
8179proc parsefont {f n} {
8180    global fontattr
8181
8182    set fontattr($f,family) [lindex $n 0]
8183    set s [lindex $n 1]
8184    if {$s eq {} || $s == 0} {
8185        set s 10
8186    } elseif {$s < 0} {
8187        set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
8188    }
8189    set fontattr($f,size) $s
8190    set fontattr($f,weight) normal
8191    set fontattr($f,slant) roman
8192    foreach style [lrange $n 2 end] {
8193        switch -- $style {
8194            "normal" -
8195            "bold"   {set fontattr($f,weight) $style}
8196            "roman" -
8197            "italic" {set fontattr($f,slant) $style}
8198        }
8199    }
8200}
8201
8202proc fontflags {f {isbold 0}} {
8203    global fontattr
8204
8205    return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8206                -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8207                -slant $fontattr($f,slant)]
8208}
8209
8210proc fontname {f} {
8211    global fontattr
8212
8213    set n [list $fontattr($f,family) $fontattr($f,size)]
8214    if {$fontattr($f,weight) eq "bold"} {
8215        lappend n "bold"
8216    }
8217    if {$fontattr($f,slant) eq "italic"} {
8218        lappend n "italic"
8219    }
8220    return $n
8221}
8222
8223proc incrfont {inc} {
8224    global mainfont textfont ctext canv cflist showrefstop
8225    global stopped entries fontattr
8226
8227    unmarkmatches
8228    set s $fontattr(mainfont,size)
8229    incr s $inc
8230    if {$s < 1} {
8231        set s 1
8232    }
8233    set fontattr(mainfont,size) $s
8234    font config mainfont -size $s
8235    font config mainfontbold -size $s
8236    set mainfont [fontname mainfont]
8237    set s $fontattr(textfont,size)
8238    incr s $inc
8239    if {$s < 1} {
8240        set s 1
8241    }
8242    set fontattr(textfont,size) $s
8243    font config textfont -size $s
8244    font config textfontbold -size $s
8245    set textfont [fontname textfont]
8246    setcoords
8247    settabs
8248    redisplay
8249}
8250
8251proc clearsha1 {} {
8252    global sha1entry sha1string
8253    if {[string length $sha1string] == 40} {
8254        $sha1entry delete 0 end
8255    }
8256}
8257
8258proc sha1change {n1 n2 op} {
8259    global sha1string currentid sha1but
8260    if {$sha1string == {}
8261        || ([info exists currentid] && $sha1string == $currentid)} {
8262        set state disabled
8263    } else {
8264        set state normal
8265    }
8266    if {[$sha1but cget -state] == $state} return
8267    if {$state == "normal"} {
8268        $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
8269    } else {
8270        $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
8271    }
8272}
8273
8274proc gotocommit {} {
8275    global sha1string tagids headids curview varcid
8276
8277    if {$sha1string == {}
8278        || ([info exists currentid] && $sha1string == $currentid)} return
8279    if {[info exists tagids($sha1string)]} {
8280        set id $tagids($sha1string)
8281    } elseif {[info exists headids($sha1string)]} {
8282        set id $headids($sha1string)
8283    } else {
8284        set id [string tolower $sha1string]
8285        if {[regexp {^[0-9a-f]{4,39}$} $id]} {
8286            set matches [longid $id]
8287            if {$matches ne {}} {
8288                if {[llength $matches] > 1} {
8289                    error_popup [mc "Short SHA1 id %s is ambiguous" $id]
8290                    return
8291                }
8292                set id [lindex $matches 0]
8293            }
8294        } else {
8295            if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8296                error_popup [mc "Revision %s is not known" $sha1string]
8297                return
8298            }
8299        }
8300    }
8301    if {[commitinview $id $curview]} {
8302        selectline [rowofcommit $id] 1
8303        return
8304    }
8305    if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
8306        set msg [mc "SHA1 id %s is not known" $sha1string]
8307    } else {
8308        set msg [mc "Revision %s is not in the current view" $sha1string]
8309    }
8310    error_popup $msg
8311}
8312
8313proc lineenter {x y id} {
8314    global hoverx hovery hoverid hovertimer
8315    global commitinfo canv
8316
8317    if {![info exists commitinfo($id)] && ![getcommit $id]} return
8318    set hoverx $x
8319    set hovery $y
8320    set hoverid $id
8321    if {[info exists hovertimer]} {
8322        after cancel $hovertimer
8323    }
8324    set hovertimer [after 500 linehover]
8325    $canv delete hover
8326}
8327
8328proc linemotion {x y id} {
8329    global hoverx hovery hoverid hovertimer
8330
8331    if {[info exists hoverid] && $id == $hoverid} {
8332        set hoverx $x
8333        set hovery $y
8334        if {[info exists hovertimer]} {
8335            after cancel $hovertimer
8336        }
8337        set hovertimer [after 500 linehover]
8338    }
8339}
8340
8341proc lineleave {id} {
8342    global hoverid hovertimer canv
8343
8344    if {[info exists hoverid] && $id == $hoverid} {
8345        $canv delete hover
8346        if {[info exists hovertimer]} {
8347            after cancel $hovertimer
8348            unset hovertimer
8349        }
8350        unset hoverid
8351    }
8352}
8353
8354proc linehover {} {
8355    global hoverx hovery hoverid hovertimer
8356    global canv linespc lthickness
8357    global commitinfo
8358
8359    set text [lindex $commitinfo($hoverid) 0]
8360    set ymax [lindex [$canv cget -scrollregion] 3]
8361    if {$ymax == {}} return
8362    set yfrac [lindex [$canv yview] 0]
8363    set x [expr {$hoverx + 2 * $linespc}]
8364    set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8365    set x0 [expr {$x - 2 * $lthickness}]
8366    set y0 [expr {$y - 2 * $lthickness}]
8367    set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
8368    set y1 [expr {$y + $linespc + 2 * $lthickness}]
8369    set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8370               -fill \#ffff80 -outline black -width 1 -tags hover]
8371    $canv raise $t
8372    set t [$canv create text $x $y -anchor nw -text $text -tags hover \
8373               -font mainfont]
8374    $canv raise $t
8375}
8376
8377proc clickisonarrow {id y} {
8378    global lthickness
8379
8380    set ranges [rowranges $id]
8381    set thresh [expr {2 * $lthickness + 6}]
8382    set n [expr {[llength $ranges] - 1}]
8383    for {set i 1} {$i < $n} {incr i} {
8384        set row [lindex $ranges $i]
8385        if {abs([yc $row] - $y) < $thresh} {
8386            return $i
8387        }
8388    }
8389    return {}
8390}
8391
8392proc arrowjump {id n y} {
8393    global canv
8394
8395    # 1 <-> 2, 3 <-> 4, etc...
8396    set n [expr {(($n - 1) ^ 1) + 1}]
8397    set row [lindex [rowranges $id] $n]
8398    set yt [yc $row]
8399    set ymax [lindex [$canv cget -scrollregion] 3]
8400    if {$ymax eq {} || $ymax <= 0} return
8401    set view [$canv yview]
8402    set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8403    set yfrac [expr {$yt / $ymax - $yspan / 2}]
8404    if {$yfrac < 0} {
8405        set yfrac 0
8406    }
8407    allcanvs yview moveto $yfrac
8408}
8409
8410proc lineclick {x y id isnew} {
8411    global ctext commitinfo children canv thickerline curview
8412
8413    if {![info exists commitinfo($id)] && ![getcommit $id]} return
8414    unmarkmatches
8415    unselectline
8416    normalline
8417    $canv delete hover
8418    # draw this line thicker than normal
8419    set thickerline $id
8420    drawlines $id
8421    if {$isnew} {
8422        set ymax [lindex [$canv cget -scrollregion] 3]
8423        if {$ymax eq {}} return
8424        set yfrac [lindex [$canv yview] 0]
8425        set y [expr {$y + $yfrac * $ymax}]
8426    }
8427    set dirn [clickisonarrow $id $y]
8428    if {$dirn ne {}} {
8429        arrowjump $id $dirn $y
8430        return
8431    }
8432
8433    if {$isnew} {
8434        addtohistory [list lineclick $x $y $id 0] savectextpos
8435    }
8436    # fill the details pane with info about this line
8437    $ctext conf -state normal
8438    clear_ctext
8439    settabs 0
8440    $ctext insert end "[mc "Parent"]:\t"
8441    $ctext insert end $id link0
8442    setlink $id link0
8443    set info $commitinfo($id)
8444    $ctext insert end "\n\t[lindex $info 0]\n"
8445    $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8446    set date [formatdate [lindex $info 2]]
8447    $ctext insert end "\t[mc "Date"]:\t$date\n"
8448    set kids $children($curview,$id)
8449    if {$kids ne {}} {
8450        $ctext insert end "\n[mc "Children"]:"
8451        set i 0
8452        foreach child $kids {
8453            incr i
8454            if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8455            set info $commitinfo($child)
8456            $ctext insert end "\n\t"
8457            $ctext insert end $child link$i
8458            setlink $child link$i
8459            $ctext insert end "\n\t[lindex $info 0]"
8460            $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8461            set date [formatdate [lindex $info 2]]
8462            $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8463        }
8464    }
8465    maybe_scroll_ctext 1
8466    $ctext conf -state disabled
8467    init_flist {}
8468}
8469
8470proc normalline {} {
8471    global thickerline
8472    if {[info exists thickerline]} {
8473        set id $thickerline
8474        unset thickerline
8475        drawlines $id
8476    }
8477}
8478
8479proc selbyid {id {isnew 1}} {
8480    global curview
8481    if {[commitinview $id $curview]} {
8482        selectline [rowofcommit $id] $isnew
8483    }
8484}
8485
8486proc mstime {} {
8487    global startmstime
8488    if {![info exists startmstime]} {
8489        set startmstime [clock clicks -milliseconds]
8490    }
8491    return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8492}
8493
8494proc rowmenu {x y id} {
8495    global rowctxmenu selectedline rowmenuid curview
8496    global nullid nullid2 fakerowmenu mainhead markedid
8497
8498    stopfinding
8499    set rowmenuid $id
8500    if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8501        set state disabled
8502    } else {
8503        set state normal
8504    }
8505    if {[info exists markedid] && $markedid ne $id} {
8506        set mstate normal
8507    } else {
8508        set mstate disabled
8509    }
8510    if {$id ne $nullid && $id ne $nullid2} {
8511        set menu $rowctxmenu
8512        if {$mainhead ne {}} {
8513            $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead] -state normal
8514        } else {
8515            $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8516        }
8517        $menu entryconfigure 9 -state $mstate
8518        $menu entryconfigure 10 -state $mstate
8519        $menu entryconfigure 11 -state $mstate
8520    } else {
8521        set menu $fakerowmenu
8522    }
8523    $menu entryconfigure [mca "Diff this -> selected"] -state $state
8524    $menu entryconfigure [mca "Diff selected -> this"] -state $state
8525    $menu entryconfigure [mca "Make patch"] -state $state
8526    $menu entryconfigure [mca "Diff this -> marked commit"] -state $mstate
8527    $menu entryconfigure [mca "Diff marked commit -> this"] -state $mstate
8528    tk_popup $menu $x $y
8529}
8530
8531proc markhere {} {
8532    global rowmenuid markedid canv
8533
8534    set markedid $rowmenuid
8535    make_idmark $markedid
8536}
8537
8538proc gotomark {} {
8539    global markedid
8540
8541    if {[info exists markedid]} {
8542        selbyid $markedid
8543    }
8544}
8545
8546proc replace_by_kids {l r} {
8547    global curview children
8548
8549    set id [commitonrow $r]
8550    set l [lreplace $l 0 0]
8551    foreach kid $children($curview,$id) {
8552        lappend l [rowofcommit $kid]
8553    }
8554    return [lsort -integer -decreasing -unique $l]
8555}
8556
8557proc find_common_desc {} {
8558    global markedid rowmenuid curview children
8559
8560    if {![info exists markedid]} return
8561    if {![commitinview $markedid $curview] ||
8562        ![commitinview $rowmenuid $curview]} return
8563    #set t1 [clock clicks -milliseconds]
8564    set l1 [list [rowofcommit $markedid]]
8565    set l2 [list [rowofcommit $rowmenuid]]
8566    while 1 {
8567        set r1 [lindex $l1 0]
8568        set r2 [lindex $l2 0]
8569        if {$r1 eq {} || $r2 eq {}} break
8570        if {$r1 == $r2} {
8571            selectline $r1 1
8572            break
8573        }
8574        if {$r1 > $r2} {
8575            set l1 [replace_by_kids $l1 $r1]
8576        } else {
8577            set l2 [replace_by_kids $l2 $r2]
8578        }
8579    }
8580    #set t2 [clock clicks -milliseconds]
8581    #puts "took [expr {$t2-$t1}]ms"
8582}
8583
8584proc compare_commits {} {
8585    global markedid rowmenuid curview children
8586
8587    if {![info exists markedid]} return
8588    if {![commitinview $markedid $curview]} return
8589    addtohistory [list do_cmp_commits $markedid $rowmenuid]
8590    do_cmp_commits $markedid $rowmenuid
8591}
8592
8593proc getpatchid {id} {
8594    global patchids
8595
8596    if {![info exists patchids($id)]} {
8597        set cmd [diffcmd [list $id] {-p --root}]
8598        # trim off the initial "|"
8599        set cmd [lrange $cmd 1 end]
8600        if {[catch {
8601            set x [eval exec $cmd | git patch-id]
8602            set patchids($id) [lindex $x 0]
8603        }]} {
8604            set patchids($id) "error"
8605        }
8606    }
8607    return $patchids($id)
8608}
8609
8610proc do_cmp_commits {a b} {
8611    global ctext curview parents children patchids commitinfo
8612
8613    $ctext conf -state normal
8614    clear_ctext
8615    init_flist {}
8616    for {set i 0} {$i < 100} {incr i} {
8617        set skipa 0
8618        set skipb 0
8619        if {[llength $parents($curview,$a)] > 1} {
8620            appendshortlink $a [mc "Skipping merge commit "] "\n"
8621            set skipa 1
8622        } else {
8623            set patcha [getpatchid $a]
8624        }
8625        if {[llength $parents($curview,$b)] > 1} {
8626            appendshortlink $b [mc "Skipping merge commit "] "\n"
8627            set skipb 1
8628        } else {
8629            set patchb [getpatchid $b]
8630        }
8631        if {!$skipa && !$skipb} {
8632            set heada [lindex $commitinfo($a) 0]
8633            set headb [lindex $commitinfo($b) 0]
8634            if {$patcha eq "error"} {
8635                appendshortlink $a [mc "Error getting patch ID for "] \
8636                    [mc " - stopping\n"]
8637                break
8638            }
8639            if {$patchb eq "error"} {
8640                appendshortlink $b [mc "Error getting patch ID for "] \
8641                    [mc " - stopping\n"]
8642                break
8643            }
8644            if {$patcha eq $patchb} {
8645                if {$heada eq $headb} {
8646                    appendshortlink $a [mc "Commit "]
8647                    appendshortlink $b " == " "  $heada\n"
8648                } else {
8649                    appendshortlink $a [mc "Commit "] "  $heada\n"
8650                    appendshortlink $b [mc " is the same patch as\n       "] \
8651                        "  $headb\n"
8652                }
8653                set skipa 1
8654                set skipb 1
8655            } else {
8656                $ctext insert end "\n"
8657                appendshortlink $a [mc "Commit "] "  $heada\n"
8658                appendshortlink $b [mc " differs from\n       "] \
8659                    "  $headb\n"
8660                $ctext insert end [mc "Diff of commits:\n\n"]
8661                $ctext conf -state disabled
8662                update
8663                diffcommits $a $b
8664                return
8665            }
8666        }
8667        if {$skipa} {
8668            set kids [real_children $curview,$a]
8669            if {[llength $kids] != 1} {
8670                $ctext insert end "\n"
8671                appendshortlink $a [mc "Commit "] \
8672                    [mc " has %s children - stopping\n" [llength $kids]]
8673                break
8674            }
8675            set a [lindex $kids 0]
8676        }
8677        if {$skipb} {
8678            set kids [real_children $curview,$b]
8679            if {[llength $kids] != 1} {
8680                appendshortlink $b [mc "Commit "] \
8681                    [mc " has %s children - stopping\n" [llength $kids]]
8682                break
8683            }
8684            set b [lindex $kids 0]
8685        }
8686    }
8687    $ctext conf -state disabled
8688}
8689
8690proc diffcommits {a b} {
8691    global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
8692
8693    set tmpdir [gitknewtmpdir]
8694    set fna [file join $tmpdir "commit-[string range $a 0 7]"]
8695    set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
8696    if {[catch {
8697        exec git diff-tree -p --pretty $a >$fna
8698        exec git diff-tree -p --pretty $b >$fnb
8699    } err]} {
8700        error_popup [mc "Error writing commit to file: %s" $err]
8701        return
8702    }
8703    if {[catch {
8704        set fd [open "| diff -U$diffcontext $fna $fnb" r]
8705    } err]} {
8706        error_popup [mc "Error diffing commits: %s" $err]
8707        return
8708    }
8709    set diffids [list commits $a $b]
8710    set blobdifffd($diffids) $fd
8711    set diffinhdr 0
8712    set currdiffsubmod ""
8713    filerun $fd [list getblobdiffline $fd $diffids]
8714}
8715
8716proc diffvssel {dirn} {
8717    global rowmenuid selectedline
8718
8719    if {$selectedline eq {}} return
8720    if {$dirn} {
8721        set oldid [commitonrow $selectedline]
8722        set newid $rowmenuid
8723    } else {
8724        set oldid $rowmenuid
8725        set newid [commitonrow $selectedline]
8726    }
8727    addtohistory [list doseldiff $oldid $newid] savectextpos
8728    doseldiff $oldid $newid
8729}
8730
8731proc diffvsmark {dirn} {
8732    global rowmenuid markedid
8733
8734    if {![info exists markedid]} return
8735    if {$dirn} {
8736        set oldid $markedid
8737        set newid $rowmenuid
8738    } else {
8739        set oldid $rowmenuid
8740        set newid $markedid
8741    }
8742    addtohistory [list doseldiff $oldid $newid] savectextpos
8743    doseldiff $oldid $newid
8744}
8745
8746proc doseldiff {oldid newid} {
8747    global ctext
8748    global commitinfo
8749
8750    $ctext conf -state normal
8751    clear_ctext
8752    init_flist [mc "Top"]
8753    $ctext insert end "[mc "From"] "
8754    $ctext insert end $oldid link0
8755    setlink $oldid link0
8756    $ctext insert end "\n     "
8757    $ctext insert end [lindex $commitinfo($oldid) 0]
8758    $ctext insert end "\n\n[mc "To"]   "
8759    $ctext insert end $newid link1
8760    setlink $newid link1
8761    $ctext insert end "\n     "
8762    $ctext insert end [lindex $commitinfo($newid) 0]
8763    $ctext insert end "\n"
8764    $ctext conf -state disabled
8765    $ctext tag remove found 1.0 end
8766    startdiff [list $oldid $newid]
8767}
8768
8769proc mkpatch {} {
8770    global rowmenuid currentid commitinfo patchtop patchnum NS
8771
8772    if {![info exists currentid]} return
8773    set oldid $currentid
8774    set oldhead [lindex $commitinfo($oldid) 0]
8775    set newid $rowmenuid
8776    set newhead [lindex $commitinfo($newid) 0]
8777    set top .patch
8778    set patchtop $top
8779    catch {destroy $top}
8780    ttk_toplevel $top
8781    make_transient $top .
8782    ${NS}::label $top.title -text [mc "Generate patch"]
8783    grid $top.title - -pady 10
8784    ${NS}::label $top.from -text [mc "From:"]
8785    ${NS}::entry $top.fromsha1 -width 40
8786    $top.fromsha1 insert 0 $oldid
8787    $top.fromsha1 conf -state readonly
8788    grid $top.from $top.fromsha1 -sticky w
8789    ${NS}::entry $top.fromhead -width 60
8790    $top.fromhead insert 0 $oldhead
8791    $top.fromhead conf -state readonly
8792    grid x $top.fromhead -sticky w
8793    ${NS}::label $top.to -text [mc "To:"]
8794    ${NS}::entry $top.tosha1 -width 40
8795    $top.tosha1 insert 0 $newid
8796    $top.tosha1 conf -state readonly
8797    grid $top.to $top.tosha1 -sticky w
8798    ${NS}::entry $top.tohead -width 60
8799    $top.tohead insert 0 $newhead
8800    $top.tohead conf -state readonly
8801    grid x $top.tohead -sticky w
8802    ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
8803    grid $top.rev x -pady 10 -padx 5
8804    ${NS}::label $top.flab -text [mc "Output file:"]
8805    ${NS}::entry $top.fname -width 60
8806    $top.fname insert 0 [file normalize "patch$patchnum.patch"]
8807    incr patchnum
8808    grid $top.flab $top.fname -sticky w
8809    ${NS}::frame $top.buts
8810    ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
8811    ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
8812    bind $top <Key-Return> mkpatchgo
8813    bind $top <Key-Escape> mkpatchcan
8814    grid $top.buts.gen $top.buts.can
8815    grid columnconfigure $top.buts 0 -weight 1 -uniform a
8816    grid columnconfigure $top.buts 1 -weight 1 -uniform a
8817    grid $top.buts - -pady 10 -sticky ew
8818    focus $top.fname
8819}
8820
8821proc mkpatchrev {} {
8822    global patchtop
8823
8824    set oldid [$patchtop.fromsha1 get]
8825    set oldhead [$patchtop.fromhead get]
8826    set newid [$patchtop.tosha1 get]
8827    set newhead [$patchtop.tohead get]
8828    foreach e [list fromsha1 fromhead tosha1 tohead] \
8829            v [list $newid $newhead $oldid $oldhead] {
8830        $patchtop.$e conf -state normal
8831        $patchtop.$e delete 0 end
8832        $patchtop.$e insert 0 $v
8833        $patchtop.$e conf -state readonly
8834    }
8835}
8836
8837proc mkpatchgo {} {
8838    global patchtop nullid nullid2
8839
8840    set oldid [$patchtop.fromsha1 get]
8841    set newid [$patchtop.tosha1 get]
8842    set fname [$patchtop.fname get]
8843    set cmd [diffcmd [list $oldid $newid] -p]
8844    # trim off the initial "|"
8845    set cmd [lrange $cmd 1 end]
8846    lappend cmd >$fname &
8847    if {[catch {eval exec $cmd} err]} {
8848        error_popup "[mc "Error creating patch:"] $err" $patchtop
8849    }
8850    catch {destroy $patchtop}
8851    unset patchtop
8852}
8853
8854proc mkpatchcan {} {
8855    global patchtop
8856
8857    catch {destroy $patchtop}
8858    unset patchtop
8859}
8860
8861proc mktag {} {
8862    global rowmenuid mktagtop commitinfo NS
8863
8864    set top .maketag
8865    set mktagtop $top
8866    catch {destroy $top}
8867    ttk_toplevel $top
8868    make_transient $top .
8869    ${NS}::label $top.title -text [mc "Create tag"]
8870    grid $top.title - -pady 10
8871    ${NS}::label $top.id -text [mc "ID:"]
8872    ${NS}::entry $top.sha1 -width 40
8873    $top.sha1 insert 0 $rowmenuid
8874    $top.sha1 conf -state readonly
8875    grid $top.id $top.sha1 -sticky w
8876    ${NS}::entry $top.head -width 60
8877    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8878    $top.head conf -state readonly
8879    grid x $top.head -sticky w
8880    ${NS}::label $top.tlab -text [mc "Tag name:"]
8881    ${NS}::entry $top.tag -width 60
8882    grid $top.tlab $top.tag -sticky w
8883    ${NS}::label $top.op -text [mc "Tag message is optional"]
8884    grid $top.op -columnspan 2 -sticky we
8885    ${NS}::label $top.mlab -text [mc "Tag message:"]
8886    ${NS}::entry $top.msg -width 60
8887    grid $top.mlab $top.msg -sticky w
8888    ${NS}::frame $top.buts
8889    ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
8890    ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
8891    bind $top <Key-Return> mktaggo
8892    bind $top <Key-Escape> mktagcan
8893    grid $top.buts.gen $top.buts.can
8894    grid columnconfigure $top.buts 0 -weight 1 -uniform a
8895    grid columnconfigure $top.buts 1 -weight 1 -uniform a
8896    grid $top.buts - -pady 10 -sticky ew
8897    focus $top.tag
8898}
8899
8900proc domktag {} {
8901    global mktagtop env tagids idtags
8902
8903    set id [$mktagtop.sha1 get]
8904    set tag [$mktagtop.tag get]
8905    set msg [$mktagtop.msg get]
8906    if {$tag == {}} {
8907        error_popup [mc "No tag name specified"] $mktagtop
8908        return 0
8909    }
8910    if {[info exists tagids($tag)]} {
8911        error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
8912        return 0
8913    }
8914    if {[catch {
8915        if {$msg != {}} {
8916            exec git tag -a -m $msg $tag $id
8917        } else {
8918            exec git tag $tag $id
8919        }
8920    } err]} {
8921        error_popup "[mc "Error creating tag:"] $err" $mktagtop
8922        return 0
8923    }
8924
8925    set tagids($tag) $id
8926    lappend idtags($id) $tag
8927    redrawtags $id
8928    addedtag $id
8929    dispneartags 0
8930    run refill_reflist
8931    return 1
8932}
8933
8934proc redrawtags {id} {
8935    global canv linehtag idpos currentid curview cmitlisted markedid
8936    global canvxmax iddrawn circleitem mainheadid circlecolors
8937
8938    if {![commitinview $id $curview]} return
8939    if {![info exists iddrawn($id)]} return
8940    set row [rowofcommit $id]
8941    if {$id eq $mainheadid} {
8942        set ofill yellow
8943    } else {
8944        set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
8945    }
8946    $canv itemconf $circleitem($row) -fill $ofill
8947    $canv delete tag.$id
8948    set xt [eval drawtags $id $idpos($id)]
8949    $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
8950    set text [$canv itemcget $linehtag($id) -text]
8951    set font [$canv itemcget $linehtag($id) -font]
8952    set xr [expr {$xt + [font measure $font $text]}]
8953    if {$xr > $canvxmax} {
8954        set canvxmax $xr
8955        setcanvscroll
8956    }
8957    if {[info exists currentid] && $currentid == $id} {
8958        make_secsel $id
8959    }
8960    if {[info exists markedid] && $markedid eq $id} {
8961        make_idmark $id
8962    }
8963}
8964
8965proc mktagcan {} {
8966    global mktagtop
8967
8968    catch {destroy $mktagtop}
8969    unset mktagtop
8970}
8971
8972proc mktaggo {} {
8973    if {![domktag]} return
8974    mktagcan
8975}
8976
8977proc writecommit {} {
8978    global rowmenuid wrcomtop commitinfo wrcomcmd NS
8979
8980    set top .writecommit
8981    set wrcomtop $top
8982    catch {destroy $top}
8983    ttk_toplevel $top
8984    make_transient $top .
8985    ${NS}::label $top.title -text [mc "Write commit to file"]
8986    grid $top.title - -pady 10
8987    ${NS}::label $top.id -text [mc "ID:"]
8988    ${NS}::entry $top.sha1 -width 40
8989    $top.sha1 insert 0 $rowmenuid
8990    $top.sha1 conf -state readonly
8991    grid $top.id $top.sha1 -sticky w
8992    ${NS}::entry $top.head -width 60
8993    $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8994    $top.head conf -state readonly
8995    grid x $top.head -sticky w
8996    ${NS}::label $top.clab -text [mc "Command:"]
8997    ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
8998    grid $top.clab $top.cmd -sticky w -pady 10
8999    ${NS}::label $top.flab -text [mc "Output file:"]
9000    ${NS}::entry $top.fname -width 60
9001    $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
9002    grid $top.flab $top.fname -sticky w
9003    ${NS}::frame $top.buts
9004    ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
9005    ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
9006    bind $top <Key-Return> wrcomgo
9007    bind $top <Key-Escape> wrcomcan
9008    grid $top.buts.gen $top.buts.can
9009    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9010    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9011    grid $top.buts - -pady 10 -sticky ew
9012    focus $top.fname
9013}
9014
9015proc wrcomgo {} {
9016    global wrcomtop
9017
9018    set id [$wrcomtop.sha1 get]
9019    set cmd "echo $id | [$wrcomtop.cmd get]"
9020    set fname [$wrcomtop.fname get]
9021    if {[catch {exec sh -c $cmd >$fname &} err]} {
9022        error_popup "[mc "Error writing commit:"] $err" $wrcomtop
9023    }
9024    catch {destroy $wrcomtop}
9025    unset wrcomtop
9026}
9027
9028proc wrcomcan {} {
9029    global wrcomtop
9030
9031    catch {destroy $wrcomtop}
9032    unset wrcomtop
9033}
9034
9035proc mkbranch {} {
9036    global rowmenuid mkbrtop NS
9037
9038    set top .makebranch
9039    catch {destroy $top}
9040    ttk_toplevel $top
9041    make_transient $top .
9042    ${NS}::label $top.title -text [mc "Create new branch"]
9043    grid $top.title - -pady 10
9044    ${NS}::label $top.id -text [mc "ID:"]
9045    ${NS}::entry $top.sha1 -width 40
9046    $top.sha1 insert 0 $rowmenuid
9047    $top.sha1 conf -state readonly
9048    grid $top.id $top.sha1 -sticky w
9049    ${NS}::label $top.nlab -text [mc "Name:"]
9050    ${NS}::entry $top.name -width 40
9051    grid $top.nlab $top.name -sticky w
9052    ${NS}::frame $top.buts
9053    ${NS}::button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
9054    ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
9055    bind $top <Key-Return> [list mkbrgo $top]
9056    bind $top <Key-Escape> "catch {destroy $top}"
9057    grid $top.buts.go $top.buts.can
9058    grid columnconfigure $top.buts 0 -weight 1 -uniform a
9059    grid columnconfigure $top.buts 1 -weight 1 -uniform a
9060    grid $top.buts - -pady 10 -sticky ew
9061    focus $top.name
9062}
9063
9064proc mkbrgo {top} {
9065    global headids idheads
9066
9067    set name [$top.name get]
9068    set id [$top.sha1 get]
9069    set cmdargs {}
9070    set old_id {}
9071    if {$name eq {}} {
9072        error_popup [mc "Please specify a name for the new branch"] $top
9073        return
9074    }
9075    if {[info exists headids($name)]} {
9076        if {![confirm_popup [mc \
9077                "Branch '%s' already exists. Overwrite?" $name] $top]} {
9078            return
9079        }
9080        set old_id $headids($name)
9081        lappend cmdargs -f
9082    }
9083    catch {destroy $top}
9084    lappend cmdargs $name $id
9085    nowbusy newbranch
9086    update
9087    if {[catch {
9088        eval exec git branch $cmdargs
9089    } err]} {
9090        notbusy newbranch
9091        error_popup $err
9092    } else {
9093        notbusy newbranch
9094        if {$old_id ne {}} {
9095            movehead $id $name
9096            movedhead $id $name
9097            redrawtags $old_id
9098            redrawtags $id
9099        } else {
9100            set headids($name) $id
9101            lappend idheads($id) $name
9102            addedhead $id $name
9103            redrawtags $id
9104        }
9105        dispneartags 0
9106        run refill_reflist
9107    }
9108}
9109
9110proc exec_citool {tool_args {baseid {}}} {
9111    global commitinfo env
9112
9113    set save_env [array get env GIT_AUTHOR_*]
9114
9115    if {$baseid ne {}} {
9116        if {![info exists commitinfo($baseid)]} {
9117            getcommit $baseid
9118        }
9119        set author [lindex $commitinfo($baseid) 1]
9120        set date [lindex $commitinfo($baseid) 2]
9121        if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9122                    $author author name email]
9123            && $date ne {}} {
9124            set env(GIT_AUTHOR_NAME) $name
9125            set env(GIT_AUTHOR_EMAIL) $email
9126            set env(GIT_AUTHOR_DATE) $date
9127        }
9128    }
9129
9130    eval exec git citool $tool_args &
9131
9132    array unset env GIT_AUTHOR_*
9133    array set env $save_env
9134}
9135
9136proc cherrypick {} {
9137    global rowmenuid curview
9138    global mainhead mainheadid
9139    global gitdir
9140
9141    set oldhead [exec git rev-parse HEAD]
9142    set dheads [descheads $rowmenuid]
9143    if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
9144        set ok [confirm_popup [mc "Commit %s is already\
9145                included in branch %s -- really re-apply it?" \
9146                                   [string range $rowmenuid 0 7] $mainhead]]
9147        if {!$ok} return
9148    }
9149    nowbusy cherrypick [mc "Cherry-picking"]
9150    update
9151    # Unfortunately git-cherry-pick writes stuff to stderr even when
9152    # no error occurs, and exec takes that as an indication of error...
9153    if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9154        notbusy cherrypick
9155        if {[regexp -line \
9156                 {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9157                 $err msg fname]} {
9158            error_popup [mc "Cherry-pick failed because of local changes\
9159                        to file '%s'.\nPlease commit, reset or stash\
9160                        your changes and try again." $fname]
9161        } elseif {[regexp -line \
9162                       {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
9163                       $err]} {
9164            if {[confirm_popup [mc "Cherry-pick failed because of merge\
9165                        conflict.\nDo you wish to run git citool to\
9166                        resolve it?"]]} {
9167                # Force citool to read MERGE_MSG
9168                file delete [file join $gitdir "GITGUI_MSG"]
9169                exec_citool {} $rowmenuid
9170            }
9171        } else {
9172            error_popup $err
9173        }
9174        run updatecommits
9175        return
9176    }
9177    set newhead [exec git rev-parse HEAD]
9178    if {$newhead eq $oldhead} {
9179        notbusy cherrypick
9180        error_popup [mc "No changes committed"]
9181        return
9182    }
9183    addnewchild $newhead $oldhead
9184    if {[commitinview $oldhead $curview]} {
9185        # XXX this isn't right if we have a path limit...
9186        insertrow $newhead $oldhead $curview
9187        if {$mainhead ne {}} {
9188            movehead $newhead $mainhead
9189            movedhead $newhead $mainhead
9190        }
9191        set mainheadid $newhead
9192        redrawtags $oldhead
9193        redrawtags $newhead
9194        selbyid $newhead
9195    }
9196    notbusy cherrypick
9197}
9198
9199proc resethead {} {
9200    global mainhead rowmenuid confirm_ok resettype NS
9201
9202    set confirm_ok 0
9203    set w ".confirmreset"
9204    ttk_toplevel $w
9205    make_transient $w .
9206    wm title $w [mc "Confirm reset"]
9207    ${NS}::label $w.m -text \
9208        [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
9209    pack $w.m -side top -fill x -padx 20 -pady 20
9210    ${NS}::labelframe $w.f -text [mc "Reset type:"]
9211    set resettype mixed
9212    ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
9213        -text [mc "Soft: Leave working tree and index untouched"]
9214    grid $w.f.soft -sticky w
9215    ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
9216        -text [mc "Mixed: Leave working tree untouched, reset index"]
9217    grid $w.f.mixed -sticky w
9218    ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
9219        -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
9220    grid $w.f.hard -sticky w
9221    pack $w.f -side top -fill x -padx 4
9222    ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
9223    pack $w.ok -side left -fill x -padx 20 -pady 20
9224    ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
9225    bind $w <Key-Escape> [list destroy $w]
9226    pack $w.cancel -side right -fill x -padx 20 -pady 20
9227    bind $w <Visibility> "grab $w; focus $w"
9228    tkwait window $w
9229    if {!$confirm_ok} return
9230    if {[catch {set fd [open \
9231            [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
9232        error_popup $err
9233    } else {
9234        dohidelocalchanges
9235        filerun $fd [list readresetstat $fd]
9236        nowbusy reset [mc "Resetting"]
9237        selbyid $rowmenuid
9238    }
9239}
9240
9241proc readresetstat {fd} {
9242    global mainhead mainheadid showlocalchanges rprogcoord
9243
9244    if {[gets $fd line] >= 0} {
9245        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9246            set rprogcoord [expr {1.0 * $m / $n}]
9247            adjustprogress
9248        }
9249        return 1
9250    }
9251    set rprogcoord 0
9252    adjustprogress
9253    notbusy reset
9254    if {[catch {close $fd} err]} {
9255        error_popup $err
9256    }
9257    set oldhead $mainheadid
9258    set newhead [exec git rev-parse HEAD]
9259    if {$newhead ne $oldhead} {
9260        movehead $newhead $mainhead
9261        movedhead $newhead $mainhead
9262        set mainheadid $newhead
9263        redrawtags $oldhead
9264        redrawtags $newhead
9265    }
9266    if {$showlocalchanges} {
9267        doshowlocalchanges
9268    }
9269    return 0
9270}
9271
9272# context menu for a head
9273proc headmenu {x y id head} {
9274    global headmenuid headmenuhead headctxmenu mainhead
9275
9276    stopfinding
9277    set headmenuid $id
9278    set headmenuhead $head
9279    set state normal
9280    if {[string match "remotes/*" $head]} {
9281        set state disabled
9282    }
9283    if {$head eq $mainhead} {
9284        set state disabled
9285    }
9286    $headctxmenu entryconfigure 0 -state $state
9287    $headctxmenu entryconfigure 1 -state $state
9288    tk_popup $headctxmenu $x $y
9289}
9290
9291proc cobranch {} {
9292    global headmenuid headmenuhead headids
9293    global showlocalchanges
9294
9295    # check the tree is clean first??
9296    nowbusy checkout [mc "Checking out"]
9297    update
9298    dohidelocalchanges
9299    if {[catch {
9300        set fd [open [list | git checkout $headmenuhead 2>@1] r]
9301    } err]} {
9302        notbusy checkout
9303        error_popup $err
9304        if {$showlocalchanges} {
9305            dodiffindex
9306        }
9307    } else {
9308        filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
9309    }
9310}
9311
9312proc readcheckoutstat {fd newhead newheadid} {
9313    global mainhead mainheadid headids showlocalchanges progresscoords
9314    global viewmainheadid curview
9315
9316    if {[gets $fd line] >= 0} {
9317        if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9318            set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9319            adjustprogress
9320        }
9321        return 1
9322    }
9323    set progresscoords {0 0}
9324    adjustprogress
9325    notbusy checkout
9326    if {[catch {close $fd} err]} {
9327        error_popup $err
9328    }
9329    set oldmainid $mainheadid
9330    set mainhead $newhead
9331    set mainheadid $newheadid
9332    set viewmainheadid($curview) $newheadid
9333    redrawtags $oldmainid
9334    redrawtags $newheadid
9335    selbyid $newheadid
9336    if {$showlocalchanges} {
9337        dodiffindex
9338    }
9339}
9340
9341proc rmbranch {} {
9342    global headmenuid headmenuhead mainhead
9343    global idheads
9344
9345    set head $headmenuhead
9346    set id $headmenuid
9347    # this check shouldn't be needed any more...
9348    if {$head eq $mainhead} {
9349        error_popup [mc "Cannot delete the currently checked-out branch"]
9350        return
9351    }
9352    set dheads [descheads $id]
9353    if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
9354        # the stuff on this branch isn't on any other branch
9355        if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9356                        branch.\nReally delete branch %s?" $head $head]]} return
9357    }
9358    nowbusy rmbranch
9359    update
9360    if {[catch {exec git branch -D $head} err]} {
9361        notbusy rmbranch
9362        error_popup $err
9363        return
9364    }
9365    removehead $id $head
9366    removedhead $id $head
9367    redrawtags $id
9368    notbusy rmbranch
9369    dispneartags 0
9370    run refill_reflist
9371}
9372
9373# Display a list of tags and heads
9374proc showrefs {} {
9375    global showrefstop bgcolor fgcolor selectbgcolor NS
9376    global bglist fglist reflistfilter reflist maincursor
9377
9378    set top .showrefs
9379    set showrefstop $top
9380    if {[winfo exists $top]} {
9381        raise $top
9382        refill_reflist
9383        return
9384    }
9385    ttk_toplevel $top
9386    wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
9387    make_transient $top .
9388    text $top.list -background $bgcolor -foreground $fgcolor \
9389        -selectbackground $selectbgcolor -font mainfont \
9390        -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
9391        -width 30 -height 20 -cursor $maincursor \
9392        -spacing1 1 -spacing3 1 -state disabled
9393    $top.list tag configure highlight -background $selectbgcolor
9394    lappend bglist $top.list
9395    lappend fglist $top.list
9396    ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
9397    ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
9398    grid $top.list $top.ysb -sticky nsew
9399    grid $top.xsb x -sticky ew
9400    ${NS}::frame $top.f
9401    ${NS}::label $top.f.l -text "[mc "Filter"]: "
9402    ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
9403    set reflistfilter "*"
9404    trace add variable reflistfilter write reflistfilter_change
9405    pack $top.f.e -side right -fill x -expand 1
9406    pack $top.f.l -side left
9407    grid $top.f - -sticky ew -pady 2
9408    ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
9409    bind $top <Key-Escape> [list destroy $top]
9410    grid $top.close -
9411    grid columnconfigure $top 0 -weight 1
9412    grid rowconfigure $top 0 -weight 1
9413    bind $top.list <1> {break}
9414    bind $top.list <B1-Motion> {break}
9415    bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
9416    set reflist {}
9417    refill_reflist
9418}
9419
9420proc sel_reflist {w x y} {
9421    global showrefstop reflist headids tagids otherrefids
9422
9423    if {![winfo exists $showrefstop]} return
9424    set l [lindex [split [$w index "@$x,$y"] "."] 0]
9425    set ref [lindex $reflist [expr {$l-1}]]
9426    set n [lindex $ref 0]
9427    switch -- [lindex $ref 1] {
9428        "H" {selbyid $headids($n)}
9429        "T" {selbyid $tagids($n)}
9430        "o" {selbyid $otherrefids($n)}
9431    }
9432    $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
9433}
9434
9435proc unsel_reflist {} {
9436    global showrefstop
9437
9438    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9439    $showrefstop.list tag remove highlight 0.0 end
9440}
9441
9442proc reflistfilter_change {n1 n2 op} {
9443    global reflistfilter
9444
9445    after cancel refill_reflist
9446    after 200 refill_reflist
9447}
9448
9449proc refill_reflist {} {
9450    global reflist reflistfilter showrefstop headids tagids otherrefids
9451    global curview
9452
9453    if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9454    set refs {}
9455    foreach n [array names headids] {
9456        if {[string match $reflistfilter $n]} {
9457            if {[commitinview $headids($n) $curview]} {
9458                lappend refs [list $n H]
9459            } else {
9460                interestedin $headids($n) {run refill_reflist}
9461            }
9462        }
9463    }
9464    foreach n [array names tagids] {
9465        if {[string match $reflistfilter $n]} {
9466            if {[commitinview $tagids($n) $curview]} {
9467                lappend refs [list $n T]
9468            } else {
9469                interestedin $tagids($n) {run refill_reflist}
9470            }
9471        }
9472    }
9473    foreach n [array names otherrefids] {
9474        if {[string match $reflistfilter $n]} {
9475            if {[commitinview $otherrefids($n) $curview]} {
9476                lappend refs [list $n o]
9477            } else {
9478                interestedin $otherrefids($n) {run refill_reflist}
9479            }
9480        }
9481    }
9482    set refs [lsort -index 0 $refs]
9483    if {$refs eq $reflist} return
9484
9485    # Update the contents of $showrefstop.list according to the
9486    # differences between $reflist (old) and $refs (new)
9487    $showrefstop.list conf -state normal
9488    $showrefstop.list insert end "\n"
9489    set i 0
9490    set j 0
9491    while {$i < [llength $reflist] || $j < [llength $refs]} {
9492        if {$i < [llength $reflist]} {
9493            if {$j < [llength $refs]} {
9494                set cmp [string compare [lindex $reflist $i 0] \
9495                             [lindex $refs $j 0]]
9496                if {$cmp == 0} {
9497                    set cmp [string compare [lindex $reflist $i 1] \
9498                                 [lindex $refs $j 1]]
9499                }
9500            } else {
9501                set cmp -1
9502            }
9503        } else {
9504            set cmp 1
9505        }
9506        switch -- $cmp {
9507            -1 {
9508                $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
9509                incr i
9510            }
9511            0 {
9512                incr i
9513                incr j
9514            }
9515            1 {
9516                set l [expr {$j + 1}]
9517                $showrefstop.list image create $l.0 -align baseline \
9518                    -image reficon-[lindex $refs $j 1] -padx 2
9519                $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
9520                incr j
9521            }
9522        }
9523    }
9524    set reflist $refs
9525    # delete last newline
9526    $showrefstop.list delete end-2c end-1c
9527    $showrefstop.list conf -state disabled
9528}
9529
9530# Stuff for finding nearby tags
9531proc getallcommits {} {
9532    global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
9533    global idheads idtags idotherrefs allparents tagobjid
9534    global gitdir
9535
9536    if {![info exists allcommits]} {
9537        set nextarc 0
9538        set allcommits 0
9539        set seeds {}
9540        set allcwait 0
9541        set cachedarcs 0
9542        set allccache [file join $gitdir "gitk.cache"]
9543        if {![catch {
9544            set f [open $allccache r]
9545            set allcwait 1
9546            getcache $f
9547        }]} return
9548    }
9549
9550    if {$allcwait} {
9551        return
9552    }
9553    set cmd [list | git rev-list --parents]
9554    set allcupdate [expr {$seeds ne {}}]
9555    if {!$allcupdate} {
9556        set ids "--all"
9557    } else {
9558        set refs [concat [array names idheads] [array names idtags] \
9559                      [array names idotherrefs]]
9560        set ids {}
9561        set tagobjs {}
9562        foreach name [array names tagobjid] {
9563            lappend tagobjs $tagobjid($name)
9564        }
9565        foreach id [lsort -unique $refs] {
9566            if {![info exists allparents($id)] &&
9567                [lsearch -exact $tagobjs $id] < 0} {
9568                lappend ids $id
9569            }
9570        }
9571        if {$ids ne {}} {
9572            foreach id $seeds {
9573                lappend ids "^$id"
9574            }
9575        }
9576    }
9577    if {$ids ne {}} {
9578        set fd [open [concat $cmd $ids] r]
9579        fconfigure $fd -blocking 0
9580        incr allcommits
9581        nowbusy allcommits
9582        filerun $fd [list getallclines $fd]
9583    } else {
9584        dispneartags 0
9585    }
9586}
9587
9588# Since most commits have 1 parent and 1 child, we group strings of
9589# such commits into "arcs" joining branch/merge points (BMPs), which
9590# are commits that either don't have 1 parent or don't have 1 child.
9591#
9592# arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
9593# arcout(id) - outgoing arcs for BMP
9594# arcids(a) - list of IDs on arc including end but not start
9595# arcstart(a) - BMP ID at start of arc
9596# arcend(a) - BMP ID at end of arc
9597# growing(a) - arc a is still growing
9598# arctags(a) - IDs out of arcids (excluding end) that have tags
9599# archeads(a) - IDs out of arcids (excluding end) that have heads
9600# The start of an arc is at the descendent end, so "incoming" means
9601# coming from descendents, and "outgoing" means going towards ancestors.
9602
9603proc getallclines {fd} {
9604    global allparents allchildren idtags idheads nextarc
9605    global arcnos arcids arctags arcout arcend arcstart archeads growing
9606    global seeds allcommits cachedarcs allcupdate
9607
9608    set nid 0
9609    while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
9610        set id [lindex $line 0]
9611        if {[info exists allparents($id)]} {
9612            # seen it already
9613            continue
9614        }
9615        set cachedarcs 0
9616        set olds [lrange $line 1 end]
9617        set allparents($id) $olds
9618        if {![info exists allchildren($id)]} {
9619            set allchildren($id) {}
9620            set arcnos($id) {}
9621            lappend seeds $id
9622        } else {
9623            set a $arcnos($id)
9624            if {[llength $olds] == 1 && [llength $a] == 1} {
9625                lappend arcids($a) $id
9626                if {[info exists idtags($id)]} {
9627                    lappend arctags($a) $id
9628                }
9629                if {[info exists idheads($id)]} {
9630                    lappend archeads($a) $id
9631                }
9632                if {[info exists allparents($olds)]} {
9633                    # seen parent already
9634                    if {![info exists arcout($olds)]} {
9635                        splitarc $olds
9636                    }
9637                    lappend arcids($a) $olds
9638                    set arcend($a) $olds
9639                    unset growing($a)
9640                }
9641                lappend allchildren($olds) $id
9642                lappend arcnos($olds) $a
9643                continue
9644            }
9645        }
9646        foreach a $arcnos($id) {
9647            lappend arcids($a) $id
9648            set arcend($a) $id
9649            unset growing($a)
9650        }
9651
9652        set ao {}
9653        foreach p $olds {
9654            lappend allchildren($p) $id
9655            set a [incr nextarc]
9656            set arcstart($a) $id
9657            set archeads($a) {}
9658            set arctags($a) {}
9659            set archeads($a) {}
9660            set arcids($a) {}
9661            lappend ao $a
9662            set growing($a) 1
9663            if {[info exists allparents($p)]} {
9664                # seen it already, may need to make a new branch
9665                if {![info exists arcout($p)]} {
9666                    splitarc $p
9667                }
9668                lappend arcids($a) $p
9669                set arcend($a) $p
9670                unset growing($a)
9671            }
9672            lappend arcnos($p) $a
9673        }
9674        set arcout($id) $ao
9675    }
9676    if {$nid > 0} {
9677        global cached_dheads cached_dtags cached_atags
9678        catch {unset cached_dheads}
9679        catch {unset cached_dtags}
9680        catch {unset cached_atags}
9681    }
9682    if {![eof $fd]} {
9683        return [expr {$nid >= 1000? 2: 1}]
9684    }
9685    set cacheok 1
9686    if {[catch {
9687        fconfigure $fd -blocking 1
9688        close $fd
9689    } err]} {
9690        # got an error reading the list of commits
9691        # if we were updating, try rereading the whole thing again
9692        if {$allcupdate} {
9693            incr allcommits -1
9694            dropcache $err
9695            return
9696        }
9697        error_popup "[mc "Error reading commit topology information;\
9698                branch and preceding/following tag information\
9699                will be incomplete."]\n($err)"
9700        set cacheok 0
9701    }
9702    if {[incr allcommits -1] == 0} {
9703        notbusy allcommits
9704        if {$cacheok} {
9705            run savecache
9706        }
9707    }
9708    dispneartags 0
9709    return 0
9710}
9711
9712proc recalcarc {a} {
9713    global arctags archeads arcids idtags idheads
9714
9715    set at {}
9716    set ah {}
9717    foreach id [lrange $arcids($a) 0 end-1] {
9718        if {[info exists idtags($id)]} {
9719            lappend at $id
9720        }
9721        if {[info exists idheads($id)]} {
9722            lappend ah $id
9723        }
9724    }
9725    set arctags($a) $at
9726    set archeads($a) $ah
9727}
9728
9729proc splitarc {p} {
9730    global arcnos arcids nextarc arctags archeads idtags idheads
9731    global arcstart arcend arcout allparents growing
9732
9733    set a $arcnos($p)
9734    if {[llength $a] != 1} {
9735        puts "oops splitarc called but [llength $a] arcs already"
9736        return
9737    }
9738    set a [lindex $a 0]
9739    set i [lsearch -exact $arcids($a) $p]
9740    if {$i < 0} {
9741        puts "oops splitarc $p not in arc $a"
9742        return
9743    }
9744    set na [incr nextarc]
9745    if {[info exists arcend($a)]} {
9746        set arcend($na) $arcend($a)
9747    } else {
9748        set l [lindex $allparents([lindex $arcids($a) end]) 0]
9749        set j [lsearch -exact $arcnos($l) $a]
9750        set arcnos($l) [lreplace $arcnos($l) $j $j $na]
9751    }
9752    set tail [lrange $arcids($a) [expr {$i+1}] end]
9753    set arcids($a) [lrange $arcids($a) 0 $i]
9754    set arcend($a) $p
9755    set arcstart($na) $p
9756    set arcout($p) $na
9757    set arcids($na) $tail
9758    if {[info exists growing($a)]} {
9759        set growing($na) 1
9760        unset growing($a)
9761    }
9762
9763    foreach id $tail {
9764        if {[llength $arcnos($id)] == 1} {
9765            set arcnos($id) $na
9766        } else {
9767            set j [lsearch -exact $arcnos($id) $a]
9768            set arcnos($id) [lreplace $arcnos($id) $j $j $na]
9769        }
9770    }
9771
9772    # reconstruct tags and heads lists
9773    if {$arctags($a) ne {} || $archeads($a) ne {}} {
9774        recalcarc $a
9775        recalcarc $na
9776    } else {
9777        set arctags($na) {}
9778        set archeads($na) {}
9779    }
9780}
9781
9782# Update things for a new commit added that is a child of one
9783# existing commit.  Used when cherry-picking.
9784proc addnewchild {id p} {
9785    global allparents allchildren idtags nextarc
9786    global arcnos arcids arctags arcout arcend arcstart archeads growing
9787    global seeds allcommits
9788
9789    if {![info exists allcommits] || ![info exists arcnos($p)]} return
9790    set allparents($id) [list $p]
9791    set allchildren($id) {}
9792    set arcnos($id) {}
9793    lappend seeds $id
9794    lappend allchildren($p) $id
9795    set a [incr nextarc]
9796    set arcstart($a) $id
9797    set archeads($a) {}
9798    set arctags($a) {}
9799    set arcids($a) [list $p]
9800    set arcend($a) $p
9801    if {![info exists arcout($p)]} {
9802        splitarc $p
9803    }
9804    lappend arcnos($p) $a
9805    set arcout($id) [list $a]
9806}
9807
9808# This implements a cache for the topology information.
9809# The cache saves, for each arc, the start and end of the arc,
9810# the ids on the arc, and the outgoing arcs from the end.
9811proc readcache {f} {
9812    global arcnos arcids arcout arcstart arcend arctags archeads nextarc
9813    global idtags idheads allparents cachedarcs possible_seeds seeds growing
9814    global allcwait
9815
9816    set a $nextarc
9817    set lim $cachedarcs
9818    if {$lim - $a > 500} {
9819        set lim [expr {$a + 500}]
9820    }
9821    if {[catch {
9822        if {$a == $lim} {
9823            # finish reading the cache and setting up arctags, etc.
9824            set line [gets $f]
9825            if {$line ne "1"} {error "bad final version"}
9826            close $f
9827            foreach id [array names idtags] {
9828                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9829                    [llength $allparents($id)] == 1} {
9830                    set a [lindex $arcnos($id) 0]
9831                    if {$arctags($a) eq {}} {
9832                        recalcarc $a
9833                    }
9834                }
9835            }
9836            foreach id [array names idheads] {
9837                if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9838                    [llength $allparents($id)] == 1} {
9839                    set a [lindex $arcnos($id) 0]
9840                    if {$archeads($a) eq {}} {
9841                        recalcarc $a
9842                    }
9843                }
9844            }
9845            foreach id [lsort -unique $possible_seeds] {
9846                if {$arcnos($id) eq {}} {
9847                    lappend seeds $id
9848                }
9849            }
9850            set allcwait 0
9851        } else {
9852            while {[incr a] <= $lim} {
9853                set line [gets $f]
9854                if {[llength $line] != 3} {error "bad line"}
9855                set s [lindex $line 0]
9856                set arcstart($a) $s
9857                lappend arcout($s) $a
9858                if {![info exists arcnos($s)]} {
9859                    lappend possible_seeds $s
9860                    set arcnos($s) {}
9861                }
9862                set e [lindex $line 1]
9863                if {$e eq {}} {
9864                    set growing($a) 1
9865                } else {
9866                    set arcend($a) $e
9867                    if {![info exists arcout($e)]} {
9868                        set arcout($e) {}
9869                    }
9870                }
9871                set arcids($a) [lindex $line 2]
9872                foreach id $arcids($a) {
9873                    lappend allparents($s) $id
9874                    set s $id
9875                    lappend arcnos($id) $a
9876                }
9877                if {![info exists allparents($s)]} {
9878                    set allparents($s) {}
9879                }
9880                set arctags($a) {}
9881                set archeads($a) {}
9882            }
9883            set nextarc [expr {$a - 1}]
9884        }
9885    } err]} {
9886        dropcache $err
9887        return 0
9888    }
9889    if {!$allcwait} {
9890        getallcommits
9891    }
9892    return $allcwait
9893}
9894
9895proc getcache {f} {
9896    global nextarc cachedarcs possible_seeds
9897
9898    if {[catch {
9899        set line [gets $f]
9900        if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
9901        # make sure it's an integer
9902        set cachedarcs [expr {int([lindex $line 1])}]
9903        if {$cachedarcs < 0} {error "bad number of arcs"}
9904        set nextarc 0
9905        set possible_seeds {}
9906        run readcache $f
9907    } err]} {
9908        dropcache $err
9909    }
9910    return 0
9911}
9912
9913proc dropcache {err} {
9914    global allcwait nextarc cachedarcs seeds
9915
9916    #puts "dropping cache ($err)"
9917    foreach v {arcnos arcout arcids arcstart arcend growing \
9918                   arctags archeads allparents allchildren} {
9919        global $v
9920        catch {unset $v}
9921    }
9922    set allcwait 0
9923    set nextarc 0
9924    set cachedarcs 0
9925    set seeds {}
9926    getallcommits
9927}
9928
9929proc writecache {f} {
9930    global cachearc cachedarcs allccache
9931    global arcstart arcend arcnos arcids arcout
9932
9933    set a $cachearc
9934    set lim $cachedarcs
9935    if {$lim - $a > 1000} {
9936        set lim [expr {$a + 1000}]
9937    }
9938    if {[catch {
9939        while {[incr a] <= $lim} {
9940            if {[info exists arcend($a)]} {
9941                puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
9942            } else {
9943                puts $f [list $arcstart($a) {} $arcids($a)]
9944            }
9945        }
9946    } err]} {
9947        catch {close $f}
9948        catch {file delete $allccache}
9949        #puts "writing cache failed ($err)"
9950        return 0
9951    }
9952    set cachearc [expr {$a - 1}]
9953    if {$a > $cachedarcs} {
9954        puts $f "1"
9955        close $f
9956        return 0
9957    }
9958    return 1
9959}
9960
9961proc savecache {} {
9962    global nextarc cachedarcs cachearc allccache
9963
9964    if {$nextarc == $cachedarcs} return
9965    set cachearc 0
9966    set cachedarcs $nextarc
9967    catch {
9968        set f [open $allccache w]
9969        puts $f [list 1 $cachedarcs]
9970        run writecache $f
9971    }
9972}
9973
9974# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
9975# or 0 if neither is true.
9976proc anc_or_desc {a b} {
9977    global arcout arcstart arcend arcnos cached_isanc
9978
9979    if {$arcnos($a) eq $arcnos($b)} {
9980        # Both are on the same arc(s); either both are the same BMP,
9981        # or if one is not a BMP, the other is also not a BMP or is
9982        # the BMP at end of the arc (and it only has 1 incoming arc).
9983        # Or both can be BMPs with no incoming arcs.
9984        if {$a eq $b || $arcnos($a) eq {}} {
9985            return 0
9986        }
9987        # assert {[llength $arcnos($a)] == 1}
9988        set arc [lindex $arcnos($a) 0]
9989        set i [lsearch -exact $arcids($arc) $a]
9990        set j [lsearch -exact $arcids($arc) $b]
9991        if {$i < 0 || $i > $j} {
9992            return 1
9993        } else {
9994            return -1
9995        }
9996    }
9997
9998    if {![info exists arcout($a)]} {
9999        set arc [lindex $arcnos($a) 0]
10000        if {[info exists arcend($arc)]} {
10001            set aend $arcend($arc)
10002        } else {
10003            set aend {}
10004        }
10005        set a $arcstart($arc)
10006    } else {
10007        set aend $a
10008    }
10009    if {![info exists arcout($b)]} {
10010        set arc [lindex $arcnos($b) 0]
10011        if {[info exists arcend($arc)]} {
10012            set bend $arcend($arc)
10013        } else {
10014            set bend {}
10015        }
10016        set b $arcstart($arc)
10017    } else {
10018        set bend $b
10019    }
10020    if {$a eq $bend} {
10021        return 1
10022    }
10023    if {$b eq $aend} {
10024        return -1
10025    }
10026    if {[info exists cached_isanc($a,$bend)]} {
10027        if {$cached_isanc($a,$bend)} {
10028            return 1
10029        }
10030    }
10031    if {[info exists cached_isanc($b,$aend)]} {
10032        if {$cached_isanc($b,$aend)} {
10033            return -1
10034        }
10035        if {[info exists cached_isanc($a,$bend)]} {
10036            return 0
10037        }
10038    }
10039
10040    set todo [list $a $b]
10041    set anc($a) a
10042    set anc($b) b
10043    for {set i 0} {$i < [llength $todo]} {incr i} {
10044        set x [lindex $todo $i]
10045        if {$anc($x) eq {}} {
10046            continue
10047        }
10048        foreach arc $arcnos($x) {
10049            set xd $arcstart($arc)
10050            if {$xd eq $bend} {
10051                set cached_isanc($a,$bend) 1
10052                set cached_isanc($b,$aend) 0
10053                return 1
10054            } elseif {$xd eq $aend} {
10055                set cached_isanc($b,$aend) 1
10056                set cached_isanc($a,$bend) 0
10057                return -1
10058            }
10059            if {![info exists anc($xd)]} {
10060                set anc($xd) $anc($x)
10061                lappend todo $xd
10062            } elseif {$anc($xd) ne $anc($x)} {
10063                set anc($xd) {}
10064            }
10065        }
10066    }
10067    set cached_isanc($a,$bend) 0
10068    set cached_isanc($b,$aend) 0
10069    return 0
10070}
10071
10072# This identifies whether $desc has an ancestor that is
10073# a growing tip of the graph and which is not an ancestor of $anc
10074# and returns 0 if so and 1 if not.
10075# If we subsequently discover a tag on such a growing tip, and that
10076# turns out to be a descendent of $anc (which it could, since we
10077# don't necessarily see children before parents), then $desc
10078# isn't a good choice to display as a descendent tag of
10079# $anc (since it is the descendent of another tag which is
10080# a descendent of $anc).  Similarly, $anc isn't a good choice to
10081# display as a ancestor tag of $desc.
10082#
10083proc is_certain {desc anc} {
10084    global arcnos arcout arcstart arcend growing problems
10085
10086    set certain {}
10087    if {[llength $arcnos($anc)] == 1} {
10088        # tags on the same arc are certain
10089        if {$arcnos($desc) eq $arcnos($anc)} {
10090            return 1
10091        }
10092        if {![info exists arcout($anc)]} {
10093            # if $anc is partway along an arc, use the start of the arc instead
10094            set a [lindex $arcnos($anc) 0]
10095            set anc $arcstart($a)
10096        }
10097    }
10098    if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
10099        set x $desc
10100    } else {
10101        set a [lindex $arcnos($desc) 0]
10102        set x $arcend($a)
10103    }
10104    if {$x == $anc} {
10105        return 1
10106    }
10107    set anclist [list $x]
10108    set dl($x) 1
10109    set nnh 1
10110    set ngrowanc 0
10111    for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
10112        set x [lindex $anclist $i]
10113        if {$dl($x)} {
10114            incr nnh -1
10115        }
10116        set done($x) 1
10117        foreach a $arcout($x) {
10118            if {[info exists growing($a)]} {
10119                if {![info exists growanc($x)] && $dl($x)} {
10120                    set growanc($x) 1
10121                    incr ngrowanc
10122                }
10123            } else {
10124                set y $arcend($a)
10125                if {[info exists dl($y)]} {
10126                    if {$dl($y)} {
10127                        if {!$dl($x)} {
10128                            set dl($y) 0
10129                            if {![info exists done($y)]} {
10130                                incr nnh -1
10131                            }
10132                            if {[info exists growanc($x)]} {
10133                                incr ngrowanc -1
10134                            }
10135                            set xl [list $y]
10136                            for {set k 0} {$k < [llength $xl]} {incr k} {
10137                                set z [lindex $xl $k]
10138                                foreach c $arcout($z) {
10139                                    if {[info exists arcend($c)]} {
10140                                        set v $arcend($c)
10141                                        if {[info exists dl($v)] && $dl($v)} {
10142                                            set dl($v) 0
10143                                            if {![info exists done($v)]} {
10144                                                incr nnh -1
10145                                            }
10146                                            if {[info exists growanc($v)]} {
10147                                                incr ngrowanc -1
10148                                            }
10149                                            lappend xl $v
10150                                        }
10151                                    }
10152                                }
10153                            }
10154                        }
10155                    }
10156                } elseif {$y eq $anc || !$dl($x)} {
10157                    set dl($y) 0
10158                    lappend anclist $y
10159                } else {
10160                    set dl($y) 1
10161                    lappend anclist $y
10162                    incr nnh
10163                }
10164            }
10165        }
10166    }
10167    foreach x [array names growanc] {
10168        if {$dl($x)} {
10169            return 0
10170        }
10171        return 0
10172    }
10173    return 1
10174}
10175
10176proc validate_arctags {a} {
10177    global arctags idtags
10178
10179    set i -1
10180    set na $arctags($a)
10181    foreach id $arctags($a) {
10182        incr i
10183        if {![info exists idtags($id)]} {
10184            set na [lreplace $na $i $i]
10185            incr i -1
10186        }
10187    }
10188    set arctags($a) $na
10189}
10190
10191proc validate_archeads {a} {
10192    global archeads idheads
10193
10194    set i -1
10195    set na $archeads($a)
10196    foreach id $archeads($a) {
10197        incr i
10198        if {![info exists idheads($id)]} {
10199            set na [lreplace $na $i $i]
10200            incr i -1
10201        }
10202    }
10203    set archeads($a) $na
10204}
10205
10206# Return the list of IDs that have tags that are descendents of id,
10207# ignoring IDs that are descendents of IDs already reported.
10208proc desctags {id} {
10209    global arcnos arcstart arcids arctags idtags allparents
10210    global growing cached_dtags
10211
10212    if {![info exists allparents($id)]} {
10213        return {}
10214    }
10215    set t1 [clock clicks -milliseconds]
10216    set argid $id
10217    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10218        # part-way along an arc; check that arc first
10219        set a [lindex $arcnos($id) 0]
10220        if {$arctags($a) ne {}} {
10221            validate_arctags $a
10222            set i [lsearch -exact $arcids($a) $id]
10223            set tid {}
10224            foreach t $arctags($a) {
10225                set j [lsearch -exact $arcids($a) $t]
10226                if {$j >= $i} break
10227                set tid $t
10228            }
10229            if {$tid ne {}} {
10230                return $tid
10231            }
10232        }
10233        set id $arcstart($a)
10234        if {[info exists idtags($id)]} {
10235            return $id
10236        }
10237    }
10238    if {[info exists cached_dtags($id)]} {
10239        return $cached_dtags($id)
10240    }
10241
10242    set origid $id
10243    set todo [list $id]
10244    set queued($id) 1
10245    set nc 1
10246    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10247        set id [lindex $todo $i]
10248        set done($id) 1
10249        set ta [info exists hastaggedancestor($id)]
10250        if {!$ta} {
10251            incr nc -1
10252        }
10253        # ignore tags on starting node
10254        if {!$ta && $i > 0} {
10255            if {[info exists idtags($id)]} {
10256                set tagloc($id) $id
10257                set ta 1
10258            } elseif {[info exists cached_dtags($id)]} {
10259                set tagloc($id) $cached_dtags($id)
10260                set ta 1
10261            }
10262        }
10263        foreach a $arcnos($id) {
10264            set d $arcstart($a)
10265            if {!$ta && $arctags($a) ne {}} {
10266                validate_arctags $a
10267                if {$arctags($a) ne {}} {
10268                    lappend tagloc($id) [lindex $arctags($a) end]
10269                }
10270            }
10271            if {$ta || $arctags($a) ne {}} {
10272                set tomark [list $d]
10273                for {set j 0} {$j < [llength $tomark]} {incr j} {
10274                    set dd [lindex $tomark $j]
10275                    if {![info exists hastaggedancestor($dd)]} {
10276                        if {[info exists done($dd)]} {
10277                            foreach b $arcnos($dd) {
10278                                lappend tomark $arcstart($b)
10279                            }
10280                            if {[info exists tagloc($dd)]} {
10281                                unset tagloc($dd)
10282                            }
10283                        } elseif {[info exists queued($dd)]} {
10284                            incr nc -1
10285                        }
10286                        set hastaggedancestor($dd) 1
10287                    }
10288                }
10289            }
10290            if {![info exists queued($d)]} {
10291                lappend todo $d
10292                set queued($d) 1
10293                if {![info exists hastaggedancestor($d)]} {
10294                    incr nc
10295                }
10296            }
10297        }
10298    }
10299    set tags {}
10300    foreach id [array names tagloc] {
10301        if {![info exists hastaggedancestor($id)]} {
10302            foreach t $tagloc($id) {
10303                if {[lsearch -exact $tags $t] < 0} {
10304                    lappend tags $t
10305                }
10306            }
10307        }
10308    }
10309    set t2 [clock clicks -milliseconds]
10310    set loopix $i
10311
10312    # remove tags that are descendents of other tags
10313    for {set i 0} {$i < [llength $tags]} {incr i} {
10314        set a [lindex $tags $i]
10315        for {set j 0} {$j < $i} {incr j} {
10316            set b [lindex $tags $j]
10317            set r [anc_or_desc $a $b]
10318            if {$r == 1} {
10319                set tags [lreplace $tags $j $j]
10320                incr j -1
10321                incr i -1
10322            } elseif {$r == -1} {
10323                set tags [lreplace $tags $i $i]
10324                incr i -1
10325                break
10326            }
10327        }
10328    }
10329
10330    if {[array names growing] ne {}} {
10331        # graph isn't finished, need to check if any tag could get
10332        # eclipsed by another tag coming later.  Simply ignore any
10333        # tags that could later get eclipsed.
10334        set ctags {}
10335        foreach t $tags {
10336            if {[is_certain $t $origid]} {
10337                lappend ctags $t
10338            }
10339        }
10340        if {$tags eq $ctags} {
10341            set cached_dtags($origid) $tags
10342        } else {
10343            set tags $ctags
10344        }
10345    } else {
10346        set cached_dtags($origid) $tags
10347    }
10348    set t3 [clock clicks -milliseconds]
10349    if {0 && $t3 - $t1 >= 100} {
10350        puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10351            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10352    }
10353    return $tags
10354}
10355
10356proc anctags {id} {
10357    global arcnos arcids arcout arcend arctags idtags allparents
10358    global growing cached_atags
10359
10360    if {![info exists allparents($id)]} {
10361        return {}
10362    }
10363    set t1 [clock clicks -milliseconds]
10364    set argid $id
10365    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10366        # part-way along an arc; check that arc first
10367        set a [lindex $arcnos($id) 0]
10368        if {$arctags($a) ne {}} {
10369            validate_arctags $a
10370            set i [lsearch -exact $arcids($a) $id]
10371            foreach t $arctags($a) {
10372                set j [lsearch -exact $arcids($a) $t]
10373                if {$j > $i} {
10374                    return $t
10375                }
10376            }
10377        }
10378        if {![info exists arcend($a)]} {
10379            return {}
10380        }
10381        set id $arcend($a)
10382        if {[info exists idtags($id)]} {
10383            return $id
10384        }
10385    }
10386    if {[info exists cached_atags($id)]} {
10387        return $cached_atags($id)
10388    }
10389
10390    set origid $id
10391    set todo [list $id]
10392    set queued($id) 1
10393    set taglist {}
10394    set nc 1
10395    for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10396        set id [lindex $todo $i]
10397        set done($id) 1
10398        set td [info exists hastaggeddescendent($id)]
10399        if {!$td} {
10400            incr nc -1
10401        }
10402        # ignore tags on starting node
10403        if {!$td && $i > 0} {
10404            if {[info exists idtags($id)]} {
10405                set tagloc($id) $id
10406                set td 1
10407            } elseif {[info exists cached_atags($id)]} {
10408                set tagloc($id) $cached_atags($id)
10409                set td 1
10410            }
10411        }
10412        foreach a $arcout($id) {
10413            if {!$td && $arctags($a) ne {}} {
10414                validate_arctags $a
10415                if {$arctags($a) ne {}} {
10416                    lappend tagloc($id) [lindex $arctags($a) 0]
10417                }
10418            }
10419            if {![info exists arcend($a)]} continue
10420            set d $arcend($a)
10421            if {$td || $arctags($a) ne {}} {
10422                set tomark [list $d]
10423                for {set j 0} {$j < [llength $tomark]} {incr j} {
10424                    set dd [lindex $tomark $j]
10425                    if {![info exists hastaggeddescendent($dd)]} {
10426                        if {[info exists done($dd)]} {
10427                            foreach b $arcout($dd) {
10428                                if {[info exists arcend($b)]} {
10429                                    lappend tomark $arcend($b)
10430                                }
10431                            }
10432                            if {[info exists tagloc($dd)]} {
10433                                unset tagloc($dd)
10434                            }
10435                        } elseif {[info exists queued($dd)]} {
10436                            incr nc -1
10437                        }
10438                        set hastaggeddescendent($dd) 1
10439                    }
10440                }
10441            }
10442            if {![info exists queued($d)]} {
10443                lappend todo $d
10444                set queued($d) 1
10445                if {![info exists hastaggeddescendent($d)]} {
10446                    incr nc
10447                }
10448            }
10449        }
10450    }
10451    set t2 [clock clicks -milliseconds]
10452    set loopix $i
10453    set tags {}
10454    foreach id [array names tagloc] {
10455        if {![info exists hastaggeddescendent($id)]} {
10456            foreach t $tagloc($id) {
10457                if {[lsearch -exact $tags $t] < 0} {
10458                    lappend tags $t
10459                }
10460            }
10461        }
10462    }
10463
10464    # remove tags that are ancestors of other tags
10465    for {set i 0} {$i < [llength $tags]} {incr i} {
10466        set a [lindex $tags $i]
10467        for {set j 0} {$j < $i} {incr j} {
10468            set b [lindex $tags $j]
10469            set r [anc_or_desc $a $b]
10470            if {$r == -1} {
10471                set tags [lreplace $tags $j $j]
10472                incr j -1
10473                incr i -1
10474            } elseif {$r == 1} {
10475                set tags [lreplace $tags $i $i]
10476                incr i -1
10477                break
10478            }
10479        }
10480    }
10481
10482    if {[array names growing] ne {}} {
10483        # graph isn't finished, need to check if any tag could get
10484        # eclipsed by another tag coming later.  Simply ignore any
10485        # tags that could later get eclipsed.
10486        set ctags {}
10487        foreach t $tags {
10488            if {[is_certain $origid $t]} {
10489                lappend ctags $t
10490            }
10491        }
10492        if {$tags eq $ctags} {
10493            set cached_atags($origid) $tags
10494        } else {
10495            set tags $ctags
10496        }
10497    } else {
10498        set cached_atags($origid) $tags
10499    }
10500    set t3 [clock clicks -milliseconds]
10501    if {0 && $t3 - $t1 >= 100} {
10502        puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
10503            [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10504    }
10505    return $tags
10506}
10507
10508# Return the list of IDs that have heads that are descendents of id,
10509# including id itself if it has a head.
10510proc descheads {id} {
10511    global arcnos arcstart arcids archeads idheads cached_dheads
10512    global allparents
10513
10514    if {![info exists allparents($id)]} {
10515        return {}
10516    }
10517    set aret {}
10518    if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10519        # part-way along an arc; check it first
10520        set a [lindex $arcnos($id) 0]
10521        if {$archeads($a) ne {}} {
10522            validate_archeads $a
10523            set i [lsearch -exact $arcids($a) $id]
10524            foreach t $archeads($a) {
10525                set j [lsearch -exact $arcids($a) $t]
10526                if {$j > $i} break
10527                lappend aret $t
10528            }
10529        }
10530        set id $arcstart($a)
10531    }
10532    set origid $id
10533    set todo [list $id]
10534    set seen($id) 1
10535    set ret {}
10536    for {set i 0} {$i < [llength $todo]} {incr i} {
10537        set id [lindex $todo $i]
10538        if {[info exists cached_dheads($id)]} {
10539            set ret [concat $ret $cached_dheads($id)]
10540        } else {
10541            if {[info exists idheads($id)]} {
10542                lappend ret $id
10543            }
10544            foreach a $arcnos($id) {
10545                if {$archeads($a) ne {}} {
10546                    validate_archeads $a
10547                    if {$archeads($a) ne {}} {
10548                        set ret [concat $ret $archeads($a)]
10549                    }
10550                }
10551                set d $arcstart($a)
10552                if {![info exists seen($d)]} {
10553                    lappend todo $d
10554                    set seen($d) 1
10555                }
10556            }
10557        }
10558    }
10559    set ret [lsort -unique $ret]
10560    set cached_dheads($origid) $ret
10561    return [concat $ret $aret]
10562}
10563
10564proc addedtag {id} {
10565    global arcnos arcout cached_dtags cached_atags
10566
10567    if {![info exists arcnos($id)]} return
10568    if {![info exists arcout($id)]} {
10569        recalcarc [lindex $arcnos($id) 0]
10570    }
10571    catch {unset cached_dtags}
10572    catch {unset cached_atags}
10573}
10574
10575proc addedhead {hid head} {
10576    global arcnos arcout cached_dheads
10577
10578    if {![info exists arcnos($hid)]} return
10579    if {![info exists arcout($hid)]} {
10580        recalcarc [lindex $arcnos($hid) 0]
10581    }
10582    catch {unset cached_dheads}
10583}
10584
10585proc removedhead {hid head} {
10586    global cached_dheads
10587
10588    catch {unset cached_dheads}
10589}
10590
10591proc movedhead {hid head} {
10592    global arcnos arcout cached_dheads
10593
10594    if {![info exists arcnos($hid)]} return
10595    if {![info exists arcout($hid)]} {
10596        recalcarc [lindex $arcnos($hid) 0]
10597    }
10598    catch {unset cached_dheads}
10599}
10600
10601proc changedrefs {} {
10602    global cached_dheads cached_dtags cached_atags tagcontents
10603    global arctags archeads arcnos arcout idheads idtags
10604
10605    foreach id [concat [array names idheads] [array names idtags]] {
10606        if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
10607            set a [lindex $arcnos($id) 0]
10608            if {![info exists donearc($a)]} {
10609                recalcarc $a
10610                set donearc($a) 1
10611            }
10612        }
10613    }
10614    catch {unset tagcontents}
10615    catch {unset cached_dtags}
10616    catch {unset cached_atags}
10617    catch {unset cached_dheads}
10618}
10619
10620proc rereadrefs {} {
10621    global idtags idheads idotherrefs mainheadid
10622
10623    set refids [concat [array names idtags] \
10624                    [array names idheads] [array names idotherrefs]]
10625    foreach id $refids {
10626        if {![info exists ref($id)]} {
10627            set ref($id) [listrefs $id]
10628        }
10629    }
10630    set oldmainhead $mainheadid
10631    readrefs
10632    changedrefs
10633    set refids [lsort -unique [concat $refids [array names idtags] \
10634                        [array names idheads] [array names idotherrefs]]]
10635    foreach id $refids {
10636        set v [listrefs $id]
10637        if {![info exists ref($id)] || $ref($id) != $v} {
10638            redrawtags $id
10639        }
10640    }
10641    if {$oldmainhead ne $mainheadid} {
10642        redrawtags $oldmainhead
10643        redrawtags $mainheadid
10644    }
10645    run refill_reflist
10646}
10647
10648proc listrefs {id} {
10649    global idtags idheads idotherrefs
10650
10651    set x {}
10652    if {[info exists idtags($id)]} {
10653        set x $idtags($id)
10654    }
10655    set y {}
10656    if {[info exists idheads($id)]} {
10657        set y $idheads($id)
10658    }
10659    set z {}
10660    if {[info exists idotherrefs($id)]} {
10661        set z $idotherrefs($id)
10662    }
10663    return [list $x $y $z]
10664}
10665
10666proc showtag {tag isnew} {
10667    global ctext tagcontents tagids linknum tagobjid
10668
10669    if {$isnew} {
10670        addtohistory [list showtag $tag 0] savectextpos
10671    }
10672    $ctext conf -state normal
10673    clear_ctext
10674    settabs 0
10675    set linknum 0
10676    if {![info exists tagcontents($tag)]} {
10677        catch {
10678           set tagcontents($tag) [exec git cat-file tag $tag]
10679        }
10680    }
10681    if {[info exists tagcontents($tag)]} {
10682        set text $tagcontents($tag)
10683    } else {
10684        set text "[mc "Tag"]: $tag\n[mc "Id"]:  $tagids($tag)"
10685    }
10686    appendwithlinks $text {}
10687    maybe_scroll_ctext 1
10688    $ctext conf -state disabled
10689    init_flist {}
10690}
10691
10692proc doquit {} {
10693    global stopped
10694    global gitktmpdir
10695
10696    set stopped 100
10697    savestuff .
10698    destroy .
10699
10700    if {[info exists gitktmpdir]} {
10701        catch {file delete -force $gitktmpdir}
10702    }
10703}
10704
10705proc mkfontdisp {font top which} {
10706    global fontattr fontpref $font NS use_ttk
10707
10708    set fontpref($font) [set $font]
10709    ${NS}::button $top.${font}but -text $which \
10710        -command [list choosefont $font $which]
10711    ${NS}::label $top.$font -relief flat -font $font \
10712        -text $fontattr($font,family) -justify left
10713    grid x $top.${font}but $top.$font -sticky w
10714}
10715
10716proc choosefont {font which} {
10717    global fontparam fontlist fonttop fontattr
10718    global prefstop NS
10719
10720    set fontparam(which) $which
10721    set fontparam(font) $font
10722    set fontparam(family) [font actual $font -family]
10723    set fontparam(size) $fontattr($font,size)
10724    set fontparam(weight) $fontattr($font,weight)
10725    set fontparam(slant) $fontattr($font,slant)
10726    set top .gitkfont
10727    set fonttop $top
10728    if {![winfo exists $top]} {
10729        font create sample
10730        eval font config sample [font actual $font]
10731        ttk_toplevel $top
10732        make_transient $top $prefstop
10733        wm title $top [mc "Gitk font chooser"]
10734        ${NS}::label $top.l -textvariable fontparam(which)
10735        pack $top.l -side top
10736        set fontlist [lsort [font families]]
10737        ${NS}::frame $top.f
10738        listbox $top.f.fam -listvariable fontlist \
10739            -yscrollcommand [list $top.f.sb set]
10740        bind $top.f.fam <<ListboxSelect>> selfontfam
10741        ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
10742        pack $top.f.sb -side right -fill y
10743        pack $top.f.fam -side left -fill both -expand 1
10744        pack $top.f -side top -fill both -expand 1
10745        ${NS}::frame $top.g
10746        spinbox $top.g.size -from 4 -to 40 -width 4 \
10747            -textvariable fontparam(size) \
10748            -validatecommand {string is integer -strict %s}
10749        checkbutton $top.g.bold -padx 5 \
10750            -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
10751            -variable fontparam(weight) -onvalue bold -offvalue normal
10752        checkbutton $top.g.ital -padx 5 \
10753            -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
10754            -variable fontparam(slant) -onvalue italic -offvalue roman
10755        pack $top.g.size $top.g.bold $top.g.ital -side left
10756        pack $top.g -side top
10757        canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
10758            -background white
10759        $top.c create text 100 25 -anchor center -text $which -font sample \
10760            -fill black -tags text
10761        bind $top.c <Configure> [list centertext $top.c]
10762        pack $top.c -side top -fill x
10763        ${NS}::frame $top.buts
10764        ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
10765        ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
10766        bind $top <Key-Return> fontok
10767        bind $top <Key-Escape> fontcan
10768        grid $top.buts.ok $top.buts.can
10769        grid columnconfigure $top.buts 0 -weight 1 -uniform a
10770        grid columnconfigure $top.buts 1 -weight 1 -uniform a
10771        pack $top.buts -side bottom -fill x
10772        trace add variable fontparam write chg_fontparam
10773    } else {
10774        raise $top
10775        $top.c itemconf text -text $which
10776    }
10777    set i [lsearch -exact $fontlist $fontparam(family)]
10778    if {$i >= 0} {
10779        $top.f.fam selection set $i
10780        $top.f.fam see $i
10781    }
10782}
10783
10784proc centertext {w} {
10785    $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
10786}
10787
10788proc fontok {} {
10789    global fontparam fontpref prefstop
10790
10791    set f $fontparam(font)
10792    set fontpref($f) [list $fontparam(family) $fontparam(size)]
10793    if {$fontparam(weight) eq "bold"} {
10794        lappend fontpref($f) "bold"
10795    }
10796    if {$fontparam(slant) eq "italic"} {
10797        lappend fontpref($f) "italic"
10798    }
10799    set w $prefstop.notebook.fonts.$f
10800    $w conf -text $fontparam(family) -font $fontpref($f)
10801
10802    fontcan
10803}
10804
10805proc fontcan {} {
10806    global fonttop fontparam
10807
10808    if {[info exists fonttop]} {
10809        catch {destroy $fonttop}
10810        catch {font delete sample}
10811        unset fonttop
10812        unset fontparam
10813    }
10814}
10815
10816if {[package vsatisfies [package provide Tk] 8.6]} {
10817    # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
10818    # function to make use of it.
10819    proc choosefont {font which} {
10820        tk fontchooser configure -title $which -font $font \
10821            -command [list on_choosefont $font $which]
10822        tk fontchooser show
10823    }
10824    proc on_choosefont {font which newfont} {
10825        global fontparam
10826        puts stderr "$font $newfont"
10827        array set f [font actual $newfont]
10828        set fontparam(which) $which
10829        set fontparam(font) $font
10830        set fontparam(family) $f(-family)
10831        set fontparam(size) $f(-size)
10832        set fontparam(weight) $f(-weight)
10833        set fontparam(slant) $f(-slant)
10834        fontok
10835    }
10836}
10837
10838proc selfontfam {} {
10839    global fonttop fontparam
10840
10841    set i [$fonttop.f.fam curselection]
10842    if {$i ne {}} {
10843        set fontparam(family) [$fonttop.f.fam get $i]
10844    }
10845}
10846
10847proc chg_fontparam {v sub op} {
10848    global fontparam
10849
10850    font config sample -$sub $fontparam($sub)
10851}
10852
10853# Create a property sheet tab page
10854proc create_prefs_page {w} {
10855    global NS
10856    set parent [join [lrange [split $w .] 0 end-1] .]
10857    if {[winfo class $parent] eq "TNotebook"} {
10858        ${NS}::frame $w
10859    } else {
10860        ${NS}::labelframe $w
10861    }
10862}
10863
10864proc prefspage_general {notebook} {
10865    global NS maxwidth maxgraphpct showneartags showlocalchanges
10866    global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
10867    global hideremotes want_ttk have_ttk
10868
10869    set page [create_prefs_page $notebook.general]
10870
10871    ${NS}::label $page.ldisp -text [mc "Commit list display options"]
10872    grid $page.ldisp - -sticky w -pady 10
10873    ${NS}::label $page.spacer -text " "
10874    ${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
10875    spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
10876    grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w
10877    ${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
10878    spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
10879    grid x $page.maxpctl $page.maxpct -sticky w
10880    ${NS}::checkbutton $page.showlocal -text [mc "Show local changes"] \
10881        -variable showlocalchanges
10882    grid x $page.showlocal -sticky w
10883    ${NS}::checkbutton $page.autoselect -text [mc "Auto-select SHA1 (length)"] \
10884        -variable autoselect
10885    spinbox $page.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
10886    grid x $page.autoselect $page.autosellen -sticky w
10887    ${NS}::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \
10888        -variable hideremotes
10889    grid x $page.hideremotes -sticky w
10890
10891    ${NS}::label $page.ddisp -text [mc "Diff display options"]
10892    grid $page.ddisp - -sticky w -pady 10
10893    ${NS}::label $page.tabstopl -text [mc "Tab spacing"]
10894    spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
10895    grid x $page.tabstopl $page.tabstop -sticky w
10896    ${NS}::checkbutton $page.ntag -text [mc "Display nearby tags"] \
10897        -variable showneartags
10898    grid x $page.ntag -sticky w
10899    ${NS}::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \
10900        -variable limitdiffs
10901    grid x $page.ldiff -sticky w
10902    ${NS}::checkbutton $page.lattr -text [mc "Support per-file encodings"] \
10903        -variable perfile_attrs
10904    grid x $page.lattr -sticky w
10905
10906    ${NS}::entry $page.extdifft -textvariable extdifftool
10907    ${NS}::frame $page.extdifff
10908    ${NS}::label $page.extdifff.l -text [mc "External diff tool" ]
10909    ${NS}::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff
10910    pack $page.extdifff.l $page.extdifff.b -side left
10911    pack configure $page.extdifff.l -padx 10
10912    grid x $page.extdifff $page.extdifft -sticky ew
10913
10914    ${NS}::label $page.lgen -text [mc "General options"]
10915    grid $page.lgen - -sticky w -pady 10
10916    ${NS}::checkbutton $page.want_ttk -variable want_ttk \
10917        -text [mc "Use themed widgets"]
10918    if {$have_ttk} {
10919        ${NS}::label $page.ttk_note -text [mc "(change requires restart)"]
10920    } else {
10921        ${NS}::label $page.ttk_note -text [mc "(currently unavailable)"]
10922    }
10923    grid x $page.want_ttk $page.ttk_note -sticky w
10924    return $page
10925}
10926
10927proc prefspage_colors {notebook} {
10928    global NS uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
10929
10930    set page [create_prefs_page $notebook.colors]
10931
10932    ${NS}::label $page.cdisp -text [mc "Colors: press to choose"]
10933    grid $page.cdisp - -sticky w -pady 10
10934    label $page.ui -padx 40 -relief sunk -background $uicolor
10935    ${NS}::button $page.uibut -text [mc "Interface"] \
10936       -command [list choosecolor uicolor {} $page.ui [mc "interface"] setui]
10937    grid x $page.uibut $page.ui -sticky w
10938    label $page.bg -padx 40 -relief sunk -background $bgcolor
10939    ${NS}::button $page.bgbut -text [mc "Background"] \
10940        -command [list choosecolor bgcolor {} $page.bg [mc "background"] setbg]
10941    grid x $page.bgbut $page.bg -sticky w
10942    label $page.fg -padx 40 -relief sunk -background $fgcolor
10943    ${NS}::button $page.fgbut -text [mc "Foreground"] \
10944        -command [list choosecolor fgcolor {} $page.fg [mc "foreground"] setfg]
10945    grid x $page.fgbut $page.fg -sticky w
10946    label $page.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
10947    ${NS}::button $page.diffoldbut -text [mc "Diff: old lines"] \
10948        -command [list choosecolor diffcolors 0 $page.diffold [mc "diff old lines"] \
10949                      [list $ctext tag conf d0 -foreground]]
10950    grid x $page.diffoldbut $page.diffold -sticky w
10951    label $page.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
10952    ${NS}::button $page.diffnewbut -text [mc "Diff: new lines"] \
10953        -command [list choosecolor diffcolors 1 $page.diffnew [mc "diff new lines"] \
10954                      [list $ctext tag conf dresult -foreground]]
10955    grid x $page.diffnewbut $page.diffnew -sticky w
10956    label $page.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
10957    ${NS}::button $page.hunksepbut -text [mc "Diff: hunk header"] \
10958        -command [list choosecolor diffcolors 2 $page.hunksep \
10959                      [mc "diff hunk header"] \
10960                      [list $ctext tag conf hunksep -foreground]]
10961    grid x $page.hunksepbut $page.hunksep -sticky w
10962    label $page.markbgsep -padx 40 -relief sunk -background $markbgcolor
10963    ${NS}::button $page.markbgbut -text [mc "Marked line bg"] \
10964        -command [list choosecolor markbgcolor {} $page.markbgsep \
10965                      [mc "marked line background"] \
10966                      [list $ctext tag conf omark -background]]
10967    grid x $page.markbgbut $page.markbgsep -sticky w
10968    label $page.selbgsep -padx 40 -relief sunk -background $selectbgcolor
10969    ${NS}::button $page.selbgbut -text [mc "Select bg"] \
10970        -command [list choosecolor selectbgcolor {} $page.selbgsep [mc "background"] setselbg]
10971    grid x $page.selbgbut $page.selbgsep -sticky w
10972    return $page
10973}
10974
10975proc prefspage_fonts {notebook} {
10976    global NS
10977    set page [create_prefs_page $notebook.fonts]
10978    ${NS}::label $page.cfont -text [mc "Fonts: press to choose"]
10979    grid $page.cfont - -sticky w -pady 10
10980    mkfontdisp mainfont $page [mc "Main font"]
10981    mkfontdisp textfont $page [mc "Diff display font"]
10982    mkfontdisp uifont $page [mc "User interface font"]
10983    return $page
10984}
10985
10986proc doprefs {} {
10987    global maxwidth maxgraphpct use_ttk NS
10988    global oldprefs prefstop showneartags showlocalchanges
10989    global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
10990    global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
10991    global hideremotes want_ttk have_ttk
10992
10993    set top .gitkprefs
10994    set prefstop $top
10995    if {[winfo exists $top]} {
10996        raise $top
10997        return
10998    }
10999    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11000                   limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11001        set oldprefs($v) [set $v]
11002    }
11003    ttk_toplevel $top
11004    wm title $top [mc "Gitk preferences"]
11005    make_transient $top .
11006
11007    if {[set use_notebook [expr {$use_ttk && [info command ::ttk::notebook] ne ""}]]} {
11008        set notebook [ttk::notebook $top.notebook]
11009    } else {
11010        set notebook [${NS}::frame $top.notebook -borderwidth 0 -relief flat]
11011    }
11012
11013    lappend pages [prefspage_general $notebook] [mc "General"]
11014    lappend pages [prefspage_colors $notebook] [mc "Colors"]
11015    lappend pages [prefspage_fonts $notebook] [mc "Fonts"]
11016    set col 0
11017    foreach {page title} $pages {
11018        if {$use_notebook} {
11019            $notebook add $page -text $title
11020        } else {
11021            set btn [${NS}::button $notebook.b_[string map {. X} $page] \
11022                         -text $title -command [list raise $page]]
11023            $page configure -text $title
11024            grid $btn -row 0 -column [incr col] -sticky w
11025            grid $page -row 1 -column 0 -sticky news -columnspan 100
11026        }
11027    }
11028
11029    if {!$use_notebook} {
11030        grid columnconfigure $notebook 0 -weight 1
11031        grid rowconfigure $notebook 1 -weight 1
11032        raise [lindex $pages 0]
11033    }
11034
11035    grid $notebook -sticky news -padx 2 -pady 2
11036    grid rowconfigure $top 0 -weight 1
11037    grid columnconfigure $top 0 -weight 1
11038
11039    ${NS}::frame $top.buts
11040    ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
11041    ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
11042    bind $top <Key-Return> prefsok
11043    bind $top <Key-Escape> prefscan
11044    grid $top.buts.ok $top.buts.can
11045    grid columnconfigure $top.buts 0 -weight 1 -uniform a
11046    grid columnconfigure $top.buts 1 -weight 1 -uniform a
11047    grid $top.buts - - -pady 10 -sticky ew
11048    grid columnconfigure $top 2 -weight 1
11049    bind $top <Visibility> [list focus $top.buts.ok]
11050}
11051
11052proc choose_extdiff {} {
11053    global extdifftool
11054
11055    set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
11056    if {$prog ne {}} {
11057        set extdifftool $prog
11058    }
11059}
11060
11061proc choosecolor {v vi w x cmd} {
11062    global $v
11063
11064    set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
11065               -title [mc "Gitk: choose color for %s" $x]]
11066    if {$c eq {}} return
11067    $w conf -background $c
11068    lset $v $vi $c
11069    eval $cmd $c
11070}
11071
11072proc setselbg {c} {
11073    global bglist cflist
11074    foreach w $bglist {
11075        $w configure -selectbackground $c
11076    }
11077    $cflist tag configure highlight \
11078        -background [$cflist cget -selectbackground]
11079    allcanvs itemconf secsel -fill $c
11080}
11081
11082# This sets the background color and the color scheme for the whole UI.
11083# For some reason, tk_setPalette chooses a nasty dark red for selectColor
11084# if we don't specify one ourselves, which makes the checkbuttons and
11085# radiobuttons look bad.  This chooses white for selectColor if the
11086# background color is light, or black if it is dark.
11087proc setui {c} {
11088    if {[tk windowingsystem] eq "win32"} { return }
11089    set bg [winfo rgb . $c]
11090    set selc black
11091    if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
11092        set selc white
11093    }
11094    tk_setPalette background $c selectColor $selc
11095}
11096
11097proc setbg {c} {
11098    global bglist
11099
11100    foreach w $bglist {
11101        $w conf -background $c
11102    }
11103}
11104
11105proc setfg {c} {
11106    global fglist canv
11107
11108    foreach w $fglist {
11109        $w conf -foreground $c
11110    }
11111    allcanvs itemconf text -fill $c
11112    $canv itemconf circle -outline $c
11113    $canv itemconf markid -outline $c
11114}
11115
11116proc prefscan {} {
11117    global oldprefs prefstop
11118
11119    foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11120                   limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11121        global $v
11122        set $v $oldprefs($v)
11123    }
11124    catch {destroy $prefstop}
11125    unset prefstop
11126    fontcan
11127}
11128
11129proc prefsok {} {
11130    global maxwidth maxgraphpct
11131    global oldprefs prefstop showneartags showlocalchanges
11132    global fontpref mainfont textfont uifont
11133    global limitdiffs treediffs perfile_attrs
11134    global hideremotes
11135
11136    catch {destroy $prefstop}
11137    unset prefstop
11138    fontcan
11139    set fontchanged 0
11140    if {$mainfont ne $fontpref(mainfont)} {
11141        set mainfont $fontpref(mainfont)
11142        parsefont mainfont $mainfont
11143        eval font configure mainfont [fontflags mainfont]
11144        eval font configure mainfontbold [fontflags mainfont 1]
11145        setcoords
11146        set fontchanged 1
11147    }
11148    if {$textfont ne $fontpref(textfont)} {
11149        set textfont $fontpref(textfont)
11150        parsefont textfont $textfont
11151        eval font configure textfont [fontflags textfont]
11152        eval font configure textfontbold [fontflags textfont 1]
11153    }
11154    if {$uifont ne $fontpref(uifont)} {
11155        set uifont $fontpref(uifont)
11156        parsefont uifont $uifont
11157        eval font configure uifont [fontflags uifont]
11158    }
11159    settabs
11160    if {$showlocalchanges != $oldprefs(showlocalchanges)} {
11161        if {$showlocalchanges} {
11162            doshowlocalchanges
11163        } else {
11164            dohidelocalchanges
11165        }
11166    }
11167    if {$limitdiffs != $oldprefs(limitdiffs) ||
11168        ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11169        # treediffs elements are limited by path;
11170        # won't have encodings cached if perfile_attrs was just turned on
11171        catch {unset treediffs}
11172    }
11173    if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
11174        || $maxgraphpct != $oldprefs(maxgraphpct)} {
11175        redisplay
11176    } elseif {$showneartags != $oldprefs(showneartags) ||
11177          $limitdiffs != $oldprefs(limitdiffs)} {
11178        reselectline
11179    }
11180    if {$hideremotes != $oldprefs(hideremotes)} {
11181        rereadrefs
11182    }
11183}
11184
11185proc formatdate {d} {
11186    global datetimeformat
11187    if {$d ne {}} {
11188        set d [clock format [lindex $d 0] -format $datetimeformat]
11189    }
11190    return $d
11191}
11192
11193# This list of encoding names and aliases is distilled from
11194# http://www.iana.org/assignments/character-sets.
11195# Not all of them are supported by Tcl.
11196set encoding_aliases {
11197    { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11198      ISO646-US US-ASCII us IBM367 cp367 csASCII }
11199    { ISO-10646-UTF-1 csISO10646UTF1 }
11200    { ISO_646.basic:1983 ref csISO646basic1983 }
11201    { INVARIANT csINVARIANT }
11202    { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11203    { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11204    { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11205    { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11206    { NATS-DANO iso-ir-9-1 csNATSDANO }
11207    { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11208    { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11209    { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11210    { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11211    { ISO-2022-KR csISO2022KR }
11212    { EUC-KR csEUCKR }
11213    { ISO-2022-JP csISO2022JP }
11214    { ISO-2022-JP-2 csISO2022JP2 }
11215    { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11216      csISO13JISC6220jp }
11217    { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11218    { IT iso-ir-15 ISO646-IT csISO15Italian }
11219    { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11220    { ES iso-ir-17 ISO646-ES csISO17Spanish }
11221    { greek7-old iso-ir-18 csISO18Greek7Old }
11222    { latin-greek iso-ir-19 csISO19LatinGreek }
11223    { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11224    { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11225    { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11226    { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11227    { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11228    { BS_viewdata iso-ir-47 csISO47BSViewdata }
11229    { INIS iso-ir-49 csISO49INIS }
11230    { INIS-8 iso-ir-50 csISO50INIS8 }
11231    { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11232    { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11233    { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11234    { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11235    { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11236    { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11237      csISO60Norwegian1 }
11238    { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11239    { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11240    { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11241    { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11242    { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11243    { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11244    { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11245    { greek7 iso-ir-88 csISO88Greek7 }
11246    { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11247    { iso-ir-90 csISO90 }
11248    { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11249    { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11250      csISO92JISC62991984b }
11251    { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11252    { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11253    { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11254      csISO95JIS62291984handadd }
11255    { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11256    { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11257    { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11258    { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11259      CP819 csISOLatin1 }
11260    { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11261    { T.61-7bit iso-ir-102 csISO102T617bit }
11262    { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11263    { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
11264    { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
11265    { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
11266    { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
11267    { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
11268    { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
11269    { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
11270      arabic csISOLatinArabic }
11271    { ISO_8859-6-E csISO88596E ISO-8859-6-E }
11272    { ISO_8859-6-I csISO88596I ISO-8859-6-I }
11273    { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
11274      greek greek8 csISOLatinGreek }
11275    { T.101-G2 iso-ir-128 csISO128T101G2 }
11276    { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
11277      csISOLatinHebrew }
11278    { ISO_8859-8-E csISO88598E ISO-8859-8-E }
11279    { ISO_8859-8-I csISO88598I ISO-8859-8-I }
11280    { CSN_369103 iso-ir-139 csISO139CSN369103 }
11281    { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
11282    { ISO_6937-2-add iso-ir-142 csISOTextComm }
11283    { IEC_P27-1 iso-ir-143 csISO143IECP271 }
11284    { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
11285      csISOLatinCyrillic }
11286    { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
11287    { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
11288    { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
11289    { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
11290    { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
11291    { ISO_6937-2-25 iso-ir-152 csISO6937Add }
11292    { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
11293    { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
11294    { ISO_10367-box iso-ir-155 csISO10367Box }
11295    { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
11296    { latin-lap lap iso-ir-158 csISO158Lap }
11297    { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
11298    { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
11299    { us-dk csUSDK }
11300    { dk-us csDKUS }
11301    { JIS_X0201 X0201 csHalfWidthKatakana }
11302    { KSC5636 ISO646-KR csKSC5636 }
11303    { ISO-10646-UCS-2 csUnicode }
11304    { ISO-10646-UCS-4 csUCS4 }
11305    { DEC-MCS dec csDECMCS }
11306    { hp-roman8 roman8 r8 csHPRoman8 }
11307    { macintosh mac csMacintosh }
11308    { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
11309      csIBM037 }
11310    { IBM038 EBCDIC-INT cp038 csIBM038 }
11311    { IBM273 CP273 csIBM273 }
11312    { IBM274 EBCDIC-BE CP274 csIBM274 }
11313    { IBM275 EBCDIC-BR cp275 csIBM275 }
11314    { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
11315    { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
11316    { IBM280 CP280 ebcdic-cp-it csIBM280 }
11317    { IBM281 EBCDIC-JP-E cp281 csIBM281 }
11318    { IBM284 CP284 ebcdic-cp-es csIBM284 }
11319    { IBM285 CP285 ebcdic-cp-gb csIBM285 }
11320    { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
11321    { IBM297 cp297 ebcdic-cp-fr csIBM297 }
11322    { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
11323    { IBM423 cp423 ebcdic-cp-gr csIBM423 }
11324    { IBM424 cp424 ebcdic-cp-he csIBM424 }
11325    { IBM437 cp437 437 csPC8CodePage437 }
11326    { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
11327    { IBM775 cp775 csPC775Baltic }
11328    { IBM850 cp850 850 csPC850Multilingual }
11329    { IBM851 cp851 851 csIBM851 }
11330    { IBM852 cp852 852 csPCp852 }
11331    { IBM855 cp855 855 csIBM855 }
11332    { IBM857 cp857 857 csIBM857 }
11333    { IBM860 cp860 860 csIBM860 }
11334    { IBM861 cp861 861 cp-is csIBM861 }
11335    { IBM862 cp862 862 csPC862LatinHebrew }
11336    { IBM863 cp863 863 csIBM863 }
11337    { IBM864 cp864 csIBM864 }
11338    { IBM865 cp865 865 csIBM865 }
11339    { IBM866 cp866 866 csIBM866 }
11340    { IBM868 CP868 cp-ar csIBM868 }
11341    { IBM869 cp869 869 cp-gr csIBM869 }
11342    { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
11343    { IBM871 CP871 ebcdic-cp-is csIBM871 }
11344    { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
11345    { IBM891 cp891 csIBM891 }
11346    { IBM903 cp903 csIBM903 }
11347    { IBM904 cp904 904 csIBBM904 }
11348    { IBM905 CP905 ebcdic-cp-tr csIBM905 }
11349    { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
11350    { IBM1026 CP1026 csIBM1026 }
11351    { EBCDIC-AT-DE csIBMEBCDICATDE }
11352    { EBCDIC-AT-DE-A csEBCDICATDEA }
11353    { EBCDIC-CA-FR csEBCDICCAFR }
11354    { EBCDIC-DK-NO csEBCDICDKNO }
11355    { EBCDIC-DK-NO-A csEBCDICDKNOA }
11356    { EBCDIC-FI-SE csEBCDICFISE }
11357    { EBCDIC-FI-SE-A csEBCDICFISEA }
11358    { EBCDIC-FR csEBCDICFR }
11359    { EBCDIC-IT csEBCDICIT }
11360    { EBCDIC-PT csEBCDICPT }
11361    { EBCDIC-ES csEBCDICES }
11362    { EBCDIC-ES-A csEBCDICESA }
11363    { EBCDIC-ES-S csEBCDICESS }
11364    { EBCDIC-UK csEBCDICUK }
11365    { EBCDIC-US csEBCDICUS }
11366    { UNKNOWN-8BIT csUnknown8BiT }
11367    { MNEMONIC csMnemonic }
11368    { MNEM csMnem }
11369    { VISCII csVISCII }
11370    { VIQR csVIQR }
11371    { KOI8-R csKOI8R }
11372    { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
11373    { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
11374    { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
11375    { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
11376    { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
11377    { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
11378    { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
11379    { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
11380    { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
11381    { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
11382    { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
11383    { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
11384    { IBM1047 IBM-1047 }
11385    { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
11386    { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
11387    { UNICODE-1-1 csUnicode11 }
11388    { CESU-8 csCESU-8 }
11389    { BOCU-1 csBOCU-1 }
11390    { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
11391    { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
11392      l8 }
11393    { ISO-8859-15 ISO_8859-15 Latin-9 }
11394    { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
11395    { GBK CP936 MS936 windows-936 }
11396    { JIS_Encoding csJISEncoding }
11397    { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
11398    { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
11399      EUC-JP }
11400    { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
11401    { ISO-10646-UCS-Basic csUnicodeASCII }
11402    { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
11403    { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
11404    { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
11405    { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
11406    { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
11407    { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
11408    { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
11409    { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
11410    { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
11411    { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
11412    { Adobe-Standard-Encoding csAdobeStandardEncoding }
11413    { Ventura-US csVenturaUS }
11414    { Ventura-International csVenturaInternational }
11415    { PC8-Danish-Norwegian csPC8DanishNorwegian }
11416    { PC8-Turkish csPC8Turkish }
11417    { IBM-Symbols csIBMSymbols }
11418    { IBM-Thai csIBMThai }
11419    { HP-Legal csHPLegal }
11420    { HP-Pi-font csHPPiFont }
11421    { HP-Math8 csHPMath8 }
11422    { Adobe-Symbol-Encoding csHPPSMath }
11423    { HP-DeskTop csHPDesktop }
11424    { Ventura-Math csVenturaMath }
11425    { Microsoft-Publishing csMicrosoftPublishing }
11426    { Windows-31J csWindows31J }
11427    { GB2312 csGB2312 }
11428    { Big5 csBig5 }
11429}
11430
11431proc tcl_encoding {enc} {
11432    global encoding_aliases tcl_encoding_cache
11433    if {[info exists tcl_encoding_cache($enc)]} {
11434        return $tcl_encoding_cache($enc)
11435    }
11436    set names [encoding names]
11437    set lcnames [string tolower $names]
11438    set enc [string tolower $enc]
11439    set i [lsearch -exact $lcnames $enc]
11440    if {$i < 0} {
11441        # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
11442        if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
11443            set i [lsearch -exact $lcnames $encx]
11444        }
11445    }
11446    if {$i < 0} {
11447        foreach l $encoding_aliases {
11448            set ll [string tolower $l]
11449            if {[lsearch -exact $ll $enc] < 0} continue
11450            # look through the aliases for one that tcl knows about
11451            foreach e $ll {
11452                set i [lsearch -exact $lcnames $e]
11453                if {$i < 0} {
11454                    if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
11455                        set i [lsearch -exact $lcnames $ex]
11456                    }
11457                }
11458                if {$i >= 0} break
11459            }
11460            break
11461        }
11462    }
11463    set tclenc {}
11464    if {$i >= 0} {
11465        set tclenc [lindex $names $i]
11466    }
11467    set tcl_encoding_cache($enc) $tclenc
11468    return $tclenc
11469}
11470
11471proc gitattr {path attr default} {
11472    global path_attr_cache
11473    if {[info exists path_attr_cache($attr,$path)]} {
11474        set r $path_attr_cache($attr,$path)
11475    } else {
11476        set r "unspecified"
11477        if {![catch {set line [exec git check-attr $attr -- $path]}]} {
11478            regexp "(.*): $attr: (.*)" $line m f r
11479        }
11480        set path_attr_cache($attr,$path) $r
11481    }
11482    if {$r eq "unspecified"} {
11483        return $default
11484    }
11485    return $r
11486}
11487
11488proc cache_gitattr {attr pathlist} {
11489    global path_attr_cache
11490    set newlist {}
11491    foreach path $pathlist {
11492        if {![info exists path_attr_cache($attr,$path)]} {
11493            lappend newlist $path
11494        }
11495    }
11496    set lim 1000
11497    if {[tk windowingsystem] == "win32"} {
11498        # windows has a 32k limit on the arguments to a command...
11499        set lim 30
11500    }
11501    while {$newlist ne {}} {
11502        set head [lrange $newlist 0 [expr {$lim - 1}]]
11503        set newlist [lrange $newlist $lim end]
11504        if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
11505            foreach row [split $rlist "\n"] {
11506                if {[regexp "(.*): $attr: (.*)" $row m path value]} {
11507                    if {[string index $path 0] eq "\""} {
11508                        set path [encoding convertfrom [lindex $path 0]]
11509                    }
11510                    set path_attr_cache($attr,$path) $value
11511                }
11512            }
11513        }
11514    }
11515}
11516
11517proc get_path_encoding {path} {
11518    global gui_encoding perfile_attrs
11519    set tcl_enc $gui_encoding
11520    if {$path ne {} && $perfile_attrs} {
11521        set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
11522        if {$enc2 ne {}} {
11523            set tcl_enc $enc2
11524        }
11525    }
11526    return $tcl_enc
11527}
11528
11529# First check that Tcl/Tk is recent enough
11530if {[catch {package require Tk 8.4} err]} {
11531    show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
11532                     Gitk requires at least Tcl/Tk 8.4." list
11533    exit 1
11534}
11535
11536# defaults...
11537set wrcomcmd "git diff-tree --stdin -p --pretty"
11538
11539set gitencoding {}
11540catch {
11541    set gitencoding [exec git config --get i18n.commitencoding]
11542}
11543catch {
11544    set gitencoding [exec git config --get i18n.logoutputencoding]
11545}
11546if {$gitencoding == ""} {
11547    set gitencoding "utf-8"
11548}
11549set tclencoding [tcl_encoding $gitencoding]
11550if {$tclencoding == {}} {
11551    puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
11552}
11553
11554set gui_encoding [encoding system]
11555catch {
11556    set enc [exec git config --get gui.encoding]
11557    if {$enc ne {}} {
11558        set tclenc [tcl_encoding $enc]
11559        if {$tclenc ne {}} {
11560            set gui_encoding $tclenc
11561        } else {
11562            puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
11563        }
11564    }
11565}
11566
11567set log_showroot true
11568catch {
11569    set log_showroot [exec git config --bool --get log.showroot]
11570}
11571
11572if {[tk windowingsystem] eq "aqua"} {
11573    set mainfont {{Lucida Grande} 9}
11574    set textfont {Monaco 9}
11575    set uifont {{Lucida Grande} 9 bold}
11576} elseif {![catch {::tk::pkgconfig get fontsystem} xft] && $xft eq "xft"} {
11577    # fontconfig!
11578    set mainfont {sans 9}
11579    set textfont {monospace 9}
11580    set uifont {sans 9 bold}
11581} else {
11582    set mainfont {Helvetica 9}
11583    set textfont {Courier 9}
11584    set uifont {Helvetica 9 bold}
11585}
11586set tabstop 8
11587set findmergefiles 0
11588set maxgraphpct 50
11589set maxwidth 16
11590set revlistorder 0
11591set fastdate 0
11592set uparrowlen 5
11593set downarrowlen 5
11594set mingaplen 100
11595set cmitmode "patch"
11596set wrapcomment "none"
11597set showneartags 1
11598set hideremotes 0
11599set maxrefs 20
11600set maxlinelen 200
11601set showlocalchanges 1
11602set limitdiffs 1
11603set datetimeformat "%Y-%m-%d %H:%M:%S"
11604set autoselect 1
11605set autosellen 40
11606set perfile_attrs 0
11607set want_ttk 1
11608
11609if {[tk windowingsystem] eq "aqua"} {
11610    set extdifftool "opendiff"
11611} else {
11612    set extdifftool "meld"
11613}
11614
11615set colors {green red blue magenta darkgrey brown orange}
11616if {[tk windowingsystem] eq "win32"} {
11617    set uicolor SystemButtonFace
11618    set bgcolor SystemWindow
11619    set fgcolor SystemButtonText
11620    set selectbgcolor SystemHighlight
11621} else {
11622    set uicolor grey85
11623    set bgcolor white
11624    set fgcolor black
11625    set selectbgcolor gray85
11626}
11627set diffcolors {red "#00a000" blue}
11628set diffcontext 3
11629set ignorespace 0
11630set worddiff ""
11631set markbgcolor "#e0e0ff"
11632
11633set circlecolors {white blue gray blue blue}
11634
11635# button for popping up context menus
11636if {[tk windowingsystem] eq "aqua"} {
11637    set ctxbut <Button-2>
11638} else {
11639    set ctxbut <Button-3>
11640}
11641
11642## For msgcat loading, first locate the installation location.
11643if { [info exists ::env(GITK_MSGSDIR)] } {
11644    ## Msgsdir was manually set in the environment.
11645    set gitk_msgsdir $::env(GITK_MSGSDIR)
11646} else {
11647    ## Let's guess the prefix from argv0.
11648    set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
11649    set gitk_libdir [file join $gitk_prefix share gitk lib]
11650    set gitk_msgsdir [file join $gitk_libdir msgs]
11651    unset gitk_prefix
11652}
11653
11654## Internationalization (i18n) through msgcat and gettext. See
11655## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
11656package require msgcat
11657namespace import ::msgcat::mc
11658## And eventually load the actual message catalog
11659::msgcat::mcload $gitk_msgsdir
11660
11661catch {source ~/.gitk}
11662
11663parsefont mainfont $mainfont
11664eval font create mainfont [fontflags mainfont]
11665eval font create mainfontbold [fontflags mainfont 1]
11666
11667parsefont textfont $textfont
11668eval font create textfont [fontflags textfont]
11669eval font create textfontbold [fontflags textfont 1]
11670
11671parsefont uifont $uifont
11672eval font create uifont [fontflags uifont]
11673
11674setui $uicolor
11675
11676setoptions
11677
11678# check that we can find a .git directory somewhere...
11679if {[catch {set gitdir [exec git rev-parse --git-dir]}]} {
11680    show_error {} . [mc "Cannot find a git repository here."]
11681    exit 1
11682}
11683
11684set selecthead {}
11685set selectheadid {}
11686
11687set revtreeargs {}
11688set cmdline_files {}
11689set i 0
11690set revtreeargscmd {}
11691foreach arg $argv {
11692    switch -glob -- $arg {
11693        "" { }
11694        "--" {
11695            set cmdline_files [lrange $argv [expr {$i + 1}] end]
11696            break
11697        }
11698        "--select-commit=*" {
11699            set selecthead [string range $arg 16 end]
11700        }
11701        "--argscmd=*" {
11702            set revtreeargscmd [string range $arg 10 end]
11703        }
11704        default {
11705            lappend revtreeargs $arg
11706        }
11707    }
11708    incr i
11709}
11710
11711if {$selecthead eq "HEAD"} {
11712    set selecthead {}
11713}
11714
11715if {$i >= [llength $argv] && $revtreeargs ne {}} {
11716    # no -- on command line, but some arguments (other than --argscmd)
11717    if {[catch {
11718        set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
11719        set cmdline_files [split $f "\n"]
11720        set n [llength $cmdline_files]
11721        set revtreeargs [lrange $revtreeargs 0 end-$n]
11722        # Unfortunately git rev-parse doesn't produce an error when
11723        # something is both a revision and a filename.  To be consistent
11724        # with git log and git rev-list, check revtreeargs for filenames.
11725        foreach arg $revtreeargs {
11726            if {[file exists $arg]} {
11727                show_error {} . [mc "Ambiguous argument '%s': both revision\
11728                                 and filename" $arg]
11729                exit 1
11730            }
11731        }
11732    } err]} {
11733        # unfortunately we get both stdout and stderr in $err,
11734        # so look for "fatal:".
11735        set i [string first "fatal:" $err]
11736        if {$i > 0} {
11737            set err [string range $err [expr {$i + 6}] end]
11738        }
11739        show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
11740        exit 1
11741    }
11742}
11743
11744set nullid "0000000000000000000000000000000000000000"
11745set nullid2 "0000000000000000000000000000000000000001"
11746set nullfile "/dev/null"
11747
11748set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
11749if {![info exists have_ttk]} {
11750    set have_ttk [llength [info commands ::ttk::style]]
11751}
11752set use_ttk [expr {$have_ttk && $want_ttk}]
11753set NS [expr {$use_ttk ? "ttk" : ""}]
11754
11755regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
11756
11757set show_notes {}
11758if {[package vcompare $git_version "1.6.6.2"] >= 0} {
11759    set show_notes "--show-notes"
11760}
11761
11762set appname "gitk"
11763
11764set runq {}
11765set history {}
11766set historyindex 0
11767set fh_serial 0
11768set nhl_names {}
11769set highlight_paths {}
11770set findpattern {}
11771set searchdirn -forwards
11772set boldids {}
11773set boldnameids {}
11774set diffelide {0 0}
11775set markingmatches 0
11776set linkentercount 0
11777set need_redisplay 0
11778set nrows_drawn 0
11779set firsttabstop 0
11780
11781set nextviewnum 1
11782set curview 0
11783set selectedview 0
11784set selectedhlview [mc "None"]
11785set highlight_related [mc "None"]
11786set highlight_files {}
11787set viewfiles(0) {}
11788set viewperm(0) 0
11789set viewargs(0) {}
11790set viewargscmd(0) {}
11791
11792set selectedline {}
11793set numcommits 0
11794set loginstance 0
11795set cmdlineok 0
11796set stopped 0
11797set stuffsaved 0
11798set patchnum 0
11799set lserial 0
11800set hasworktree [hasworktree]
11801set cdup {}
11802if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} {
11803    set cdup [exec git rev-parse --show-cdup]
11804}
11805set worktree [exec git rev-parse --show-toplevel]
11806setcoords
11807makewindow
11808catch {
11809    image create photo gitlogo      -width 16 -height 16
11810
11811    image create photo gitlogominus -width  4 -height  2
11812    gitlogominus put #C00000 -to 0 0 4 2
11813    gitlogo copy gitlogominus -to  1 5
11814    gitlogo copy gitlogominus -to  6 5
11815    gitlogo copy gitlogominus -to 11 5
11816    image delete gitlogominus
11817
11818    image create photo gitlogoplus  -width  4 -height  4
11819    gitlogoplus  put #008000 -to 1 0 3 4
11820    gitlogoplus  put #008000 -to 0 1 4 3
11821    gitlogo copy gitlogoplus  -to  1 9
11822    gitlogo copy gitlogoplus  -to  6 9
11823    gitlogo copy gitlogoplus  -to 11 9
11824    image delete gitlogoplus
11825
11826    image create photo gitlogo32    -width 32 -height 32
11827    gitlogo32 copy gitlogo -zoom 2 2
11828
11829    wm iconphoto . -default gitlogo gitlogo32
11830}
11831# wait for the window to become visible
11832tkwait visibility .
11833wm title . "$appname: [reponame]"
11834update
11835readrefs
11836
11837if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
11838    # create a view for the files/dirs specified on the command line
11839    set curview 1
11840    set selectedview 1
11841    set nextviewnum 2
11842    set viewname(1) [mc "Command line"]
11843    set viewfiles(1) $cmdline_files
11844    set viewargs(1) $revtreeargs
11845    set viewargscmd(1) $revtreeargscmd
11846    set viewperm(1) 0
11847    set vdatemode(1) 0
11848    addviewmenu 1
11849    .bar.view entryconf [mca "Edit view..."] -state normal
11850    .bar.view entryconf [mca "Delete view"] -state normal
11851}
11852
11853if {[info exists permviews]} {
11854    foreach v $permviews {
11855        set n $nextviewnum
11856        incr nextviewnum
11857        set viewname($n) [lindex $v 0]
11858        set viewfiles($n) [lindex $v 1]
11859        set viewargs($n) [lindex $v 2]
11860        set viewargscmd($n) [lindex $v 3]
11861        set viewperm($n) 1
11862        addviewmenu $n
11863    }
11864}
11865
11866if {[tk windowingsystem] eq "win32"} {
11867    focus -force .
11868}
11869
11870getcommits {}
11871
11872# Local variables:
11873# mode: tcl
11874# indent-tabs-mode: t
11875# tab-width: 8
11876# End: