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