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