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