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