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