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