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