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