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