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