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