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