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