gitk-git/gitk

   1 #!/bin/sh
   2 # Tcl ignores the next line -*- tcl -*- \
   3 exec wish "$0" -- "$@"
   4
   5 # Copyright © 2005-2014 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
  10 package require Tk
  11
  12 proc hasworktree {} {
  13     return [expr {[exec git rev-parse --is-bare-repository] == "false" &&
  14                   [exec git rev-parse --is-inside-git-dir] == "false"}]
  15 }
  16
  17 proc reponame {} {
  18     global gitdir
  19     set n [file normalize $gitdir]
  20     if {[string match "*/.git" $n]} {
  21         set n [string range $n 0 end-5]
  22     }
  23     return [file tail $n]
  24 }
  25
  26 proc gitworktree {} {
  27     variable _gitworktree
  28     if {[info exists _gitworktree]} {
  29         return $_gitworktree
  30     }
  31     # v1.7.0 introduced --show-toplevel to return the canonical work-tree
  32     if {[catch {set _gitworktree [exec git rev-parse --show-toplevel]}]} {
  33         # try to set work tree from environment, core.worktree or use
  34         # cdup to obtain a relative path to the top of the worktree. If
  35         # run from the top, the ./ prefix ensures normalize expands pwd.
  36         if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
  37             catch {set _gitworktree [exec git config --get core.worktree]}
  38             if {$_gitworktree eq ""} {
  39                 set _gitworktree [file normalize ./[exec git rev-parse --show-cdup]]
  40             }
  41         }
  42     }
  43     return $_gitworktree
  44 }
  45
  46 # A simple scheduler for compute-intensive stuff.
  47 # The aim is to make sure that event handlers for GUI actions can
  48 # run at least every 50-100 ms.  Unfortunately fileevent handlers are
  49 # run before X event handlers, so reading from a fast source can
  50 # make the GUI completely unresponsive.
  51 proc run args {
  52     global isonrunq runq currunq
  53
  54     set script $args
  55     if {[info exists isonrunq($script)]} return
  56     if {$runq eq {} && ![info exists currunq]} {
  57         after idle dorunq
  58     }
  59     lappend runq [list {} $script]
  60     set isonrunq($script) 1
  61 }
  62
  63 proc filerun {fd script} {
  64     fileevent $fd readable [list filereadable $fd $script]
  65 }
  66
  67 proc filereadable {fd script} {
  68     global runq currunq
  69
  70     fileevent $fd readable {}
  71     if {$runq eq {} && ![info exists currunq]} {
  72         after idle dorunq
  73     }
  74     lappend runq [list $fd $script]
  75 }
  76
  77 proc nukefile {fd} {
  78     global runq
  79
  80     for {set i 0} {$i < [llength $runq]} {} {
  81         if {[lindex $runq $i 0] eq $fd} {
  82             set runq [lreplace $runq $i $i]
  83         } else {
  84             incr i
  85         }
  86     }
  87 }
  88
  89 proc dorunq {} {
  90     global isonrunq runq currunq
  91
  92     set tstart [clock clicks -milliseconds]
  93     set t0 $tstart
  94     while {[llength $runq] > 0} {
  95         set fd [lindex $runq 0 0]
  96         set script [lindex $runq 0 1]
  97         set currunq [lindex $runq 0]
  98         set runq [lrange $runq 1 end]
  99         set repeat [eval $script]
 100         unset currunq
 101         set t1 [clock clicks -milliseconds]
 102         set t [expr {$t1 - $t0}]
 103         if {$repeat ne {} && $repeat} {
 104             if {$fd eq {} || $repeat == 2} {
 105                 # script returns 1 if it wants to be readded
 106                 # file readers return 2 if they could do more straight away
 107                 lappend runq [list $fd $script]
 108             } else {
 109                 fileevent $fd readable [list filereadable $fd $script]
 110             }
 111         } elseif {$fd eq {}} {
 112             unset isonrunq($script)
 113         }
 114         set t0 $t1
 115         if {$t1 - $tstart >= 80} break
 116     }
 117     if {$runq ne {}} {
 118         after idle dorunq
 119     }
 120 }
 121
 122 proc reg_instance {fd} {
 123     global commfd leftover loginstance
 124
 125     set i [incr loginstance]
 126     set commfd($i) $fd
 127     set leftover($i) {}
 128     return $i
 129 }
 130
 131 proc unmerged_files {files} {
 132     global nr_unmerged
 133
 134     # find the list of unmerged files
 135     set mlist {}
 136     set nr_unmerged 0
 137     if {[catch {
 138         set fd [open "| git ls-files -u" r]
 139     } err]} {
 140         show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
 141         exit 1
 142     }
 143     while {[gets $fd line] >= 0} {
 144         set i [string first "\t" $line]
 145         if {$i < 0} continue
 146         set fname [string range $line [expr {$i+1}] end]
 147         if {[lsearch -exact $mlist $fname] >= 0} continue
 148         incr nr_unmerged
 149         if {$files eq {} || [path_filter $files $fname]} {
 150             lappend mlist $fname
 151         }
 152     }
 153     catch {close $fd}
 154     return $mlist
 155 }
 156
 157 proc parseviewargs {n arglist} {
 158     global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs env
 159     global vinlinediff
 160     global worddiff git_version
 161
 162     set vdatemode($n) 0
 163     set vmergeonly($n) 0
 164     set vinlinediff($n) 0
 165     set glflags {}
 166     set diffargs {}
 167     set nextisval 0
 168     set revargs {}
 169     set origargs $arglist
 170     set allknown 1
 171     set filtered 0
 172     set i -1
 173     foreach arg $arglist {
 174         incr i
 175         if {$nextisval} {
 176             lappend glflags $arg
 177             set nextisval 0
 178             continue
 179         }
 180         switch -glob -- $arg {
 181             "-d" -
 182             "--date-order" {
 183                 set vdatemode($n) 1
 184                 # remove from origargs in case we hit an unknown option
 185                 set origargs [lreplace $origargs $i $i]
 186                 incr i -1
 187             }
 188             "-[puabwcrRBMC]" -
 189             "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
 190             "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
 191             "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
 192             "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
 193             "--ignore-space-change" - "-U*" - "--unified=*" {
 194                 # These request or affect diff output, which we don't want.
 195                 # Some could be used to set our defaults for diff display.
 196                 lappend diffargs $arg
 197             }
 198             "--raw" - "--patch-with-raw" - "--patch-with-stat" -
 199             "--name-only" - "--name-status" - "--color" -
 200             "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
 201             "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
 202             "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
 203             "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
 204             "--objects" - "--objects-edge" - "--reverse" {
 205                 # These cause our parsing of git log's output to fail, or else
 206                 # they're options we want to set ourselves, so ignore them.
 207             }
 208             "--color-words*" - "--word-diff=color" {
 209                 # These trigger a word diff in the console interface,
 210                 # so help the user by enabling our own support
 211                 if {[package vcompare $git_version "1.7.2"] >= 0} {
 212                     set worddiff [mc "Color words"]
 213                 }
 214             }
 215             "--word-diff*" {
 216                 if {[package vcompare $git_version "1.7.2"] >= 0} {
 217                     set worddiff [mc "Markup words"]
 218                 }
 219             }
 220             "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
 221             "--check" - "--exit-code" - "--quiet" - "--topo-order" -
 222             "--full-history" - "--dense" - "--sparse" -
 223             "--follow" - "--left-right" - "--encoding=*" {
 224                 # These are harmless, and some are even useful
 225                 lappend glflags $arg
 226             }
 227             "--diff-filter=*" - "--no-merges" - "--unpacked" -
 228             "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
 229             "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
 230             "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
 231             "--remove-empty" - "--first-parent" - "--cherry-pick" -
 232             "-S*" - "-G*" - "--pickaxe-all" - "--pickaxe-regex" -
 233             "--simplify-by-decoration" {
 234                 # These mean that we get a subset of the commits
 235                 set filtered 1
 236                 lappend glflags $arg
 237             }
 238             "-L*" {
 239                 # Line-log with 'stuck' argument (unstuck form is
 240                 # not supported)
 241                 set filtered 1
 242                 set vinlinediff($n) 1
 243                 set allknown 0
 244                 lappend glflags $arg
 245             }
 246             "-n" {
 247                 # This appears to be the only one that has a value as a
 248                 # separate word following it
 249                 set filtered 1
 250                 set nextisval 1
 251                 lappend glflags $arg
 252             }
 253             "--not" - "--all" {
 254                 lappend revargs $arg
 255             }
 256             "--merge" {
 257                 set vmergeonly($n) 1
 258                 # git rev-parse doesn't understand --merge
 259                 lappend revargs --gitk-symmetric-diff-marker MERGE_HEAD...HEAD
 260             }
 261             "--no-replace-objects" {
 262                 set env(GIT_NO_REPLACE_OBJECTS) "1"
 263             }
 264             "-*" {
 265                 # Other flag arguments including -<n>
 266                 if {[string is digit -strict [string range $arg 1 end]]} {
 267                     set filtered 1
 268                 } else {
 269                     # a flag argument that we don't recognize;
 270                     # that means we can't optimize
 271                     set allknown 0
 272                 }
 273                 lappend glflags $arg
 274             }
 275             default {
 276                 # Non-flag arguments specify commits or ranges of commits
 277                 if {[string match "*...*" $arg]} {
 278                     lappend revargs --gitk-symmetric-diff-marker
 279                 }
 280                 lappend revargs $arg
 281             }
 282         }
 283     }
 284     set vdflags($n) $diffargs
 285     set vflags($n) $glflags
 286     set vrevs($n) $revargs
 287     set vfiltered($n) $filtered
 288     set vorigargs($n) $origargs
 289     return $allknown
 290 }
 291
 292 proc parseviewrevs {view revs} {
 293     global vposids vnegids
 294
 295     if {$revs eq {}} {
 296         set revs HEAD
 297     } elseif {[lsearch -exact $revs --all] >= 0} {
 298         lappend revs HEAD
 299     }
 300     if {[catch {set ids [eval exec git rev-parse $revs]} err]} {
 301         # we get stdout followed by stderr in $err
 302         # for an unknown rev, git rev-parse echoes it and then errors out
 303         set errlines [split $err "\n"]
 304         set badrev {}
 305         for {set l 0} {$l < [llength $errlines]} {incr l} {
 306             set line [lindex $errlines $l]
 307             if {!([string length $line] == 40 && [string is xdigit $line])} {
 308                 if {[string match "fatal:*" $line]} {
 309                     if {[string match "fatal: ambiguous argument*" $line]
 310                         && $badrev ne {}} {
 311                         if {[llength $badrev] == 1} {
 312                             set err "unknown revision $badrev"
 313                         } else {
 314                             set err "unknown revisions: [join $badrev ", "]"
 315                         }
 316                     } else {
 317                         set err [join [lrange $errlines $l end] "\n"]
 318                     }
 319                     break
 320                 }
 321                 lappend badrev $line
 322             }
 323         }
 324         error_popup "[mc "Error parsing revisions:"] $err"
 325         return {}
 326     }
 327     set ret {}
 328     set pos {}
 329     set neg {}
 330     set sdm 0
 331     foreach id [split $ids "\n"] {
 332         if {$id eq "--gitk-symmetric-diff-marker"} {
 333             set sdm 4
 334         } elseif {[string match "^*" $id]} {
 335             if {$sdm != 1} {
 336                 lappend ret $id
 337                 if {$sdm == 3} {
 338                     set sdm 0
 339                 }
 340             }
 341             lappend neg [string range $id 1 end]
 342         } else {
 343             if {$sdm != 2} {
 344                 lappend ret $id
 345             } else {
 346                 lset ret end $id...[lindex $ret end]
 347             }
 348             lappend pos $id
 349         }
 350         incr sdm -1
 351     }
 352     set vposids($view) $pos
 353     set vnegids($view) $neg
 354     return $ret
 355 }
 356
 357 # Start off a git log process and arrange to read its output
 358 proc start_rev_list {view} {
 359     global startmsecs commitidx viewcomplete curview
 360     global tclencoding
 361     global viewargs viewargscmd viewfiles vfilelimit
 362     global showlocalchanges
 363     global viewactive viewinstances vmergeonly
 364     global mainheadid viewmainheadid viewmainheadid_orig
 365     global vcanopt vflags vrevs vorigargs
 366     global show_notes
 367
 368     set startmsecs [clock clicks -milliseconds]
 369     set commitidx($view) 0
 370     # these are set this way for the error exits
 371     set viewcomplete($view) 1
 372     set viewactive($view) 0
 373     varcinit $view
 374
 375     set args $viewargs($view)
 376     if {$viewargscmd($view) ne {}} {
 377         if {[catch {
 378             set str [exec sh -c $viewargscmd($view)]
 379         } err]} {
 380             error_popup "[mc "Error executing --argscmd command:"] $err"
 381             return 0
 382         }
 383         set args [concat $args [split $str "\n"]]
 384     }
 385     set vcanopt($view) [parseviewargs $view $args]
 386
 387     set files $viewfiles($view)
 388     if {$vmergeonly($view)} {
 389         set files [unmerged_files $files]
 390         if {$files eq {}} {
 391             global nr_unmerged
 392             if {$nr_unmerged == 0} {
 393                 error_popup [mc "No files selected: --merge specified but\
 394                              no files are unmerged."]
 395             } else {
 396                 error_popup [mc "No files selected: --merge specified but\
 397                              no unmerged files are within file limit."]
 398             }
 399             return 0
 400         }
 401     }
 402     set vfilelimit($view) $files
 403
 404     if {$vcanopt($view)} {
 405         set revs [parseviewrevs $view $vrevs($view)]
 406         if {$revs eq {}} {
 407             return 0
 408         }
 409         set args [concat $vflags($view) $revs]
 410     } else {
 411         set args $vorigargs($view)
 412     }
 413
 414     if {[catch {
 415         set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
 416                         --parents --boundary $args "--" $files] r]
 417     } err]} {
 418         error_popup "[mc "Error executing git log:"] $err"
 419         return 0
 420     }
 421     set i [reg_instance $fd]
 422     set viewinstances($view) [list $i]
 423     set viewmainheadid($view) $mainheadid
 424     set viewmainheadid_orig($view) $mainheadid
 425     if {$files ne {} && $mainheadid ne {}} {
 426         get_viewmainhead $view
 427     }
 428     if {$showlocalchanges && $viewmainheadid($view) ne {}} {
 429         interestedin $viewmainheadid($view) dodiffindex
 430     }
 431     fconfigure $fd -blocking 0 -translation lf -eofchar {}
 432     if {$tclencoding != {}} {
 433         fconfigure $fd -encoding $tclencoding
 434     }
 435     filerun $fd [list getcommitlines $fd $i $view 0]
 436     nowbusy $view [mc "Reading"]
 437     set viewcomplete($view) 0
 438     set viewactive($view) 1
 439     return 1
 440 }
 441
 442 proc stop_instance {inst} {
 443     global commfd leftover
 444
 445     set fd $commfd($inst)
 446     catch {
 447         set pid [pid $fd]
 448
 449         if {$::tcl_platform(platform) eq {windows}} {
 450             exec taskkill /pid $pid
 451         } else {
 452             exec kill $pid
 453         }
 454     }
 455     catch {close $fd}
 456     nukefile $fd
 457     unset commfd($inst)
 458     unset leftover($inst)
 459 }
 460
 461 proc stop_backends {} {
 462     global commfd
 463
 464     foreach inst [array names commfd] {
 465         stop_instance $inst
 466     }
 467 }
 468
 469 proc stop_rev_list {view} {
 470     global viewinstances
 471
 472     foreach inst $viewinstances($view) {
 473         stop_instance $inst
 474     }
 475     set viewinstances($view) {}
 476 }
 477
 478 proc reset_pending_select {selid} {
 479     global pending_select mainheadid selectheadid
 480
 481     if {$selid ne {}} {
 482         set pending_select $selid
 483     } elseif {$selectheadid ne {}} {
 484         set pending_select $selectheadid
 485     } else {
 486         set pending_select $mainheadid
 487     }
 488 }
 489
 490 proc getcommits {selid} {
 491     global canv curview need_redisplay viewactive
 492
 493     initlayout
 494     if {[start_rev_list $curview]} {
 495         reset_pending_select $selid
 496         show_status [mc "Reading commits..."]
 497         set need_redisplay 1
 498     } else {
 499         show_status [mc "No commits selected"]
 500     }
 501 }
 502
 503 proc updatecommits {} {
 504     global curview vcanopt vorigargs vfilelimit viewinstances
 505     global viewactive viewcomplete tclencoding
 506     global startmsecs showneartags showlocalchanges
 507     global mainheadid viewmainheadid viewmainheadid_orig pending_select
 508     global hasworktree
 509     global varcid vposids vnegids vflags vrevs
 510     global show_notes
 511
 512     set hasworktree [hasworktree]
 513     rereadrefs
 514     set view $curview
 515     if {$mainheadid ne $viewmainheadid_orig($view)} {
 516         if {$showlocalchanges} {
 517             dohidelocalchanges
 518         }
 519         set viewmainheadid($view) $mainheadid
 520         set viewmainheadid_orig($view) $mainheadid
 521         if {$vfilelimit($view) ne {}} {
 522             get_viewmainhead $view
 523         }
 524     }
 525     if {$showlocalchanges} {
 526         doshowlocalchanges
 527     }
 528     if {$vcanopt($view)} {
 529         set oldpos $vposids($view)
 530         set oldneg $vnegids($view)
 531         set revs [parseviewrevs $view $vrevs($view)]
 532         if {$revs eq {}} {
 533             return
 534         }
 535         # note: getting the delta when negative refs change is hard,
 536         # and could require multiple git log invocations, so in that
 537         # case we ask git log for all the commits (not just the delta)
 538         if {$oldneg eq $vnegids($view)} {
 539             set newrevs {}
 540             set npos 0
 541             # take out positive refs that we asked for before or
 542             # that we have already seen
 543             foreach rev $revs {
 544                 if {[string length $rev] == 40} {
 545                     if {[lsearch -exact $oldpos $rev] < 0
 546                         && ![info exists varcid($view,$rev)]} {
 547                         lappend newrevs $rev
 548                         incr npos
 549                     }
 550                 } else {
 551                     lappend $newrevs $rev
 552                 }
 553             }
 554             if {$npos == 0} return
 555             set revs $newrevs
 556             set vposids($view) [lsort -unique [concat $oldpos $vposids($view)]]
 557         }
 558         set args [concat $vflags($view) $revs --not $oldpos]
 559     } else {
 560         set args $vorigargs($view)
 561     }
 562     if {[catch {
 563         set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
 564                         --parents --boundary $args "--" $vfilelimit($view)] r]
 565     } err]} {
 566         error_popup "[mc "Error executing git log:"] $err"
 567         return
 568     }
 569     if {$viewactive($view) == 0} {
 570         set startmsecs [clock clicks -milliseconds]
 571     }
 572     set i [reg_instance $fd]
 573     lappend viewinstances($view) $i
 574     fconfigure $fd -blocking 0 -translation lf -eofchar {}
 575     if {$tclencoding != {}} {
 576         fconfigure $fd -encoding $tclencoding
 577     }
 578     filerun $fd [list getcommitlines $fd $i $view 1]
 579     incr viewactive($view)
 580     set viewcomplete($view) 0
 581     reset_pending_select {}
 582     nowbusy $view [mc "Reading"]
 583     if {$showneartags} {
 584         getallcommits
 585     }
 586 }
 587
 588 proc reloadcommits {} {
 589     global curview viewcomplete selectedline currentid thickerline
 590     global showneartags treediffs commitinterest cached_commitrow
 591     global targetid
 592
 593     set selid {}
 594     if {$selectedline ne {}} {
 595         set selid $currentid
 596     }
 597
 598     if {!$viewcomplete($curview)} {
 599         stop_rev_list $curview
 600     }
 601     resetvarcs $curview
 602     set selectedline {}
 603     unset -nocomplain currentid
 604     unset -nocomplain thickerline
 605     unset -nocomplain treediffs
 606     readrefs
 607     changedrefs
 608     if {$showneartags} {
 609         getallcommits
 610     }
 611     clear_display
 612     unset -nocomplain commitinterest
 613     unset -nocomplain cached_commitrow
 614     unset -nocomplain targetid
 615     setcanvscroll
 616     getcommits $selid
 617     return 0
 618 }
 619
 620 # This makes a string representation of a positive integer which
 621 # sorts as a string in numerical order
 622 proc strrep {n} {
 623     if {$n < 16} {
 624         return [format "%x" $n]
 625     } elseif {$n < 256} {
 626         return [format "x%.2x" $n]
 627     } elseif {$n < 65536} {
 628         return [format "y%.4x" $n]
 629     }
 630     return [format "z%.8x" $n]
 631 }
 632
 633 # Procedures used in reordering commits from git log (without
 634 # --topo-order) into the order for display.
 635
 636 proc varcinit {view} {
 637     global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
 638     global vtokmod varcmod vrowmod varcix vlastins
 639
 640     set varcstart($view) {{}}
 641     set vupptr($view) {0}
 642     set vdownptr($view) {0}
 643     set vleftptr($view) {0}
 644     set vbackptr($view) {0}
 645     set varctok($view) {{}}
 646     set varcrow($view) {{}}
 647     set vtokmod($view) {}
 648     set varcmod($view) 0
 649     set vrowmod($view) 0
 650     set varcix($view) {{}}
 651     set vlastins($view) {0}
 652 }
 653
 654 proc resetvarcs {view} {
 655     global varcid varccommits parents children vseedcount ordertok
 656     global vshortids
 657
 658     foreach vid [array names varcid $view,*] {
 659         unset varcid($vid)
 660         unset children($vid)
 661         unset parents($vid)
 662     }
 663     foreach vid [array names vshortids $view,*] {
 664         unset vshortids($vid)
 665     }
 666     # some commits might have children but haven't been seen yet
 667     foreach vid [array names children $view,*] {
 668         unset children($vid)
 669     }
 670     foreach va [array names varccommits $view,*] {
 671         unset varccommits($va)
 672     }
 673     foreach vd [array names vseedcount $view,*] {
 674         unset vseedcount($vd)
 675     }
 676     unset -nocomplain ordertok
 677 }
 678
 679 # returns a list of the commits with no children
 680 proc seeds {v} {
 681     global vdownptr vleftptr varcstart
 682
 683     set ret {}
 684     set a [lindex $vdownptr($v) 0]
 685     while {$a != 0} {
 686         lappend ret [lindex $varcstart($v) $a]
 687         set a [lindex $vleftptr($v) $a]
 688     }
 689     return $ret
 690 }
 691
 692 proc newvarc {view id} {
 693     global varcid varctok parents children vdatemode
 694     global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
 695     global commitdata commitinfo vseedcount varccommits vlastins
 696
 697     set a [llength $varctok($view)]
 698     set vid $view,$id
 699     if {[llength $children($vid)] == 0 || $vdatemode($view)} {
 700         if {![info exists commitinfo($id)]} {
 701             parsecommit $id $commitdata($id) 1
 702         }
 703         set cdate [lindex [lindex $commitinfo($id) 4] 0]
 704         if {![string is integer -strict $cdate]} {
 705             set cdate 0
 706         }
 707         if {![info exists vseedcount($view,$cdate)]} {
 708             set vseedcount($view,$cdate) -1
 709         }
 710         set c [incr vseedcount($view,$cdate)]
 711         set cdate [expr {$cdate ^ 0xffffffff}]
 712         set tok "s[strrep $cdate][strrep $c]"
 713     } else {
 714         set tok {}
 715     }
 716     set ka 0
 717     if {[llength $children($vid)] > 0} {
 718         set kid [lindex $children($vid) end]
 719         set k $varcid($view,$kid)
 720         if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
 721             set ki $kid
 722             set ka $k
 723             set tok [lindex $varctok($view) $k]
 724         }
 725     }
 726     if {$ka != 0} {
 727         set i [lsearch -exact $parents($view,$ki) $id]
 728         set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
 729         append tok [strrep $j]
 730     }
 731     set c [lindex $vlastins($view) $ka]
 732     if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
 733         set c $ka
 734         set b [lindex $vdownptr($view) $ka]
 735     } else {
 736         set b [lindex $vleftptr($view) $c]
 737     }
 738     while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
 739         set c $b
 740         set b [lindex $vleftptr($view) $c]
 741     }
 742     if {$c == $ka} {
 743         lset vdownptr($view) $ka $a
 744         lappend vbackptr($view) 0
 745     } else {
 746         lset vleftptr($view) $c $a
 747         lappend vbackptr($view) $c
 748     }
 749     lset vlastins($view) $ka $a
 750     lappend vupptr($view) $ka
 751     lappend vleftptr($view) $b
 752     if {$b != 0} {
 753         lset vbackptr($view) $b $a
 754     }
 755     lappend varctok($view) $tok
 756     lappend varcstart($view) $id
 757     lappend vdownptr($view) 0
 758     lappend varcrow($view) {}
 759     lappend varcix($view) {}
 760     set varccommits($view,$a) {}
 761     lappend vlastins($view) 0
 762     return $a
 763 }
 764
 765 proc splitvarc {p v} {
 766     global varcid varcstart varccommits varctok vtokmod
 767     global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
 768
 769     set oa $varcid($v,$p)
 770     set otok [lindex $varctok($v) $oa]
 771     set ac $varccommits($v,$oa)
 772     set i [lsearch -exact $varccommits($v,$oa) $p]
 773     if {$i <= 0} return
 774     set na [llength $varctok($v)]
 775     # "%" sorts before "0"...
 776     set tok "$otok%[strrep $i]"
 777     lappend varctok($v) $tok
 778     lappend varcrow($v) {}
 779     lappend varcix($v) {}
 780     set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
 781     set varccommits($v,$na) [lrange $ac $i end]
 782     lappend varcstart($v) $p
 783     foreach id $varccommits($v,$na) {
 784         set varcid($v,$id) $na
 785     }
 786     lappend vdownptr($v) [lindex $vdownptr($v) $oa]
 787     lappend vlastins($v) [lindex $vlastins($v) $oa]
 788     lset vdownptr($v) $oa $na
 789     lset vlastins($v) $oa 0
 790     lappend vupptr($v) $oa
 791     lappend vleftptr($v) 0
 792     lappend vbackptr($v) 0
 793     for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
 794         lset vupptr($v) $b $na
 795     }
 796     if {[string compare $otok $vtokmod($v)] <= 0} {
 797         modify_arc $v $oa
 798     }
 799 }
 800
 801 proc renumbervarc {a v} {
 802     global parents children varctok varcstart varccommits
 803     global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
 804
 805     set t1 [clock clicks -milliseconds]
 806     set todo {}
 807     set isrelated($a) 1
 808     set kidchanged($a) 1
 809     set ntot 0
 810     while {$a != 0} {
 811         if {[info exists isrelated($a)]} {
 812             lappend todo $a
 813             set id [lindex $varccommits($v,$a) end]
 814             foreach p $parents($v,$id) {
 815                 if {[info exists varcid($v,$p)]} {
 816                     set isrelated($varcid($v,$p)) 1
 817                 }
 818             }
 819         }
 820         incr ntot
 821         set b [lindex $vdownptr($v) $a]
 822         if {$b == 0} {
 823             while {$a != 0} {
 824                 set b [lindex $vleftptr($v) $a]
 825                 if {$b != 0} break
 826                 set a [lindex $vupptr($v) $a]
 827             }
 828         }
 829         set a $b
 830     }
 831     foreach a $todo {
 832         if {![info exists kidchanged($a)]} continue
 833         set id [lindex $varcstart($v) $a]
 834         if {[llength $children($v,$id)] > 1} {
 835             set children($v,$id) [lsort -command [list vtokcmp $v] \
 836                                       $children($v,$id)]
 837         }
 838         set oldtok [lindex $varctok($v) $a]
 839         if {!$vdatemode($v)} {
 840             set tok {}
 841         } else {
 842             set tok $oldtok
 843         }
 844         set ka 0
 845         set kid [last_real_child $v,$id]
 846         if {$kid ne {}} {
 847             set k $varcid($v,$kid)
 848             if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
 849                 set ki $kid
 850                 set ka $k
 851                 set tok [lindex $varctok($v) $k]
 852             }
 853         }
 854         if {$ka != 0} {
 855             set i [lsearch -exact $parents($v,$ki) $id]
 856             set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
 857             append tok [strrep $j]
 858         }
 859         if {$tok eq $oldtok} {
 860             continue
 861         }
 862         set id [lindex $varccommits($v,$a) end]
 863         foreach p $parents($v,$id) {
 864             if {[info exists varcid($v,$p)]} {
 865                 set kidchanged($varcid($v,$p)) 1
 866             } else {
 867                 set sortkids($p) 1
 868             }
 869         }
 870         lset varctok($v) $a $tok
 871         set b [lindex $vupptr($v) $a]
 872         if {$b != $ka} {
 873             if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
 874                 modify_arc $v $ka
 875             }
 876             if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
 877                 modify_arc $v $b
 878             }
 879             set c [lindex $vbackptr($v) $a]
 880             set d [lindex $vleftptr($v) $a]
 881             if {$c == 0} {
 882                 lset vdownptr($v) $b $d
 883             } else {
 884                 lset vleftptr($v) $c $d
 885             }
 886             if {$d != 0} {
 887                 lset vbackptr($v) $d $c
 888             }
 889             if {[lindex $vlastins($v) $b] == $a} {
 890                 lset vlastins($v) $b $c
 891             }
 892             lset vupptr($v) $a $ka
 893             set c [lindex $vlastins($v) $ka]
 894             if {$c == 0 || \
 895                     [string compare $tok [lindex $varctok($v) $c]] < 0} {
 896                 set c $ka
 897                 set b [lindex $vdownptr($v) $ka]
 898             } else {
 899                 set b [lindex $vleftptr($v) $c]
 900             }
 901             while {$b != 0 && \
 902                       [string compare $tok [lindex $varctok($v) $b]] >= 0} {
 903                 set c $b
 904                 set b [lindex $vleftptr($v) $c]
 905             }
 906             if {$c == $ka} {
 907                 lset vdownptr($v) $ka $a
 908                 lset vbackptr($v) $a 0
 909             } else {
 910                 lset vleftptr($v) $c $a
 911                 lset vbackptr($v) $a $c
 912             }
 913             lset vleftptr($v) $a $b
 914             if {$b != 0} {
 915                 lset vbackptr($v) $b $a
 916             }
 917             lset vlastins($v) $ka $a
 918         }
 919     }
 920     foreach id [array names sortkids] {
 921         if {[llength $children($v,$id)] > 1} {
 922             set children($v,$id) [lsort -command [list vtokcmp $v] \
 923                                       $children($v,$id)]
 924         }
 925     }
 926     set t2 [clock clicks -milliseconds]
 927     #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
 928 }
 929
 930 # Fix up the graph after we have found out that in view $v,
 931 # $p (a commit that we have already seen) is actually the parent
 932 # of the last commit in arc $a.
 933 proc fix_reversal {p a v} {
 934     global varcid varcstart varctok vupptr
 935
 936     set pa $varcid($v,$p)
 937     if {$p ne [lindex $varcstart($v) $pa]} {
 938         splitvarc $p $v
 939         set pa $varcid($v,$p)
 940     }
 941     # seeds always need to be renumbered
 942     if {[lindex $vupptr($v) $pa] == 0 ||
 943         [string compare [lindex $varctok($v) $a] \
 944              [lindex $varctok($v) $pa]] > 0} {
 945         renumbervarc $pa $v
 946     }
 947 }
 948
 949 proc insertrow {id p v} {
 950     global cmitlisted children parents varcid varctok vtokmod
 951     global varccommits ordertok commitidx numcommits curview
 952     global targetid targetrow vshortids
 953
 954     readcommit $id
 955     set vid $v,$id
 956     set cmitlisted($vid) 1
 957     set children($vid) {}
 958     set parents($vid) [list $p]
 959     set a [newvarc $v $id]
 960     set varcid($vid) $a
 961     lappend vshortids($v,[string range $id 0 3]) $id
 962     if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
 963         modify_arc $v $a
 964     }
 965     lappend varccommits($v,$a) $id
 966     set vp $v,$p
 967     if {[llength [lappend children($vp) $id]] > 1} {
 968         set children($vp) [lsort -command [list vtokcmp $v] $children($vp)]
 969         unset -nocomplain ordertok
 970     }
 971     fix_reversal $p $a $v
 972     incr commitidx($v)
 973     if {$v == $curview} {
 974         set numcommits $commitidx($v)
 975         setcanvscroll
 976         if {[info exists targetid]} {
 977             if {![comes_before $targetid $p]} {
 978                 incr targetrow
 979             }
 980         }
 981     }
 982 }
 983
 984 proc insertfakerow {id p} {
 985     global varcid varccommits parents children cmitlisted
 986     global commitidx varctok vtokmod targetid targetrow curview numcommits
 987
 988     set v $curview
 989     set a $varcid($v,$p)
 990     set i [lsearch -exact $varccommits($v,$a) $p]
 991     if {$i < 0} {
 992         puts "oops: insertfakerow can't find [shortids $p] on arc $a"
 993         return
 994     }
 995     set children($v,$id) {}
 996     set parents($v,$id) [list $p]
 997     set varcid($v,$id) $a
 998     lappend children($v,$p) $id
 999     set cmitlisted($v,$id) 1
1000     set numcommits [incr commitidx($v)]
1001     # note we deliberately don't update varcstart($v) even if $i == 0
1002     set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
1003     modify_arc $v $a $i
1004     if {[info exists targetid]} {
1005         if {![comes_before $targetid $p]} {
1006             incr targetrow
1007         }
1008     }
1009     setcanvscroll
1010     drawvisible
1011 }
1012
1013 proc removefakerow {id} {
1014     global varcid varccommits parents children commitidx
1015     global varctok vtokmod cmitlisted currentid selectedline
1016     global targetid curview numcommits
1017
1018     set v $curview
1019     if {[llength $parents($v,$id)] != 1} {
1020         puts "oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
1021         return
1022     }
1023     set p [lindex $parents($v,$id) 0]
1024     set a $varcid($v,$id)
1025     set i [lsearch -exact $varccommits($v,$a) $id]
1026     if {$i < 0} {
1027         puts "oops: removefakerow can't find [shortids $id] on arc $a"
1028         return
1029     }
1030     unset varcid($v,$id)
1031     set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
1032     unset parents($v,$id)
1033     unset children($v,$id)
1034     unset cmitlisted($v,$id)
1035     set numcommits [incr commitidx($v) -1]
1036     set j [lsearch -exact $children($v,$p) $id]
1037     if {$j >= 0} {
1038         set children($v,$p) [lreplace $children($v,$p) $j $j]
1039     }
1040     modify_arc $v $a $i
1041     if {[info exist currentid] && $id eq $currentid} {
1042         unset currentid
1043         set selectedline {}
1044     }
1045     if {[info exists targetid] && $targetid eq $id} {
1046         set targetid $p
1047     }
1048     setcanvscroll
1049     drawvisible
1050 }
1051
1052 proc real_children {vp} {
1053     global children nullid nullid2
1054
1055     set kids {}
1056     foreach id $children($vp) {
1057         if {$id ne $nullid && $id ne $nullid2} {
1058             lappend kids $id
1059         }
1060     }
1061     return $kids
1062 }
1063
1064 proc first_real_child {vp} {
1065     global children nullid nullid2
1066
1067     foreach id $children($vp) {
1068         if {$id ne $nullid && $id ne $nullid2} {
1069             return $id
1070         }
1071     }
1072     return {}
1073 }
1074
1075 proc last_real_child {vp} {
1076     global children nullid nullid2
1077
1078     set kids $children($vp)
1079     for {set i [llength $kids]} {[incr i -1] >= 0} {} {
1080         set id [lindex $kids $i]
1081         if {$id ne $nullid && $id ne $nullid2} {
1082             return $id
1083         }
1084     }
1085     return {}
1086 }
1087
1088 proc vtokcmp {v a b} {
1089     global varctok varcid
1090
1091     return [string compare [lindex $varctok($v) $varcid($v,$a)] \
1092                 [lindex $varctok($v) $varcid($v,$b)]]
1093 }
1094
1095 # This assumes that if lim is not given, the caller has checked that
1096 # arc a's token is less than $vtokmod($v)
1097 proc modify_arc {v a {lim {}}} {
1098     global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
1099
1100     if {$lim ne {}} {
1101         set c [string compare [lindex $varctok($v) $a] $vtokmod($v)]
1102         if {$c > 0} return
1103         if {$c == 0} {
1104             set r [lindex $varcrow($v) $a]
1105             if {$r ne {} && $vrowmod($v) <= $r + $lim} return
1106         }
1107     }
1108     set vtokmod($v) [lindex $varctok($v) $a]
1109     set varcmod($v) $a
1110     if {$v == $curview} {
1111         while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
1112             set a [lindex $vupptr($v) $a]
1113             set lim {}
1114         }
1115         set r 0
1116         if {$a != 0} {
1117             if {$lim eq {}} {
1118                 set lim [llength $varccommits($v,$a)]
1119             }
1120             set r [expr {[lindex $varcrow($v) $a] + $lim}]
1121         }
1122         set vrowmod($v) $r
1123         undolayout $r
1124     }
1125 }
1126
1127 proc update_arcrows {v} {
1128     global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
1129     global varcid vrownum varcorder varcix varccommits
1130     global vupptr vdownptr vleftptr varctok
1131     global displayorder parentlist curview cached_commitrow
1132
1133     if {$vrowmod($v) == $commitidx($v)} return
1134     if {$v == $curview} {
1135         if {[llength $displayorder] > $vrowmod($v)} {
1136             set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
1137             set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
1138         }
1139         unset -nocomplain cached_commitrow
1140     }
1141     set narctot [expr {[llength $varctok($v)] - 1}]
1142     set a $varcmod($v)
1143     while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
1144         # go up the tree until we find something that has a row number,
1145         # or we get to a seed
1146         set a [lindex $vupptr($v) $a]
1147     }
1148     if {$a == 0} {
1149         set a [lindex $vdownptr($v) 0]
1150         if {$a == 0} return
1151         set vrownum($v) {0}
1152         set varcorder($v) [list $a]
1153         lset varcix($v) $a 0
1154         lset varcrow($v) $a 0
1155         set arcn 0
1156         set row 0
1157     } else {
1158         set arcn [lindex $varcix($v) $a]
1159         if {[llength $vrownum($v)] > $arcn + 1} {
1160             set vrownum($v) [lrange $vrownum($v) 0 $arcn]
1161             set varcorder($v) [lrange $varcorder($v) 0 $arcn]
1162         }
1163         set row [lindex $varcrow($v) $a]
1164     }
1165     while {1} {
1166         set p $a
1167         incr row [llength $varccommits($v,$a)]
1168         # go down if possible
1169         set b [lindex $vdownptr($v) $a]
1170         if {$b == 0} {
1171             # if not, go left, or go up until we can go left
1172             while {$a != 0} {
1173                 set b [lindex $vleftptr($v) $a]
1174                 if {$b != 0} break
1175                 set a [lindex $vupptr($v) $a]
1176             }
1177             if {$a == 0} break
1178         }
1179         set a $b
1180         incr arcn
1181         lappend vrownum($v) $row
1182         lappend varcorder($v) $a
1183         lset varcix($v) $a $arcn
1184         lset varcrow($v) $a $row
1185     }
1186     set vtokmod($v) [lindex $varctok($v) $p]
1187     set varcmod($v) $p
1188     set vrowmod($v) $row
1189     if {[info exists currentid]} {
1190         set selectedline [rowofcommit $currentid]
1191     }
1192 }
1193
1194 # Test whether view $v contains commit $id
1195 proc commitinview {id v} {
1196     global varcid
1197
1198     return [info exists varcid($v,$id)]
1199 }
1200
1201 # Return the row number for commit $id in the current view
1202 proc rowofcommit {id} {
1203     global varcid varccommits varcrow curview cached_commitrow
1204     global varctok vtokmod
1205
1206     set v $curview
1207     if {![info exists varcid($v,$id)]} {
1208         puts "oops rowofcommit no arc for [shortids $id]"
1209         return {}
1210     }
1211     set a $varcid($v,$id)
1212     if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
1213         update_arcrows $v
1214     }
1215     if {[info exists cached_commitrow($id)]} {
1216         return $cached_commitrow($id)
1217     }
1218     set i [lsearch -exact $varccommits($v,$a) $id]
1219     if {$i < 0} {
1220         puts "oops didn't find commit [shortids $id] in arc $a"
1221         return {}
1222     }
1223     incr i [lindex $varcrow($v) $a]
1224     set cached_commitrow($id) $i
1225     return $i
1226 }
1227
1228 # Returns 1 if a is on an earlier row than b, otherwise 0
1229 proc comes_before {a b} {
1230     global varcid varctok curview
1231
1232     set v $curview
1233     if {$a eq $b || ![info exists varcid($v,$a)] || \
1234             ![info exists varcid($v,$b)]} {
1235         return 0
1236     }
1237     if {$varcid($v,$a) != $varcid($v,$b)} {
1238         return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
1239                            [lindex $varctok($v) $varcid($v,$b)]] < 0}]
1240     }
1241     return [expr {[rowofcommit $a] < [rowofcommit $b]}]
1242 }
1243
1244 proc bsearch {l elt} {
1245     if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
1246         return 0
1247     }
1248     set lo 0
1249     set hi [llength $l]
1250     while {$hi - $lo > 1} {
1251         set mid [expr {int(($lo + $hi) / 2)}]
1252         set t [lindex $l $mid]
1253         if {$elt < $t} {
1254             set hi $mid
1255         } elseif {$elt > $t} {
1256             set lo $mid
1257         } else {
1258             return $mid
1259         }
1260     }
1261     return $lo
1262 }
1263
1264 # Make sure rows $start..$end-1 are valid in displayorder and parentlist
1265 proc make_disporder {start end} {
1266     global vrownum curview commitidx displayorder parentlist
1267     global varccommits varcorder parents vrowmod varcrow
1268     global d_valid_start d_valid_end
1269
1270     if {$end > $vrowmod($curview)} {
1271         update_arcrows $curview
1272     }
1273     set ai [bsearch $vrownum($curview) $start]
1274     set start [lindex $vrownum($curview) $ai]
1275     set narc [llength $vrownum($curview)]
1276     for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
1277         set a [lindex $varcorder($curview) $ai]
1278         set l [llength $displayorder]
1279         set al [llength $varccommits($curview,$a)]
1280         if {$l < $r + $al} {
1281             if {$l < $r} {
1282                 set pad [ntimes [expr {$r - $l}] {}]
1283                 set displayorder [concat $displayorder $pad]
1284                 set parentlist [concat $parentlist $pad]
1285             } elseif {$l > $r} {
1286                 set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
1287                 set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
1288             }
1289             foreach id $varccommits($curview,$a) {
1290                 lappend displayorder $id
1291                 lappend parentlist $parents($curview,$id)
1292             }
1293         } elseif {[lindex $displayorder [expr {$r + $al - 1}]] eq {}} {
1294             set i $r
1295             foreach id $varccommits($curview,$a) {
1296                 lset displayorder $i $id
1297                 lset parentlist $i $parents($curview,$id)
1298                 incr i
1299             }
1300         }
1301         incr r $al
1302     }
1303 }
1304
1305 proc commitonrow {row} {
1306     global displayorder
1307
1308     set id [lindex $displayorder $row]
1309     if {$id eq {}} {
1310         make_disporder $row [expr {$row + 1}]
1311         set id [lindex $displayorder $row]
1312     }
1313     return $id
1314 }
1315
1316 proc closevarcs {v} {
1317     global varctok varccommits varcid parents children
1318     global cmitlisted commitidx vtokmod
1319
1320     set missing_parents 0
1321     set scripts {}
1322     set narcs [llength $varctok($v)]
1323     for {set a 1} {$a < $narcs} {incr a} {
1324         set id [lindex $varccommits($v,$a) end]
1325         foreach p $parents($v,$id) {
1326             if {[info exists varcid($v,$p)]} continue
1327             # add p as a new commit
1328             incr missing_parents
1329             set cmitlisted($v,$p) 0
1330             set parents($v,$p) {}
1331             if {[llength $children($v,$p)] == 1 &&
1332                 [llength $parents($v,$id)] == 1} {
1333                 set b $a
1334             } else {
1335                 set b [newvarc $v $p]
1336             }
1337             set varcid($v,$p) $b
1338             if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
1339                 modify_arc $v $b
1340             }
1341             lappend varccommits($v,$b) $p
1342             incr commitidx($v)
1343             set scripts [check_interest $p $scripts]
1344         }
1345     }
1346     if {$missing_parents > 0} {
1347         foreach s $scripts {
1348             eval $s
1349         }
1350     }
1351 }
1352
1353 # Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
1354 # Assumes we already have an arc for $rwid.
1355 proc rewrite_commit {v id rwid} {
1356     global children parents varcid varctok vtokmod varccommits
1357
1358     foreach ch $children($v,$id) {
1359         # make $rwid be $ch's parent in place of $id
1360         set i [lsearch -exact $parents($v,$ch) $id]
1361         if {$i < 0} {
1362             puts "oops rewrite_commit didn't find $id in parent list for $ch"
1363         }
1364         set parents($v,$ch) [lreplace $parents($v,$ch) $i $i $rwid]
1365         # add $ch to $rwid's children and sort the list if necessary
1366         if {[llength [lappend children($v,$rwid) $ch]] > 1} {
1367             set children($v,$rwid) [lsort -command [list vtokcmp $v] \
1368                                         $children($v,$rwid)]
1369         }
1370         # fix the graph after joining $id to $rwid
1371         set a $varcid($v,$ch)
1372         fix_reversal $rwid $a $v
1373         # parentlist is wrong for the last element of arc $a
1374         # even if displayorder is right, hence the 3rd arg here
1375         modify_arc $v $a [expr {[llength $varccommits($v,$a)] - 1}]
1376     }
1377 }
1378
1379 # Mechanism for registering a command to be executed when we come
1380 # across a particular commit.  To handle the case when only the
1381 # prefix of the commit is known, the commitinterest array is now
1382 # indexed by the first 4 characters of the ID.  Each element is a
1383 # list of id, cmd pairs.
1384 proc interestedin {id cmd} {
1385     global commitinterest
1386
1387     lappend commitinterest([string range $id 0 3]) $id $cmd
1388 }
1389
1390 proc check_interest {id scripts} {
1391     global commitinterest
1392
1393     set prefix [string range $id 0 3]
1394     if {[info exists commitinterest($prefix)]} {
1395         set newlist {}
1396         foreach {i script} $commitinterest($prefix) {
1397             if {[string match "$i*" $id]} {
1398                 lappend scripts [string map [list "%I" $id "%P" $i] $script]
1399             } else {
1400                 lappend newlist $i $script
1401             }
1402         }
1403         if {$newlist ne {}} {
1404             set commitinterest($prefix) $newlist
1405         } else {
1406             unset commitinterest($prefix)
1407         }
1408     }
1409     return $scripts
1410 }
1411
1412 proc getcommitlines {fd inst view updating}  {
1413     global cmitlisted leftover
1414     global commitidx commitdata vdatemode
1415     global parents children curview hlview
1416     global idpending ordertok
1417     global varccommits varcid varctok vtokmod vfilelimit vshortids
1418
1419     set stuff [read $fd 500000]
1420     # git log doesn't terminate the last commit with a null...
1421     if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
1422         set stuff "\0"
1423     }
1424     if {$stuff == {}} {
1425         if {![eof $fd]} {
1426             return 1
1427         }
1428         global commfd viewcomplete viewactive viewname
1429         global viewinstances
1430         unset commfd($inst)
1431         set i [lsearch -exact $viewinstances($view) $inst]
1432         if {$i >= 0} {
1433             set viewinstances($view) [lreplace $viewinstances($view) $i $i]
1434         }
1435         # set it blocking so we wait for the process to terminate
1436         fconfigure $fd -blocking 1
1437         if {[catch {close $fd} err]} {
1438             set fv {}
1439             if {$view != $curview} {
1440                 set fv " for the \"$viewname($view)\" view"
1441             }
1442             if {[string range $err 0 4] == "usage"} {
1443                 set err "Gitk: error reading commits$fv:\
1444                         bad arguments to git log."
1445                 if {$viewname($view) eq [mc "Command line"]} {
1446                     append err \
1447                         "  (Note: arguments to gitk are passed to git log\
1448                          to allow selection of commits to be displayed.)"
1449                 }
1450             } else {
1451                 set err "Error reading commits$fv: $err"
1452             }
1453             error_popup $err
1454         }
1455         if {[incr viewactive($view) -1] <= 0} {
1456             set viewcomplete($view) 1
1457             # Check if we have seen any ids listed as parents that haven't
1458             # appeared in the list
1459             closevarcs $view
1460             notbusy $view
1461         }
1462         if {$view == $curview} {
1463             run chewcommits
1464         }
1465         return 0
1466     }
1467     set start 0
1468     set gotsome 0
1469     set scripts {}
1470     while 1 {
1471         set i [string first "\0" $stuff $start]
1472         if {$i < 0} {
1473             append leftover($inst) [string range $stuff $start end]
1474             break
1475         }
1476         if {$start == 0} {
1477             set cmit $leftover($inst)
1478             append cmit [string range $stuff 0 [expr {$i - 1}]]
1479             set leftover($inst) {}
1480         } else {
1481             set cmit [string range $stuff $start [expr {$i - 1}]]
1482         }
1483         set start [expr {$i + 1}]
1484         set j [string first "\n" $cmit]
1485         set ok 0
1486         set listed 1
1487         if {$j >= 0 && [string match "commit *" $cmit]} {
1488             set ids [string range $cmit 7 [expr {$j - 1}]]
1489             if {[string match {[-^<>]*} $ids]} {
1490                 switch -- [string index $ids 0] {
1491                     "-" {set listed 0}
1492                     "^" {set listed 2}
1493                     "<" {set listed 3}
1494                     ">" {set listed 4}
1495                 }
1496                 set ids [string range $ids 1 end]
1497             }
1498             set ok 1
1499             foreach id $ids {
1500                 if {[string length $id] != 40} {
1501                     set ok 0
1502                     break
1503                 }
1504             }
1505         }
1506         if {!$ok} {
1507             set shortcmit $cmit
1508             if {[string length $shortcmit] > 80} {
1509                 set shortcmit "[string range $shortcmit 0 80]..."
1510             }
1511             error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
1512             exit 1
1513         }
1514         set id [lindex $ids 0]
1515         set vid $view,$id
1516
1517         lappend vshortids($view,[string range $id 0 3]) $id
1518
1519         if {!$listed && $updating && ![info exists varcid($vid)] &&
1520             $vfilelimit($view) ne {}} {
1521             # git log doesn't rewrite parents for unlisted commits
1522             # when doing path limiting, so work around that here
1523             # by working out the rewritten parent with git rev-list
1524             # and if we already know about it, using the rewritten
1525             # parent as a substitute parent for $id's children.
1526             if {![catch {
1527                 set rwid [exec git rev-list --first-parent --max-count=1 \
1528                               $id -- $vfilelimit($view)]
1529             }]} {
1530                 if {$rwid ne {} && [info exists varcid($view,$rwid)]} {
1531                     # use $rwid in place of $id
1532                     rewrite_commit $view $id $rwid
1533                     continue
1534                 }
1535             }
1536         }
1537
1538         set a 0
1539         if {[info exists varcid($vid)]} {
1540             if {$cmitlisted($vid) || !$listed} continue
1541             set a $varcid($vid)
1542         }
1543         if {$listed} {
1544             set olds [lrange $ids 1 end]
1545         } else {
1546             set olds {}
1547         }
1548         set commitdata($id) [string range $cmit [expr {$j + 1}] end]
1549         set cmitlisted($vid) $listed
1550         set parents($vid) $olds
1551         if {![info exists children($vid)]} {
1552             set children($vid) {}
1553         } elseif {$a == 0 && [llength $children($vid)] == 1} {
1554             set k [lindex $children($vid) 0]
1555             if {[llength $parents($view,$k)] == 1 &&
1556                 (!$vdatemode($view) ||
1557                  $varcid($view,$k) == [llength $varctok($view)] - 1)} {
1558                 set a $varcid($view,$k)
1559             }
1560         }
1561         if {$a == 0} {
1562             # new arc
1563             set a [newvarc $view $id]
1564         }
1565         if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
1566             modify_arc $view $a
1567         }
1568         if {![info exists varcid($vid)]} {
1569             set varcid($vid) $a
1570             lappend varccommits($view,$a) $id
1571             incr commitidx($view)
1572         }
1573
1574         set i 0
1575         foreach p $olds {
1576             if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
1577                 set vp $view,$p
1578                 if {[llength [lappend children($vp) $id]] > 1 &&
1579                     [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
1580                     set children($vp) [lsort -command [list vtokcmp $view] \
1581                                            $children($vp)]
1582                     unset -nocomplain ordertok
1583                 }
1584                 if {[info exists varcid($view,$p)]} {
1585                     fix_reversal $p $a $view
1586                 }
1587             }
1588             incr i
1589         }
1590
1591         set scripts [check_interest $id $scripts]
1592         set gotsome 1
1593     }
1594     if {$gotsome} {
1595         global numcommits hlview
1596
1597         if {$view == $curview} {
1598             set numcommits $commitidx($view)
1599             run chewcommits
1600         }
1601         if {[info exists hlview] && $view == $hlview} {
1602             # we never actually get here...
1603             run vhighlightmore
1604         }
1605         foreach s $scripts {
1606             eval $s
1607         }
1608     }
1609     return 2
1610 }
1611
1612 proc chewcommits {} {
1613     global curview hlview viewcomplete
1614     global pending_select
1615
1616     layoutmore
1617     if {$viewcomplete($curview)} {
1618         global commitidx varctok
1619         global numcommits startmsecs
1620
1621         if {[info exists pending_select]} {
1622             update
1623             reset_pending_select {}
1624
1625             if {[commitinview $pending_select $curview]} {
1626                 selectline [rowofcommit $pending_select] 1
1627             } else {
1628                 set row [first_real_row]
1629                 selectline $row 1
1630             }
1631         }
1632         if {$commitidx($curview) > 0} {
1633             #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
1634             #puts "overall $ms ms for $numcommits commits"
1635             #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
1636         } else {
1637             show_status [mc "No commits selected"]
1638         }
1639         notbusy layout
1640     }
1641     return 0
1642 }
1643
1644 proc do_readcommit {id} {
1645     global tclencoding
1646
1647     # Invoke git-log to handle automatic encoding conversion
1648     set fd [open [concat | git log --no-color --pretty=raw -1 $id] r]
1649     # Read the results using i18n.logoutputencoding
1650     fconfigure $fd -translation lf -eofchar {}
1651     if {$tclencoding != {}} {
1652         fconfigure $fd -encoding $tclencoding
1653     }
1654     set contents [read $fd]
1655     close $fd
1656     # Remove the heading line
1657     regsub {^commit [0-9a-f]+\n} $contents {} contents
1658
1659     return $contents
1660 }
1661
1662 proc readcommit {id} {
1663     if {[catch {set contents [do_readcommit $id]}]} return
1664     parsecommit $id $contents 1
1665 }
1666
1667 proc parsecommit {id contents listed} {
1668     global commitinfo
1669
1670     set inhdr 1
1671     set comment {}
1672     set headline {}
1673     set auname {}
1674     set audate {}
1675     set comname {}
1676     set comdate {}
1677     set hdrend [string first "\n\n" $contents]
1678     if {$hdrend < 0} {
1679         # should never happen...
1680         set hdrend [string length $contents]
1681     }
1682     set header [string range $contents 0 [expr {$hdrend - 1}]]
1683     set comment [string range $contents [expr {$hdrend + 2}] end]
1684     foreach line [split $header "\n"] {
1685         set line [split $line " "]
1686         set tag [lindex $line 0]
1687         if {$tag == "author"} {
1688             set audate [lrange $line end-1 end]
1689             set auname [join [lrange $line 1 end-2] " "]
1690         } elseif {$tag == "committer"} {
1691             set comdate [lrange $line end-1 end]
1692             set comname [join [lrange $line 1 end-2] " "]
1693         }
1694     }
1695     set headline {}
1696     # take the first non-blank line of the comment as the headline
1697     set headline [string trimleft $comment]
1698     set i [string first "\n" $headline]
1699     if {$i >= 0} {
1700         set headline [string range $headline 0 $i]
1701     }
1702     set headline [string trimright $headline]
1703     set i [string first "\r" $headline]
1704     if {$i >= 0} {
1705         set headline [string trimright [string range $headline 0 $i]]
1706     }
1707     if {!$listed} {
1708         # git log indents the comment by 4 spaces;
1709         # if we got this via git cat-file, add the indentation
1710         set newcomment {}
1711         foreach line [split $comment "\n"] {
1712             append newcomment "    "
1713             append newcomment $line
1714             append newcomment "\n"
1715         }
1716         set comment $newcomment
1717     }
1718     set hasnote [string first "\nNotes:\n" $contents]
1719     set diff ""
1720     # If there is diff output shown in the git-log stream, split it
1721     # out.  But get rid of the empty line that always precedes the
1722     # diff.
1723     set i [string first "\n\ndiff" $comment]
1724     if {$i >= 0} {
1725         set diff [string range $comment $i+1 end]
1726         set comment [string range $comment 0 $i-1]
1727     }
1728     set commitinfo($id) [list $headline $auname $audate \
1729                              $comname $comdate $comment $hasnote $diff]
1730 }
1731
1732 proc getcommit {id} {
1733     global commitdata commitinfo
1734
1735     if {[info exists commitdata($id)]} {
1736         parsecommit $id $commitdata($id) 1
1737     } else {
1738         readcommit $id
1739         if {![info exists commitinfo($id)]} {
1740             set commitinfo($id) [list [mc "No commit information available"]]
1741         }
1742     }
1743     return 1
1744 }
1745
1746 # Expand an abbreviated commit ID to a list of full 40-char IDs that match
1747 # and are present in the current view.
1748 # This is fairly slow...
1749 proc longid {prefix} {
1750     global varcid curview vshortids
1751
1752     set ids {}
1753     if {[string length $prefix] >= 4} {
1754         set vshortid $curview,[string range $prefix 0 3]
1755         if {[info exists vshortids($vshortid)]} {
1756             foreach id $vshortids($vshortid) {
1757                 if {[string match "$prefix*" $id]} {
1758                     if {[lsearch -exact $ids $id] < 0} {
1759                         lappend ids $id
1760                         if {[llength $ids] >= 2} break
1761                     }
1762                 }
1763             }
1764         }
1765     } else {
1766         foreach match [array names varcid "$curview,$prefix*"] {
1767             lappend ids [lindex [split $match ","] 1]
1768             if {[llength $ids] >= 2} break
1769         }
1770     }
1771     return $ids
1772 }
1773
1774 proc readrefs {} {
1775     global tagids idtags headids idheads tagobjid
1776     global otherrefids idotherrefs mainhead mainheadid
1777     global selecthead selectheadid
1778     global hideremotes
1779
1780     foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
1781         unset -nocomplain $v
1782     }
1783     set refd [open [list | git show-ref -d] r]
1784     while {[gets $refd line] >= 0} {
1785         if {[string index $line 40] ne " "} continue
1786         set id [string range $line 0 39]
1787         set ref [string range $line 41 end]
1788         if {![string match "refs/*" $ref]} continue
1789         set name [string range $ref 5 end]
1790         if {[string match "remotes/*" $name]} {
1791             if {![string match "*/HEAD" $name] && !$hideremotes} {
1792                 set headids($name) $id
1793                 lappend idheads($id) $name
1794             }
1795         } elseif {[string match "heads/*" $name]} {
1796             set name [string range $name 6 end]
1797             set headids($name) $id
1798             lappend idheads($id) $name
1799         } elseif {[string match "tags/*" $name]} {
1800             # this lets refs/tags/foo^{} overwrite refs/tags/foo,
1801             # which is what we want since the former is the commit ID
1802             set name [string range $name 5 end]
1803             if {[string match "*^{}" $name]} {
1804                 set name [string range $name 0 end-3]
1805             } else {
1806                 set tagobjid($name) $id
1807             }
1808             set tagids($name) $id
1809             lappend idtags($id) $name
1810         } else {
1811             set otherrefids($name) $id
1812             lappend idotherrefs($id) $name
1813         }
1814     }
1815     catch {close $refd}
1816     set mainhead {}
1817     set mainheadid {}
1818     catch {
1819         set mainheadid [exec git rev-parse HEAD]
1820         set thehead [exec git symbolic-ref HEAD]
1821         if {[string match "refs/heads/*" $thehead]} {
1822             set mainhead [string range $thehead 11 end]
1823         }
1824     }
1825     set selectheadid {}
1826     if {$selecthead ne {}} {
1827         catch {
1828             set selectheadid [exec git rev-parse --verify $selecthead]
1829         }
1830     }
1831 }
1832
1833 # skip over fake commits
1834 proc first_real_row {} {
1835     global nullid nullid2 numcommits
1836
1837     for {set row 0} {$row < $numcommits} {incr row} {
1838         set id [commitonrow $row]
1839         if {$id ne $nullid && $id ne $nullid2} {
1840             break
1841         }
1842     }
1843     return $row
1844 }
1845
1846 # update things for a head moved to a child of its previous location
1847 proc movehead {id name} {
1848     global headids idheads
1849
1850     removehead $headids($name) $name
1851     set headids($name) $id
1852     lappend idheads($id) $name
1853 }
1854
1855 # update things when a head has been removed
1856 proc removehead {id name} {
1857     global headids idheads
1858
1859     if {$idheads($id) eq $name} {
1860         unset idheads($id)
1861     } else {
1862         set i [lsearch -exact $idheads($id) $name]
1863         if {$i >= 0} {
1864             set idheads($id) [lreplace $idheads($id) $i $i]
1865         }
1866     }
1867     unset headids($name)
1868 }
1869
1870 proc ttk_toplevel {w args} {
1871     global use_ttk
1872     eval [linsert $args 0 ::toplevel $w]
1873     if {$use_ttk} {
1874         place [ttk::frame $w._toplevel_background] -x 0 -y 0 -relwidth 1 -relheight 1
1875     }
1876     return $w
1877 }
1878
1879 proc make_transient {window origin} {
1880     global have_tk85
1881
1882     # In MacOS Tk 8.4 transient appears to work by setting
1883     # overrideredirect, which is utterly useless, since the
1884     # windows get no border, and are not even kept above
1885     # the parent.
1886     if {!$have_tk85 && [tk windowingsystem] eq {aqua}} return
1887
1888     wm transient $window $origin
1889
1890     # Windows fails to place transient windows normally, so
1891     # schedule a callback to center them on the parent.
1892     if {[tk windowingsystem] eq {win32}} {
1893         after idle [list tk::PlaceWindow $window widget $origin]
1894     }
1895 }
1896
1897 proc show_error {w top msg} {
1898     global NS
1899     if {![info exists NS]} {set NS ""}
1900     if {[wm state $top] eq "withdrawn"} { wm deiconify $top }
1901     message $w.m -text $msg -justify center -aspect 400
1902     pack $w.m -side top -fill x -padx 20 -pady 20
1903     ${NS}::button $w.ok -default active -text [mc OK] -command "destroy $top"
1904     pack $w.ok -side bottom -fill x
1905     bind $top <Visibility> "grab $top; focus $top"
1906     bind $top <Key-Return> "destroy $top"
1907     bind $top <Key-space>  "destroy $top"
1908     bind $top <Key-Escape> "destroy $top"
1909     tkwait window $top
1910 }
1911
1912 proc error_popup {msg {owner .}} {
1913     if {[tk windowingsystem] eq "win32"} {
1914         tk_messageBox -icon error -type ok -title [wm title .] \
1915             -parent $owner -message $msg
1916     } else {
1917         set w .error
1918         ttk_toplevel $w
1919         make_transient $w $owner
1920         show_error $w $w $msg
1921     }
1922 }
1923
1924 proc confirm_popup {msg {owner .}} {
1925     global confirm_ok NS
1926     set confirm_ok 0
1927     set w .confirm
1928     ttk_toplevel $w
1929     make_transient $w $owner
1930     message $w.m -text $msg -justify center -aspect 400
1931     pack $w.m -side top -fill x -padx 20 -pady 20
1932     ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
1933     pack $w.ok -side left -fill x
1934     ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
1935     pack $w.cancel -side right -fill x
1936     bind $w <Visibility> "grab $w; focus $w"
1937     bind $w <Key-Return> "set confirm_ok 1; destroy $w"
1938     bind $w <Key-space>  "set confirm_ok 1; destroy $w"
1939     bind $w <Key-Escape> "destroy $w"
1940     tk::PlaceWindow $w widget $owner
1941     tkwait window $w
1942     return $confirm_ok
1943 }
1944
1945 proc setoptions {} {
1946     if {[tk windowingsystem] ne "win32"} {
1947         option add *Panedwindow.showHandle 1 startupFile
1948         option add *Panedwindow.sashRelief raised startupFile
1949         if {[tk windowingsystem] ne "aqua"} {
1950             option add *Menu.font uifont startupFile
1951         }
1952     } else {
1953         option add *Menu.TearOff 0 startupFile
1954     }
1955     option add *Button.font uifont startupFile
1956     option add *Checkbutton.font uifont startupFile
1957     option add *Radiobutton.font uifont startupFile
1958     option add *Menubutton.font uifont startupFile
1959     option add *Label.font uifont startupFile
1960     option add *Message.font uifont startupFile
1961     option add *Entry.font textfont startupFile
1962     option add *Text.font textfont startupFile
1963     option add *Labelframe.font uifont startupFile
1964     option add *Spinbox.font textfont startupFile
1965     option add *Listbox.font mainfont startupFile
1966 }
1967
1968 # Make a menu and submenus.
1969 # m is the window name for the menu, items is the list of menu items to add.
1970 # Each item is a list {mc label type description options...}
1971 # mc is ignored; it's so we can put mc there to alert xgettext
1972 # label is the string that appears in the menu
1973 # type is cascade, command or radiobutton (should add checkbutton)
1974 # description depends on type; it's the sublist for cascade, the
1975 # command to invoke for command, or {variable value} for radiobutton
1976 proc makemenu {m items} {
1977     menu $m
1978     if {[tk windowingsystem] eq {aqua}} {
1979         set Meta1 Cmd
1980     } else {
1981         set Meta1 Ctrl
1982     }
1983     foreach i $items {
1984         set name [mc [lindex $i 1]]
1985         set type [lindex $i 2]
1986         set thing [lindex $i 3]
1987         set params [list $type]
1988         if {$name ne {}} {
1989             set u [string first "&" [string map {&& x} $name]]
1990             lappend params -label [string map {&& & & {}} $name]
1991             if {$u >= 0} {
1992                 lappend params -underline $u
1993             }
1994         }
1995         switch -- $type {
1996             "cascade" {
1997                 set submenu [string tolower [string map {& ""} [lindex $i 1]]]
1998                 lappend params -menu $m.$submenu
1999             }
2000             "command" {
2001                 lappend params -command $thing
2002             }
2003             "radiobutton" {
2004                 lappend params -variable [lindex $thing 0] \
2005                     -value [lindex $thing 1]
2006             }
2007         }
2008         set tail [lrange $i 4 end]
2009         regsub -all {\yMeta1\y} $tail $Meta1 tail
2010         eval $m add $params $tail
2011         if {$type eq "cascade"} {
2012             makemenu $m.$submenu $thing
2013         }
2014     }
2015 }
2016
2017 # translate string and remove ampersands
2018 proc mca {str} {
2019     return [string map {&& & & {}} [mc $str]]
2020 }
2021
2022 proc cleardropsel {w} {
2023     $w selection clear
2024 }
2025 proc makedroplist {w varname args} {
2026     global use_ttk
2027     if {$use_ttk} {
2028         set width 0
2029         foreach label $args {
2030             set cx [string length $label]
2031             if {$cx > $width} {set width $cx}
2032         }
2033         set gm [ttk::combobox $w -width $width -state readonly\
2034                     -textvariable $varname -values $args \
2035                     -exportselection false]
2036         bind $gm <<ComboboxSelected>> [list $gm selection clear]
2037     } else {
2038         set gm [eval [linsert $args 0 tk_optionMenu $w $varname]]
2039     }
2040     return $gm
2041 }
2042
2043 proc makewindow {} {
2044     global canv canv2 canv3 linespc charspc ctext cflist cscroll
2045     global tabstop
2046     global findtype findtypemenu findloc findstring fstring geometry
2047     global entries sha1entry sha1string sha1but
2048     global diffcontextstring diffcontext
2049     global ignorespace
2050     global maincursor textcursor curtextcursor
2051     global rowctxmenu fakerowmenu mergemax wrapcomment
2052     global highlight_files gdttype
2053     global searchstring sstring
2054     global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
2055     global uifgcolor uifgdisabledcolor
2056     global filesepbgcolor filesepfgcolor
2057     global mergecolors foundbgcolor currentsearchhitbgcolor
2058     global headctxmenu progresscanv progressitem progresscoords statusw
2059     global fprogitem fprogcoord lastprogupdate progupdatepending
2060     global rprogitem rprogcoord rownumsel numcommits
2061     global have_tk85 use_ttk NS
2062     global git_version
2063     global worddiff
2064
2065     # The "mc" arguments here are purely so that xgettext
2066     # sees the following string as needing to be translated
2067     set file {
2068         mc "&File" cascade {
2069             {mc "&Update" command updatecommits -accelerator F5}
2070             {mc "&Reload" command reloadcommits -accelerator Shift-F5}
2071             {mc "Reread re&ferences" command rereadrefs}
2072             {mc "&List references" command showrefs -accelerator F2}
2073             {xx "" separator}
2074             {mc "Start git &gui" command {exec git gui &}}
2075             {xx "" separator}
2076             {mc "&Quit" command doquit -accelerator Meta1-Q}
2077         }}
2078     set edit {
2079         mc "&Edit" cascade {
2080             {mc "&Preferences" command doprefs}
2081         }}
2082     set view {
2083         mc "&View" cascade {
2084             {mc "&New view..." command {newview 0} -accelerator Shift-F4}
2085             {mc "&Edit view..." command editview -state disabled -accelerator F4}
2086             {mc "&Delete view" command delview -state disabled}
2087             {xx "" separator}
2088             {mc "&All files" radiobutton {selectedview 0} -command {showview 0}}
2089         }}
2090     if {[tk windowingsystem] ne "aqua"} {
2091         set help {
2092         mc "&Help" cascade {
2093             {mc "&About gitk" command about}
2094             {mc "&Key bindings" command keys}
2095         }}
2096         set bar [list $file $edit $view $help]
2097     } else {
2098         proc ::tk::mac::ShowPreferences {} {doprefs}
2099         proc ::tk::mac::Quit {} {doquit}
2100         lset file end [lreplace [lindex $file end] end-1 end]
2101         set apple {
2102         xx "&Apple" cascade {
2103             {mc "&About gitk" command about}
2104             {xx "" separator}
2105         }}
2106         set help {
2107         mc "&Help" cascade {
2108             {mc "&Key bindings" command keys}
2109         }}
2110         set bar [list $apple $file $view $help]
2111     }
2112     makemenu .bar $bar
2113     . configure -menu .bar
2114
2115     if {$use_ttk} {
2116         # cover the non-themed toplevel with a themed frame.
2117         place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1
2118     }
2119
2120     # the gui has upper and lower half, parts of a paned window.
2121     ${NS}::panedwindow .ctop -orient vertical
2122
2123     # possibly use assumed geometry
2124     if {![info exists geometry(pwsash0)]} {
2125         set geometry(topheight) [expr {15 * $linespc}]
2126         set geometry(topwidth) [expr {80 * $charspc}]
2127         set geometry(botheight) [expr {15 * $linespc}]
2128         set geometry(botwidth) [expr {50 * $charspc}]
2129         set geometry(pwsash0) [list [expr {40 * $charspc}] 2]
2130         set geometry(pwsash1) [list [expr {60 * $charspc}] 2]
2131     }
2132
2133     # the upper half will have a paned window, a scroll bar to the right, and some stuff below
2134     ${NS}::frame .tf -height $geometry(topheight) -width $geometry(topwidth)
2135     ${NS}::frame .tf.histframe
2136     ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal
2137     if {!$use_ttk} {
2138         .tf.histframe.pwclist configure -sashpad 0 -handlesize 4
2139     }
2140
2141     # create three canvases
2142     set cscroll .tf.histframe.csb
2143     set canv .tf.histframe.pwclist.canv
2144     canvas $canv \
2145         -selectbackground $selectbgcolor \
2146         -background $bgcolor -bd 0 \
2147         -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
2148     .tf.histframe.pwclist add $canv
2149     set canv2 .tf.histframe.pwclist.canv2
2150     canvas $canv2 \
2151         -selectbackground $selectbgcolor \
2152         -background $bgcolor -bd 0 -yscrollincr $linespc
2153     .tf.histframe.pwclist add $canv2
2154     set canv3 .tf.histframe.pwclist.canv3
2155     canvas $canv3 \
2156         -selectbackground $selectbgcolor \
2157         -background $bgcolor -bd 0 -yscrollincr $linespc
2158     .tf.histframe.pwclist add $canv3
2159     if {$use_ttk} {
2160         bind .tf.histframe.pwclist <Map> {
2161             bind %W <Map> {}
2162             .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0]
2163             .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0]
2164         }
2165     } else {
2166         eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
2167         eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
2168     }
2169
2170     # a scroll bar to rule them
2171     ${NS}::scrollbar $cscroll -command {allcanvs yview}
2172     if {!$use_ttk} {$cscroll configure -highlightthickness 0}
2173     pack $cscroll -side right -fill y
2174     bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
2175     lappend bglist $canv $canv2 $canv3
2176     pack .tf.histframe.pwclist -fill both -expand 1 -side left
2177
2178     # we have two button bars at bottom of top frame. Bar 1
2179     ${NS}::frame .tf.bar
2180     ${NS}::frame .tf.lbar -height 15
2181
2182     set sha1entry .tf.bar.sha1
2183     set entries $sha1entry
2184     set sha1but .tf.bar.sha1label
2185     button $sha1but -text "[mc "SHA1 ID:"] " -state disabled -relief flat \
2186         -command gotocommit -width 8
2187     $sha1but conf -disabledforeground [$sha1but cget -foreground]
2188     pack .tf.bar.sha1label -side left
2189     ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string
2190     trace add variable sha1string write sha1change
2191     pack $sha1entry -side left -pady 2
2192
2193     set bm_left_data {
2194         #define left_width 16
2195         #define left_height 16
2196         static unsigned char left_bits[] = {
2197         0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
2198         0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
2199         0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
2200     }
2201     set bm_right_data {
2202         #define right_width 16
2203         #define right_height 16
2204         static unsigned char right_bits[] = {
2205         0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
2206         0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
2207         0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
2208     }
2209     image create bitmap bm-left -data $bm_left_data -foreground $uifgcolor
2210     image create bitmap bm-left-gray -data $bm_left_data -foreground $uifgdisabledcolor
2211     image create bitmap bm-right -data $bm_right_data -foreground $uifgcolor
2212     image create bitmap bm-right-gray -data $bm_right_data -foreground $uifgdisabledcolor
2213
2214     ${NS}::button .tf.bar.leftbut -command goback -state disabled -width 26
2215     if {$use_ttk} {
2216         .tf.bar.leftbut configure -image [list bm-left disabled bm-left-gray]
2217     } else {
2218         .tf.bar.leftbut configure -image bm-left
2219     }
2220     pack .tf.bar.leftbut -side left -fill y
2221     ${NS}::button .tf.bar.rightbut -command goforw -state disabled -width 26
2222     if {$use_ttk} {
2223         .tf.bar.rightbut configure -image [list bm-right disabled bm-right-gray]
2224     } else {
2225         .tf.bar.rightbut configure -image bm-right
2226     }
2227     pack .tf.bar.rightbut -side left -fill y
2228
2229     ${NS}::label .tf.bar.rowlabel -text [mc "Row"]
2230     set rownumsel {}
2231     ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \
2232         -relief sunken -anchor e
2233     ${NS}::label .tf.bar.rowlabel2 -text "/"
2234     ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \
2235         -relief sunken -anchor e
2236     pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
2237         -side left
2238     if {!$use_ttk} {
2239         foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont}
2240     }
2241     global selectedline
2242     trace add variable selectedline write selectedline_change
2243
2244     # Status label and progress bar
2245     set statusw .tf.bar.status
2246     ${NS}::label $statusw -width 15 -relief sunken
2247     pack $statusw -side left -padx 5
2248     if {$use_ttk} {
2249         set progresscanv [ttk::progressbar .tf.bar.progress]
2250     } else {
2251         set h [expr {[font metrics uifont -linespace] + 2}]
2252         set progresscanv .tf.bar.progress
2253         canvas $progresscanv -relief sunken -height $h -borderwidth 2
2254         set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
2255         set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
2256         set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
2257     }
2258     pack $progresscanv -side right -expand 1 -fill x -padx {0 2}
2259     set progresscoords {0 0}
2260     set fprogcoord 0
2261     set rprogcoord 0
2262     bind $progresscanv <Configure> adjustprogress
2263     set lastprogupdate [clock clicks -milliseconds]
2264     set progupdatepending 0
2265
2266     # build up the bottom bar of upper window
2267     ${NS}::label .tf.lbar.flabel -text "[mc "Find"] "
2268
2269     set bm_down_data {
2270         #define down_width 16
2271         #define down_height 16
2272         static unsigned char down_bits[] = {
2273         0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2274         0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2275         0x87, 0xe1, 0x8e, 0x71, 0x9c, 0x39, 0xb8, 0x1d,
2276         0xf0, 0x0f, 0xe0, 0x07, 0xc0, 0x03, 0x80, 0x01};
2277     }
2278     image create bitmap bm-down -data $bm_down_data -foreground $uifgcolor
2279     ${NS}::button .tf.lbar.fnext -width 26 -command {dofind 1 1}
2280     .tf.lbar.fnext configure -image bm-down
2281
2282     set bm_up_data {
2283         #define up_width 16
2284         #define up_height 16
2285         static unsigned char up_bits[] = {
2286         0x80, 0x01, 0xc0, 0x03, 0xe0, 0x07, 0xf0, 0x0f,
2287         0xb8, 0x1d, 0x9c, 0x39, 0x8e, 0x71, 0x87, 0xe1,
2288         0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
2289         0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01};
2290     }
2291     image create bitmap bm-up -data $bm_up_data -foreground $uifgcolor
2292     ${NS}::button .tf.lbar.fprev -width 26 -command {dofind -1 1}
2293     .tf.lbar.fprev configure -image bm-up
2294
2295     ${NS}::label .tf.lbar.flab2 -text " [mc "commit"] "
2296
2297     pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
2298         -side left -fill y
2299     set gdttype [mc "containing:"]
2300     set gm [makedroplist .tf.lbar.gdttype gdttype \
2301                 [mc "containing:"] \
2302                 [mc "touching paths:"] \
2303                 [mc "adding/removing string:"] \
2304                 [mc "changing lines matching:"]]
2305     trace add variable gdttype write gdttype_change
2306     pack .tf.lbar.gdttype -side left -fill y
2307
2308     set findstring {}
2309     set fstring .tf.lbar.findstring
2310     lappend entries $fstring
2311     ${NS}::entry $fstring -width 30 -textvariable findstring
2312     trace add variable findstring write find_change
2313     set findtype [mc "Exact"]
2314     set findtypemenu [makedroplist .tf.lbar.findtype \
2315                           findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
2316     trace add variable findtype write findcom_change
2317     set findloc [mc "All fields"]
2318     makedroplist .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
2319         [mc "Comments"] [mc "Author"] [mc "Committer"]
2320     trace add variable findloc write find_change
2321     pack .tf.lbar.findloc -side right
2322     pack .tf.lbar.findtype -side right
2323     pack $fstring -side left -expand 1 -fill x
2324
2325     # Finish putting the upper half of the viewer together
2326     pack .tf.lbar -in .tf -side bottom -fill x
2327     pack .tf.bar -in .tf -side bottom -fill x
2328     pack .tf.histframe -fill both -side top -expand 1
2329     .ctop add .tf
2330     if {!$use_ttk} {
2331         .ctop paneconfigure .tf -height $geometry(topheight)
2332         .ctop paneconfigure .tf -width $geometry(topwidth)
2333     }
2334
2335     # now build up the bottom
2336     ${NS}::panedwindow .pwbottom -orient horizontal
2337
2338     # lower left, a text box over search bar, scroll bar to the right
2339     # if we know window height, then that will set the lower text height, otherwise
2340     # we set lower text height which will drive window height
2341     if {[info exists geometry(main)]} {
2342         ${NS}::frame .bleft -width $geometry(botwidth)
2343     } else {
2344         ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
2345     }
2346     ${NS}::frame .bleft.top
2347     ${NS}::frame .bleft.mid
2348     ${NS}::frame .bleft.bottom
2349
2350     ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch
2351     pack .bleft.top.search -side left -padx 5
2352     set sstring .bleft.top.sstring
2353     set searchstring ""
2354     ${NS}::entry $sstring -width 20 -textvariable searchstring
2355     lappend entries $sstring
2356     trace add variable searchstring write incrsearch
2357     pack $sstring -side left -expand 1 -fill x
2358     ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \
2359         -command changediffdisp -variable diffelide -value {0 0}
2360     ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \
2361         -command changediffdisp -variable diffelide -value {0 1}
2362     ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \
2363         -command changediffdisp -variable diffelide -value {1 0}
2364     ${NS}::label .bleft.mid.labeldiffcontext -text "      [mc "Lines of context"]: "
2365     pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
2366     spinbox .bleft.mid.diffcontext -width 5 \
2367         -from 0 -increment 1 -to 10000000 \
2368         -validate all -validatecommand "diffcontextvalidate %P" \
2369         -textvariable diffcontextstring
2370     .bleft.mid.diffcontext set $diffcontext
2371     trace add variable diffcontextstring write diffcontextchange
2372     lappend entries .bleft.mid.diffcontext
2373     pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
2374     ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
2375         -command changeignorespace -variable ignorespace
2376     pack .bleft.mid.ignspace -side left -padx 5
2377
2378     set worddiff [mc "Line diff"]
2379     if {[package vcompare $git_version "1.7.2"] >= 0} {
2380         makedroplist .bleft.mid.worddiff worddiff [mc "Line diff"] \
2381             [mc "Markup words"] [mc "Color words"]
2382         trace add variable worddiff write changeworddiff
2383         pack .bleft.mid.worddiff -side left -padx 5
2384     }
2385
2386     set ctext .bleft.bottom.ctext
2387     text $ctext -background $bgcolor -foreground $fgcolor \
2388         -state disabled -font textfont \
2389         -yscrollcommand scrolltext -wrap none \
2390         -xscrollcommand ".bleft.bottom.sbhorizontal set"
2391     if {$have_tk85} {
2392         $ctext conf -tabstyle wordprocessor
2393     }
2394     ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview"
2395     ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h
2396     pack .bleft.top -side top -fill x
2397     pack .bleft.mid -side top -fill x
2398     grid $ctext .bleft.bottom.sb -sticky nsew
2399     grid .bleft.bottom.sbhorizontal -sticky ew
2400     grid columnconfigure .bleft.bottom 0 -weight 1
2401     grid rowconfigure .bleft.bottom 0 -weight 1
2402     grid rowconfigure .bleft.bottom 1 -weight 0
2403     pack .bleft.bottom -side top -fill both -expand 1
2404     lappend bglist $ctext
2405     lappend fglist $ctext
2406
2407     $ctext tag conf comment -wrap $wrapcomment
2408     $ctext tag conf filesep -font textfontbold -fore $filesepfgcolor -back $filesepbgcolor
2409     $ctext tag conf hunksep -fore [lindex $diffcolors 2]
2410     $ctext tag conf d0 -fore [lindex $diffcolors 0]
2411     $ctext tag conf dresult -fore [lindex $diffcolors 1]
2412     $ctext tag conf m0 -fore [lindex $mergecolors 0]
2413     $ctext tag conf m1 -fore [lindex $mergecolors 1]
2414     $ctext tag conf m2 -fore [lindex $mergecolors 2]
2415     $ctext tag conf m3 -fore [lindex $mergecolors 3]
2416     $ctext tag conf m4 -fore [lindex $mergecolors 4]
2417     $ctext tag conf m5 -fore [lindex $mergecolors 5]
2418     $ctext tag conf m6 -fore [lindex $mergecolors 6]
2419     $ctext tag conf m7 -fore [lindex $mergecolors 7]
2420     $ctext tag conf m8 -fore [lindex $mergecolors 8]
2421     $ctext tag conf m9 -fore [lindex $mergecolors 9]
2422     $ctext tag conf m10 -fore [lindex $mergecolors 10]
2423     $ctext tag conf m11 -fore [lindex $mergecolors 11]
2424     $ctext tag conf m12 -fore [lindex $mergecolors 12]
2425     $ctext tag conf m13 -fore [lindex $mergecolors 13]
2426     $ctext tag conf m14 -fore [lindex $mergecolors 14]
2427     $ctext tag conf m15 -fore [lindex $mergecolors 15]
2428     $ctext tag conf mmax -fore darkgrey
2429     set mergemax 16
2430     $ctext tag conf mresult -font textfontbold
2431     $ctext tag conf msep -font textfontbold
2432     $ctext tag conf found -back $foundbgcolor
2433     $ctext tag conf currentsearchhit -back $currentsearchhitbgcolor
2434     $ctext tag conf wwrap -wrap word -lmargin2 1c
2435     $ctext tag conf bold -font textfontbold
2436
2437     .pwbottom add .bleft
2438     if {!$use_ttk} {
2439         .pwbottom paneconfigure .bleft -width $geometry(botwidth)
2440     }
2441
2442     # lower right
2443     ${NS}::frame .bright
2444     ${NS}::frame .bright.mode
2445     ${NS}::radiobutton .bright.mode.patch -text [mc "Patch"] \
2446         -command reselectline -variable cmitmode -value "patch"
2447     ${NS}::radiobutton .bright.mode.tree -text [mc "Tree"] \
2448         -command reselectline -variable cmitmode -value "tree"
2449     grid .bright.mode.patch .bright.mode.tree -sticky ew
2450     pack .bright.mode -side top -fill x
2451     set cflist .bright.cfiles
2452     set indent [font measure mainfont "nn"]
2453     text $cflist \
2454         -selectbackground $selectbgcolor \
2455         -background $bgcolor -foreground $fgcolor \
2456         -font mainfont \
2457         -tabs [list $indent [expr {2 * $indent}]] \
2458         -yscrollcommand ".bright.sb set" \
2459         -cursor [. cget -cursor] \
2460         -spacing1 1 -spacing3 1
2461     lappend bglist $cflist
2462     lappend fglist $cflist
2463     ${NS}::scrollbar .bright.sb -command "$cflist yview"
2464     pack .bright.sb -side right -fill y
2465     pack $cflist -side left -fill both -expand 1
2466     $cflist tag configure highlight \
2467         -background [$cflist cget -selectbackground]
2468     $cflist tag configure bold -font mainfontbold
2469
2470     .pwbottom add .bright
2471     .ctop add .pwbottom
2472
2473     # restore window width & height if known
2474     if {[info exists geometry(main)]} {
2475         if {[scan $geometry(main) "%dx%d" w h] >= 2} {
2476             if {$w > [winfo screenwidth .]} {
2477                 set w [winfo screenwidth .]
2478             }
2479             if {$h > [winfo screenheight .]} {
2480                 set h [winfo screenheight .]
2481             }
2482             wm geometry . "${w}x$h"
2483         }
2484     }
2485
2486     if {[info exists geometry(state)] && $geometry(state) eq "zoomed"} {
2487         wm state . $geometry(state)
2488     }
2489
2490     if {[tk windowingsystem] eq {aqua}} {
2491         set M1B M1
2492         set ::BM "3"
2493     } else {
2494         set M1B Control
2495         set ::BM "2"
2496     }
2497
2498     if {$use_ttk} {
2499         bind .ctop <Map> {
2500             bind %W <Map> {}
2501             %W sashpos 0 $::geometry(topheight)
2502         }
2503         bind .pwbottom <Map> {
2504             bind %W <Map> {}
2505             %W sashpos 0 $::geometry(botwidth)
2506         }
2507     }
2508
2509     bind .pwbottom <Configure> {resizecdetpanes %W %w}
2510     pack .ctop -fill both -expand 1
2511     bindall <1> {selcanvline %W %x %y}
2512     #bindall <B1-Motion> {selcanvline %W %x %y}
2513     if {[tk windowingsystem] == "win32"} {
2514         bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
2515         bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
2516     } else {
2517         bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
2518         bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
2519         bind $ctext <Button> {
2520             if {"%b" eq 6} {
2521                 $ctext xview scroll -5 units
2522             } elseif {"%b" eq 7} {
2523                 $ctext xview scroll 5 units
2524             }
2525         }
2526         if {[tk windowingsystem] eq "aqua"} {
2527             bindall <MouseWheel> {
2528                 set delta [expr {- (%D)}]
2529                 allcanvs yview scroll $delta units
2530             }
2531             bindall <Shift-MouseWheel> {
2532                 set delta [expr {- (%D)}]
2533                 $canv xview scroll $delta units
2534             }
2535         }
2536     }
2537     bindall <$::BM> "canvscan mark %W %x %y"
2538     bindall <B$::BM-Motion> "canvscan dragto %W %x %y"
2539     bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2540     bind . <$M1B-Key-w> doquit
2541     bindkey <Home> selfirstline
2542     bindkey <End> sellastline
2543     bind . <Key-Up> "selnextline -1"
2544     bind . <Key-Down> "selnextline 1"
2545     bind . <Shift-Key-Up> "dofind -1 0"
2546     bind . <Shift-Key-Down> "dofind 1 0"
2547     bindkey <Key-Right> "goforw"
2548     bindkey <Key-Left> "goback"
2549     bind . <Key-Prior> "selnextpage -1"
2550     bind . <Key-Next> "selnextpage 1"
2551     bind . <$M1B-Home> "allcanvs yview moveto 0.0"
2552     bind . <$M1B-End> "allcanvs yview moveto 1.0"
2553     bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
2554     bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
2555     bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
2556     bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
2557     bindkey <Key-Delete> "$ctext yview scroll -1 pages"
2558     bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
2559     bindkey <Key-space> "$ctext yview scroll 1 pages"
2560     bindkey p "selnextline -1"
2561     bindkey n "selnextline 1"
2562     bindkey z "goback"
2563     bindkey x "goforw"
2564     bindkey k "selnextline -1"
2565     bindkey j "selnextline 1"
2566     bindkey h "goback"
2567     bindkey l "goforw"
2568     bindkey b prevfile
2569     bindkey d "$ctext yview scroll 18 units"
2570     bindkey u "$ctext yview scroll -18 units"
2571     bindkey g {$sha1entry delete 0 end; focus $sha1entry}
2572     bindkey / {focus $fstring}
2573     bindkey <Key-KP_Divide> {focus $fstring}
2574     bindkey <Key-Return> {dofind 1 1}
2575     bindkey ? {dofind -1 1}
2576     bindkey f nextfile
2577     bind . <F5> updatecommits
2578     bindmodfunctionkey Shift 5 reloadcommits
2579     bind . <F2> showrefs
2580     bindmodfunctionkey Shift 4 {newview 0}
2581     bind . <F4> edit_or_newview
2582     bind . <$M1B-q> doquit
2583     bind . <$M1B-f> {dofind 1 1}
2584     bind . <$M1B-g> {dofind 1 0}
2585     bind . <$M1B-r> dosearchback
2586     bind . <$M1B-s> dosearch
2587     bind . <$M1B-equal> {incrfont 1}
2588     bind . <$M1B-plus> {incrfont 1}
2589     bind . <$M1B-KP_Add> {incrfont 1}
2590     bind . <$M1B-minus> {incrfont -1}
2591     bind . <$M1B-KP_Subtract> {incrfont -1}
2592     wm protocol . WM_DELETE_WINDOW doquit
2593     bind . <Destroy> {stop_backends}
2594     bind . <Button-1> "click %W"
2595     bind $fstring <Key-Return> {dofind 1 1}
2596     bind $sha1entry <Key-Return> {gotocommit; break}
2597     bind $sha1entry <<PasteSelection>> clearsha1
2598     bind $sha1entry <<Paste>> clearsha1
2599     bind $cflist <1> {sel_flist %W %x %y; break}
2600     bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
2601     bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
2602     global ctxbut
2603     bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
2604     bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
2605     bind $ctext <Button-1> {focus %W}
2606     bind $ctext <<Selection>> rehighlight_search_results
2607     for {set i 1} {$i < 10} {incr i} {
2608         bind . <$M1B-Key-$i> [list go_to_parent $i]
2609     }
2610
2611     set maincursor [. cget -cursor]
2612     set textcursor [$ctext cget -cursor]
2613     set curtextcursor $textcursor
2614
2615     set rowctxmenu .rowctxmenu
2616     makemenu $rowctxmenu {
2617         {mc "Diff this -> selected" command {diffvssel 0}}
2618         {mc "Diff selected -> this" command {diffvssel 1}}
2619         {mc "Make patch" command mkpatch}
2620         {mc "Create tag" command mktag}
2621         {mc "Copy commit summary" command copysummary}
2622         {mc "Write commit to file" command writecommit}
2623         {mc "Create new branch" command mkbranch}
2624         {mc "Cherry-pick this commit" command cherrypick}
2625         {mc "Reset HEAD branch to here" command resethead}
2626         {mc "Mark this commit" command markhere}
2627         {mc "Return to mark" command gotomark}
2628         {mc "Find descendant of this and mark" command find_common_desc}
2629         {mc "Compare with marked commit" command compare_commits}
2630         {mc "Diff this -> marked commit" command {diffvsmark 0}}
2631         {mc "Diff marked commit -> this" command {diffvsmark 1}}
2632         {mc "Revert this commit" command revert}
2633     }
2634     $rowctxmenu configure -tearoff 0
2635
2636     set fakerowmenu .fakerowmenu
2637     makemenu $fakerowmenu {
2638         {mc "Diff this -> selected" command {diffvssel 0}}
2639         {mc "Diff selected -> this" command {diffvssel 1}}
2640         {mc "Make patch" command mkpatch}
2641         {mc "Diff this -> marked commit" command {diffvsmark 0}}
2642         {mc "Diff marked commit -> this" command {diffvsmark 1}}
2643     }
2644     $fakerowmenu configure -tearoff 0
2645
2646     set headctxmenu .headctxmenu
2647     makemenu $headctxmenu {
2648         {mc "Check out this branch" command cobranch}
2649         {mc "Remove this branch" command rmbranch}
2650         {mc "Copy branch name" command {clipboard clear; clipboard append $headmenuhead}}
2651     }
2652     $headctxmenu configure -tearoff 0
2653
2654     global flist_menu
2655     set flist_menu .flistctxmenu
2656     makemenu $flist_menu {
2657         {mc "Highlight this too" command {flist_hl 0}}
2658         {mc "Highlight this only" command {flist_hl 1}}
2659         {mc "External diff" command {external_diff}}
2660         {mc "Blame parent commit" command {external_blame 1}}
2661         {mc "Copy path" command {clipboard clear; clipboard append $flist_menu_file}}
2662     }
2663     $flist_menu configure -tearoff 0
2664
2665     global diff_menu
2666     set diff_menu .diffctxmenu
2667     makemenu $diff_menu {
2668         {mc "Show origin of this line" command show_line_source}
2669         {mc "Run git gui blame on this line" command {external_blame_diff}}
2670     }
2671     $diff_menu configure -tearoff 0
2672 }
2673
2674 # Windows sends all mouse wheel events to the current focused window, not
2675 # the one where the mouse hovers, so bind those events here and redirect
2676 # to the correct window
2677 proc windows_mousewheel_redirector {W X Y D} {
2678     global canv canv2 canv3
2679     set w [winfo containing -displayof $W $X $Y]
2680     if {$w ne ""} {
2681         set u [expr {$D < 0 ? 5 : -5}]
2682         if {$w == $canv || $w == $canv2 || $w == $canv3} {
2683             allcanvs yview scroll $u units
2684         } else {
2685             catch {
2686                 $w yview scroll $u units
2687             }
2688         }
2689     }
2690 }
2691
2692 # Update row number label when selectedline changes
2693 proc selectedline_change {n1 n2 op} {
2694     global selectedline rownumsel
2695
2696     if {$selectedline eq {}} {
2697         set rownumsel {}
2698     } else {
2699         set rownumsel [expr {$selectedline + 1}]
2700     }
2701 }
2702
2703 # mouse-2 makes all windows scan vertically, but only the one
2704 # the cursor is in scans horizontally
2705 proc canvscan {op w x y} {
2706     global canv canv2 canv3
2707     foreach c [list $canv $canv2 $canv3] {
2708         if {$c == $w} {
2709             $c scan $op $x $y
2710         } else {
2711             $c scan $op 0 $y
2712         }
2713     }
2714 }
2715
2716 proc scrollcanv {cscroll f0 f1} {
2717     $cscroll set $f0 $f1
2718     drawvisible
2719     flushhighlights
2720 }
2721
2722 # when we make a key binding for the toplevel, make sure
2723 # it doesn't get triggered when that key is pressed in the
2724 # find string entry widget.
2725 proc bindkey {ev script} {
2726     global entries
2727     bind . $ev $script
2728     set escript [bind Entry $ev]
2729     if {$escript == {}} {
2730         set escript [bind Entry <Key>]
2731     }
2732     foreach e $entries {
2733         bind $e $ev "$escript; break"
2734     }
2735 }
2736
2737 proc bindmodfunctionkey {mod n script} {
2738     bind . <$mod-F$n> $script
2739     catch { bind . <$mod-XF86_Switch_VT_$n> $script }
2740 }
2741
2742 # set the focus back to the toplevel for any click outside
2743 # the entry widgets
2744 proc click {w} {
2745     global ctext entries
2746     foreach e [concat $entries $ctext] {
2747         if {$w == $e} return
2748     }
2749     focus .
2750 }
2751
2752 # Adjust the progress bar for a change in requested extent or canvas size
2753 proc adjustprogress {} {
2754     global progresscanv progressitem progresscoords
2755     global fprogitem fprogcoord lastprogupdate progupdatepending
2756     global rprogitem rprogcoord use_ttk
2757
2758     if {$use_ttk} {
2759         $progresscanv configure -value [expr {int($fprogcoord * 100)}]
2760         return
2761     }
2762
2763     set w [expr {[winfo width $progresscanv] - 4}]
2764     set x0 [expr {$w * [lindex $progresscoords 0]}]
2765     set x1 [expr {$w * [lindex $progresscoords 1]}]
2766     set h [winfo height $progresscanv]
2767     $progresscanv coords $progressitem $x0 0 $x1 $h
2768     $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
2769     $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
2770     set now [clock clicks -milliseconds]
2771     if {$now >= $lastprogupdate + 100} {
2772         set progupdatepending 0
2773         update
2774     } elseif {!$progupdatepending} {
2775         set progupdatepending 1
2776         after [expr {$lastprogupdate + 100 - $now}] doprogupdate
2777     }
2778 }
2779
2780 proc doprogupdate {} {
2781     global lastprogupdate progupdatepending
2782
2783     if {$progupdatepending} {
2784         set progupdatepending 0
2785         set lastprogupdate [clock clicks -milliseconds]
2786         update
2787     }
2788 }
2789
2790 proc config_check_tmp_exists {tries_left} {
2791     global config_file_tmp
2792
2793     if {[file exists $config_file_tmp]} {
2794         incr tries_left -1
2795         if {$tries_left > 0} {
2796             after 100 [list config_check_tmp_exists $tries_left]
2797         } else {
2798             error_popup "There appears to be a stale $config_file_tmp\
2799  file, which will prevent gitk from saving its configuration on exit.\
2800  Please remove it if it is not being used by any existing gitk process."
2801         }
2802     }
2803 }
2804
2805 proc config_init_trace {name} {
2806     global config_variable_changed config_variable_original
2807
2808     upvar #0 $name var
2809     set config_variable_changed($name) 0
2810     set config_variable_original($name) $var
2811 }
2812
2813 proc config_variable_change_cb {name name2 op} {
2814     global config_variable_changed config_variable_original
2815
2816     upvar #0 $name var
2817     if {$op eq "write" &&
2818         (![info exists config_variable_original($name)] ||
2819          $config_variable_original($name) ne $var)} {
2820         set config_variable_changed($name) 1
2821     }
2822 }
2823
2824 proc savestuff {w} {
2825     global stuffsaved
2826     global config_file config_file_tmp
2827     global config_variables config_variable_changed
2828     global viewchanged
2829
2830     upvar #0 viewname current_viewname
2831     upvar #0 viewfiles current_viewfiles
2832     upvar #0 viewargs current_viewargs
2833     upvar #0 viewargscmd current_viewargscmd
2834     upvar #0 viewperm current_viewperm
2835     upvar #0 nextviewnum current_nextviewnum
2836     upvar #0 use_ttk current_use_ttk
2837
2838     if {$stuffsaved} return
2839     if {![winfo viewable .]} return
2840     set remove_tmp 0
2841     if {[catch {
2842         set try_count 0
2843         while {[catch {set f [open $config_file_tmp {WRONLY CREAT EXCL}]}]} {
2844             if {[incr try_count] > 50} {
2845                 error "Unable to write config file: $config_file_tmp exists"
2846             }
2847             after 100
2848         }
2849         set remove_tmp 1
2850         if {$::tcl_platform(platform) eq {windows}} {
2851             file attributes $config_file_tmp -hidden true
2852         }
2853         if {[file exists $config_file]} {
2854             source $config_file
2855         }
2856         foreach var_name $config_variables {
2857             upvar #0 $var_name var
2858             upvar 0 $var_name old_var
2859             if {!$config_variable_changed($var_name) && [info exists old_var]} {
2860                 puts $f [list set $var_name $old_var]
2861             } else {
2862                 puts $f [list set $var_name $var]
2863             }
2864         }
2865
2866         puts $f "set geometry(main) [wm geometry .]"
2867         puts $f "set geometry(state) [wm state .]"
2868         puts $f "set geometry(topwidth) [winfo width .tf]"
2869         puts $f "set geometry(topheight) [winfo height .tf]"
2870         if {$current_use_ttk} {
2871             puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
2872             puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
2873         } else {
2874             puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
2875             puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
2876         }
2877         puts $f "set geometry(botwidth) [winfo width .bleft]"
2878         puts $f "set geometry(botheight) [winfo height .bleft]"
2879
2880         array set view_save {}
2881         array set views {}
2882         if {![info exists permviews]} { set permviews {} }
2883         foreach view $permviews {
2884             set view_save([lindex $view 0]) 1
2885             set views([lindex $view 0]) $view
2886         }
2887         puts -nonewline $f "set permviews {"
2888         for {set v 1} {$v < $current_nextviewnum} {incr v} {
2889             if {$viewchanged($v)} {
2890                 if {$current_viewperm($v)} {
2891                     set views($current_viewname($v)) [list $current_viewname($v) $current_viewfiles($v) $current_viewargs($v) $current_viewargscmd($v)]
2892                 } else {
2893                     set view_save($current_viewname($v)) 0
2894                 }
2895             }
2896         }
2897         # write old and updated view to their places and append remaining to the end
2898         foreach view $permviews {
2899             set view_name [lindex $view 0]
2900             if {$view_save($view_name)} {
2901                 puts $f "{$views($view_name)}"
2902             }
2903             unset views($view_name)
2904         }
2905         foreach view_name [array names views] {
2906             puts $f "{$views($view_name)}"
2907         }
2908         puts $f "}"
2909         close $f
2910         file rename -force $config_file_tmp $config_file
2911         set remove_tmp 0
2912     } err]} {
2913         puts "Error saving config: $err"
2914     }
2915     if {$remove_tmp} {
2916         file delete -force $config_file_tmp
2917     }
2918     set stuffsaved 1
2919 }
2920
2921 proc resizeclistpanes {win w} {
2922     global oldwidth use_ttk
2923     if {[info exists oldwidth($win)]} {
2924         if {$use_ttk} {
2925             set s0 [$win sashpos 0]
2926             set s1 [$win sashpos 1]
2927         } else {
2928             set s0 [$win sash coord 0]
2929             set s1 [$win sash coord 1]
2930         }
2931         if {$w < 60} {
2932             set sash0 [expr {int($w/2 - 2)}]
2933             set sash1 [expr {int($w*5/6 - 2)}]
2934         } else {
2935             set factor [expr {1.0 * $w / $oldwidth($win)}]
2936             set sash0 [expr {int($factor * [lindex $s0 0])}]
2937             set sash1 [expr {int($factor * [lindex $s1 0])}]
2938             if {$sash0 < 30} {
2939                 set sash0 30
2940             }
2941             if {$sash1 < $sash0 + 20} {
2942                 set sash1 [expr {$sash0 + 20}]
2943             }
2944             if {$sash1 > $w - 10} {
2945                 set sash1 [expr {$w - 10}]
2946                 if {$sash0 > $sash1 - 20} {
2947                     set sash0 [expr {$sash1 - 20}]
2948                 }
2949             }
2950         }
2951         if {$use_ttk} {
2952             $win sashpos 0 $sash0
2953             $win sashpos 1 $sash1
2954         } else {
2955             $win sash place 0 $sash0 [lindex $s0 1]
2956             $win sash place 1 $sash1 [lindex $s1 1]
2957         }
2958     }
2959     set oldwidth($win) $w
2960 }
2961
2962 proc resizecdetpanes {win w} {
2963     global oldwidth use_ttk
2964     if {[info exists oldwidth($win)]} {
2965         if {$use_ttk} {
2966             set s0 [$win sashpos 0]
2967         } else {
2968             set s0 [$win sash coord 0]
2969         }
2970         if {$w < 60} {
2971             set sash0 [expr {int($w*3/4 - 2)}]
2972         } else {
2973             set factor [expr {1.0 * $w / $oldwidth($win)}]
2974             set sash0 [expr {int($factor * [lindex $s0 0])}]
2975             if {$sash0 < 45} {
2976                 set sash0 45
2977             }
2978             if {$sash0 > $w - 15} {
2979                 set sash0 [expr {$w - 15}]
2980             }
2981         }
2982         if {$use_ttk} {
2983             $win sashpos 0 $sash0
2984         } else {
2985             $win sash place 0 $sash0 [lindex $s0 1]
2986         }
2987     }
2988     set oldwidth($win) $w
2989 }
2990
2991 proc allcanvs args {
2992     global canv canv2 canv3
2993     eval $canv $args
2994     eval $canv2 $args
2995     eval $canv3 $args
2996 }
2997
2998 proc bindall {event action} {
2999     global canv canv2 canv3
3000     bind $canv $event $action
3001     bind $canv2 $event $action
3002     bind $canv3 $event $action
3003 }
3004
3005 proc about {} {
3006     global uifont NS
3007     set w .about
3008     if {[winfo exists $w]} {
3009         raise $w
3010         return
3011     }
3012     ttk_toplevel $w
3013     wm title $w [mc "About gitk"]
3014     make_transient $w .
3015     message $w.m -text [mc "
3016 Gitk - a commit viewer for git
3017
3018 Copyright \u00a9 2005-2014 Paul Mackerras
3019
3020 Use and redistribute under the terms of the GNU General Public License"] \
3021             -justify center -aspect 400 -border 2 -bg white -relief groove
3022     pack $w.m -side top -fill x -padx 2 -pady 2
3023     ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
3024     pack $w.ok -side bottom
3025     bind $w <Visibility> "focus $w.ok"
3026     bind $w <Key-Escape> "destroy $w"
3027     bind $w <Key-Return> "destroy $w"
3028     tk::PlaceWindow $w widget .
3029 }
3030
3031 proc keys {} {
3032     global NS
3033     set w .keys
3034     if {[winfo exists $w]} {
3035         raise $w
3036         return
3037     }
3038     if {[tk windowingsystem] eq {aqua}} {
3039         set M1T Cmd
3040     } else {
3041         set M1T Ctrl
3042     }
3043     ttk_toplevel $w
3044     wm title $w [mc "Gitk key bindings"]
3045     make_transient $w .
3046     message $w.m -text "
3047 [mc "Gitk key bindings:"]
3048
3049 [mc "<%s-Q>             Quit" $M1T]
3050 [mc "<%s-W>             Close window" $M1T]
3051 [mc "<Home>             Move to first commit"]
3052 [mc "<End>              Move to last commit"]
3053 [mc "<Up>, p, k Move up one commit"]
3054 [mc "<Down>, n, j       Move down one commit"]
3055 [mc "<Left>, z, h       Go back in history list"]
3056 [mc "<Right>, x, l      Go forward in history list"]
3057 [mc "<%s-n>     Go to n-th parent of current commit in history list" $M1T]
3058 [mc "<PageUp>   Move up one page in commit list"]
3059 [mc "<PageDown> Move down one page in commit list"]
3060 [mc "<%s-Home>  Scroll to top of commit list" $M1T]
3061 [mc "<%s-End>   Scroll to bottom of commit list" $M1T]
3062 [mc "<%s-Up>    Scroll commit list up one line" $M1T]
3063 [mc "<%s-Down>  Scroll commit list down one line" $M1T]
3064 [mc "<%s-PageUp>        Scroll commit list up one page" $M1T]
3065 [mc "<%s-PageDown>      Scroll commit list down one page" $M1T]
3066 [mc "<Shift-Up> Find backwards (upwards, later commits)"]
3067 [mc "<Shift-Down>       Find forwards (downwards, earlier commits)"]
3068 [mc "<Delete>, b        Scroll diff view up one page"]
3069 [mc "<Backspace>        Scroll diff view up one page"]
3070 [mc "<Space>            Scroll diff view down one page"]
3071 [mc "u          Scroll diff view up 18 lines"]
3072 [mc "d          Scroll diff view down 18 lines"]
3073 [mc "<%s-F>             Find" $M1T]
3074 [mc "<%s-G>             Move to next find hit" $M1T]
3075 [mc "<Return>   Move to next find hit"]
3076 [mc "g          Go to commit"]
3077 [mc "/          Focus the search box"]
3078 [mc "?          Move to previous find hit"]
3079 [mc "f          Scroll diff view to next file"]
3080 [mc "<%s-S>             Search for next hit in diff view" $M1T]
3081 [mc "<%s-R>             Search for previous hit in diff view" $M1T]
3082 [mc "<%s-KP+>   Increase font size" $M1T]
3083 [mc "<%s-plus>  Increase font size" $M1T]
3084 [mc "<%s-KP->   Decrease font size" $M1T]
3085 [mc "<%s-minus> Decrease font size" $M1T]
3086 [mc "<F5>               Update"]
3087 " \
3088             -justify left -bg white -border 2 -relief groove
3089     pack $w.m -side top -fill both -padx 2 -pady 2
3090     ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
3091     bind $w <Key-Escape> [list destroy $w]
3092     pack $w.ok -side bottom
3093     bind $w <Visibility> "focus $w.ok"
3094     bind $w <Key-Escape> "destroy $w"
3095     bind $w <Key-Return> "destroy $w"
3096 }
3097
3098 # Procedures for manipulating the file list window at the
3099 # bottom right of the overall window.
3100
3101 proc treeview {w l openlevs} {
3102     global treecontents treediropen treeheight treeparent treeindex
3103
3104     set ix 0
3105     set treeindex() 0
3106     set lev 0
3107     set prefix {}
3108     set prefixend -1
3109     set prefendstack {}
3110     set htstack {}
3111     set ht 0
3112     set treecontents() {}
3113     $w conf -state normal
3114     foreach f $l {
3115         while {[string range $f 0 $prefixend] ne $prefix} {
3116             if {$lev <= $openlevs} {
3117                 $w mark set e:$treeindex($prefix) "end -1c"
3118                 $w mark gravity e:$treeindex($prefix) left
3119             }
3120             set treeheight($prefix) $ht
3121             incr ht [lindex $htstack end]
3122             set htstack [lreplace $htstack end end]
3123             set prefixend [lindex $prefendstack end]
3124             set prefendstack [lreplace $prefendstack end end]
3125             set prefix [string range $prefix 0 $prefixend]
3126             incr lev -1
3127         }
3128         set tail [string range $f [expr {$prefixend+1}] end]
3129         while {[set slash [string first "/" $tail]] >= 0} {
3130             lappend htstack $ht
3131             set ht 0
3132             lappend prefendstack $prefixend
3133             incr prefixend [expr {$slash + 1}]
3134             set d [string range $tail 0 $slash]
3135             lappend treecontents($prefix) $d
3136             set oldprefix $prefix
3137             append prefix $d
3138             set treecontents($prefix) {}
3139             set treeindex($prefix) [incr ix]
3140             set treeparent($prefix) $oldprefix
3141             set tail [string range $tail [expr {$slash+1}] end]
3142             if {$lev <= $openlevs} {
3143                 set ht 1
3144                 set treediropen($prefix) [expr {$lev < $openlevs}]
3145                 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
3146                 $w mark set d:$ix "end -1c"
3147                 $w mark gravity d:$ix left
3148                 set str "\n"
3149                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3150                 $w insert end $str
3151                 $w image create end -align center -image $bm -padx 1 \
3152                     -name a:$ix
3153                 $w insert end $d [highlight_tag $prefix]
3154                 $w mark set s:$ix "end -1c"
3155                 $w mark gravity s:$ix left
3156             }
3157             incr lev
3158         }
3159         if {$tail ne {}} {
3160             if {$lev <= $openlevs} {
3161                 incr ht
3162                 set str "\n"
3163                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
3164                 $w insert end $str
3165                 $w insert end $tail [highlight_tag $f]
3166             }
3167             lappend treecontents($prefix) $tail
3168         }
3169     }
3170     while {$htstack ne {}} {
3171         set treeheight($prefix) $ht
3172         incr ht [lindex $htstack end]
3173         set htstack [lreplace $htstack end end]
3174         set prefixend [lindex $prefendstack end]
3175         set prefendstack [lreplace $prefendstack end end]
3176         set prefix [string range $prefix 0 $prefixend]
3177     }
3178     $w conf -state disabled
3179 }
3180
3181 proc linetoelt {l} {
3182     global treeheight treecontents
3183
3184     set y 2
3185     set prefix {}
3186     while {1} {
3187         foreach e $treecontents($prefix) {
3188             if {$y == $l} {
3189                 return "$prefix$e"
3190             }
3191             set n 1
3192             if {[string index $e end] eq "/"} {
3193                 set n $treeheight($prefix$e)
3194                 if {$y + $n > $l} {
3195                     append prefix $e
3196                     incr y
3197                     break
3198                 }
3199             }
3200             incr y $n
3201         }
3202     }
3203 }
3204
3205 proc highlight_tree {y prefix} {
3206     global treeheight treecontents cflist
3207
3208     foreach e $treecontents($prefix) {
3209         set path $prefix$e
3210         if {[highlight_tag $path] ne {}} {
3211             $cflist tag add bold $y.0 "$y.0 lineend"
3212         }
3213         incr y
3214         if {[string index $e end] eq "/" && $treeheight($path) > 1} {
3215             set y [highlight_tree $y $path]
3216         }
3217     }
3218     return $y
3219 }
3220
3221 proc treeclosedir {w dir} {
3222     global treediropen treeheight treeparent treeindex
3223
3224     set ix $treeindex($dir)
3225     $w conf -state normal
3226     $w delete s:$ix e:$ix
3227     set treediropen($dir) 0
3228     $w image configure a:$ix -image tri-rt
3229     $w conf -state disabled
3230     set n [expr {1 - $treeheight($dir)}]
3231     while {$dir ne {}} {
3232         incr treeheight($dir) $n
3233         set dir $treeparent($dir)
3234     }
3235 }
3236
3237 proc treeopendir {w dir} {
3238     global treediropen treeheight treeparent treecontents treeindex
3239
3240     set ix $treeindex($dir)
3241     $w conf -state normal
3242     $w image configure a:$ix -image tri-dn
3243     $w mark set e:$ix s:$ix
3244     $w mark gravity e:$ix right
3245     set lev 0
3246     set str "\n"
3247     set n [llength $treecontents($dir)]
3248     for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
3249         incr lev
3250         append str "\t"
3251         incr treeheight($x) $n
3252     }
3253     foreach e $treecontents($dir) {
3254         set de $dir$e
3255         if {[string index $e end] eq "/"} {
3256             set iy $treeindex($de)
3257             $w mark set d:$iy e:$ix
3258             $w mark gravity d:$iy left
3259             $w insert e:$ix $str
3260             set treediropen($de) 0
3261             $w image create e:$ix -align center -image tri-rt -padx 1 \
3262                 -name a:$iy
3263             $w insert e:$ix $e [highlight_tag $de]
3264             $w mark set s:$iy e:$ix
3265             $w mark gravity s:$iy left
3266             set treeheight($de) 1
3267         } else {
3268             $w insert e:$ix $str
3269             $w insert e:$ix $e [highlight_tag $de]
3270         }
3271     }
3272     $w mark gravity e:$ix right
3273     $w conf -state disabled
3274     set treediropen($dir) 1
3275     set top [lindex [split [$w index @0,0] .] 0]
3276     set ht [$w cget -height]
3277     set l [lindex [split [$w index s:$ix] .] 0]
3278     if {$l < $top} {
3279         $w yview $l.0
3280     } elseif {$l + $n + 1 > $top + $ht} {
3281         set top [expr {$l + $n + 2 - $ht}]
3282         if {$l < $top} {
3283             set top $l
3284         }
3285         $w yview $top.0
3286     }
3287 }
3288
3289 proc treeclick {w x y} {
3290     global treediropen cmitmode ctext cflist cflist_top
3291
3292     if {$cmitmode ne "tree"} return
3293     if {![info exists cflist_top]} return
3294     set l [lindex [split [$w index "@$x,$y"] "."] 0]
3295     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3296     $cflist tag add highlight $l.0 "$l.0 lineend"
3297     set cflist_top $l
3298     if {$l == 1} {
3299         $ctext yview 1.0
3300         return
3301     }
3302     set e [linetoelt $l]
3303     if {[string index $e end] ne "/"} {
3304         showfile $e
3305     } elseif {$treediropen($e)} {
3306         treeclosedir $w $e
3307     } else {
3308         treeopendir $w $e
3309     }
3310 }
3311
3312 proc setfilelist {id} {
3313     global treefilelist cflist jump_to_here
3314
3315     treeview $cflist $treefilelist($id) 0
3316     if {$jump_to_here ne {}} {
3317         set f [lindex $jump_to_here 0]
3318         if {[lsearch -exact $treefilelist($id) $f] >= 0} {
3319             showfile $f
3320         }
3321     }
3322 }
3323
3324 image create bitmap tri-rt -background black -foreground blue -data {
3325     #define tri-rt_width 13
3326     #define tri-rt_height 13
3327     static unsigned char tri-rt_bits[] = {
3328        0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
3329        0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
3330        0x00, 0x00};
3331 } -maskdata {
3332     #define tri-rt-mask_width 13
3333     #define tri-rt-mask_height 13
3334     static unsigned char tri-rt-mask_bits[] = {
3335        0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
3336        0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
3337        0x08, 0x00};
3338 }
3339 image create bitmap tri-dn -background black -foreground blue -data {
3340     #define tri-dn_width 13
3341     #define tri-dn_height 13
3342     static unsigned char tri-dn_bits[] = {
3343        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
3344        0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3345        0x00, 0x00};
3346 } -maskdata {
3347     #define tri-dn-mask_width 13
3348     #define tri-dn-mask_height 13
3349     static unsigned char tri-dn-mask_bits[] = {
3350        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
3351        0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
3352        0x00, 0x00};
3353 }
3354
3355 image create bitmap reficon-T -background black -foreground yellow -data {
3356     #define tagicon_width 13
3357     #define tagicon_height 9
3358     static unsigned char tagicon_bits[] = {
3359        0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
3360        0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
3361 } -maskdata {
3362     #define tagicon-mask_width 13
3363     #define tagicon-mask_height 9
3364     static unsigned char tagicon-mask_bits[] = {
3365        0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
3366        0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
3367 }
3368 set rectdata {
3369     #define headicon_width 13
3370     #define headicon_height 9
3371     static unsigned char headicon_bits[] = {
3372        0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
3373        0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
3374 }
3375 set rectmask {
3376     #define headicon-mask_width 13
3377     #define headicon-mask_height 9
3378     static unsigned char headicon-mask_bits[] = {
3379        0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
3380        0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
3381 }
3382 image create bitmap reficon-H -background black -foreground green \
3383     -data $rectdata -maskdata $rectmask
3384 image create bitmap reficon-o -background black -foreground "#ddddff" \
3385     -data $rectdata -maskdata $rectmask
3386
3387 proc init_flist {first} {
3388     global cflist cflist_top difffilestart
3389
3390     $cflist conf -state normal
3391     $cflist delete 0.0 end
3392     if {$first ne {}} {
3393         $cflist insert end $first
3394         set cflist_top 1
3395         $cflist tag add highlight 1.0 "1.0 lineend"
3396     } else {
3397         unset -nocomplain cflist_top
3398     }
3399     $cflist conf -state disabled
3400     set difffilestart {}
3401 }
3402
3403 proc highlight_tag {f} {
3404     global highlight_paths
3405
3406     foreach p $highlight_paths {
3407         if {[string match $p $f]} {
3408             return "bold"
3409         }
3410     }
3411     return {}
3412 }
3413
3414 proc highlight_filelist {} {
3415     global cmitmode cflist
3416
3417     $cflist conf -state normal
3418     if {$cmitmode ne "tree"} {
3419         set end [lindex [split [$cflist index end] .] 0]
3420         for {set l 2} {$l < $end} {incr l} {
3421             set line [$cflist get $l.0 "$l.0 lineend"]
3422             if {[highlight_tag $line] ne {}} {
3423                 $cflist tag add bold $l.0 "$l.0 lineend"
3424             }
3425         }
3426     } else {
3427         highlight_tree 2 {}
3428     }
3429     $cflist conf -state disabled
3430 }
3431
3432 proc unhighlight_filelist {} {
3433     global cflist
3434
3435     $cflist conf -state normal
3436     $cflist tag remove bold 1.0 end
3437     $cflist conf -state disabled
3438 }
3439
3440 proc add_flist {fl} {
3441     global cflist
3442
3443     $cflist conf -state normal
3444     foreach f $fl {
3445         $cflist insert end "\n"
3446         $cflist insert end $f [highlight_tag $f]
3447     }
3448     $cflist conf -state disabled
3449 }
3450
3451 proc sel_flist {w x y} {
3452     global ctext difffilestart cflist cflist_top cmitmode
3453
3454     if {$cmitmode eq "tree"} return
3455     if {![info exists cflist_top]} return
3456     set l [lindex [split [$w index "@$x,$y"] "."] 0]
3457     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
3458     $cflist tag add highlight $l.0 "$l.0 lineend"
3459     set cflist_top $l
3460     if {$l == 1} {
3461         $ctext yview 1.0
3462     } else {
3463         catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
3464     }
3465     suppress_highlighting_file_for_current_scrollpos
3466 }
3467
3468 proc pop_flist_menu {w X Y x y} {
3469     global ctext cflist cmitmode flist_menu flist_menu_file
3470     global treediffs diffids
3471
3472     stopfinding
3473     set l [lindex [split [$w index "@$x,$y"] "."] 0]
3474     if {$l <= 1} return
3475     if {$cmitmode eq "tree"} {
3476         set e [linetoelt $l]
3477         if {[string index $e end] eq "/"} return
3478     } else {
3479         set e [lindex $treediffs($diffids) [expr {$l-2}]]
3480     }
3481     set flist_menu_file $e
3482     set xdiffstate "normal"
3483     if {$cmitmode eq "tree"} {
3484         set xdiffstate "disabled"
3485     }
3486     # Disable "External diff" item in tree mode
3487     $flist_menu entryconf 2 -state $xdiffstate
3488     tk_popup $flist_menu $X $Y
3489 }
3490
3491 proc find_ctext_fileinfo {line} {
3492     global ctext_file_names ctext_file_lines
3493
3494     set ok [bsearch $ctext_file_lines $line]
3495     set tline [lindex $ctext_file_lines $ok]
3496
3497     if {$ok >= [llength $ctext_file_lines] || $line < $tline} {
3498         return {}
3499     } else {
3500         return [list [lindex $ctext_file_names $ok] $tline]
3501     }
3502 }
3503
3504 proc pop_diff_menu {w X Y x y} {
3505     global ctext diff_menu flist_menu_file
3506     global diff_menu_txtpos diff_menu_line
3507     global diff_menu_filebase
3508
3509     set diff_menu_txtpos [split [$w index "@$x,$y"] "."]
3510     set diff_menu_line [lindex $diff_menu_txtpos 0]
3511     # don't pop up the menu on hunk-separator or file-separator lines
3512     if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} {
3513         return
3514     }
3515     stopfinding
3516     set f [find_ctext_fileinfo $diff_menu_line]
3517     if {$f eq {}} return
3518     set flist_menu_file [lindex $f 0]
3519     set diff_menu_filebase [lindex $f 1]
3520     tk_popup $diff_menu $X $Y
3521 }
3522
3523 proc flist_hl {only} {
3524     global flist_menu_file findstring gdttype
3525
3526     set x [shellquote $flist_menu_file]
3527     if {$only || $findstring eq {} || $gdttype ne [mc "touching paths:"]} {
3528         set findstring $x
3529     } else {
3530         append findstring " " $x
3531     }
3532     set gdttype [mc "touching paths:"]
3533 }
3534
3535 proc gitknewtmpdir {} {
3536     global diffnum gitktmpdir gitdir env
3537
3538     if {![info exists gitktmpdir]} {
3539         if {[info exists env(GITK_TMPDIR)]} {
3540             set tmpdir $env(GITK_TMPDIR)
3541         } elseif {[info exists env(TMPDIR)]} {
3542             set tmpdir $env(TMPDIR)
3543         } else {
3544             set tmpdir $gitdir
3545         }
3546         set gitktmpformat [file join $tmpdir ".gitk-tmp.XXXXXX"]
3547         if {[catch {set gitktmpdir [exec mktemp -d $gitktmpformat]}]} {
3548             set gitktmpdir [file join $gitdir [format ".gitk-tmp.%s" [pid]]]
3549         }
3550         if {[catch {file mkdir $gitktmpdir} err]} {
3551             error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err"
3552             unset gitktmpdir
3553             return {}
3554         }
3555         set diffnum 0
3556     }
3557     incr diffnum
3558     set diffdir [file join $gitktmpdir $diffnum]
3559     if {[catch {file mkdir $diffdir} err]} {
3560         error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err"
3561         return {}
3562     }
3563     return $diffdir
3564 }
3565
3566 proc save_file_from_commit {filename output what} {
3567     global nullfile
3568
3569     if {[catch {exec git show $filename -- > $output} err]} {
3570         if {[string match "fatal: bad revision *" $err]} {
3571             return $nullfile
3572         }
3573         error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err"
3574         return {}
3575     }
3576     return $output
3577 }
3578
3579 proc external_diff_get_one_file {diffid filename diffdir} {
3580     global nullid nullid2 nullfile
3581     global worktree
3582
3583     if {$diffid == $nullid} {
3584         set difffile [file join $worktree $filename]
3585         if {[file exists $difffile]} {
3586             return $difffile
3587         }
3588         return $nullfile
3589     }
3590     if {$diffid == $nullid2} {
3591         set difffile [file join $diffdir "\[index\] [file tail $filename]"]
3592         return [save_file_from_commit :$filename $difffile index]
3593     }
3594     set difffile [file join $diffdir "\[$diffid\] [file tail $filename]"]
3595     return [save_file_from_commit $diffid:$filename $difffile \
3596                "revision $diffid"]
3597 }
3598
3599 proc external_diff {} {
3600     global nullid nullid2
3601     global flist_menu_file
3602     global diffids
3603     global extdifftool
3604
3605     if {[llength $diffids] == 1} {
3606         # no reference commit given
3607         set diffidto [lindex $diffids 0]
3608         if {$diffidto eq $nullid} {
3609             # diffing working copy with index
3610             set diffidfrom $nullid2
3611         } elseif {$diffidto eq $nullid2} {
3612             # diffing index with HEAD
3613             set diffidfrom "HEAD"
3614         } else {
3615             # use first parent commit
3616             global parentlist selectedline
3617             set diffidfrom [lindex $parentlist $selectedline 0]
3618         }
3619     } else {
3620         set diffidfrom [lindex $diffids 0]
3621         set diffidto [lindex $diffids 1]
3622     }
3623
3624     # make sure that several diffs wont collide
3625     set diffdir [gitknewtmpdir]
3626     if {$diffdir eq {}} return
3627
3628     # gather files to diff
3629     set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir]
3630     set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir]
3631
3632     if {$difffromfile ne {} && $difftofile ne {}} {
3633         set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile]
3634         if {[catch {set fl [open |$cmd r]} err]} {
3635             file delete -force $diffdir
3636             error_popup "$extdifftool: [mc "command failed:"] $err"
3637         } else {
3638             fconfigure $fl -blocking 0
3639             filerun $fl [list delete_at_eof $fl $diffdir]
3640         }
3641     }
3642 }
3643
3644 proc find_hunk_blamespec {base line} {
3645     global ctext
3646
3647     # Find and parse the hunk header
3648     set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0]
3649     if {$s_lix eq {}} return
3650
3651     set s_line [$ctext get $s_lix "$s_lix + 1 lines"]
3652     if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \
3653             s_line old_specs osz osz1 new_line nsz]} {
3654         return
3655     }
3656
3657     # base lines for the parents
3658     set base_lines [list $new_line]
3659     foreach old_spec [lrange [split $old_specs " "] 1 end] {
3660         if {![regexp -- {-(\d+)(,\d+)?} $old_spec \
3661                 old_spec old_line osz]} {
3662             return
3663         }
3664         lappend base_lines $old_line
3665     }
3666
3667     # Now scan the lines to determine offset within the hunk
3668     set max_parent [expr {[llength $base_lines]-2}]
3669     set dline 0
3670     set s_lno [lindex [split $s_lix "."] 0]
3671
3672     # Determine if the line is removed
3673     set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"]
3674     if {[string match {[-+ ]*} $chunk]} {
3675         set removed_idx [string first "-" $chunk]
3676         # Choose a parent index
3677         if {$removed_idx >= 0} {
3678             set parent $removed_idx
3679         } else {
3680             set unchanged_idx [string first " " $chunk]
3681             if {$unchanged_idx >= 0} {
3682                 set parent $unchanged_idx
3683             } else {
3684                 # blame the current commit
3685                 set parent -1
3686             }
3687         }
3688         # then count other lines that belong to it
3689         for {set i $line} {[incr i -1] > $s_lno} {} {
3690             set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"]
3691             # Determine if the line is removed
3692             set removed_idx [string first "-" $chunk]
3693             if {$parent >= 0} {
3694                 set code [string index $chunk $parent]
3695                 if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} {
3696                     incr dline
3697                 }
3698             } else {
3699                 if {$removed_idx < 0} {
3700                     incr dline
3701                 }
3702             }
3703         }
3704         incr parent
3705     } else {
3706         set parent 0
3707     }
3708
3709     incr dline [lindex $base_lines $parent]
3710     return [list $parent $dline]
3711 }
3712
3713 proc external_blame_diff {} {
3714     global currentid cmitmode
3715     global diff_menu_txtpos diff_menu_line
3716     global diff_menu_filebase flist_menu_file
3717
3718     if {$cmitmode eq "tree"} {
3719         set parent_idx 0
3720         set line [expr {$diff_menu_line - $diff_menu_filebase}]
3721     } else {
3722         set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3723         if {$hinfo ne {}} {
3724             set parent_idx [lindex $hinfo 0]
3725             set line [lindex $hinfo 1]
3726         } else {
3727             set parent_idx 0
3728             set line 0
3729         }
3730     }
3731
3732     external_blame $parent_idx $line
3733 }
3734
3735 # Find the SHA1 ID of the blob for file $fname in the index
3736 # at stage 0 or 2
3737 proc index_sha1 {fname} {
3738     set f [open [list | git ls-files -s $fname] r]
3739     while {[gets $f line] >= 0} {
3740         set info [lindex [split $line "\t"] 0]
3741         set stage [lindex $info 2]
3742         if {$stage eq "0" || $stage eq "2"} {
3743             close $f
3744             return [lindex $info 1]
3745         }
3746     }
3747     close $f
3748     return {}
3749 }
3750
3751 # Turn an absolute path into one relative to the current directory
3752 proc make_relative {f} {
3753     if {[file pathtype $f] eq "relative"} {
3754         return $f
3755     }
3756     set elts [file split $f]
3757     set here [file split [pwd]]
3758     set ei 0
3759     set hi 0
3760     set res {}
3761     foreach d $here {
3762         if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} {
3763             lappend res ".."
3764         } else {
3765             incr ei
3766         }
3767         incr hi
3768     }
3769     set elts [concat $res [lrange $elts $ei end]]
3770     return [eval file join $elts]
3771 }
3772
3773 proc external_blame {parent_idx {line {}}} {
3774     global flist_menu_file cdup
3775     global nullid nullid2
3776     global parentlist selectedline currentid
3777
3778     if {$parent_idx > 0} {
3779         set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]]
3780     } else {
3781         set base_commit $currentid
3782     }
3783
3784     if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} {
3785         error_popup [mc "No such commit"]
3786         return
3787     }
3788
3789     set cmdline [list git gui blame]
3790     if {$line ne {} && $line > 1} {
3791         lappend cmdline "--line=$line"
3792     }
3793     set f [file join $cdup $flist_menu_file]
3794     # Unfortunately it seems git gui blame doesn't like
3795     # being given an absolute path...
3796     set f [make_relative $f]
3797     lappend cmdline $base_commit $f
3798     if {[catch {eval exec $cmdline &} err]} {
3799         error_popup "[mc "git gui blame: command failed:"] $err"
3800     }
3801 }
3802
3803 proc show_line_source {} {
3804     global cmitmode currentid parents curview blamestuff blameinst
3805     global diff_menu_line diff_menu_filebase flist_menu_file
3806     global nullid nullid2 gitdir cdup
3807
3808     set from_index {}
3809     if {$cmitmode eq "tree"} {
3810         set id $currentid
3811         set line [expr {$diff_menu_line - $diff_menu_filebase}]
3812     } else {
3813         set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line]
3814         if {$h eq {}} return
3815         set pi [lindex $h 0]
3816         if {$pi == 0} {
3817             mark_ctext_line $diff_menu_line
3818             return
3819         }
3820         incr pi -1
3821         if {$currentid eq $nullid} {
3822             if {$pi > 0} {
3823                 # must be a merge in progress...
3824                 if {[catch {
3825                     # get the last line from .git/MERGE_HEAD
3826                     set f [open [file join $gitdir MERGE_HEAD] r]
3827                     set id [lindex [split [read $f] "\n"] end-1]
3828                     close $f
3829                 } err]} {
3830                     error_popup [mc "Couldn't read merge head: %s" $err]
3831                     return
3832                 }
3833             } elseif {$parents($curview,$currentid) eq $nullid2} {
3834                 # need to do the blame from the index
3835                 if {[catch {
3836                     set from_index [index_sha1 $flist_menu_file]
3837                 } err]} {
3838                     error_popup [mc "Error reading index: %s" $err]
3839                     return
3840                 }
3841             } else {
3842                 set id $parents($curview,$currentid)
3843             }
3844         } else {
3845             set id [lindex $parents($curview,$currentid) $pi]
3846         }
3847         set line [lindex $h 1]
3848     }
3849     set blameargs {}
3850     if {$from_index ne {}} {
3851         lappend blameargs | git cat-file blob $from_index
3852     }
3853     lappend blameargs | git blame -p -L$line,+1
3854     if {$from_index ne {}} {
3855         lappend blameargs --contents -
3856     } else {
3857         lappend blameargs $id
3858     }
3859     lappend blameargs -- [file join $cdup $flist_menu_file]
3860     if {[catch {
3861         set f [open $blameargs r]
3862     } err]} {
3863         error_popup [mc "Couldn't start git blame: %s" $err]
3864         return
3865     }
3866     nowbusy blaming [mc "Searching"]
3867     fconfigure $f -blocking 0
3868     set i [reg_instance $f]
3869     set blamestuff($i) {}
3870     set blameinst $i
3871     filerun $f [list read_line_source $f $i]
3872 }
3873
3874 proc stopblaming {} {
3875     global blameinst
3876
3877     if {[info exists blameinst]} {
3878         stop_instance $blameinst
3879         unset blameinst
3880         notbusy blaming
3881     }
3882 }
3883
3884 proc read_line_source {fd inst} {
3885     global blamestuff curview commfd blameinst nullid nullid2
3886
3887     while {[gets $fd line] >= 0} {
3888         lappend blamestuff($inst) $line
3889     }
3890     if {![eof $fd]} {
3891         return 1
3892     }
3893     unset commfd($inst)
3894     unset blameinst
3895     notbusy blaming
3896     fconfigure $fd -blocking 1
3897     if {[catch {close $fd} err]} {
3898         error_popup [mc "Error running git blame: %s" $err]
3899         return 0
3900     }
3901
3902     set fname {}
3903     set line [split [lindex $blamestuff($inst) 0] " "]
3904     set id [lindex $line 0]
3905     set lnum [lindex $line 1]
3906     if {[string length $id] == 40 && [string is xdigit $id] &&
3907         [string is digit -strict $lnum]} {
3908         # look for "filename" line
3909         foreach l $blamestuff($inst) {
3910             if {[string match "filename *" $l]} {
3911                 set fname [string range $l 9 end]
3912                 break
3913             }
3914         }
3915     }
3916     if {$fname ne {}} {
3917         # all looks good, select it
3918         if {$id eq $nullid} {
3919             # blame uses all-zeroes to mean not committed,
3920             # which would mean a change in the index
3921             set id $nullid2
3922         }
3923         if {[commitinview $id $curview]} {
3924             selectline [rowofcommit $id] 1 [list $fname $lnum] 1
3925         } else {
3926             error_popup [mc "That line comes from commit %s, \
3927                              which is not in this view" [shortids $id]]
3928         }
3929     } else {
3930         puts "oops couldn't parse git blame output"
3931     }
3932     return 0
3933 }
3934
3935 # delete $dir when we see eof on $f (presumably because the child has exited)
3936 proc delete_at_eof {f dir} {
3937     while {[gets $f line] >= 0} {}
3938     if {[eof $f]} {
3939         if {[catch {close $f} err]} {
3940             error_popup "[mc "External diff viewer failed:"] $err"
3941         }
3942         file delete -force $dir
3943         return 0
3944     }
3945     return 1
3946 }
3947
3948 # Functions for adding and removing shell-type quoting
3949
3950 proc shellquote {str} {
3951     if {![string match "*\['\"\\ \t]*" $str]} {
3952         return $str
3953     }
3954     if {![string match "*\['\"\\]*" $str]} {
3955         return "\"$str\""
3956     }
3957     if {![string match "*'*" $str]} {
3958         return "'$str'"
3959     }
3960     return "\"[string map {\" \\\" \\ \\\\} $str]\""
3961 }
3962
3963 proc shellarglist {l} {
3964     set str {}
3965     foreach a $l {
3966         if {$str ne {}} {
3967             append str " "
3968         }
3969         append str [shellquote $a]
3970     }
3971     return $str
3972 }
3973
3974 proc shelldequote {str} {
3975     set ret {}
3976     set used -1
3977     while {1} {
3978         incr used
3979         if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
3980             append ret [string range $str $used end]
3981             set used [string length $str]
3982             break
3983         }
3984         set first [lindex $first 0]
3985         set ch [string index $str $first]
3986         if {$first > $used} {
3987             append ret [string range $str $used [expr {$first - 1}]]
3988             set used $first
3989         }
3990         if {$ch eq " " || $ch eq "\t"} break
3991         incr used
3992         if {$ch eq "'"} {
3993             set first [string first "'" $str $used]
3994             if {$first < 0} {
3995                 error "unmatched single-quote"
3996             }
3997             append ret [string range $str $used [expr {$first - 1}]]
3998             set used $first
3999             continue
4000         }
4001         if {$ch eq "\\"} {
4002             if {$used >= [string length $str]} {
4003                 error "trailing backslash"
4004             }
4005             append ret [string index $str $used]
4006             continue
4007         }
4008         # here ch == "\""
4009         while {1} {
4010             if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
4011                 error "unmatched double-quote"
4012             }
4013             set first [lindex $first 0]
4014             set ch [string index $str $first]
4015             if {$first > $used} {
4016                 append ret [string range $str $used [expr {$first - 1}]]
4017                 set used $first
4018             }
4019             if {$ch eq "\""} break
4020             incr used
4021             append ret [string index $str $used]
4022             incr used
4023         }
4024     }
4025     return [list $used $ret]
4026 }
4027
4028 proc shellsplit {str} {
4029     set l {}
4030     while {1} {
4031         set str [string trimleft $str]
4032         if {$str eq {}} break
4033         set dq [shelldequote $str]
4034         set n [lindex $dq 0]
4035         set word [lindex $dq 1]
4036         set str [string range $str $n end]
4037         lappend l $word
4038     }
4039     return $l
4040 }
4041
4042 proc set_window_title {} {
4043     global appname curview viewname vrevs
4044     set rev [mc "All files"]
4045     if {$curview ne 0} {
4046         if {$viewname($curview) eq [mc "Command line"]} {
4047             set rev [string map {"--gitk-symmetric-diff-marker" "--merge"} $vrevs($curview)]
4048         } else {
4049             set rev $viewname($curview)
4050         }
4051     }
4052     wm title . "[reponame]: $rev - $appname"
4053 }
4054
4055 # Code to implement multiple views
4056
4057 proc newview {ishighlight} {
4058     global nextviewnum newviewname newishighlight
4059     global revtreeargs viewargscmd newviewopts curview
4060
4061     set newishighlight $ishighlight
4062     set top .gitkview
4063     if {[winfo exists $top]} {
4064         raise $top
4065         return
4066     }
4067     decode_view_opts $nextviewnum $revtreeargs
4068     set newviewname($nextviewnum) "[mc "View"] $nextviewnum"
4069     set newviewopts($nextviewnum,perm) 0
4070     set newviewopts($nextviewnum,cmd)  $viewargscmd($curview)
4071     vieweditor $top $nextviewnum [mc "Gitk view definition"]
4072 }
4073
4074 set known_view_options {
4075     {perm      b    .  {}               {mc "Remember this view"}}
4076     {reflabel  l    +  {}               {mc "References (space separated list):"}}
4077     {refs      t15  .. {}               {mc "Branches & tags:"}}
4078     {allrefs   b    *. "--all"          {mc "All refs"}}
4079     {branches  b    .  "--branches"     {mc "All (local) branches"}}
4080     {tags      b    .  "--tags"         {mc "All tags"}}
4081     {remotes   b    .  "--remotes"      {mc "All remote-tracking branches"}}
4082     {commitlbl l    +  {}               {mc "Commit Info (regular expressions):"}}
4083     {author    t15  .. "--author=*"     {mc "Author:"}}
4084     {committer t15  .  "--committer=*"  {mc "Committer:"}}
4085     {loginfo   t15  .. "--grep=*"       {mc "Commit Message:"}}
4086     {allmatch  b    .. "--all-match"    {mc "Matches all Commit Info criteria"}}
4087     {igrep     b    .. "--invert-grep"  {mc "Matches no Commit Info criteria"}}
4088     {changes_l l    +  {}               {mc "Changes to Files:"}}
4089     {pickaxe_s r0   .  {}               {mc "Fixed String"}}
4090     {pickaxe_t r1   .  "--pickaxe-regex"  {mc "Regular Expression"}}
4091     {pickaxe   t15  .. "-S*"            {mc "Search string:"}}
4092     {datelabel l    +  {}               {mc "Commit Dates (\"2 weeks ago\", \"2009-03-17 15:27:38\", \"March 17, 2009 15:27:38\"):"}}
4093     {since     t15  ..  {"--since=*" "--after=*"}  {mc "Since:"}}
4094     {until     t15  .   {"--until=*" "--before=*"} {mc "Until:"}}
4095     {limit_lbl l    +  {}               {mc "Limit and/or skip a number of revisions (positive integer):"}}
4096     {limit     t10  *. "--max-count=*"  {mc "Number to show:"}}
4097     {skip      t10  .  "--skip=*"       {mc "Number to skip:"}}
4098     {misc_lbl  l    +  {}               {mc "Miscellaneous options:"}}
4099     {dorder    b    *. {"--date-order" "-d"}      {mc "Strictly sort by date"}}
4100     {lright    b    .  "--left-right"   {mc "Mark branch sides"}}
4101     {first     b    .  "--first-parent" {mc "Limit to first parent"}}
4102     {smplhst   b    .  "--simplify-by-decoration"   {mc "Simple history"}}
4103     {args      t50  *. {}               {mc "Additional arguments to git log:"}}
4104     {allpaths  path +  {}               {mc "Enter files and directories to include, one per line:"}}
4105     {cmd       t50= +  {}               {mc "Command to generate more commits to include:"}}
4106     }
4107
4108 # Convert $newviewopts($n, ...) into args for git log.
4109 proc encode_view_opts {n} {
4110     global known_view_options newviewopts
4111
4112     set rargs [list]
4113     foreach opt $known_view_options {
4114         set patterns [lindex $opt 3]
4115         if {$patterns eq {}} continue
4116         set pattern [lindex $patterns 0]
4117
4118         if {[lindex $opt 1] eq "b"} {
4119             set val $newviewopts($n,[lindex $opt 0])
4120             if {$val} {
4121                 lappend rargs $pattern
4122             }
4123         } elseif {[regexp {^r(\d+)$} [lindex $opt 1] type value]} {
4124             regexp {^(.*_)} [lindex $opt 0] uselessvar button_id
4125             set val $newviewopts($n,$button_id)
4126             if {$val eq $value} {
4127                 lappend rargs $pattern
4128             }
4129         } else {
4130             set val $newviewopts($n,[lindex $opt 0])
4131             set val [string trim $val]
4132             if {$val ne {}} {
4133                 set pfix [string range $pattern 0 end-1]
4134                 lappend rargs $pfix$val
4135             }
4136         }
4137     }
4138     set rargs [concat $rargs [shellsplit $newviewopts($n,refs)]]
4139     return [concat $rargs [shellsplit $newviewopts($n,args)]]
4140 }
4141
4142 # Fill $newviewopts($n, ...) based on args for git log.
4143 proc decode_view_opts {n view_args} {
4144     global known_view_options newviewopts
4145
4146     foreach opt $known_view_options {
4147         set id [lindex $opt 0]
4148         if {[lindex $opt 1] eq "b"} {
4149             # Checkboxes
4150             set val 0
4151         } elseif {[regexp {^r(\d+)$} [lindex $opt 1]]} {
4152             # Radiobuttons
4153             regexp {^(.*_)} $id uselessvar id
4154             set val 0
4155         } else {
4156             # Text fields
4157             set val {}
4158         }
4159         set newviewopts($n,$id) $val
4160     }
4161     set oargs [list]
4162     set refargs [list]
4163     foreach arg $view_args {
4164         if {[regexp -- {^-([0-9]+)$} $arg arg cnt]
4165             && ![info exists found(limit)]} {
4166             set newviewopts($n,limit) $cnt
4167             set found(limit) 1
4168             continue
4169         }
4170         catch { unset val }
4171         foreach opt $known_view_options {
4172             set id [lindex $opt 0]
4173             if {[info exists found($id)]} continue
4174             foreach pattern [lindex $opt 3] {
4175                 if {![string match $pattern $arg]} continue
4176                 if {[lindex $opt 1] eq "b"} {
4177                     # Check buttons
4178                     set val 1
4179                 } elseif {[regexp {^r(\d+)$} [lindex $opt 1] match num]} {
4180                     # Radio buttons
4181                     regexp {^(.*_)} $id uselessvar id
4182                     set val $num
4183                 } else {
4184                     # Text input fields
4185                     set size [string length $pattern]
4186                     set val [string range $arg [expr {$size-1}] end]
4187                 }
4188                 set newviewopts($n,$id) $val
4189                 set found($id) 1
4190                 break
4191             }
4192             if {[info exists val]} break
4193         }
4194         if {[info exists val]} continue
4195         if {[regexp {^-} $arg]} {
4196             lappend oargs $arg
4197         } else {
4198             lappend refargs $arg
4199         }
4200     }
4201     set newviewopts($n,refs) [shellarglist $refargs]
4202     set newviewopts($n,args) [shellarglist $oargs]
4203 }
4204
4205 proc edit_or_newview {} {
4206     global curview
4207
4208     if {$curview > 0} {
4209         editview
4210     } else {
4211         newview 0
4212     }
4213 }
4214
4215 proc editview {} {
4216     global curview
4217     global viewname viewperm newviewname newviewopts
4218     global viewargs viewargscmd
4219
4220     set top .gitkvedit-$curview
4221     if {[winfo exists $top]} {
4222         raise $top
4223         return
4224     }
4225     decode_view_opts $curview $viewargs($curview)
4226     set newviewname($curview)      $viewname($curview)
4227     set newviewopts($curview,perm) $viewperm($curview)
4228     set newviewopts($curview,cmd)  $viewargscmd($curview)
4229     vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)"
4230 }
4231
4232 proc vieweditor {top n title} {
4233     global newviewname newviewopts viewfiles bgcolor
4234     global known_view_options NS
4235
4236     ttk_toplevel $top
4237     wm title $top [concat $title [mc "-- criteria for selecting revisions"]]
4238     make_transient $top .
4239
4240     # View name
4241     ${NS}::frame $top.nfr
4242     ${NS}::label $top.nl -text [mc "View Name"]
4243     ${NS}::entry $top.name -width 20 -textvariable newviewname($n)
4244     pack $top.nfr -in $top -fill x -pady 5 -padx 3
4245     pack $top.nl -in $top.nfr -side left -padx {0 5}
4246     pack $top.name -in $top.nfr -side left -padx {0 25}
4247
4248     # View options
4249     set cframe $top.nfr
4250     set cexpand 0
4251     set cnt 0
4252     foreach opt $known_view_options {
4253         set id [lindex $opt 0]
4254         set type [lindex $opt 1]
4255         set flags [lindex $opt 2]
4256         set title [eval [lindex $opt 4]]
4257         set lxpad 0
4258
4259         if {$flags eq "+" || $flags eq "*"} {
4260             set cframe $top.fr$cnt
4261             incr cnt
4262             ${NS}::frame $cframe
4263             pack $cframe -in $top -fill x -pady 3 -padx 3
4264             set cexpand [expr {$flags eq "*"}]
4265         } elseif {$flags eq ".." || $flags eq "*."} {
4266             set cframe $top.fr$cnt
4267             incr cnt
4268             ${NS}::frame $cframe
4269             pack $cframe -in $top -fill x -pady 3 -padx [list 15 3]
4270             set cexpand [expr {$flags eq "*."}]
4271         } else {
4272             set lxpad 5
4273         }
4274
4275         if {$type eq "l"} {
4276             ${NS}::label $cframe.l_$id -text $title
4277             pack $cframe.l_$id -in $cframe -side left -pady [list 3 0] -anchor w
4278         } elseif {$type eq "b"} {
4279             ${NS}::checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id)
4280             pack $cframe.c_$id -in $cframe -side left \
4281                 -padx [list $lxpad 0] -expand $cexpand -anchor w
4282         } elseif {[regexp {^r(\d+)$} $type type sz]} {
4283             regexp {^(.*_)} $id uselessvar button_id
4284             ${NS}::radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz
4285             pack $cframe.c_$id -in $cframe -side left \
4286                 -padx [list $lxpad 0] -expand $cexpand -anchor w
4287         } elseif {[regexp {^t(\d+)$} $type type sz]} {
4288             ${NS}::label $cframe.l_$id -text $title
4289             ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4290                 -textvariable newviewopts($n,$id)
4291             pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0]
4292             pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x
4293         } elseif {[regexp {^t(\d+)=$} $type type sz]} {
4294             ${NS}::label $cframe.l_$id -text $title
4295             ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \
4296                 -textvariable newviewopts($n,$id)
4297             pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w
4298             pack $cframe.e_$id -in $cframe -side top -fill x
4299         } elseif {$type eq "path"} {
4300             ${NS}::label $top.l -text $title
4301             pack $top.l -in $top -side top -pady [list 3 0] -anchor w -padx 3
4302             text $top.t -width 40 -height 5 -background $bgcolor
4303             if {[info exists viewfiles($n)]} {
4304                 foreach f $viewfiles($n) {
4305                     $top.t insert end $f
4306                     $top.t insert end "\n"
4307                 }
4308                 $top.t delete {end - 1c} end
4309                 $top.t mark set insert 0.0
4310             }
4311             pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3
4312         }
4313     }
4314
4315     ${NS}::frame $top.buts
4316     ${NS}::button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n]
4317     ${NS}::button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1]
4318     ${NS}::button $top.buts.can -text [mc "Cancel"] -command [list destroy $top]
4319     bind $top <Control-Return> [list newviewok $top $n]
4320     bind $top <F5> [list newviewok $top $n 1]
4321     bind $top <Escape> [list destroy $top]
4322     grid $top.buts.ok $top.buts.apply $top.buts.can
4323     grid columnconfigure $top.buts 0 -weight 1 -uniform a
4324     grid columnconfigure $top.buts 1 -weight 1 -uniform a
4325     grid columnconfigure $top.buts 2 -weight 1 -uniform a
4326     pack $top.buts -in $top -side top -fill x
4327     focus $top.t
4328 }
4329
4330 proc doviewmenu {m first cmd op argv} {
4331     set nmenu [$m index end]
4332     for {set i $first} {$i <= $nmenu} {incr i} {
4333         if {[$m entrycget $i -command] eq $cmd} {
4334             eval $m $op $i $argv
4335             break
4336         }
4337     }
4338 }
4339
4340 proc allviewmenus {n op args} {
4341     # global viewhlmenu
4342
4343     doviewmenu .bar.view 5 [list showview $n] $op $args
4344     # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
4345 }
4346
4347 proc newviewok {top n {apply 0}} {
4348     global nextviewnum newviewperm newviewname newishighlight
4349     global viewname viewfiles viewperm viewchanged selectedview curview
4350     global viewargs viewargscmd newviewopts viewhlmenu
4351
4352     if {[catch {
4353         set newargs [encode_view_opts $n]
4354     } err]} {
4355         error_popup "[mc "Error in commit selection arguments:"] $err" $top
4356         return
4357     }
4358     set files {}
4359     foreach f [split [$top.t get 0.0 end] "\n"] {
4360         set ft [string trim $f]
4361         if {$ft ne {}} {
4362             lappend files $ft
4363         }
4364     }
4365     if {![info exists viewfiles($n)]} {
4366         # creating a new view
4367         incr nextviewnum
4368         set viewname($n) $newviewname($n)
4369         set viewperm($n) $newviewopts($n,perm)
4370         set viewchanged($n) 1
4371         set viewfiles($n) $files
4372         set viewargs($n) $newargs
4373         set viewargscmd($n) $newviewopts($n,cmd)
4374         addviewmenu $n
4375         if {!$newishighlight} {
4376             run showview $n
4377         } else {
4378             run addvhighlight $n
4379         }
4380     } else {
4381         # editing an existing view
4382         set viewperm($n) $newviewopts($n,perm)
4383         set viewchanged($n) 1
4384         if {$newviewname($n) ne $viewname($n)} {
4385             set viewname($n) $newviewname($n)
4386             doviewmenu .bar.view 5 [list showview $n] \
4387                 entryconf [list -label $viewname($n)]
4388             # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
4389                 # entryconf [list -label $viewname($n) -value $viewname($n)]
4390         }
4391         if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \
4392                 $newviewopts($n,cmd) ne $viewargscmd($n)} {
4393             set viewfiles($n) $files
4394             set viewargs($n) $newargs
4395             set viewargscmd($n) $newviewopts($n,cmd)
4396             if {$curview == $n} {
4397                 run reloadcommits
4398             }
4399         }
4400     }
4401     if {$apply} return
4402     catch {destroy $top}
4403 }
4404
4405 proc delview {} {
4406     global curview viewperm hlview selectedhlview viewchanged
4407
4408     if {$curview == 0} return
4409     if {[info exists hlview] && $hlview == $curview} {
4410         set selectedhlview [mc "None"]
4411         unset hlview
4412     }
4413     allviewmenus $curview delete
4414     set viewperm($curview) 0
4415     set viewchanged($curview) 1
4416     showview 0
4417 }
4418
4419 proc addviewmenu {n} {
4420     global viewname viewhlmenu
4421
4422     .bar.view add radiobutton -label $viewname($n) \
4423         -command [list showview $n] -variable selectedview -value $n
4424     #$viewhlmenu add radiobutton -label $viewname($n) \
4425     #   -command [list addvhighlight $n] -variable selectedhlview
4426 }
4427
4428 proc showview {n} {
4429     global curview cached_commitrow ordertok
4430     global displayorder parentlist rowidlist rowisopt rowfinal
4431     global colormap rowtextx nextcolor canvxmax
4432     global numcommits viewcomplete
4433     global selectedline currentid canv canvy0
4434     global treediffs
4435     global pending_select mainheadid
4436     global commitidx
4437     global selectedview
4438     global hlview selectedhlview commitinterest
4439
4440     if {$n == $curview} return
4441     set selid {}
4442     set ymax [lindex [$canv cget -scrollregion] 3]
4443     set span [$canv yview]
4444     set ytop [expr {[lindex $span 0] * $ymax}]
4445     set ybot [expr {[lindex $span 1] * $ymax}]
4446     set yscreen [expr {($ybot - $ytop) / 2}]
4447     if {$selectedline ne {}} {
4448         set selid $currentid
4449         set y [yc $selectedline]
4450         if {$ytop < $y && $y < $ybot} {
4451             set yscreen [expr {$y - $ytop}]
4452         }
4453     } elseif {[info exists pending_select]} {
4454         set selid $pending_select
4455         unset pending_select
4456     }
4457     unselectline
4458     normalline
4459     unset -nocomplain treediffs
4460     clear_display
4461     if {[info exists hlview] && $hlview == $n} {
4462         unset hlview
4463         set selectedhlview [mc "None"]
4464     }
4465     unset -nocomplain commitinterest
4466     unset -nocomplain cached_commitrow
4467     unset -nocomplain ordertok
4468
4469     set curview $n
4470     set selectedview $n
4471     .bar.view entryconf [mca "&Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
4472     .bar.view entryconf [mca "&Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
4473
4474     run refill_reflist
4475     if {![info exists viewcomplete($n)]} {
4476         getcommits $selid
4477         return
4478     }
4479
4480     set displayorder {}
4481     set parentlist {}
4482     set rowidlist {}
4483     set rowisopt {}
4484     set rowfinal {}
4485     set numcommits $commitidx($n)
4486
4487     unset -nocomplain colormap
4488     unset -nocomplain rowtextx
4489     set nextcolor 0
4490     set canvxmax [$canv cget -width]
4491     set curview $n
4492     set row 0
4493     setcanvscroll
4494     set yf 0
4495     set row {}
4496     if {$selid ne {} && [commitinview $selid $n]} {
4497         set row [rowofcommit $selid]
4498         # try to get the selected row in the same position on the screen
4499         set ymax [lindex [$canv cget -scrollregion] 3]
4500         set ytop [expr {[yc $row] - $yscreen}]
4501         if {$ytop < 0} {
4502             set ytop 0
4503         }
4504         set yf [expr {$ytop * 1.0 / $ymax}]
4505     }
4506     allcanvs yview moveto $yf
4507     drawvisible
4508     if {$row ne {}} {
4509         selectline $row 0
4510     } elseif {!$viewcomplete($n)} {
4511         reset_pending_select $selid
4512     } else {
4513         reset_pending_select {}
4514
4515         if {[commitinview $pending_select $curview]} {
4516             selectline [rowofcommit $pending_select] 1
4517         } else {
4518             set row [first_real_row]
4519             if {$row < $numcommits} {
4520                 selectline $row 0
4521             }
4522         }
4523     }
4524     if {!$viewcomplete($n)} {
4525         if {$numcommits == 0} {
4526             show_status [mc "Reading commits..."]
4527         }
4528     } elseif {$numcommits == 0} {
4529         show_status [mc "No commits selected"]
4530     }
4531     set_window_title
4532 }
4533
4534 # Stuff relating to the highlighting facility
4535
4536 proc ishighlighted {id} {
4537     global vhighlights fhighlights nhighlights rhighlights
4538
4539     if {[info exists nhighlights($id)] && $nhighlights($id) > 0} {
4540         return $nhighlights($id)
4541     }
4542     if {[info exists vhighlights($id)] && $vhighlights($id) > 0} {
4543         return $vhighlights($id)
4544     }
4545     if {[info exists fhighlights($id)] && $fhighlights($id) > 0} {
4546         return $fhighlights($id)
4547     }
4548     if {[info exists rhighlights($id)] && $rhighlights($id) > 0} {
4549         return $rhighlights($id)
4550     }
4551     return 0
4552 }
4553
4554 proc bolden {id font} {
4555     global canv linehtag currentid boldids need_redisplay markedid
4556
4557     # need_redisplay = 1 means the display is stale and about to be redrawn
4558     if {$need_redisplay} return
4559     lappend boldids $id
4560     $canv itemconf $linehtag($id) -font $font
4561     if {[info exists currentid] && $id eq $currentid} {
4562         $canv delete secsel
4563         set t [eval $canv create rect [$canv bbox $linehtag($id)] \
4564                    -outline {{}} -tags secsel \
4565                    -fill [$canv cget -selectbackground]]
4566         $canv lower $t
4567     }
4568     if {[info exists markedid] && $id eq $markedid} {
4569         make_idmark $id
4570     }
4571 }
4572
4573 proc bolden_name {id font} {
4574     global canv2 linentag currentid boldnameids need_redisplay
4575
4576     if {$need_redisplay} return
4577     lappend boldnameids $id
4578     $canv2 itemconf $linentag($id) -font $font
4579     if {[info exists currentid] && $id eq $currentid} {
4580         $canv2 delete secsel
4581         set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \
4582                    -outline {{}} -tags secsel \
4583                    -fill [$canv2 cget -selectbackground]]
4584         $canv2 lower $t
4585     }
4586 }
4587
4588 proc unbolden {} {
4589     global boldids
4590
4591     set stillbold {}
4592     foreach id $boldids {
4593         if {![ishighlighted $id]} {
4594             bolden $id mainfont
4595         } else {
4596             lappend stillbold $id
4597         }
4598     }
4599     set boldids $stillbold
4600 }
4601
4602 proc addvhighlight {n} {
4603     global hlview viewcomplete curview vhl_done commitidx
4604
4605     if {[info exists hlview]} {
4606         delvhighlight
4607     }
4608     set hlview $n
4609     if {$n != $curview && ![info exists viewcomplete($n)]} {
4610         start_rev_list $n
4611     }
4612     set vhl_done $commitidx($hlview)
4613     if {$vhl_done > 0} {
4614         drawvisible
4615     }
4616 }
4617
4618 proc delvhighlight {} {
4619     global hlview vhighlights
4620
4621     if {![info exists hlview]} return
4622     unset hlview
4623     unset -nocomplain vhighlights
4624     unbolden
4625 }
4626
4627 proc vhighlightmore {} {
4628     global hlview vhl_done commitidx vhighlights curview
4629
4630     set max $commitidx($hlview)
4631     set vr [visiblerows]
4632     set r0 [lindex $vr 0]
4633     set r1 [lindex $vr 1]
4634     for {set i $vhl_done} {$i < $max} {incr i} {
4635         set id [commitonrow $i $hlview]
4636         if {[commitinview $id $curview]} {
4637             set row [rowofcommit $id]
4638             if {$r0 <= $row && $row <= $r1} {
4639                 if {![highlighted $row]} {
4640                     bolden $id mainfontbold
4641                 }
4642                 set vhighlights($id) 1
4643             }
4644         }
4645     }
4646     set vhl_done $max
4647     return 0
4648 }
4649
4650 proc askvhighlight {row id} {
4651     global hlview vhighlights iddrawn
4652
4653     if {[commitinview $id $hlview]} {
4654         if {[info exists iddrawn($id)] && ![ishighlighted $id]} {
4655             bolden $id mainfontbold
4656         }
4657         set vhighlights($id) 1
4658     } else {
4659         set vhighlights($id) 0
4660     }
4661 }
4662
4663 proc hfiles_change {} {
4664     global highlight_files filehighlight fhighlights fh_serial
4665     global highlight_paths
4666
4667     if {[info exists filehighlight]} {
4668         # delete previous highlights
4669         catch {close $filehighlight}
4670         unset filehighlight
4671         unset -nocomplain fhighlights
4672         unbolden
4673         unhighlight_filelist
4674     }
4675     set highlight_paths {}
4676     after cancel do_file_hl $fh_serial
4677     incr fh_serial
4678     if {$highlight_files ne {}} {
4679         after 300 do_file_hl $fh_serial
4680     }
4681 }
4682
4683 proc gdttype_change {name ix op} {
4684     global gdttype highlight_files findstring findpattern
4685
4686     stopfinding
4687     if {$findstring ne {}} {
4688         if {$gdttype eq [mc "containing:"]} {
4689             if {$highlight_files ne {}} {
4690                 set highlight_files {}
4691                 hfiles_change
4692             }
4693             findcom_change
4694         } else {
4695             if {$findpattern ne {}} {
4696                 set findpattern {}
4697                 findcom_change
4698             }
4699             set highlight_files $findstring
4700             hfiles_change
4701         }
4702         drawvisible
4703     }
4704     # enable/disable findtype/findloc menus too
4705 }
4706
4707 proc find_change {name ix op} {
4708     global gdttype findstring highlight_files
4709
4710     stopfinding
4711     if {$gdttype eq [mc "containing:"]} {
4712         findcom_change
4713     } else {
4714         if {$highlight_files ne $findstring} {
4715             set highlight_files $findstring
4716             hfiles_change
4717         }
4718     }
4719     drawvisible
4720 }
4721
4722 proc findcom_change args {
4723     global nhighlights boldnameids
4724     global findpattern findtype findstring gdttype
4725
4726     stopfinding
4727     # delete previous highlights, if any
4728     foreach id $boldnameids {
4729         bolden_name $id mainfont
4730     }
4731     set boldnameids {}
4732     unset -nocomplain nhighlights
4733     unbolden
4734     unmarkmatches
4735     if {$gdttype ne [mc "containing:"] || $findstring eq {}} {
4736         set findpattern {}
4737     } elseif {$findtype eq [mc "Regexp"]} {
4738         set findpattern $findstring
4739     } else {
4740         set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
4741                    $findstring]
4742         set findpattern "*$e*"
4743     }
4744 }
4745
4746 proc makepatterns {l} {
4747     set ret {}
4748     foreach e $l {
4749         set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
4750         if {[string index $ee end] eq "/"} {
4751             lappend ret "$ee*"
4752         } else {
4753             lappend ret $ee
4754             lappend ret "$ee/*"
4755         }
4756     }
4757     return $ret
4758 }
4759
4760 proc do_file_hl {serial} {
4761     global highlight_files filehighlight highlight_paths gdttype fhl_list
4762     global cdup findtype
4763
4764     if {$gdttype eq [mc "touching paths:"]} {
4765         # If "exact" match then convert backslashes to forward slashes.
4766         # Most useful to support Windows-flavoured file paths.
4767         if {$findtype eq [mc "Exact"]} {
4768             set highlight_files [string map {"\\" "/"} $highlight_files]
4769         }
4770         if {[catch {set paths [shellsplit $highlight_files]}]} return
4771         set highlight_paths [makepatterns $paths]
4772         highlight_filelist
4773         set relative_paths {}
4774         foreach path $paths {
4775             lappend relative_paths [file join $cdup $path]
4776         }
4777         set gdtargs [concat -- $relative_paths]
4778     } elseif {$gdttype eq [mc "adding/removing string:"]} {
4779         set gdtargs [list "-S$highlight_files"]
4780     } elseif {$gdttype eq [mc "changing lines matching:"]} {
4781         set gdtargs [list "-G$highlight_files"]
4782     } else {
4783         # must be "containing:", i.e. we're searching commit info
4784         return
4785     }
4786     set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
4787     set filehighlight [open $cmd r+]
4788     fconfigure $filehighlight -blocking 0
4789     filerun $filehighlight readfhighlight
4790     set fhl_list {}
4791     drawvisible
4792     flushhighlights
4793 }
4794
4795 proc flushhighlights {} {
4796     global filehighlight fhl_list
4797
4798     if {[info exists filehighlight]} {
4799         lappend fhl_list {}
4800         puts $filehighlight ""
4801         flush $filehighlight
4802     }
4803 }
4804
4805 proc askfilehighlight {row id} {
4806     global filehighlight fhighlights fhl_list
4807
4808     lappend fhl_list $id
4809     set fhighlights($id) -1
4810     puts $filehighlight $id
4811 }
4812
4813 proc readfhighlight {} {
4814     global filehighlight fhighlights curview iddrawn
4815     global fhl_list find_dirn
4816
4817     if {![info exists filehighlight]} {
4818         return 0
4819     }
4820     set nr 0
4821     while {[incr nr] <= 100 && [gets $filehighlight line] >= 0} {
4822         set line [string trim $line]
4823         set i [lsearch -exact $fhl_list $line]
4824         if {$i < 0} continue
4825         for {set j 0} {$j < $i} {incr j} {
4826             set id [lindex $fhl_list $j]
4827             set fhighlights($id) 0
4828         }
4829         set fhl_list [lrange $fhl_list [expr {$i+1}] end]
4830         if {$line eq {}} continue
4831         if {![commitinview $line $curview]} continue
4832         if {[info exists iddrawn($line)] && ![ishighlighted $line]} {
4833             bolden $line mainfontbold
4834         }
4835         set fhighlights($line) 1
4836     }
4837     if {[eof $filehighlight]} {
4838         # strange...
4839         puts "oops, git diff-tree died"
4840         catch {close $filehighlight}
4841         unset filehighlight
4842         return 0
4843     }
4844     if {[info exists find_dirn]} {
4845         run findmore
4846     }
4847     return 1
4848 }
4849
4850 proc doesmatch {f} {
4851     global findtype findpattern
4852
4853     if {$findtype eq [mc "Regexp"]} {
4854         return [regexp $findpattern $f]
4855     } elseif {$findtype eq [mc "IgnCase"]} {
4856         return [string match -nocase $findpattern $f]
4857     } else {
4858         return [string match $findpattern $f]
4859     }
4860 }
4861
4862 proc askfindhighlight {row id} {
4863     global nhighlights commitinfo iddrawn
4864     global findloc
4865     global markingmatches
4866
4867     if {![info exists commitinfo($id)]} {
4868         getcommit $id
4869     }
4870     set info $commitinfo($id)
4871     set isbold 0
4872     set fldtypes [list [mc Headline] [mc Author] "" [mc Committer] "" [mc Comments]]
4873     foreach f $info ty $fldtypes {
4874         if {$ty eq ""} continue
4875         if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4876             [doesmatch $f]} {
4877             if {$ty eq [mc "Author"]} {
4878                 set isbold 2
4879                 break
4880             }
4881             set isbold 1
4882         }
4883     }
4884     if {$isbold && [info exists iddrawn($id)]} {
4885         if {![ishighlighted $id]} {
4886             bolden $id mainfontbold
4887             if {$isbold > 1} {
4888                 bolden_name $id mainfontbold
4889             }
4890         }
4891         if {$markingmatches} {
4892             markrowmatches $row $id
4893         }
4894     }
4895     set nhighlights($id) $isbold
4896 }
4897
4898 proc markrowmatches {row id} {
4899     global canv canv2 linehtag linentag commitinfo findloc
4900
4901     set headline [lindex $commitinfo($id) 0]
4902     set author [lindex $commitinfo($id) 1]
4903     $canv delete match$row
4904     $canv2 delete match$row
4905     if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4906         set m [findmatches $headline]
4907         if {$m ne {}} {
4908             markmatches $canv $row $headline $linehtag($id) $m \
4909                 [$canv itemcget $linehtag($id) -font] $row
4910         }
4911     }
4912     if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4913         set m [findmatches $author]
4914         if {$m ne {}} {
4915             markmatches $canv2 $row $author $linentag($id) $m \
4916                 [$canv2 itemcget $linentag($id) -font] $row
4917         }
4918     }
4919 }
4920
4921 proc vrel_change {name ix op} {
4922     global highlight_related
4923
4924     rhighlight_none
4925     if {$highlight_related ne [mc "None"]} {
4926         run drawvisible
4927     }
4928 }
4929
4930 # prepare for testing whether commits are descendents or ancestors of a
4931 proc rhighlight_sel {a} {
4932     global descendent desc_todo ancestor anc_todo
4933     global highlight_related
4934
4935     unset -nocomplain descendent
4936     set desc_todo [list $a]
4937     unset -nocomplain ancestor
4938     set anc_todo [list $a]
4939     if {$highlight_related ne [mc "None"]} {
4940         rhighlight_none
4941         run drawvisible
4942     }
4943 }
4944
4945 proc rhighlight_none {} {
4946     global rhighlights
4947
4948     unset -nocomplain rhighlights
4949     unbolden
4950 }
4951
4952 proc is_descendent {a} {
4953     global curview children descendent desc_todo
4954
4955     set v $curview
4956     set la [rowofcommit $a]
4957     set todo $desc_todo
4958     set leftover {}
4959     set done 0
4960     for {set i 0} {$i < [llength $todo]} {incr i} {
4961         set do [lindex $todo $i]
4962         if {[rowofcommit $do] < $la} {
4963             lappend leftover $do
4964             continue
4965         }
4966         foreach nk $children($v,$do) {
4967             if {![info exists descendent($nk)]} {
4968                 set descendent($nk) 1
4969                 lappend todo $nk
4970                 if {$nk eq $a} {
4971                     set done 1
4972                 }
4973             }
4974         }
4975         if {$done} {
4976             set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4977             return
4978         }
4979     }
4980     set descendent($a) 0
4981     set desc_todo $leftover
4982 }
4983
4984 proc is_ancestor {a} {
4985     global curview parents ancestor anc_todo
4986
4987     set v $curview
4988     set la [rowofcommit $a]
4989     set todo $anc_todo
4990     set leftover {}
4991     set done 0
4992     for {set i 0} {$i < [llength $todo]} {incr i} {
4993         set do [lindex $todo $i]
4994         if {![commitinview $do $v] || [rowofcommit $do] > $la} {
4995             lappend leftover $do
4996             continue
4997         }
4998         foreach np $parents($v,$do) {
4999             if {![info exists ancestor($np)]} {
5000                 set ancestor($np) 1
5001                 lappend todo $np
5002                 if {$np eq $a} {
5003                     set done 1
5004                 }
5005             }
5006         }
5007         if {$done} {
5008             set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
5009             return
5010         }
5011     }
5012     set ancestor($a) 0
5013     set anc_todo $leftover
5014 }
5015
5016 proc askrelhighlight {row id} {
5017     global descendent highlight_related iddrawn rhighlights
5018     global selectedline ancestor
5019
5020     if {$selectedline eq {}} return
5021     set isbold 0
5022     if {$highlight_related eq [mc "Descendant"] ||
5023         $highlight_related eq [mc "Not descendant"]} {
5024         if {![info exists descendent($id)]} {
5025             is_descendent $id
5026         }
5027         if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
5028             set isbold 1
5029         }
5030     } elseif {$highlight_related eq [mc "Ancestor"] ||
5031               $highlight_related eq [mc "Not ancestor"]} {
5032         if {![info exists ancestor($id)]} {
5033             is_ancestor $id
5034         }
5035         if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
5036             set isbold 1
5037         }
5038     }
5039     if {[info exists iddrawn($id)]} {
5040         if {$isbold && ![ishighlighted $id]} {
5041             bolden $id mainfontbold
5042         }
5043     }
5044     set rhighlights($id) $isbold
5045 }
5046
5047 # Graph layout functions
5048
5049 proc shortids {ids} {
5050     set res {}
5051     foreach id $ids {
5052         if {[llength $id] > 1} {
5053             lappend res [shortids $id]
5054         } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
5055             lappend res [string range $id 0 7]
5056         } else {
5057             lappend res $id
5058         }
5059     }
5060     return $res
5061 }
5062
5063 proc ntimes {n o} {
5064     set ret {}
5065     set o [list $o]
5066     for {set mask 1} {$mask <= $n} {incr mask $mask} {
5067         if {($n & $mask) != 0} {
5068             set ret [concat $ret $o]
5069         }
5070         set o [concat $o $o]
5071     }
5072     return $ret
5073 }
5074
5075 proc ordertoken {id} {
5076     global ordertok curview varcid varcstart varctok curview parents children
5077     global nullid nullid2
5078
5079     if {[info exists ordertok($id)]} {
5080         return $ordertok($id)
5081     }
5082     set origid $id
5083     set todo {}
5084     while {1} {
5085         if {[info exists varcid($curview,$id)]} {
5086             set a $varcid($curview,$id)
5087             set p [lindex $varcstart($curview) $a]
5088         } else {
5089             set p [lindex $children($curview,$id) 0]
5090         }
5091         if {[info exists ordertok($p)]} {
5092             set tok $ordertok($p)
5093             break
5094         }
5095         set id [first_real_child $curview,$p]
5096         if {$id eq {}} {
5097             # it's a root
5098             set tok [lindex $varctok($curview) $varcid($curview,$p)]
5099             break
5100         }
5101         if {[llength $parents($curview,$id)] == 1} {
5102             lappend todo [list $p {}]
5103         } else {
5104             set j [lsearch -exact $parents($curview,$id) $p]
5105             if {$j < 0} {
5106                 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
5107             }
5108             lappend todo [list $p [strrep $j]]
5109         }
5110     }
5111     for {set i [llength $todo]} {[incr i -1] >= 0} {} {
5112         set p [lindex $todo $i 0]
5113         append tok [lindex $todo $i 1]
5114         set ordertok($p) $tok
5115     }
5116     set ordertok($origid) $tok
5117     return $tok
5118 }
5119
5120 # Work out where id should go in idlist so that order-token
5121 # values increase from left to right
5122 proc idcol {idlist id {i 0}} {
5123     set t [ordertoken $id]
5124     if {$i < 0} {
5125         set i 0
5126     }
5127     if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
5128         if {$i > [llength $idlist]} {
5129             set i [llength $idlist]
5130         }
5131         while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
5132         incr i
5133     } else {
5134         if {$t > [ordertoken [lindex $idlist $i]]} {
5135             while {[incr i] < [llength $idlist] &&
5136                    $t >= [ordertoken [lindex $idlist $i]]} {}
5137         }
5138     }
5139     return $i
5140 }
5141
5142 proc initlayout {} {
5143     global rowidlist rowisopt rowfinal displayorder parentlist
5144     global numcommits canvxmax canv
5145     global nextcolor
5146     global colormap rowtextx
5147
5148     set numcommits 0
5149     set displayorder {}
5150     set parentlist {}
5151     set nextcolor 0
5152     set rowidlist {}
5153     set rowisopt {}
5154     set rowfinal {}
5155     set canvxmax [$canv cget -width]
5156     unset -nocomplain colormap
5157     unset -nocomplain rowtextx
5158     setcanvscroll
5159 }
5160
5161 proc setcanvscroll {} {
5162     global canv canv2 canv3 numcommits linespc canvxmax canvy0
5163     global lastscrollset lastscrollrows
5164
5165     set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
5166     $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
5167     $canv2 conf -scrollregion [list 0 0 0 $ymax]
5168     $canv3 conf -scrollregion [list 0 0 0 $ymax]
5169     set lastscrollset [clock clicks -milliseconds]
5170     set lastscrollrows $numcommits
5171 }
5172
5173 proc visiblerows {} {
5174     global canv numcommits linespc
5175
5176     set ymax [lindex [$canv cget -scrollregion] 3]
5177     if {$ymax eq {} || $ymax == 0} return
5178     set f [$canv yview]
5179     set y0 [expr {int([lindex $f 0] * $ymax)}]
5180     set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
5181     if {$r0 < 0} {
5182         set r0 0
5183     }
5184     set y1 [expr {int([lindex $f 1] * $ymax)}]
5185     set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
5186     if {$r1 >= $numcommits} {
5187         set r1 [expr {$numcommits - 1}]
5188     }
5189     return [list $r0 $r1]
5190 }
5191
5192 proc layoutmore {} {
5193     global commitidx viewcomplete curview
5194     global numcommits pending_select curview
5195     global lastscrollset lastscrollrows
5196
5197     if {$lastscrollrows < 100 || $viewcomplete($curview) ||
5198         [clock clicks -milliseconds] - $lastscrollset > 500} {
5199         setcanvscroll
5200     }
5201     if {[info exists pending_select] &&
5202         [commitinview $pending_select $curview]} {
5203         update
5204         selectline [rowofcommit $pending_select] 1
5205     }
5206     drawvisible
5207 }
5208
5209 # With path limiting, we mightn't get the actual HEAD commit,
5210 # so ask git rev-list what is the first ancestor of HEAD that
5211 # touches a file in the path limit.
5212 proc get_viewmainhead {view} {
5213     global viewmainheadid vfilelimit viewinstances mainheadid
5214
5215     catch {
5216         set rfd [open [concat | git rev-list -1 $mainheadid \
5217                            -- $vfilelimit($view)] r]
5218         set j [reg_instance $rfd]
5219         lappend viewinstances($view) $j
5220         fconfigure $rfd -blocking 0
5221         filerun $rfd [list getviewhead $rfd $j $view]
5222         set viewmainheadid($curview) {}
5223     }
5224 }
5225
5226 # git rev-list should give us just 1 line to use as viewmainheadid($view)
5227 proc getviewhead {fd inst view} {
5228     global viewmainheadid commfd curview viewinstances showlocalchanges
5229
5230     set id {}
5231     if {[gets $fd line] < 0} {
5232         if {![eof $fd]} {
5233             return 1
5234         }
5235     } elseif {[string length $line] == 40 && [string is xdigit $line]} {
5236         set id $line
5237     }
5238     set viewmainheadid($view) $id
5239     close $fd
5240     unset commfd($inst)
5241     set i [lsearch -exact $viewinstances($view) $inst]
5242     if {$i >= 0} {
5243         set viewinstances($view) [lreplace $viewinstances($view) $i $i]
5244     }
5245     if {$showlocalchanges && $id ne {} && $view == $curview} {
5246         doshowlocalchanges
5247     }
5248     return 0
5249 }
5250
5251 proc doshowlocalchanges {} {
5252     global curview viewmainheadid
5253
5254     if {$viewmainheadid($curview) eq {}} return
5255     if {[commitinview $viewmainheadid($curview) $curview]} {
5256         dodiffindex
5257     } else {
5258         interestedin $viewmainheadid($curview) dodiffindex
5259     }
5260 }
5261
5262 proc dohidelocalchanges {} {
5263     global nullid nullid2 lserial curview
5264
5265     if {[commitinview $nullid $curview]} {
5266         removefakerow $nullid
5267     }
5268     if {[commitinview $nullid2 $curview]} {
5269         removefakerow $nullid2
5270     }
5271     incr lserial
5272 }
5273
5274 # spawn off a process to do git diff-index --cached HEAD
5275 proc dodiffindex {} {
5276     global lserial showlocalchanges vfilelimit curview
5277     global hasworktree git_version
5278
5279     if {!$showlocalchanges || !$hasworktree} return
5280     incr lserial
5281     if {[package vcompare $git_version "1.7.2"] >= 0} {
5282         set cmd "|git diff-index --cached --ignore-submodules=dirty HEAD"
5283     } else {
5284         set cmd "|git diff-index --cached HEAD"
5285     }
5286     if {$vfilelimit($curview) ne {}} {
5287         set cmd [concat $cmd -- $vfilelimit($curview)]
5288     }
5289     set fd [open $cmd r]
5290     fconfigure $fd -blocking 0
5291     set i [reg_instance $fd]
5292     filerun $fd [list readdiffindex $fd $lserial $i]
5293 }
5294
5295 proc readdiffindex {fd serial inst} {
5296     global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
5297     global vfilelimit
5298
5299     set isdiff 1
5300     if {[gets $fd line] < 0} {
5301         if {![eof $fd]} {
5302             return 1
5303         }
5304         set isdiff 0
5305     }
5306     # we only need to see one line and we don't really care what it says...
5307     stop_instance $inst
5308
5309     if {$serial != $lserial} {
5310         return 0
5311     }
5312
5313     # now see if there are any local changes not checked in to the index
5314     set cmd "|git diff-files"
5315     if {$vfilelimit($curview) ne {}} {
5316         set cmd [concat $cmd -- $vfilelimit($curview)]
5317     }
5318     set fd [open $cmd r]
5319     fconfigure $fd -blocking 0
5320     set i [reg_instance $fd]
5321     filerun $fd [list readdifffiles $fd $serial $i]
5322
5323     if {$isdiff && ![commitinview $nullid2 $curview]} {
5324         # add the line for the changes in the index to the graph
5325         set hl [mc "Local changes checked in to index but not committed"]
5326         set commitinfo($nullid2) [list  $hl {} {} {} {} "    $hl\n"]
5327         set commitdata($nullid2) "\n    $hl\n"
5328         if {[commitinview $nullid $curview]} {
5329             removefakerow $nullid
5330         }
5331         insertfakerow $nullid2 $viewmainheadid($curview)
5332     } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
5333         if {[commitinview $nullid $curview]} {
5334             removefakerow $nullid
5335         }
5336         removefakerow $nullid2
5337     }
5338     return 0
5339 }
5340
5341 proc readdifffiles {fd serial inst} {
5342     global viewmainheadid nullid nullid2 curview
5343     global commitinfo commitdata lserial
5344
5345     set isdiff 1
5346     if {[gets $fd line] < 0} {
5347         if {![eof $fd]} {
5348             return 1
5349         }
5350         set isdiff 0
5351     }
5352     # we only need to see one line and we don't really care what it says...
5353     stop_instance $inst
5354
5355     if {$serial != $lserial} {
5356         return 0
5357     }
5358
5359     if {$isdiff && ![commitinview $nullid $curview]} {
5360         # add the line for the local diff to the graph
5361         set hl [mc "Local uncommitted changes, not checked in to index"]
5362         set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
5363         set commitdata($nullid) "\n    $hl\n"
5364         if {[commitinview $nullid2 $curview]} {
5365             set p $nullid2
5366         } else {
5367             set p $viewmainheadid($curview)
5368         }
5369         insertfakerow $nullid $p
5370     } elseif {!$isdiff && [commitinview $nullid $curview]} {
5371         removefakerow $nullid
5372     }
5373     return 0
5374 }
5375
5376 proc nextuse {id row} {
5377     global curview children
5378
5379     if {[info exists children($curview,$id)]} {
5380         foreach kid $children($curview,$id) {
5381             if {![commitinview $kid $curview]} {
5382                 return -1
5383             }
5384             if {[rowofcommit $kid] > $row} {
5385                 return [rowofcommit $kid]
5386             }
5387         }
5388     }
5389     if {[commitinview $id $curview]} {
5390         return [rowofcommit $id]
5391     }
5392     return -1
5393 }
5394
5395 proc prevuse {id row} {
5396     global curview children
5397
5398     set ret -1
5399     if {[info exists children($curview,$id)]} {
5400         foreach kid $children($curview,$id) {
5401             if {![commitinview $kid $curview]} break
5402             if {[rowofcommit $kid] < $row} {
5403                 set ret [rowofcommit $kid]
5404             }
5405         }
5406     }
5407     return $ret
5408 }
5409
5410 proc make_idlist {row} {
5411     global displayorder parentlist uparrowlen downarrowlen mingaplen
5412     global commitidx curview children
5413
5414     set r [expr {$row - $mingaplen - $downarrowlen - 1}]
5415     if {$r < 0} {
5416         set r 0
5417     }
5418     set ra [expr {$row - $downarrowlen}]
5419     if {$ra < 0} {
5420         set ra 0
5421     }
5422     set rb [expr {$row + $uparrowlen}]
5423     if {$rb > $commitidx($curview)} {
5424         set rb $commitidx($curview)
5425     }
5426     make_disporder $r [expr {$rb + 1}]
5427     set ids {}
5428     for {} {$r < $ra} {incr r} {
5429         set nextid [lindex $displayorder [expr {$r + 1}]]
5430         foreach p [lindex $parentlist $r] {
5431             if {$p eq $nextid} continue
5432             set rn [nextuse $p $r]
5433             if {$rn >= $row &&
5434                 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
5435                 lappend ids [list [ordertoken $p] $p]
5436             }
5437         }
5438     }
5439     for {} {$r < $row} {incr r} {
5440         set nextid [lindex $displayorder [expr {$r + 1}]]
5441         foreach p [lindex $parentlist $r] {
5442             if {$p eq $nextid} continue
5443             set rn [nextuse $p $r]
5444             if {$rn < 0 || $rn >= $row} {
5445                 lappend ids [list [ordertoken $p] $p]
5446             }
5447         }
5448     }
5449     set id [lindex $displayorder $row]
5450     lappend ids [list [ordertoken $id] $id]
5451     while {$r < $rb} {
5452         foreach p [lindex $parentlist $r] {
5453             set firstkid [lindex $children($curview,$p) 0]
5454             if {[rowofcommit $firstkid] < $row} {
5455                 lappend ids [list [ordertoken $p] $p]
5456             }
5457         }
5458         incr r
5459         set id [lindex $displayorder $r]
5460         if {$id ne {}} {
5461             set firstkid [lindex $children($curview,$id) 0]
5462             if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
5463                 lappend ids [list [ordertoken $id] $id]
5464             }
5465         }
5466     }
5467     set idlist {}
5468     foreach idx [lsort -unique $ids] {
5469         lappend idlist [lindex $idx 1]
5470     }
5471     return $idlist
5472 }
5473
5474 proc rowsequal {a b} {
5475     while {[set i [lsearch -exact $a {}]] >= 0} {
5476         set a [lreplace $a $i $i]
5477     }
5478     while {[set i [lsearch -exact $b {}]] >= 0} {
5479         set b [lreplace $b $i $i]
5480     }
5481     return [expr {$a eq $b}]
5482 }
5483
5484 proc makeupline {id row rend col} {
5485     global rowidlist uparrowlen downarrowlen mingaplen
5486
5487     for {set r $rend} {1} {set r $rstart} {
5488         set rstart [prevuse $id $r]
5489         if {$rstart < 0} return
5490         if {$rstart < $row} break
5491     }
5492     if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5493         set rstart [expr {$rend - $uparrowlen - 1}]
5494     }
5495     for {set r $rstart} {[incr r] <= $row} {} {
5496         set idlist [lindex $rowidlist $r]
5497         if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5498             set col [idcol $idlist $id $col]
5499             lset rowidlist $r [linsert $idlist $col $id]
5500             changedrow $r
5501         }
5502     }
5503 }
5504
5505 proc layoutrows {row endrow} {
5506     global rowidlist rowisopt rowfinal displayorder
5507     global uparrowlen downarrowlen maxwidth mingaplen
5508     global children parentlist
5509     global commitidx viewcomplete curview
5510
5511     make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
5512     set idlist {}
5513     if {$row > 0} {
5514         set rm1 [expr {$row - 1}]
5515         foreach id [lindex $rowidlist $rm1] {
5516             if {$id ne {}} {
5517                 lappend idlist $id
5518             }
5519         }
5520         set final [lindex $rowfinal $rm1]
5521     }
5522     for {} {$row < $endrow} {incr row} {
5523         set rm1 [expr {$row - 1}]
5524         if {$rm1 < 0 || $idlist eq {}} {
5525             set idlist [make_idlist $row]
5526             set final 1
5527         } else {
5528             set id [lindex $displayorder $rm1]
5529             set col [lsearch -exact $idlist $id]
5530             set idlist [lreplace $idlist $col $col]
5531             foreach p [lindex $parentlist $rm1] {
5532                 if {[lsearch -exact $idlist $p] < 0} {
5533                     set col [idcol $idlist $p $col]
5534                     set idlist [linsert $idlist $col $p]
5535                     # if not the first child, we have to insert a line going up
5536                     if {$id ne [lindex $children($curview,$p) 0]} {
5537                         makeupline $p $rm1 $row $col
5538                     }
5539                 }
5540             }
5541             set id [lindex $displayorder $row]
5542             if {$row > $downarrowlen} {
5543                 set termrow [expr {$row - $downarrowlen - 1}]
5544                 foreach p [lindex $parentlist $termrow] {
5545                     set i [lsearch -exact $idlist $p]
5546                     if {$i < 0} continue
5547                     set nr [nextuse $p $termrow]
5548                     if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5549                         set idlist [lreplace $idlist $i $i]
5550                     }
5551                 }
5552             }
5553             set col [lsearch -exact $idlist $id]
5554             if {$col < 0} {
5555                 set col [idcol $idlist $id]
5556                 set idlist [linsert $idlist $col $id]
5557                 if {$children($curview,$id) ne {}} {
5558                     makeupline $id $rm1 $row $col
5559                 }
5560             }
5561             set r [expr {$row + $uparrowlen - 1}]
5562             if {$r < $commitidx($curview)} {
5563                 set x $col
5564                 foreach p [lindex $parentlist $r] {
5565                     if {[lsearch -exact $idlist $p] >= 0} continue
5566                     set fk [lindex $children($curview,$p) 0]
5567                     if {[rowofcommit $fk] < $row} {
5568                         set x [idcol $idlist $p $x]
5569                         set idlist [linsert $idlist $x $p]
5570                     }
5571                 }
5572                 if {[incr r] < $commitidx($curview)} {
5573                     set p [lindex $displayorder $r]
5574                     if {[lsearch -exact $idlist $p] < 0} {
5575                         set fk [lindex $children($curview,$p) 0]
5576                         if {$fk ne {} && [rowofcommit $fk] < $row} {
5577                             set x [idcol $idlist $p $x]
5578                             set idlist [linsert $idlist $x $p]
5579                         }
5580                     }
5581                 }
5582             }
5583         }
5584         if {$final && !$viewcomplete($curview) &&
5585             $row + $uparrowlen + $mingaplen + $downarrowlen
5586                 >= $commitidx($curview)} {
5587             set final 0
5588         }
5589         set l [llength $rowidlist]
5590         if {$row == $l} {
5591             lappend rowidlist $idlist
5592             lappend rowisopt 0
5593             lappend rowfinal $final
5594         } elseif {$row < $l} {
5595             if {![rowsequal $idlist [lindex $rowidlist $row]]} {
5596                 lset rowidlist $row $idlist
5597                 changedrow $row
5598             }
5599             lset rowfinal $row $final
5600         } else {
5601             set pad [ntimes [expr {$row - $l}] {}]
5602             set rowidlist [concat $rowidlist $pad]
5603             lappend rowidlist $idlist
5604             set rowfinal [concat $rowfinal $pad]
5605             lappend rowfinal $final
5606             set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5607         }
5608     }
5609     return $row
5610 }
5611
5612 proc changedrow {row} {
5613     global displayorder iddrawn rowisopt need_redisplay
5614
5615     set l [llength $rowisopt]
5616     if {$row < $l} {
5617         lset rowisopt $row 0
5618         if {$row + 1 < $l} {
5619             lset rowisopt [expr {$row + 1}] 0
5620             if {$row + 2 < $l} {
5621                 lset rowisopt [expr {$row + 2}] 0
5622             }
5623         }
5624     }
5625     set id [lindex $displayorder $row]
5626     if {[info exists iddrawn($id)]} {
5627         set need_redisplay 1
5628     }
5629 }
5630
5631 proc insert_pad {row col npad} {
5632     global rowidlist
5633
5634     set pad [ntimes $npad {}]
5635     set idlist [lindex $rowidlist $row]
5636     set bef [lrange $idlist 0 [expr {$col - 1}]]
5637     set aft [lrange $idlist $col end]
5638     set i [lsearch -exact $aft {}]
5639     if {$i > 0} {
5640         set aft [lreplace $aft $i $i]
5641     }
5642     lset rowidlist $row [concat $bef $pad $aft]
5643     changedrow $row
5644 }
5645
5646 proc optimize_rows {row col endrow} {
5647     global rowidlist rowisopt displayorder curview children
5648
5649     if {$row < 1} {
5650         set row 1
5651     }
5652     for {} {$row < $endrow} {incr row; set col 0} {
5653         if {[lindex $rowisopt $row]} continue
5654         set haspad 0
5655         set y0 [expr {$row - 1}]
5656         set ym [expr {$row - 2}]
5657         set idlist [lindex $rowidlist $row]
5658         set previdlist [lindex $rowidlist $y0]
5659         if {$idlist eq {} || $previdlist eq {}} continue
5660         if {$ym >= 0} {
5661             set pprevidlist [lindex $rowidlist $ym]
5662             if {$pprevidlist eq {}} continue
5663         } else {
5664             set pprevidlist {}
5665         }
5666         set x0 -1
5667         set xm -1
5668         for {} {$col < [llength $idlist]} {incr col} {
5669             set id [lindex $idlist $col]
5670             if {[lindex $previdlist $col] eq $id} continue
5671             if {$id eq {}} {
5672                 set haspad 1
5673                 continue
5674             }
5675             set x0 [lsearch -exact $previdlist $id]
5676             if {$x0 < 0} continue
5677             set z [expr {$x0 - $col}]
5678             set isarrow 0
5679             set z0 {}
5680             if {$ym >= 0} {
5681                 set xm [lsearch -exact $pprevidlist $id]
5682                 if {$xm >= 0} {
5683                     set z0 [expr {$xm - $x0}]
5684                 }
5685             }
5686             if {$z0 eq {}} {
5687                 # if row y0 is the first child of $id then it's not an arrow
5688                 if {[lindex $children($curview,$id) 0] ne
5689                     [lindex $displayorder $y0]} {
5690                     set isarrow 1
5691                 }
5692             }
5693             if {!$isarrow && $id ne [lindex $displayorder $row] &&
5694                 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5695                 set isarrow 1
5696             }
5697             # Looking at lines from this row to the previous row,
5698             # make them go straight up if they end in an arrow on
5699             # the previous row; otherwise make them go straight up
5700             # or at 45 degrees.
5701             if {$z < -1 || ($z < 0 && $isarrow)} {
5702                 # Line currently goes left too much;
5703                 # insert pads in the previous row, then optimize it
5704                 set npad [expr {-1 - $z + $isarrow}]
5705                 insert_pad $y0 $x0 $npad
5706                 if {$y0 > 0} {
5707                     optimize_rows $y0 $x0 $row
5708                 }
5709                 set previdlist [lindex $rowidlist $y0]
5710                 set x0 [lsearch -exact $previdlist $id]
5711                 set z [expr {$x0 - $col}]
5712                 if {$z0 ne {}} {
5713                     set pprevidlist [lindex $rowidlist $ym]
5714                     set xm [lsearch -exact $pprevidlist $id]
5715                     set z0 [expr {$xm - $x0}]
5716                 }
5717             } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5718                 # Line currently goes right too much;
5719                 # insert pads in this line
5720                 set npad [expr {$z - 1 + $isarrow}]
5721                 insert_pad $row $col $npad
5722                 set idlist [lindex $rowidlist $row]
5723                 incr col $npad
5724                 set z [expr {$x0 - $col}]
5725                 set haspad 1
5726             }
5727             if {$z0 eq {} && !$isarrow && $ym >= 0} {
5728                 # this line links to its first child on row $row-2
5729                 set id [lindex $displayorder $ym]
5730                 set xc [lsearch -exact $pprevidlist $id]
5731                 if {$xc >= 0} {
5732                     set z0 [expr {$xc - $x0}]
5733                 }
5734             }
5735             # avoid lines jigging left then immediately right
5736             if {$z0 ne {} && $z < 0 && $z0 > 0} {
5737                 insert_pad $y0 $x0 1
5738                 incr x0
5739                 optimize_rows $y0 $x0 $row
5740                 set previdlist [lindex $rowidlist $y0]
5741             }
5742         }
5743         if {!$haspad} {
5744             # Find the first column that doesn't have a line going right
5745             for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5746                 set id [lindex $idlist $col]
5747                 if {$id eq {}} break
5748                 set x0 [lsearch -exact $previdlist $id]
5749                 if {$x0 < 0} {
5750                     # check if this is the link to the first child
5751                     set kid [lindex $displayorder $y0]
5752                     if {[lindex $children($curview,$id) 0] eq $kid} {
5753                         # it is, work out offset to child
5754                         set x0 [lsearch -exact $previdlist $kid]
5755                     }
5756                 }
5757                 if {$x0 <= $col} break
5758             }
5759             # Insert a pad at that column as long as it has a line and
5760             # isn't the last column
5761             if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5762                 set idlist [linsert $idlist $col {}]
5763                 lset rowidlist $row $idlist
5764                 changedrow $row
5765             }
5766         }
5767     }
5768 }
5769
5770 proc xc {row col} {
5771     global canvx0 linespc
5772     return [expr {$canvx0 + $col * $linespc}]
5773 }
5774
5775 proc yc {row} {
5776     global canvy0 linespc
5777     return [expr {$canvy0 + $row * $linespc}]
5778 }
5779
5780 proc linewidth {id} {
5781     global thickerline lthickness
5782
5783     set wid $lthickness
5784     if {[info exists thickerline] && $id eq $thickerline} {
5785         set wid [expr {2 * $lthickness}]
5786     }
5787     return $wid
5788 }
5789
5790 proc rowranges {id} {
5791     global curview children uparrowlen downarrowlen
5792     global rowidlist
5793
5794     set kids $children($curview,$id)
5795     if {$kids eq {}} {
5796         return {}
5797     }
5798     set ret {}
5799     lappend kids $id
5800     foreach child $kids {
5801         if {![commitinview $child $curview]} break
5802         set row [rowofcommit $child]
5803         if {![info exists prev]} {
5804             lappend ret [expr {$row + 1}]
5805         } else {
5806             if {$row <= $prevrow} {
5807                 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5808             }
5809             # see if the line extends the whole way from prevrow to row
5810             if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5811                 [lsearch -exact [lindex $rowidlist \
5812                             [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5813                 # it doesn't, see where it ends
5814                 set r [expr {$prevrow + $downarrowlen}]
5815                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5816                     while {[incr r -1] > $prevrow &&
5817                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5818                 } else {
5819                     while {[incr r] <= $row &&
5820                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5821                     incr r -1
5822                 }
5823                 lappend ret $r
5824                 # see where it starts up again
5825                 set r [expr {$row - $uparrowlen}]
5826                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5827                     while {[incr r] < $row &&
5828                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5829                 } else {
5830                     while {[incr r -1] >= $prevrow &&
5831                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5832                     incr r
5833                 }
5834                 lappend ret $r
5835             }
5836         }
5837         if {$child eq $id} {
5838             lappend ret $row
5839         }
5840         set prev $child
5841         set prevrow $row
5842     }
5843     return $ret
5844 }
5845
5846 proc drawlineseg {id row endrow arrowlow} {
5847     global rowidlist displayorder iddrawn linesegs
5848     global canv colormap linespc curview maxlinelen parentlist
5849
5850     set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5851     set le [expr {$row + 1}]
5852     set arrowhigh 1
5853     while {1} {
5854         set c [lsearch -exact [lindex $rowidlist $le] $id]
5855         if {$c < 0} {
5856             incr le -1
5857             break
5858         }
5859         lappend cols $c
5860         set x [lindex $displayorder $le]
5861         if {$x eq $id} {
5862             set arrowhigh 0
5863             break
5864         }
5865         if {[info exists iddrawn($x)] || $le == $endrow} {
5866             set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5867             if {$c >= 0} {
5868                 lappend cols $c
5869                 set arrowhigh 0
5870             }
5871             break
5872         }
5873         incr le
5874     }
5875     if {$le <= $row} {
5876         return $row
5877     }
5878
5879     set lines {}
5880     set i 0
5881     set joinhigh 0
5882     if {[info exists linesegs($id)]} {
5883         set lines $linesegs($id)
5884         foreach li $lines {
5885             set r0 [lindex $li 0]
5886             if {$r0 > $row} {
5887                 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5888                     set joinhigh 1
5889                 }
5890                 break
5891             }
5892             incr i
5893         }
5894     }
5895     set joinlow 0
5896     if {$i > 0} {
5897         set li [lindex $lines [expr {$i-1}]]
5898         set r1 [lindex $li 1]
5899         if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5900             set joinlow 1
5901         }
5902     }
5903
5904     set x [lindex $cols [expr {$le - $row}]]
5905     set xp [lindex $cols [expr {$le - 1 - $row}]]
5906     set dir [expr {$xp - $x}]
5907     if {$joinhigh} {
5908         set ith [lindex $lines $i 2]
5909         set coords [$canv coords $ith]
5910         set ah [$canv itemcget $ith -arrow]
5911         set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5912         set x2 [lindex $cols [expr {$le + 1 - $row}]]
5913         if {$x2 ne {} && $x - $x2 == $dir} {
5914             set coords [lrange $coords 0 end-2]
5915         }
5916     } else {
5917         set coords [list [xc $le $x] [yc $le]]
5918     }
5919     if {$joinlow} {
5920         set itl [lindex $lines [expr {$i-1}] 2]
5921         set al [$canv itemcget $itl -arrow]
5922         set arrowlow [expr {$al eq "last" || $al eq "both"}]
5923     } elseif {$arrowlow} {
5924         if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5925             [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5926             set arrowlow 0
5927         }
5928     }
5929     set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5930     for {set y $le} {[incr y -1] > $row} {} {
5931         set x $xp
5932         set xp [lindex $cols [expr {$y - 1 - $row}]]
5933         set ndir [expr {$xp - $x}]
5934         if {$dir != $ndir || $xp < 0} {
5935             lappend coords [xc $y $x] [yc $y]
5936         }
5937         set dir $ndir
5938     }
5939     if {!$joinlow} {
5940         if {$xp < 0} {
5941             # join parent line to first child
5942             set ch [lindex $displayorder $row]
5943             set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5944             if {$xc < 0} {
5945                 puts "oops: drawlineseg: child $ch not on row $row"
5946             } elseif {$xc != $x} {
5947                 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5948                     set d [expr {int(0.5 * $linespc)}]
5949                     set x1 [xc $row $x]
5950                     if {$xc < $x} {
5951                         set x2 [expr {$x1 - $d}]
5952                     } else {
5953                         set x2 [expr {$x1 + $d}]
5954                     }
5955                     set y2 [yc $row]
5956                     set y1 [expr {$y2 + $d}]
5957                     lappend coords $x1 $y1 $x2 $y2
5958                 } elseif {$xc < $x - 1} {
5959                     lappend coords [xc $row [expr {$x-1}]] [yc $row]
5960                 } elseif {$xc > $x + 1} {
5961                     lappend coords [xc $row [expr {$x+1}]] [yc $row]
5962                 }
5963                 set x $xc
5964             }
5965             lappend coords [xc $row $x] [yc $row]
5966         } else {
5967             set xn [xc $row $xp]
5968             set yn [yc $row]
5969             lappend coords $xn $yn
5970         }
5971         if {!$joinhigh} {
5972             assigncolor $id
5973             set t [$canv create line $coords -width [linewidth $id] \
5974                        -fill $colormap($id) -tags lines.$id -arrow $arrow]
5975             $canv lower $t
5976             bindline $t $id
5977             set lines [linsert $lines $i [list $row $le $t]]
5978         } else {
5979             $canv coords $ith $coords
5980             if {$arrow ne $ah} {
5981                 $canv itemconf $ith -arrow $arrow
5982             }
5983             lset lines $i 0 $row
5984         }
5985     } else {
5986         set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
5987         set ndir [expr {$xo - $xp}]
5988         set clow [$canv coords $itl]
5989         if {$dir == $ndir} {
5990             set clow [lrange $clow 2 end]
5991         }
5992         set coords [concat $coords $clow]
5993         if {!$joinhigh} {
5994             lset lines [expr {$i-1}] 1 $le
5995         } else {
5996             # coalesce two pieces
5997             $canv delete $ith
5998             set b [lindex $lines [expr {$i-1}] 0]
5999             set e [lindex $lines $i 1]
6000             set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
6001         }
6002         $canv coords $itl $coords
6003         if {$arrow ne $al} {
6004             $canv itemconf $itl -arrow $arrow
6005         }
6006     }
6007
6008     set linesegs($id) $lines
6009     return $le
6010 }
6011
6012 proc drawparentlinks {id row} {
6013     global rowidlist canv colormap curview parentlist
6014     global idpos linespc
6015
6016     set rowids [lindex $rowidlist $row]
6017     set col [lsearch -exact $rowids $id]
6018     if {$col < 0} return
6019     set olds [lindex $parentlist $row]
6020     set row2 [expr {$row + 1}]
6021     set x [xc $row $col]
6022     set y [yc $row]
6023     set y2 [yc $row2]
6024     set d [expr {int(0.5 * $linespc)}]
6025     set ymid [expr {$y + $d}]
6026     set ids [lindex $rowidlist $row2]
6027     # rmx = right-most X coord used
6028     set rmx 0
6029     foreach p $olds {
6030         set i [lsearch -exact $ids $p]
6031         if {$i < 0} {
6032             puts "oops, parent $p of $id not in list"
6033             continue
6034         }
6035         set x2 [xc $row2 $i]
6036         if {$x2 > $rmx} {
6037             set rmx $x2
6038         }
6039         set j [lsearch -exact $rowids $p]
6040         if {$j < 0} {
6041             # drawlineseg will do this one for us
6042             continue
6043         }
6044         assigncolor $p
6045         # should handle duplicated parents here...
6046         set coords [list $x $y]
6047         if {$i != $col} {
6048             # if attaching to a vertical segment, draw a smaller
6049             # slant for visual distinctness
6050             if {$i == $j} {
6051                 if {$i < $col} {
6052                     lappend coords [expr {$x2 + $d}] $y $x2 $ymid
6053                 } else {
6054                     lappend coords [expr {$x2 - $d}] $y $x2 $ymid
6055                 }
6056             } elseif {$i < $col && $i < $j} {
6057                 # segment slants towards us already
6058                 lappend coords [xc $row $j] $y
6059             } else {
6060                 if {$i < $col - 1} {
6061                     lappend coords [expr {$x2 + $linespc}] $y
6062                 } elseif {$i > $col + 1} {
6063                     lappend coords [expr {$x2 - $linespc}] $y
6064                 }
6065                 lappend coords $x2 $y2
6066             }
6067         } else {
6068             lappend coords $x2 $y2
6069         }
6070         set t [$canv create line $coords -width [linewidth $p] \
6071                    -fill $colormap($p) -tags lines.$p]
6072         $canv lower $t
6073         bindline $t $p
6074     }
6075     if {$rmx > [lindex $idpos($id) 1]} {
6076         lset idpos($id) 1 $rmx
6077         redrawtags $id
6078     }
6079 }
6080
6081 proc drawlines {id} {
6082     global canv
6083
6084     $canv itemconf lines.$id -width [linewidth $id]
6085 }
6086
6087 proc drawcmittext {id row col} {
6088     global linespc canv canv2 canv3 fgcolor curview
6089     global cmitlisted commitinfo rowidlist parentlist
6090     global rowtextx idpos idtags idheads idotherrefs
6091     global linehtag linentag linedtag selectedline
6092     global canvxmax boldids boldnameids fgcolor markedid
6093     global mainheadid nullid nullid2 circleitem circlecolors ctxbut
6094     global mainheadcirclecolor workingfilescirclecolor indexcirclecolor
6095     global circleoutlinecolor
6096
6097     # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
6098     set listed $cmitlisted($curview,$id)
6099     if {$id eq $nullid} {
6100         set ofill $workingfilescirclecolor
6101     } elseif {$id eq $nullid2} {
6102         set ofill $indexcirclecolor
6103     } elseif {$id eq $mainheadid} {
6104         set ofill $mainheadcirclecolor
6105     } else {
6106         set ofill [lindex $circlecolors $listed]
6107     }
6108     set x [xc $row $col]
6109     set y [yc $row]
6110     set orad [expr {$linespc / 3}]
6111     if {$listed <= 2} {
6112         set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
6113                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6114                    -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6115     } elseif {$listed == 3} {
6116         # triangle pointing left for left-side commits
6117         set t [$canv create polygon \
6118                    [expr {$x - $orad}] $y \
6119                    [expr {$x + $orad - 1}] [expr {$y - $orad}] \
6120                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
6121                    -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6122     } else {
6123         # triangle pointing right for right-side commits
6124         set t [$canv create polygon \
6125                    [expr {$x + $orad - 1}] $y \
6126                    [expr {$x - $orad}] [expr {$y - $orad}] \
6127                    [expr {$x - $orad}] [expr {$y + $orad - 1}] \
6128                    -fill $ofill -outline $circleoutlinecolor -width 1 -tags circle]
6129     }
6130     set circleitem($row) $t
6131     $canv raise $t
6132     $canv bind $t <1> {selcanvline {} %x %y}
6133     set rmx [llength [lindex $rowidlist $row]]
6134     set olds [lindex $parentlist $row]
6135     if {$olds ne {}} {
6136         set nextids [lindex $rowidlist [expr {$row + 1}]]
6137         foreach p $olds {
6138             set i [lsearch -exact $nextids $p]
6139             if {$i > $rmx} {
6140                 set rmx $i
6141             }
6142         }
6143     }
6144     set xt [xc $row $rmx]
6145     set rowtextx($row) $xt
6146     set idpos($id) [list $x $xt $y]
6147     if {[info exists idtags($id)] || [info exists idheads($id)]
6148         || [info exists idotherrefs($id)]} {
6149         set xt [drawtags $id $x $xt $y]
6150     }
6151     if {[lindex $commitinfo($id) 6] > 0} {
6152         set xt [drawnotesign $xt $y]
6153     }
6154     set headline [lindex $commitinfo($id) 0]
6155     set name [lindex $commitinfo($id) 1]
6156     set date [lindex $commitinfo($id) 2]
6157     set date [formatdate $date]
6158     set font mainfont
6159     set nfont mainfont
6160     set isbold [ishighlighted $id]
6161     if {$isbold > 0} {
6162         lappend boldids $id
6163         set font mainfontbold
6164         if {$isbold > 1} {
6165             lappend boldnameids $id
6166             set nfont mainfontbold
6167         }
6168     }
6169     set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
6170                            -text $headline -font $font -tags text]
6171     $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
6172     set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
6173                            -text $name -font $nfont -tags text]
6174     set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
6175                            -text $date -font mainfont -tags text]
6176     if {$selectedline == $row} {
6177         make_secsel $id
6178     }
6179     if {[info exists markedid] && $markedid eq $id} {
6180         make_idmark $id
6181     }
6182     set xr [expr {$xt + [font measure $font $headline]}]
6183     if {$xr > $canvxmax} {
6184         set canvxmax $xr
6185         setcanvscroll
6186     }
6187 }
6188
6189 proc drawcmitrow {row} {
6190     global displayorder rowidlist nrows_drawn
6191     global iddrawn markingmatches
6192     global commitinfo numcommits
6193     global filehighlight fhighlights findpattern nhighlights
6194     global hlview vhighlights
6195     global highlight_related rhighlights
6196
6197     if {$row >= $numcommits} return
6198
6199     set id [lindex $displayorder $row]
6200     if {[info exists hlview] && ![info exists vhighlights($id)]} {
6201         askvhighlight $row $id
6202     }
6203     if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
6204         askfilehighlight $row $id
6205     }
6206     if {$findpattern ne {} && ![info exists nhighlights($id)]} {
6207         askfindhighlight $row $id
6208     }
6209     if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
6210         askrelhighlight $row $id
6211     }
6212     if {![info exists iddrawn($id)]} {
6213         set col [lsearch -exact [lindex $rowidlist $row] $id]
6214         if {$col < 0} {
6215             puts "oops, row $row id $id not in list"
6216             return
6217         }
6218         if {![info exists commitinfo($id)]} {
6219             getcommit $id
6220         }
6221         assigncolor $id
6222         drawcmittext $id $row $col
6223         set iddrawn($id) 1
6224         incr nrows_drawn
6225     }
6226     if {$markingmatches} {
6227         markrowmatches $row $id
6228     }
6229 }
6230
6231 proc drawcommits {row {endrow {}}} {
6232     global numcommits iddrawn displayorder curview need_redisplay
6233     global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
6234
6235     if {$row < 0} {
6236         set row 0
6237     }
6238     if {$endrow eq {}} {
6239         set endrow $row
6240     }
6241     if {$endrow >= $numcommits} {
6242         set endrow [expr {$numcommits - 1}]
6243     }
6244
6245     set rl1 [expr {$row - $downarrowlen - 3}]
6246     if {$rl1 < 0} {
6247         set rl1 0
6248     }
6249     set ro1 [expr {$row - 3}]
6250     if {$ro1 < 0} {
6251         set ro1 0
6252     }
6253     set r2 [expr {$endrow + $uparrowlen + 3}]
6254     if {$r2 > $numcommits} {
6255         set r2 $numcommits
6256     }
6257     for {set r $rl1} {$r < $r2} {incr r} {
6258         if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
6259             if {$rl1 < $r} {
6260                 layoutrows $rl1 $r
6261             }
6262             set rl1 [expr {$r + 1}]
6263         }
6264     }
6265     if {$rl1 < $r} {
6266         layoutrows $rl1 $r
6267     }
6268     optimize_rows $ro1 0 $r2
6269     if {$need_redisplay || $nrows_drawn > 2000} {
6270         clear_display
6271     }
6272
6273     # make the lines join to already-drawn rows either side
6274     set r [expr {$row - 1}]
6275     if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
6276         set r $row
6277     }
6278     set er [expr {$endrow + 1}]
6279     if {$er >= $numcommits ||
6280         ![info exists iddrawn([lindex $displayorder $er])]} {
6281         set er $endrow
6282     }
6283     for {} {$r <= $er} {incr r} {
6284         set id [lindex $displayorder $r]
6285         set wasdrawn [info exists iddrawn($id)]
6286         drawcmitrow $r
6287         if {$r == $er} break
6288         set nextid [lindex $displayorder [expr {$r + 1}]]
6289         if {$wasdrawn && [info exists iddrawn($nextid)]} continue
6290         drawparentlinks $id $r
6291
6292         set rowids [lindex $rowidlist $r]
6293         foreach lid $rowids {
6294             if {$lid eq {}} continue
6295             if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
6296             if {$lid eq $id} {
6297                 # see if this is the first child of any of its parents
6298                 foreach p [lindex $parentlist $r] {
6299                     if {[lsearch -exact $rowids $p] < 0} {
6300                         # make this line extend up to the child
6301                         set lineend($p) [drawlineseg $p $r $er 0]
6302                     }
6303                 }
6304             } else {
6305                 set lineend($lid) [drawlineseg $lid $r $er 1]
6306             }
6307         }
6308     }
6309 }
6310
6311 proc undolayout {row} {
6312     global uparrowlen mingaplen downarrowlen
6313     global rowidlist rowisopt rowfinal need_redisplay
6314
6315     set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
6316     if {$r < 0} {
6317         set r 0
6318     }
6319     if {[llength $rowidlist] > $r} {
6320         incr r -1
6321         set rowidlist [lrange $rowidlist 0 $r]
6322         set rowfinal [lrange $rowfinal 0 $r]
6323         set rowisopt [lrange $rowisopt 0 $r]
6324         set need_redisplay 1
6325         run drawvisible
6326     }
6327 }
6328
6329 proc drawvisible {} {
6330     global canv linespc curview vrowmod selectedline targetrow targetid
6331     global need_redisplay cscroll numcommits
6332
6333     set fs [$canv yview]
6334     set ymax [lindex [$canv cget -scrollregion] 3]
6335     if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
6336     set f0 [lindex $fs 0]
6337     set f1 [lindex $fs 1]
6338     set y0 [expr {int($f0 * $ymax)}]
6339     set y1 [expr {int($f1 * $ymax)}]
6340
6341     if {[info exists targetid]} {
6342         if {[commitinview $targetid $curview]} {
6343             set r [rowofcommit $targetid]
6344             if {$r != $targetrow} {
6345                 # Fix up the scrollregion and change the scrolling position
6346                 # now that our target row has moved.
6347                 set diff [expr {($r - $targetrow) * $linespc}]
6348                 set targetrow $r
6349                 setcanvscroll
6350                 set ymax [lindex [$canv cget -scrollregion] 3]
6351                 incr y0 $diff
6352                 incr y1 $diff
6353                 set f0 [expr {$y0 / $ymax}]
6354                 set f1 [expr {$y1 / $ymax}]
6355                 allcanvs yview moveto $f0
6356                 $cscroll set $f0 $f1
6357                 set need_redisplay 1
6358             }
6359         } else {
6360             unset targetid
6361         }
6362     }
6363
6364     set row [expr {int(($y0 - 3) / $linespc) - 1}]
6365     set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
6366     if {$endrow >= $vrowmod($curview)} {
6367         update_arcrows $curview
6368     }
6369     if {$selectedline ne {} &&
6370         $row <= $selectedline && $selectedline <= $endrow} {
6371         set targetrow $selectedline
6372     } elseif {[info exists targetid]} {
6373         set targetrow [expr {int(($row + $endrow) / 2)}]
6374     }
6375     if {[info exists targetrow]} {
6376         if {$targetrow >= $numcommits} {
6377             set targetrow [expr {$numcommits - 1}]
6378         }
6379         set targetid [commitonrow $targetrow]
6380     }
6381     drawcommits $row $endrow
6382 }
6383
6384 proc clear_display {} {
6385     global iddrawn linesegs need_redisplay nrows_drawn
6386     global vhighlights fhighlights nhighlights rhighlights
6387     global linehtag linentag linedtag boldids boldnameids
6388
6389     allcanvs delete all
6390     unset -nocomplain iddrawn
6391     unset -nocomplain linesegs
6392     unset -nocomplain linehtag
6393     unset -nocomplain linentag
6394     unset -nocomplain linedtag
6395     set boldids {}
6396     set boldnameids {}
6397     unset -nocomplain vhighlights
6398     unset -nocomplain fhighlights
6399     unset -nocomplain nhighlights
6400     unset -nocomplain rhighlights
6401     set need_redisplay 0
6402     set nrows_drawn 0
6403 }
6404
6405 proc findcrossings {id} {
6406     global rowidlist parentlist numcommits displayorder
6407
6408     set cross {}
6409     set ccross {}
6410     foreach {s e} [rowranges $id] {
6411         if {$e >= $numcommits} {
6412             set e [expr {$numcommits - 1}]
6413         }
6414         if {$e <= $s} continue
6415         for {set row $e} {[incr row -1] >= $s} {} {
6416             set x [lsearch -exact [lindex $rowidlist $row] $id]
6417             if {$x < 0} break
6418             set olds [lindex $parentlist $row]
6419             set kid [lindex $displayorder $row]
6420             set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
6421             if {$kidx < 0} continue
6422             set nextrow [lindex $rowidlist [expr {$row + 1}]]
6423             foreach p $olds {
6424                 set px [lsearch -exact $nextrow $p]
6425                 if {$px < 0} continue
6426                 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
6427                     if {[lsearch -exact $ccross $p] >= 0} continue
6428                     if {$x == $px + ($kidx < $px? -1: 1)} {
6429                         lappend ccross $p
6430                     } elseif {[lsearch -exact $cross $p] < 0} {
6431                         lappend cross $p
6432                     }
6433                 }
6434             }
6435         }
6436     }
6437     return [concat $ccross {{}} $cross]
6438 }
6439
6440 proc assigncolor {id} {
6441     global colormap colors nextcolor
6442     global parents children children curview
6443
6444     if {[info exists colormap($id)]} return
6445     set ncolors [llength $colors]
6446     if {[info exists children($curview,$id)]} {
6447         set kids $children($curview,$id)
6448     } else {
6449         set kids {}
6450     }
6451     if {[llength $kids] == 1} {
6452         set child [lindex $kids 0]
6453         if {[info exists colormap($child)]
6454             && [llength $parents($curview,$child)] == 1} {
6455             set colormap($id) $colormap($child)
6456             return
6457         }
6458     }
6459     set badcolors {}
6460     set origbad {}
6461     foreach x [findcrossings $id] {
6462         if {$x eq {}} {
6463             # delimiter between corner crossings and other crossings
6464             if {[llength $badcolors] >= $ncolors - 1} break
6465             set origbad $badcolors
6466         }
6467         if {[info exists colormap($x)]
6468             && [lsearch -exact $badcolors $colormap($x)] < 0} {
6469             lappend badcolors $colormap($x)
6470         }
6471     }
6472     if {[llength $badcolors] >= $ncolors} {
6473         set badcolors $origbad
6474     }
6475     set origbad $badcolors
6476     if {[llength $badcolors] < $ncolors - 1} {
6477         foreach child $kids {
6478             if {[info exists colormap($child)]
6479                 && [lsearch -exact $badcolors $colormap($child)] < 0} {
6480                 lappend badcolors $colormap($child)
6481             }
6482             foreach p $parents($curview,$child) {
6483                 if {[info exists colormap($p)]
6484                     && [lsearch -exact $badcolors $colormap($p)] < 0} {
6485                     lappend badcolors $colormap($p)
6486                 }
6487             }
6488         }
6489         if {[llength $badcolors] >= $ncolors} {
6490             set badcolors $origbad
6491         }
6492     }
6493     for {set i 0} {$i <= $ncolors} {incr i} {
6494         set c [lindex $colors $nextcolor]
6495         if {[incr nextcolor] >= $ncolors} {
6496             set nextcolor 0
6497         }
6498         if {[lsearch -exact $badcolors $c]} break
6499     }
6500     set colormap($id) $c
6501 }
6502
6503 proc bindline {t id} {
6504     global canv
6505
6506     $canv bind $t <Enter> "lineenter %x %y $id"
6507     $canv bind $t <Motion> "linemotion %x %y $id"
6508     $canv bind $t <Leave> "lineleave $id"
6509     $canv bind $t <Button-1> "lineclick %x %y $id 1"
6510 }
6511
6512 proc graph_pane_width {} {
6513     global use_ttk
6514
6515     if {$use_ttk} {
6516         set g [.tf.histframe.pwclist sashpos 0]
6517     } else {
6518         set g [.tf.histframe.pwclist sash coord 0]
6519     }
6520     return [lindex $g 0]
6521 }
6522
6523 proc totalwidth {l font extra} {
6524     set tot 0
6525     foreach str $l {
6526         set tot [expr {$tot + [font measure $font $str] + $extra}]
6527     }
6528     return $tot
6529 }
6530
6531 proc drawtags {id x xt y1} {
6532     global idtags idheads idotherrefs mainhead
6533     global linespc lthickness
6534     global canv rowtextx curview fgcolor bgcolor ctxbut
6535     global headbgcolor headfgcolor headoutlinecolor remotebgcolor
6536     global tagbgcolor tagfgcolor tagoutlinecolor
6537     global reflinecolor
6538
6539     set marks {}
6540     set ntags 0
6541     set nheads 0
6542     set singletag 0
6543     set maxtags 3
6544     set maxtagpct 25
6545     set maxwidth [expr {[graph_pane_width] * $maxtagpct / 100}]
6546     set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6547     set extra [expr {$delta + $lthickness + $linespc}]
6548
6549     if {[info exists idtags($id)]} {
6550         set marks $idtags($id)
6551         set ntags [llength $marks]
6552         if {$ntags > $maxtags ||
6553             [totalwidth $marks mainfont $extra] > $maxwidth} {
6554             # show just a single "n tags..." tag
6555             set singletag 1
6556             if {$ntags == 1} {
6557                 set marks [list "tag..."]
6558             } else {
6559                 set marks [list [format "%d tags..." $ntags]]
6560             }
6561             set ntags 1
6562         }
6563     }
6564     if {[info exists idheads($id)]} {
6565         set marks [concat $marks $idheads($id)]
6566         set nheads [llength $idheads($id)]
6567     }
6568     if {[info exists idotherrefs($id)]} {
6569         set marks [concat $marks $idotherrefs($id)]
6570     }
6571     if {$marks eq {}} {
6572         return $xt
6573     }
6574
6575     set yt [expr {$y1 - 0.5 * $linespc}]
6576     set yb [expr {$yt + $linespc - 1}]
6577     set xvals {}
6578     set wvals {}
6579     set i -1
6580     foreach tag $marks {
6581         incr i
6582         if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
6583             set wid [font measure mainfontbold $tag]
6584         } else {
6585             set wid [font measure mainfont $tag]
6586         }
6587         lappend xvals $xt
6588         lappend wvals $wid
6589         set xt [expr {$xt + $wid + $extra}]
6590     }
6591     set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
6592                -width $lthickness -fill $reflinecolor -tags tag.$id]
6593     $canv lower $t
6594     foreach tag $marks x $xvals wid $wvals {
6595         set tag_quoted [string map {% %%} $tag]
6596         set xl [expr {$x + $delta}]
6597         set xr [expr {$x + $delta + $wid + $lthickness}]
6598         set font mainfont
6599         if {[incr ntags -1] >= 0} {
6600             # draw a tag
6601             set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6602                        $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
6603                        -width 1 -outline $tagoutlinecolor -fill $tagbgcolor \
6604                        -tags tag.$id]
6605             if {$singletag} {
6606                 set tagclick [list showtags $id 1]
6607             } else {
6608                 set tagclick [list showtag $tag_quoted 1]
6609             }
6610             $canv bind $t <1> $tagclick
6611             set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
6612         } else {
6613             # draw a head or other ref
6614             if {[incr nheads -1] >= 0} {
6615                 set col $headbgcolor
6616                 if {$tag eq $mainhead} {
6617                     set font mainfontbold
6618                 }
6619             } else {
6620                 set col "#ddddff"
6621             }
6622             set xl [expr {$xl - $delta/2}]
6623             $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
6624                 -width 1 -outline black -fill $col -tags tag.$id
6625             if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
6626                 set rwid [font measure mainfont $remoteprefix]
6627                 set xi [expr {$x + 1}]
6628                 set yti [expr {$yt + 1}]
6629                 set xri [expr {$x + $rwid}]
6630                 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6631                         -width 0 -fill $remotebgcolor -tags tag.$id
6632             }
6633         }
6634         set t [$canv create text $xl $y1 -anchor w -text $tag -fill $headfgcolor \
6635                    -font $font -tags [list tag.$id text]]
6636         if {$ntags >= 0} {
6637             $canv bind $t <1> $tagclick
6638         } elseif {$nheads >= 0} {
6639             $canv bind $t $ctxbut [list headmenu %X %Y $id $tag_quoted]
6640         }
6641     }
6642     return $xt
6643 }
6644
6645 proc drawnotesign {xt y} {
6646     global linespc canv fgcolor
6647
6648     set orad [expr {$linespc / 3}]
6649     set t [$canv create rectangle [expr {$xt - $orad}] [expr {$y - $orad}] \
6650                [expr {$xt + $orad - 1}] [expr {$y + $orad - 1}] \
6651                -fill yellow -outline $fgcolor -width 1 -tags circle]
6652     set xt [expr {$xt + $orad * 3}]
6653     return $xt
6654 }
6655
6656 proc xcoord {i level ln} {
6657     global canvx0 xspc1 xspc2
6658
6659     set x [expr {$canvx0 + $i * $xspc1($ln)}]
6660     if {$i > 0 && $i == $level} {
6661         set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6662     } elseif {$i > $level} {
6663         set x [expr {$x + $xspc2 - $xspc1($ln)}]
6664     }
6665     return $x
6666 }
6667
6668 proc show_status {msg} {
6669     global canv fgcolor
6670
6671     clear_display
6672     set_window_title
6673     $canv create text 3 3 -anchor nw -text $msg -font mainfont \
6674         -tags text -fill $fgcolor
6675 }
6676
6677 # Don't change the text pane cursor if it is currently the hand cursor,
6678 # showing that we are over a sha1 ID link.
6679 proc settextcursor {c} {
6680     global ctext curtextcursor
6681
6682     if {[$ctext cget -cursor] == $curtextcursor} {
6683         $ctext config -cursor $c
6684     }
6685     set curtextcursor $c
6686 }
6687
6688 proc nowbusy {what {name {}}} {
6689     global isbusy busyname statusw
6690
6691     if {[array names isbusy] eq {}} {
6692         . config -cursor watch
6693         settextcursor watch
6694     }
6695     set isbusy($what) 1
6696     set busyname($what) $name
6697     if {$name ne {}} {
6698         $statusw conf -text $name
6699     }
6700 }
6701
6702 proc notbusy {what} {
6703     global isbusy maincursor textcursor busyname statusw
6704
6705     catch {
6706         unset isbusy($what)
6707         if {$busyname($what) ne {} &&
6708             [$statusw cget -text] eq $busyname($what)} {
6709             $statusw conf -text {}
6710         }
6711     }
6712     if {[array names isbusy] eq {}} {
6713         . config -cursor $maincursor
6714         settextcursor $textcursor
6715     }
6716 }
6717
6718 proc findmatches {f} {
6719     global findtype findstring
6720     if {$findtype == [mc "Regexp"]} {
6721         set matches [regexp -indices -all -inline $findstring $f]
6722     } else {
6723         set fs $findstring
6724         if {$findtype == [mc "IgnCase"]} {
6725             set f [string tolower $f]
6726             set fs [string tolower $fs]
6727         }
6728         set matches {}
6729         set i 0
6730         set l [string length $fs]
6731         while {[set j [string first $fs $f $i]] >= 0} {
6732             lappend matches [list $j [expr {$j+$l-1}]]
6733             set i [expr {$j + $l}]
6734         }
6735     }
6736     return $matches
6737 }
6738
6739 proc dofind {{dirn 1} {wrap 1}} {
6740     global findstring findstartline findcurline selectedline numcommits
6741     global gdttype filehighlight fh_serial find_dirn findallowwrap
6742
6743     if {[info exists find_dirn]} {
6744         if {$find_dirn == $dirn} return
6745         stopfinding
6746     }
6747     focus .
6748     if {$findstring eq {} || $numcommits == 0} return
6749     if {$selectedline eq {}} {
6750         set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6751     } else {
6752         set findstartline $selectedline
6753     }
6754     set findcurline $findstartline
6755     nowbusy finding [mc "Searching"]
6756     if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6757         after cancel do_file_hl $fh_serial
6758         do_file_hl $fh_serial
6759     }
6760     set find_dirn $dirn
6761     set findallowwrap $wrap
6762     run findmore
6763 }
6764
6765 proc stopfinding {} {
6766     global find_dirn findcurline fprogcoord
6767
6768     if {[info exists find_dirn]} {
6769         unset find_dirn
6770         unset findcurline
6771         notbusy finding
6772         set fprogcoord 0
6773         adjustprogress
6774     }
6775     stopblaming
6776 }
6777
6778 proc findmore {} {
6779     global commitdata commitinfo numcommits findpattern findloc
6780     global findstartline findcurline findallowwrap
6781     global find_dirn gdttype fhighlights fprogcoord
6782     global curview varcorder vrownum varccommits vrowmod
6783
6784     if {![info exists find_dirn]} {
6785         return 0
6786     }
6787     set fldtypes [list [mc "Headline"] [mc "Author"] "" [mc "Committer"] "" [mc "Comments"]]
6788     set l $findcurline
6789     set moretodo 0
6790     if {$find_dirn > 0} {
6791         incr l
6792         if {$l >= $numcommits} {
6793             set l 0
6794         }
6795         if {$l <= $findstartline} {
6796             set lim [expr {$findstartline + 1}]
6797         } else {
6798             set lim $numcommits
6799             set moretodo $findallowwrap
6800         }
6801     } else {
6802         if {$l == 0} {
6803             set l $numcommits
6804         }
6805         incr l -1
6806         if {$l >= $findstartline} {
6807             set lim [expr {$findstartline - 1}]
6808         } else {
6809             set lim -1
6810             set moretodo $findallowwrap
6811         }
6812     }
6813     set n [expr {($lim - $l) * $find_dirn}]
6814     if {$n > 500} {
6815         set n 500
6816         set moretodo 1
6817     }
6818     if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6819         update_arcrows $curview
6820     }
6821     set found 0
6822     set domore 1
6823     set ai [bsearch $vrownum($curview) $l]
6824     set a [lindex $varcorder($curview) $ai]
6825     set arow [lindex $vrownum($curview) $ai]
6826     set ids [lindex $varccommits($curview,$a)]
6827     set arowend [expr {$arow + [llength $ids]}]
6828     if {$gdttype eq [mc "containing:"]} {
6829         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6830             if {$l < $arow || $l >= $arowend} {
6831                 incr ai $find_dirn
6832                 set a [lindex $varcorder($curview) $ai]
6833                 set arow [lindex $vrownum($curview) $ai]
6834                 set ids [lindex $varccommits($curview,$a)]
6835                 set arowend [expr {$arow + [llength $ids]}]
6836             }
6837             set id [lindex $ids [expr {$l - $arow}]]
6838             # shouldn't happen unless git log doesn't give all the commits...
6839             if {![info exists commitdata($id)] ||
6840                 ![doesmatch $commitdata($id)]} {
6841                 continue
6842             }
6843             if {![info exists commitinfo($id)]} {
6844                 getcommit $id
6845             }
6846             set info $commitinfo($id)
6847             foreach f $info ty $fldtypes {
6848                 if {$ty eq ""} continue
6849                 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6850                     [doesmatch $f]} {
6851                     set found 1
6852                     break
6853                 }
6854             }
6855             if {$found} break
6856         }
6857     } else {
6858         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6859             if {$l < $arow || $l >= $arowend} {
6860                 incr ai $find_dirn
6861                 set a [lindex $varcorder($curview) $ai]
6862                 set arow [lindex $vrownum($curview) $ai]
6863                 set ids [lindex $varccommits($curview,$a)]
6864                 set arowend [expr {$arow + [llength $ids]}]
6865             }
6866             set id [lindex $ids [expr {$l - $arow}]]
6867             if {![info exists fhighlights($id)]} {
6868                 # this sets fhighlights($id) to -1
6869                 askfilehighlight $l $id
6870             }
6871             if {$fhighlights($id) > 0} {
6872                 set found $domore
6873                 break
6874             }
6875             if {$fhighlights($id) < 0} {
6876                 if {$domore} {
6877                     set domore 0
6878                     set findcurline [expr {$l - $find_dirn}]
6879                 }
6880             }
6881         }
6882     }
6883     if {$found || ($domore && !$moretodo)} {
6884         unset findcurline
6885         unset find_dirn
6886         notbusy finding
6887         set fprogcoord 0
6888         adjustprogress
6889         if {$found} {
6890             findselectline $l
6891         } else {
6892             bell
6893         }
6894         return 0
6895     }
6896     if {!$domore} {
6897         flushhighlights
6898     } else {
6899         set findcurline [expr {$l - $find_dirn}]
6900     }
6901     set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6902     if {$n < 0} {
6903         incr n $numcommits
6904     }
6905     set fprogcoord [expr {$n * 1.0 / $numcommits}]
6906     adjustprogress
6907     return $domore
6908 }
6909
6910 proc findselectline {l} {
6911     global findloc commentend ctext findcurline markingmatches gdttype
6912
6913     set markingmatches [expr {$gdttype eq [mc "containing:"]}]
6914     set findcurline $l
6915     selectline $l 1
6916     if {$markingmatches &&
6917         ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
6918         # highlight the matches in the comments
6919         set f [$ctext get 1.0 $commentend]
6920         set matches [findmatches $f]
6921         foreach match $matches {
6922             set start [lindex $match 0]
6923             set end [expr {[lindex $match 1] + 1}]
6924             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6925         }
6926     }
6927     drawvisible
6928 }
6929
6930 # mark the bits of a headline or author that match a find string
6931 proc markmatches {canv l str tag matches font row} {
6932     global selectedline
6933
6934     set bbox [$canv bbox $tag]
6935     set x0 [lindex $bbox 0]
6936     set y0 [lindex $bbox 1]
6937     set y1 [lindex $bbox 3]
6938     foreach match $matches {
6939         set start [lindex $match 0]
6940         set end [lindex $match 1]
6941         if {$start > $end} continue
6942         set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6943         set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6944         set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6945                    [expr {$x0+$xlen+2}] $y1 \
6946                    -outline {} -tags [list match$l matches] -fill yellow]
6947         $canv lower $t
6948         if {$row == $selectedline} {
6949             $canv raise $t secsel
6950         }
6951     }
6952 }
6953
6954 proc unmarkmatches {} {
6955     global markingmatches
6956
6957     allcanvs delete matches
6958     set markingmatches 0
6959     stopfinding
6960 }
6961
6962 proc selcanvline {w x y} {
6963     global canv canvy0 ctext linespc
6964     global rowtextx
6965     set ymax [lindex [$canv cget -scrollregion] 3]
6966     if {$ymax == {}} return
6967     set yfrac [lindex [$canv yview] 0]
6968     set y [expr {$y + $yfrac * $ymax}]
6969     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6970     if {$l < 0} {
6971         set l 0
6972     }
6973     if {$w eq $canv} {
6974         set xmax [lindex [$canv cget -scrollregion] 2]
6975         set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6976         if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
6977     }
6978     unmarkmatches
6979     selectline $l 1
6980 }
6981
6982 proc commit_descriptor {p} {
6983     global commitinfo
6984     if {![info exists commitinfo($p)]} {
6985         getcommit $p
6986     }
6987     set l "..."
6988     if {[llength $commitinfo($p)] > 1} {
6989         set l [lindex $commitinfo($p) 0]
6990     }
6991     return "$p ($l)\n"
6992 }
6993
6994 # append some text to the ctext widget, and make any SHA1 ID
6995 # that we know about be a clickable link.
6996 proc appendwithlinks {text tags} {
6997     global ctext linknum curview
6998
6999     set start [$ctext index "end - 1c"]
7000     $ctext insert end $text $tags
7001     set links [regexp -indices -all -inline {(?:\m|-g)[0-9a-f]{6,40}\M} $text]
7002     foreach l $links {
7003         set s [lindex $l 0]
7004         set e [lindex $l 1]
7005         set linkid [string range $text $s $e]
7006         incr e
7007         $ctext tag delete link$linknum
7008         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
7009         setlink $linkid link$linknum
7010         incr linknum
7011     }
7012 }
7013
7014 proc setlink {id lk} {
7015     global curview ctext pendinglinks
7016     global linkfgcolor
7017
7018     if {[string range $id 0 1] eq "-g"} {
7019       set id [string range $id 2 end]
7020     }
7021
7022     set known 0
7023     if {[string length $id] < 40} {
7024         set matches [longid $id]
7025         if {[llength $matches] > 0} {
7026             if {[llength $matches] > 1} return
7027             set known 1
7028             set id [lindex $matches 0]
7029         }
7030     } else {
7031         set known [commitinview $id $curview]
7032     }
7033     if {$known} {
7034         $ctext tag conf $lk -foreground $linkfgcolor -underline 1
7035         $ctext tag bind $lk <1> [list selbyid $id]
7036         $ctext tag bind $lk <Enter> {linkcursor %W 1}
7037         $ctext tag bind $lk <Leave> {linkcursor %W -1}
7038     } else {
7039         lappend pendinglinks($id) $lk
7040         interestedin $id {makelink %P}
7041     }
7042 }
7043
7044 proc appendshortlink {id {pre {}} {post {}}} {
7045     global ctext linknum
7046
7047     $ctext insert end $pre
7048     $ctext tag delete link$linknum
7049     $ctext insert end [string range $id 0 7] link$linknum
7050     $ctext insert end $post
7051     setlink $id link$linknum
7052     incr linknum
7053 }
7054
7055 proc makelink {id} {
7056     global pendinglinks
7057
7058     if {![info exists pendinglinks($id)]} return
7059     foreach lk $pendinglinks($id) {
7060         setlink $id $lk
7061     }
7062     unset pendinglinks($id)
7063 }
7064
7065 proc linkcursor {w inc} {
7066     global linkentercount curtextcursor
7067
7068     if {[incr linkentercount $inc] > 0} {
7069         $w configure -cursor hand2
7070     } else {
7071         $w configure -cursor $curtextcursor
7072         if {$linkentercount < 0} {
7073             set linkentercount 0
7074         }
7075     }
7076 }
7077
7078 proc viewnextline {dir} {
7079     global canv linespc
7080
7081     $canv delete hover
7082     set ymax [lindex [$canv cget -scrollregion] 3]
7083     set wnow [$canv yview]
7084     set wtop [expr {[lindex $wnow 0] * $ymax}]
7085     set newtop [expr {$wtop + $dir * $linespc}]
7086     if {$newtop < 0} {
7087         set newtop 0
7088     } elseif {$newtop > $ymax} {
7089         set newtop $ymax
7090     }
7091     allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7092 }
7093
7094 # add a list of tag or branch names at position pos
7095 # returns the number of names inserted
7096 proc appendrefs {pos ids var} {
7097     global ctext linknum curview $var maxrefs visiblerefs mainheadid
7098
7099     if {[catch {$ctext index $pos}]} {
7100         return 0
7101     }
7102     $ctext conf -state normal
7103     $ctext delete $pos "$pos lineend"
7104     set tags {}
7105     foreach id $ids {
7106         foreach tag [set $var\($id\)] {
7107             lappend tags [list $tag $id]
7108         }
7109     }
7110
7111     set sep {}
7112     set tags [lsort -index 0 -decreasing $tags]
7113     set nutags 0
7114
7115     if {[llength $tags] > $maxrefs} {
7116         # If we are displaying heads, and there are too many,
7117         # see if there are some important heads to display.
7118         # Currently that are the current head and heads listed in $visiblerefs option
7119         set itags {}
7120         if {$var eq "idheads"} {
7121             set utags {}
7122             foreach ti $tags {
7123                 set hname [lindex $ti 0]
7124                 set id [lindex $ti 1]
7125                 if {([lsearch -exact $visiblerefs $hname] != -1 || $id eq $mainheadid) &&
7126                     [llength $itags] < $maxrefs} {
7127                     lappend itags $ti
7128                 } else {
7129                     lappend utags $ti
7130                 }
7131             }
7132             set tags $utags
7133         }
7134         if {$itags ne {}} {
7135             set str [mc "and many more"]
7136             set sep " "
7137         } else {
7138             set str [mc "many"]
7139         }
7140         $ctext insert $pos "$str ([llength $tags])"
7141         set nutags [llength $tags]
7142         set tags $itags
7143     }
7144
7145     foreach ti $tags {
7146         set id [lindex $ti 1]
7147         set lk link$linknum
7148         incr linknum
7149         $ctext tag delete $lk
7150         $ctext insert $pos $sep
7151         $ctext insert $pos [lindex $ti 0] $lk
7152         setlink $id $lk
7153         set sep ", "
7154     }
7155     $ctext tag add wwrap "$pos linestart" "$pos lineend"
7156     $ctext conf -state disabled
7157     return [expr {[llength $tags] + $nutags}]
7158 }
7159
7160 # called when we have finished computing the nearby tags
7161 proc dispneartags {delay} {
7162     global selectedline currentid showneartags tagphase
7163
7164     if {$selectedline eq {} || !$showneartags} return
7165     after cancel dispnexttag
7166     if {$delay} {
7167         after 200 dispnexttag
7168         set tagphase -1
7169     } else {
7170         after idle dispnexttag
7171         set tagphase 0
7172     }
7173 }
7174
7175 proc dispnexttag {} {
7176     global selectedline currentid showneartags tagphase ctext
7177
7178     if {$selectedline eq {} || !$showneartags} return
7179     switch -- $tagphase {
7180         0 {
7181             set dtags [desctags $currentid]
7182             if {$dtags ne {}} {
7183                 appendrefs precedes $dtags idtags
7184             }
7185         }
7186         1 {
7187             set atags [anctags $currentid]
7188             if {$atags ne {}} {
7189                 appendrefs follows $atags idtags
7190             }
7191         }
7192         2 {
7193             set dheads [descheads $currentid]
7194             if {$dheads ne {}} {
7195                 if {[appendrefs branch $dheads idheads] > 1
7196                     && [$ctext get "branch -3c"] eq "h"} {
7197                     # turn "Branch" into "Branches"
7198                     $ctext conf -state normal
7199                     $ctext insert "branch -2c" "es"
7200                     $ctext conf -state disabled
7201                 }
7202             }
7203         }
7204     }
7205     if {[incr tagphase] <= 2} {
7206         after idle dispnexttag
7207     }
7208 }
7209
7210 proc make_secsel {id} {
7211     global linehtag linentag linedtag canv canv2 canv3
7212
7213     if {![info exists linehtag($id)]} return
7214     $canv delete secsel
7215     set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
7216                -tags secsel -fill [$canv cget -selectbackground]]
7217     $canv lower $t
7218     $canv2 delete secsel
7219     set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
7220                -tags secsel -fill [$canv2 cget -selectbackground]]
7221     $canv2 lower $t
7222     $canv3 delete secsel
7223     set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
7224                -tags secsel -fill [$canv3 cget -selectbackground]]
7225     $canv3 lower $t
7226 }
7227
7228 proc make_idmark {id} {
7229     global linehtag canv fgcolor
7230
7231     if {![info exists linehtag($id)]} return
7232     $canv delete markid
7233     set t [eval $canv create rect [$canv bbox $linehtag($id)] \
7234                -tags markid -outline $fgcolor]
7235     $canv raise $t
7236 }
7237
7238 proc selectline {l isnew {desired_loc {}} {switch_to_patch 0}} {
7239     global canv ctext commitinfo selectedline
7240     global canvy0 linespc parents children curview
7241     global currentid sha1entry
7242     global commentend idtags linknum
7243     global mergemax numcommits pending_select
7244     global cmitmode showneartags allcommits
7245     global targetrow targetid lastscrollrows
7246     global autoselect autosellen jump_to_here
7247     global vinlinediff
7248
7249     unset -nocomplain pending_select
7250     $canv delete hover
7251     normalline
7252     unsel_reflist
7253     stopfinding
7254     if {$l < 0 || $l >= $numcommits} return
7255     set id [commitonrow $l]
7256     set targetid $id
7257     set targetrow $l
7258     set selectedline $l
7259     set currentid $id
7260     if {$lastscrollrows < $numcommits} {
7261         setcanvscroll
7262     }
7263
7264     if {$cmitmode ne "patch" && $switch_to_patch} {
7265         set cmitmode "patch"
7266     }
7267
7268     set y [expr {$canvy0 + $l * $linespc}]
7269     set ymax [lindex [$canv cget -scrollregion] 3]
7270     set ytop [expr {$y - $linespc - 1}]
7271     set ybot [expr {$y + $linespc + 1}]
7272     set wnow [$canv yview]
7273     set wtop [expr {[lindex $wnow 0] * $ymax}]
7274     set wbot [expr {[lindex $wnow 1] * $ymax}]
7275     set wh [expr {$wbot - $wtop}]
7276     set newtop $wtop
7277     if {$ytop < $wtop} {
7278         if {$ybot < $wtop} {
7279             set newtop [expr {$y - $wh / 2.0}]
7280         } else {
7281             set newtop $ytop
7282             if {$newtop > $wtop - $linespc} {
7283                 set newtop [expr {$wtop - $linespc}]
7284             }
7285         }
7286     } elseif {$ybot > $wbot} {
7287         if {$ytop > $wbot} {
7288             set newtop [expr {$y - $wh / 2.0}]
7289         } else {
7290             set newtop [expr {$ybot - $wh}]
7291             if {$newtop < $wtop + $linespc} {
7292                 set newtop [expr {$wtop + $linespc}]
7293             }
7294         }
7295     }
7296     if {$newtop != $wtop} {
7297         if {$newtop < 0} {
7298             set newtop 0
7299         }
7300         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7301         drawvisible
7302     }
7303
7304     make_secsel $id
7305
7306     if {$isnew} {
7307         addtohistory [list selbyid $id 0] savecmitpos
7308     }
7309
7310     $sha1entry delete 0 end
7311     $sha1entry insert 0 $id
7312     if {$autoselect} {
7313         $sha1entry selection range 0 $autosellen
7314     }
7315     rhighlight_sel $id
7316
7317     $ctext conf -state normal
7318     clear_ctext
7319     set linknum 0
7320     if {![info exists commitinfo($id)]} {
7321         getcommit $id
7322     }
7323     set info $commitinfo($id)
7324     set date [formatdate [lindex $info 2]]
7325     $ctext insert end "[mc "Author"]: [lindex $info 1]  $date\n"
7326     set date [formatdate [lindex $info 4]]
7327     $ctext insert end "[mc "Committer"]: [lindex $info 3]  $date\n"
7328     if {[info exists idtags($id)]} {
7329         $ctext insert end [mc "Tags:"]
7330         foreach tag $idtags($id) {
7331             $ctext insert end " $tag"
7332         }
7333         $ctext insert end "\n"
7334     }
7335
7336     set headers {}
7337     set olds $parents($curview,$id)
7338     if {[llength $olds] > 1} {
7339         set np 0
7340         foreach p $olds {
7341             if {$np >= $mergemax} {
7342                 set tag mmax
7343             } else {
7344                 set tag m$np
7345             }
7346             $ctext insert end "[mc "Parent"]: " $tag
7347             appendwithlinks [commit_descriptor $p] {}
7348             incr np
7349         }
7350     } else {
7351         foreach p $olds {
7352             append headers "[mc "Parent"]: [commit_descriptor $p]"
7353         }
7354     }
7355
7356     foreach c $children($curview,$id) {
7357         append headers "[mc "Child"]:  [commit_descriptor $c]"
7358     }
7359
7360     # make anything that looks like a SHA1 ID be a clickable link
7361     appendwithlinks $headers {}
7362     if {$showneartags} {
7363         if {![info exists allcommits]} {
7364             getallcommits
7365         }
7366         $ctext insert end "[mc "Branch"]: "
7367         $ctext mark set branch "end -1c"
7368         $ctext mark gravity branch left
7369         $ctext insert end "\n[mc "Follows"]: "
7370         $ctext mark set follows "end -1c"
7371         $ctext mark gravity follows left
7372         $ctext insert end "\n[mc "Precedes"]: "
7373         $ctext mark set precedes "end -1c"
7374         $ctext mark gravity precedes left
7375         $ctext insert end "\n"
7376         dispneartags 1
7377     }
7378     $ctext insert end "\n"
7379     set comment [lindex $info 5]
7380     if {[string first "\r" $comment] >= 0} {
7381         set comment [string map {"\r" "\n    "} $comment]
7382     }
7383     appendwithlinks $comment {comment}
7384
7385     $ctext tag remove found 1.0 end
7386     $ctext conf -state disabled
7387     set commentend [$ctext index "end - 1c"]
7388
7389     set jump_to_here $desired_loc
7390     init_flist [mc "Comments"]
7391     if {$cmitmode eq "tree"} {
7392         gettree $id
7393     } elseif {$vinlinediff($curview) == 1} {
7394         showinlinediff $id
7395     } elseif {[llength $olds] <= 1} {
7396         startdiff $id
7397     } else {
7398         mergediff $id
7399     }
7400 }
7401
7402 proc selfirstline {} {
7403     unmarkmatches
7404     selectline 0 1
7405 }
7406
7407 proc sellastline {} {
7408     global numcommits
7409     unmarkmatches
7410     set l [expr {$numcommits - 1}]
7411     selectline $l 1
7412 }
7413
7414 proc selnextline {dir} {
7415     global selectedline
7416     focus .
7417     if {$selectedline eq {}} return
7418     set l [expr {$selectedline + $dir}]
7419     unmarkmatches
7420     selectline $l 1
7421 }
7422
7423 proc selnextpage {dir} {
7424     global canv linespc selectedline numcommits
7425
7426     set lpp [expr {([winfo height $canv] - 2) / $linespc}]
7427     if {$lpp < 1} {
7428         set lpp 1
7429     }
7430     allcanvs yview scroll [expr {$dir * $lpp}] units
7431     drawvisible
7432     if {$selectedline eq {}} return
7433     set l [expr {$selectedline + $dir * $lpp}]
7434     if {$l < 0} {
7435         set l 0
7436     } elseif {$l >= $numcommits} {
7437         set l [expr $numcommits - 1]
7438     }
7439     unmarkmatches
7440     selectline $l 1
7441 }
7442
7443 proc unselectline {} {
7444     global selectedline currentid
7445
7446     set selectedline {}
7447     unset -nocomplain currentid
7448     allcanvs delete secsel
7449     rhighlight_none
7450 }
7451
7452 proc reselectline {} {
7453     global selectedline
7454
7455     if {$selectedline ne {}} {
7456         selectline $selectedline 0
7457     }
7458 }
7459
7460 proc addtohistory {cmd {saveproc {}}} {
7461     global history historyindex curview
7462
7463     unset_posvars
7464     save_position
7465     set elt [list $curview $cmd $saveproc {}]
7466     if {$historyindex > 0
7467         && [lindex $history [expr {$historyindex - 1}]] == $elt} {
7468         return
7469     }
7470
7471     if {$historyindex < [llength $history]} {
7472         set history [lreplace $history $historyindex end $elt]
7473     } else {
7474         lappend history $elt
7475     }
7476     incr historyindex
7477     if {$historyindex > 1} {
7478         .tf.bar.leftbut conf -state normal
7479     } else {
7480         .tf.bar.leftbut conf -state disabled
7481     }
7482     .tf.bar.rightbut conf -state disabled
7483 }
7484
7485 # save the scrolling position of the diff display pane
7486 proc save_position {} {
7487     global historyindex history
7488
7489     if {$historyindex < 1} return
7490     set hi [expr {$historyindex - 1}]
7491     set fn [lindex $history $hi 2]
7492     if {$fn ne {}} {
7493         lset history $hi 3 [eval $fn]
7494     }
7495 }
7496
7497 proc unset_posvars {} {
7498     global last_posvars
7499
7500     if {[info exists last_posvars]} {
7501         foreach {var val} $last_posvars {
7502             global $var
7503             unset -nocomplain $var
7504         }
7505         unset last_posvars
7506     }
7507 }
7508
7509 proc godo {elt} {
7510     global curview last_posvars
7511
7512     set view [lindex $elt 0]
7513     set cmd [lindex $elt 1]
7514     set pv [lindex $elt 3]
7515     if {$curview != $view} {
7516         showview $view
7517     }
7518     unset_posvars
7519     foreach {var val} $pv {
7520         global $var
7521         set $var $val
7522     }
7523     set last_posvars $pv
7524     eval $cmd
7525 }
7526
7527 proc goback {} {
7528     global history historyindex
7529     focus .
7530
7531     if {$historyindex > 1} {
7532         save_position
7533         incr historyindex -1
7534         godo [lindex $history [expr {$historyindex - 1}]]
7535         .tf.bar.rightbut conf -state normal
7536     }
7537     if {$historyindex <= 1} {
7538         .tf.bar.leftbut conf -state disabled
7539     }
7540 }
7541
7542 proc goforw {} {
7543     global history historyindex
7544     focus .
7545
7546     if {$historyindex < [llength $history]} {
7547         save_position
7548         set cmd [lindex $history $historyindex]
7549         incr historyindex
7550         godo $cmd
7551         .tf.bar.leftbut conf -state normal
7552     }
7553     if {$historyindex >= [llength $history]} {
7554         .tf.bar.rightbut conf -state disabled
7555     }
7556 }
7557
7558 proc go_to_parent {i} {
7559     global parents curview targetid
7560     set ps $parents($curview,$targetid)
7561     if {[llength $ps] >= $i} {
7562         selbyid [lindex $ps [expr $i - 1]]
7563     }
7564 }
7565
7566 proc gettree {id} {
7567     global treefilelist treeidlist diffids diffmergeid treepending
7568     global nullid nullid2
7569
7570     set diffids $id
7571     unset -nocomplain diffmergeid
7572     if {![info exists treefilelist($id)]} {
7573         if {![info exists treepending]} {
7574             if {$id eq $nullid} {
7575                 set cmd [list | git ls-files]
7576             } elseif {$id eq $nullid2} {
7577                 set cmd [list | git ls-files --stage -t]
7578             } else {
7579                 set cmd [list | git ls-tree -r $id]
7580             }
7581             if {[catch {set gtf [open $cmd r]}]} {
7582                 return
7583             }
7584             set treepending $id
7585             set treefilelist($id) {}
7586             set treeidlist($id) {}
7587             fconfigure $gtf -blocking 0 -encoding binary
7588             filerun $gtf [list gettreeline $gtf $id]
7589         }
7590     } else {
7591         setfilelist $id
7592     }
7593 }
7594
7595 proc gettreeline {gtf id} {
7596     global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
7597
7598     set nl 0
7599     while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
7600         if {$diffids eq $nullid} {
7601             set fname $line
7602         } else {
7603             set i [string first "\t" $line]
7604             if {$i < 0} continue
7605             set fname [string range $line [expr {$i+1}] end]
7606             set line [string range $line 0 [expr {$i-1}]]
7607             if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7608             set sha1 [lindex $line 2]
7609             lappend treeidlist($id) $sha1
7610         }
7611         if {[string index $fname 0] eq "\""} {
7612             set fname [lindex $fname 0]
7613         }
7614         set fname [encoding convertfrom $fname]
7615         lappend treefilelist($id) $fname
7616     }
7617     if {![eof $gtf]} {
7618         return [expr {$nl >= 1000? 2: 1}]
7619     }
7620     close $gtf
7621     unset treepending
7622     if {$cmitmode ne "tree"} {
7623         if {![info exists diffmergeid]} {
7624             gettreediffs $diffids
7625         }
7626     } elseif {$id ne $diffids} {
7627         gettree $diffids
7628     } else {
7629         setfilelist $id
7630     }
7631     return 0
7632 }
7633
7634 proc showfile {f} {
7635     global treefilelist treeidlist diffids nullid nullid2
7636     global ctext_file_names ctext_file_lines
7637     global ctext commentend
7638
7639     set i [lsearch -exact $treefilelist($diffids) $f]
7640     if {$i < 0} {
7641         puts "oops, $f not in list for id $diffids"
7642         return
7643     }
7644     if {$diffids eq $nullid} {
7645         if {[catch {set bf [open $f r]} err]} {
7646             puts "oops, can't read $f: $err"
7647             return
7648         }
7649     } else {
7650         set blob [lindex $treeidlist($diffids) $i]
7651         if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7652             puts "oops, error reading blob $blob: $err"
7653             return
7654         }
7655     }
7656     fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7657     filerun $bf [list getblobline $bf $diffids]
7658     $ctext config -state normal
7659     clear_ctext $commentend
7660     lappend ctext_file_names $f
7661     lappend ctext_file_lines [lindex [split $commentend "."] 0]
7662     $ctext insert end "\n"
7663     $ctext insert end "$f\n" filesep
7664     $ctext config -state disabled
7665     $ctext yview $commentend
7666     settabs 0
7667 }
7668
7669 proc getblobline {bf id} {
7670     global diffids cmitmode ctext
7671
7672     if {$id ne $diffids || $cmitmode ne "tree"} {
7673         catch {close $bf}
7674         return 0
7675     }
7676     $ctext config -state normal
7677     set nl 0
7678     while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7679         $ctext insert end "$line\n"
7680     }
7681     if {[eof $bf]} {
7682         global jump_to_here ctext_file_names commentend
7683
7684         # delete last newline
7685         $ctext delete "end - 2c" "end - 1c"
7686         close $bf
7687         if {$jump_to_here ne {} &&
7688             [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7689             set lnum [expr {[lindex $jump_to_here 1] +
7690                             [lindex [split $commentend .] 0]}]
7691             mark_ctext_line $lnum
7692         }
7693         $ctext config -state disabled
7694         return 0
7695     }
7696     $ctext config -state disabled
7697     return [expr {$nl >= 1000? 2: 1}]
7698 }
7699
7700 proc mark_ctext_line {lnum} {
7701     global ctext markbgcolor
7702
7703     $ctext tag delete omark
7704     $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7705     $ctext tag conf omark -background $markbgcolor
7706     $ctext see $lnum.0
7707 }
7708
7709 proc mergediff {id} {
7710     global diffmergeid
7711     global diffids treediffs
7712     global parents curview
7713
7714     set diffmergeid $id
7715     set diffids $id
7716     set treediffs($id) {}
7717     set np [llength $parents($curview,$id)]
7718     settabs $np
7719     getblobdiffs $id
7720 }
7721
7722 proc startdiff {ids} {
7723     global treediffs diffids treepending diffmergeid nullid nullid2
7724
7725     settabs 1
7726     set diffids $ids
7727     unset -nocomplain diffmergeid
7728     if {![info exists treediffs($ids)] ||
7729         [lsearch -exact $ids $nullid] >= 0 ||
7730         [lsearch -exact $ids $nullid2] >= 0} {
7731         if {![info exists treepending]} {
7732             gettreediffs $ids
7733         }
7734     } else {
7735         addtocflist $ids
7736     }
7737 }
7738
7739 proc showinlinediff {ids} {
7740     global commitinfo commitdata ctext
7741     global treediffs
7742
7743     set info $commitinfo($ids)
7744     set diff [lindex $info 7]
7745     set difflines [split $diff "\n"]
7746
7747     initblobdiffvars
7748     set treediff {}
7749
7750     set inhdr 0
7751     foreach line $difflines {
7752         if {![string compare -length 5 "diff " $line]} {
7753             set inhdr 1
7754         } elseif {$inhdr && ![string compare -length 4 "+++ " $line]} {
7755             # offset also accounts for the b/ prefix
7756             lappend treediff [string range $line 6 end]
7757             set inhdr 0
7758         }
7759     }
7760
7761     set treediffs($ids) $treediff
7762     add_flist $treediff
7763
7764     $ctext conf -state normal
7765     foreach line $difflines {
7766         parseblobdiffline $ids $line
7767     }
7768     maybe_scroll_ctext 1
7769     $ctext conf -state disabled
7770 }
7771
7772 # If the filename (name) is under any of the passed filter paths
7773 # then return true to include the file in the listing.
7774 proc path_filter {filter name} {
7775     set worktree [gitworktree]
7776     foreach p $filter {
7777         set fq_p [file normalize $p]
7778         set fq_n [file normalize [file join $worktree $name]]
7779         if {[string match [file normalize $fq_p]* $fq_n]} {
7780             return 1
7781         }
7782     }
7783     return 0
7784 }
7785
7786 proc addtocflist {ids} {
7787     global treediffs
7788
7789     add_flist $treediffs($ids)
7790     getblobdiffs $ids
7791 }
7792
7793 proc diffcmd {ids flags} {
7794     global log_showroot nullid nullid2 git_version
7795
7796     set i [lsearch -exact $ids $nullid]
7797     set j [lsearch -exact $ids $nullid2]
7798     if {$i >= 0} {
7799         if {[llength $ids] > 1 && $j < 0} {
7800             # comparing working directory with some specific revision
7801             set cmd [concat | git diff-index $flags]
7802             if {$i == 0} {
7803                 lappend cmd -R [lindex $ids 1]
7804             } else {
7805                 lappend cmd [lindex $ids 0]
7806             }
7807         } else {
7808             # comparing working directory with index
7809             set cmd [concat | git diff-files $flags]
7810             if {$j == 1} {
7811                 lappend cmd -R
7812             }
7813         }
7814     } elseif {$j >= 0} {
7815         if {[package vcompare $git_version "1.7.2"] >= 0} {
7816             set flags "$flags --ignore-submodules=dirty"
7817         }
7818         set cmd [concat | git diff-index --cached $flags]
7819         if {[llength $ids] > 1} {
7820             # comparing index with specific revision
7821             if {$j == 0} {
7822                 lappend cmd -R [lindex $ids 1]
7823             } else {
7824                 lappend cmd [lindex $ids 0]
7825             }
7826         } else {
7827             # comparing index with HEAD
7828             lappend cmd HEAD
7829         }
7830     } else {
7831         if {$log_showroot} {
7832             lappend flags --root
7833         }
7834         set cmd [concat | git diff-tree -r $flags $ids]
7835     }
7836     return $cmd
7837 }
7838
7839 proc gettreediffs {ids} {
7840     global treediff treepending limitdiffs vfilelimit curview
7841
7842     set cmd [diffcmd $ids {--no-commit-id}]
7843     if {$limitdiffs && $vfilelimit($curview) ne {}} {
7844             set cmd [concat $cmd -- $vfilelimit($curview)]
7845     }
7846     if {[catch {set gdtf [open $cmd r]}]} return
7847
7848     set treepending $ids
7849     set treediff {}
7850     fconfigure $gdtf -blocking 0 -encoding binary
7851     filerun $gdtf [list gettreediffline $gdtf $ids]
7852 }
7853
7854 proc gettreediffline {gdtf ids} {
7855     global treediff treediffs treepending diffids diffmergeid
7856     global cmitmode vfilelimit curview limitdiffs perfile_attrs
7857
7858     set nr 0
7859     set sublist {}
7860     set max 1000
7861     if {$perfile_attrs} {
7862         # cache_gitattr is slow, and even slower on win32 where we
7863         # have to invoke it for only about 30 paths at a time
7864         set max 500
7865         if {[tk windowingsystem] == "win32"} {
7866             set max 120
7867         }
7868     }
7869     while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7870         set i [string first "\t" $line]
7871         if {$i >= 0} {
7872             set file [string range $line [expr {$i+1}] end]
7873             if {[string index $file 0] eq "\""} {
7874                 set file [lindex $file 0]
7875             }
7876             set file [encoding convertfrom $file]
7877             if {$file ne [lindex $treediff end]} {
7878                 lappend treediff $file
7879                 lappend sublist $file
7880             }
7881         }
7882     }
7883     if {$perfile_attrs} {
7884         cache_gitattr encoding $sublist
7885     }
7886     if {![eof $gdtf]} {
7887         return [expr {$nr >= $max? 2: 1}]
7888     }
7889     close $gdtf
7890     set treediffs($ids) $treediff
7891     unset treepending
7892     if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7893         gettree $diffids
7894     } elseif {$ids != $diffids} {
7895         if {![info exists diffmergeid]} {
7896             gettreediffs $diffids
7897         }
7898     } else {
7899         addtocflist $ids
7900     }
7901     return 0
7902 }
7903
7904 # empty string or positive integer
7905 proc diffcontextvalidate {v} {
7906     return [regexp {^(|[1-9][0-9]*)$} $v]
7907 }
7908
7909 proc diffcontextchange {n1 n2 op} {
7910     global diffcontextstring diffcontext
7911
7912     if {[string is integer -strict $diffcontextstring]} {
7913         if {$diffcontextstring >= 0} {
7914             set diffcontext $diffcontextstring
7915             reselectline
7916         }
7917     }
7918 }
7919
7920 proc changeignorespace {} {
7921     reselectline
7922 }
7923
7924 proc changeworddiff {name ix op} {
7925     reselectline
7926 }
7927
7928 proc initblobdiffvars {} {
7929     global diffencoding targetline diffnparents
7930     global diffinhdr currdiffsubmod diffseehere
7931     set targetline {}
7932     set diffnparents 0
7933     set diffinhdr 0
7934     set diffencoding [get_path_encoding {}]
7935     set currdiffsubmod ""
7936     set diffseehere -1
7937 }
7938
7939 proc getblobdiffs {ids} {
7940     global blobdifffd diffids env
7941     global treediffs
7942     global diffcontext
7943     global ignorespace
7944     global worddiff
7945     global limitdiffs vfilelimit curview
7946     global git_version
7947
7948     set textconv {}
7949     if {[package vcompare $git_version "1.6.1"] >= 0} {
7950         set textconv "--textconv"
7951     }
7952     set submodule {}
7953     if {[package vcompare $git_version "1.6.6"] >= 0} {
7954         set submodule "--submodule"
7955     }
7956     set cmd [diffcmd $ids "-p $textconv $submodule  -C --cc --no-commit-id -U$diffcontext"]
7957     if {$ignorespace} {
7958         append cmd " -w"
7959     }
7960     if {$worddiff ne [mc "Line diff"]} {
7961         append cmd " --word-diff=porcelain"
7962     }
7963     if {$limitdiffs && $vfilelimit($curview) ne {}} {
7964         set cmd [concat $cmd -- $vfilelimit($curview)]
7965     }
7966     if {[catch {set bdf [open $cmd r]} err]} {
7967         error_popup [mc "Error getting diffs: %s" $err]
7968         return
7969     }
7970     fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
7971     set blobdifffd($ids) $bdf
7972     initblobdiffvars
7973     filerun $bdf [list getblobdiffline $bdf $diffids]
7974 }
7975
7976 proc savecmitpos {} {
7977     global ctext cmitmode
7978
7979     if {$cmitmode eq "tree"} {
7980         return {}
7981     }
7982     return [list target_scrollpos [$ctext index @0,0]]
7983 }
7984
7985 proc savectextpos {} {
7986     global ctext
7987
7988     return [list target_scrollpos [$ctext index @0,0]]
7989 }
7990
7991 proc maybe_scroll_ctext {ateof} {
7992     global ctext target_scrollpos
7993
7994     if {![info exists target_scrollpos]} return
7995     if {!$ateof} {
7996         set nlines [expr {[winfo height $ctext]
7997                           / [font metrics textfont -linespace]}]
7998         if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
7999     }
8000     $ctext yview $target_scrollpos
8001     unset target_scrollpos
8002 }
8003
8004 proc setinlist {var i val} {
8005     global $var
8006
8007     while {[llength [set $var]] < $i} {
8008         lappend $var {}
8009     }
8010     if {[llength [set $var]] == $i} {
8011         lappend $var $val
8012     } else {
8013         lset $var $i $val
8014     }
8015 }
8016
8017 proc makediffhdr {fname ids} {
8018     global ctext curdiffstart treediffs diffencoding
8019     global ctext_file_names jump_to_here targetline diffline
8020
8021     set fname [encoding convertfrom $fname]
8022     set diffencoding [get_path_encoding $fname]
8023     set i [lsearch -exact $treediffs($ids) $fname]
8024     if {$i >= 0} {
8025         setinlist difffilestart $i $curdiffstart
8026     }
8027     lset ctext_file_names end $fname
8028     set l [expr {(78 - [string length $fname]) / 2}]
8029     set pad [string range "----------------------------------------" 1 $l]
8030     $ctext insert $curdiffstart "$pad $fname $pad" filesep
8031     set targetline {}
8032     if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
8033         set targetline [lindex $jump_to_here 1]
8034     }
8035     set diffline 0
8036 }
8037
8038 proc blobdiffmaybeseehere {ateof} {
8039     global diffseehere
8040     if {$diffseehere >= 0} {
8041         mark_ctext_line [lindex [split $diffseehere .] 0]
8042     }
8043     maybe_scroll_ctext $ateof
8044 }
8045
8046 proc getblobdiffline {bdf ids} {
8047     global diffids blobdifffd
8048     global ctext
8049
8050     set nr 0
8051     $ctext conf -state normal
8052     while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
8053         if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
8054             catch {close $bdf}
8055             return 0
8056         }
8057         parseblobdiffline $ids $line
8058     }
8059     $ctext conf -state disabled
8060     blobdiffmaybeseehere [eof $bdf]
8061     if {[eof $bdf]} {
8062         catch {close $bdf}
8063         return 0
8064     }
8065     return [expr {$nr >= 1000? 2: 1}]
8066 }
8067
8068 proc parseblobdiffline {ids line} {
8069     global ctext curdiffstart
8070     global diffnexthead diffnextnote difffilestart
8071     global ctext_file_names ctext_file_lines
8072     global diffinhdr treediffs mergemax diffnparents
8073     global diffencoding jump_to_here targetline diffline currdiffsubmod
8074     global worddiff diffseehere
8075
8076     if {![string compare -length 5 "diff " $line]} {
8077         if {![regexp {^diff (--cc|--git) } $line m type]} {
8078             set line [encoding convertfrom $line]
8079             $ctext insert end "$line\n" hunksep
8080             continue
8081         }
8082         # start of a new file
8083         set diffinhdr 1
8084         $ctext insert end "\n"
8085         set curdiffstart [$ctext index "end - 1c"]
8086         lappend ctext_file_names ""
8087         lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8088         $ctext insert end "\n" filesep
8089
8090         if {$type eq "--cc"} {
8091             # start of a new file in a merge diff
8092             set fname [string range $line 10 end]
8093             if {[lsearch -exact $treediffs($ids) $fname] < 0} {
8094                 lappend treediffs($ids) $fname
8095                 add_flist [list $fname]
8096             }
8097
8098         } else {
8099             set line [string range $line 11 end]
8100             # If the name hasn't changed the length will be odd,
8101             # the middle char will be a space, and the two bits either
8102             # side will be a/name and b/name, or "a/name" and "b/name".
8103             # If the name has changed we'll get "rename from" and
8104             # "rename to" or "copy from" and "copy to" lines following
8105             # this, and we'll use them to get the filenames.
8106             # This complexity is necessary because spaces in the
8107             # filename(s) don't get escaped.
8108             set l [string length $line]
8109             set i [expr {$l / 2}]
8110             if {!(($l & 1) && [string index $line $i] eq " " &&
8111                   [string range $line 2 [expr {$i - 1}]] eq \
8112                       [string range $line [expr {$i + 3}] end])} {
8113                 return
8114             }
8115             # unescape if quoted and chop off the a/ from the front
8116             if {[string index $line 0] eq "\""} {
8117                 set fname [string range [lindex $line 0] 2 end]
8118             } else {
8119                 set fname [string range $line 2 [expr {$i - 1}]]
8120             }
8121         }
8122         makediffhdr $fname $ids
8123
8124     } elseif {![string compare -length 16 "* Unmerged path " $line]} {
8125         set fname [encoding convertfrom [string range $line 16 end]]
8126         $ctext insert end "\n"
8127         set curdiffstart [$ctext index "end - 1c"]
8128         lappend ctext_file_names $fname
8129         lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
8130         $ctext insert end "$line\n" filesep
8131         set i [lsearch -exact $treediffs($ids) $fname]
8132         if {$i >= 0} {
8133             setinlist difffilestart $i $curdiffstart
8134         }
8135
8136     } elseif {![string compare -length 2 "@@" $line]} {
8137         regexp {^@@+} $line ats
8138         set line [encoding convertfrom $diffencoding $line]
8139         $ctext insert end "$line\n" hunksep
8140         if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
8141             set diffline $nl
8142         }
8143         set diffnparents [expr {[string length $ats] - 1}]
8144         set diffinhdr 0
8145
8146     } elseif {![string compare -length 10 "Submodule " $line]} {
8147         # start of a new submodule
8148         if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
8149             set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
8150         } else {
8151             set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
8152         }
8153         if {$currdiffsubmod != $fname} {
8154             $ctext insert end "\n";     # Add newline after commit message
8155         }
8156         set curdiffstart [$ctext index "end - 1c"]
8157         lappend ctext_file_names ""
8158         if {$currdiffsubmod != $fname} {
8159             lappend ctext_file_lines $fname
8160             makediffhdr $fname $ids
8161             set currdiffsubmod $fname
8162             $ctext insert end "\n$line\n" filesep
8163         } else {
8164             $ctext insert end "$line\n" filesep
8165         }
8166     } elseif {![string compare -length 3 "  >" $line]} {
8167         set $currdiffsubmod ""
8168         set line [encoding convertfrom $diffencoding $line]
8169         $ctext insert end "$line\n" dresult
8170     } elseif {![string compare -length 3 "  <" $line]} {
8171         set $currdiffsubmod ""
8172         set line [encoding convertfrom $diffencoding $line]
8173         $ctext insert end "$line\n" d0
8174     } elseif {$diffinhdr} {
8175         if {![string compare -length 12 "rename from " $line]} {
8176             set fname [string range $line [expr 6 + [string first " from " $line] ] end]
8177             if {[string index $fname 0] eq "\""} {
8178                 set fname [lindex $fname 0]
8179             }
8180             set fname [encoding convertfrom $fname]
8181             set i [lsearch -exact $treediffs($ids) $fname]
8182             if {$i >= 0} {
8183                 setinlist difffilestart $i $curdiffstart
8184             }
8185         } elseif {![string compare -length 10 $line "rename to "] ||
8186                   ![string compare -length 8 $line "copy to "]} {
8187             set fname [string range $line [expr 4 + [string first " to " $line] ] end]
8188             if {[string index $fname 0] eq "\""} {
8189                 set fname [lindex $fname 0]
8190             }
8191             makediffhdr $fname $ids
8192         } elseif {[string compare -length 3 $line "---"] == 0} {
8193             # do nothing
8194             return
8195         } elseif {[string compare -length 3 $line "+++"] == 0} {
8196             set diffinhdr 0
8197             return
8198         }
8199         $ctext insert end "$line\n" filesep
8200
8201     } else {
8202         set line [string map {\x1A ^Z} \
8203                       [encoding convertfrom $diffencoding $line]]
8204         # parse the prefix - one ' ', '-' or '+' for each parent
8205         set prefix [string range $line 0 [expr {$diffnparents - 1}]]
8206         set tag [expr {$diffnparents > 1? "m": "d"}]
8207         set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
8208         set words_pre_markup ""
8209         set words_post_markup ""
8210         if {[string trim $prefix " -+"] eq {}} {
8211             # prefix only has " ", "-" and "+" in it: normal diff line
8212             set num [string first "-" $prefix]
8213             if {$dowords} {
8214                 set line [string range $line 1 end]
8215             }
8216             if {$num >= 0} {
8217                 # removed line, first parent with line is $num
8218                 if {$num >= $mergemax} {
8219                     set num "max"
8220                 }
8221                 if {$dowords && $worddiff eq [mc "Markup words"]} {
8222                     $ctext insert end "\[-$line-\]" $tag$num
8223                 } else {
8224                     $ctext insert end "$line" $tag$num
8225                 }
8226                 if {!$dowords} {
8227                     $ctext insert end "\n" $tag$num
8228                 }
8229             } else {
8230                 set tags {}
8231                 if {[string first "+" $prefix] >= 0} {
8232                     # added line
8233                     lappend tags ${tag}result
8234                     if {$diffnparents > 1} {
8235                         set num [string first " " $prefix]
8236                         if {$num >= 0} {
8237                             if {$num >= $mergemax} {
8238                                 set num "max"
8239                             }
8240                             lappend tags m$num
8241                         }
8242                     }
8243                     set words_pre_markup "{+"
8244                     set words_post_markup "+}"
8245                 }
8246                 if {$targetline ne {}} {
8247                     if {$diffline == $targetline} {
8248                         set diffseehere [$ctext index "end - 1 chars"]
8249                         set targetline {}
8250                     } else {
8251                         incr diffline
8252                     }
8253                 }
8254                 if {$dowords && $worddiff eq [mc "Markup words"]} {
8255                     $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
8256                 } else {
8257                     $ctext insert end "$line" $tags
8258                 }
8259                 if {!$dowords} {
8260                     $ctext insert end "\n" $tags
8261                 }
8262             }
8263         } elseif {$dowords && $prefix eq "~"} {
8264             $ctext insert end "\n" {}
8265         } else {
8266             # "\ No newline at end of file",
8267             # or something else we don't recognize
8268             $ctext insert end "$line\n" hunksep
8269         }
8270     }
8271 }
8272
8273 proc changediffdisp {} {
8274     global ctext diffelide
8275
8276     $ctext tag conf d0 -elide [lindex $diffelide 0]
8277     $ctext tag conf dresult -elide [lindex $diffelide 1]
8278 }
8279
8280 proc highlightfile {cline} {
8281     global cflist cflist_top
8282
8283     if {![info exists cflist_top]} return
8284
8285     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
8286     $cflist tag add highlight $cline.0 "$cline.0 lineend"
8287     $cflist see $cline.0
8288     set cflist_top $cline
8289 }
8290
8291 proc highlightfile_for_scrollpos {topidx} {
8292     global cmitmode difffilestart
8293
8294     if {$cmitmode eq "tree"} return
8295     if {![info exists difffilestart]} return
8296
8297     set top [lindex [split $topidx .] 0]
8298     if {$difffilestart eq {} || $top < [lindex $difffilestart 0]} {
8299         highlightfile 0
8300     } else {
8301         highlightfile [expr {[bsearch $difffilestart $top] + 2}]
8302     }
8303 }
8304
8305 proc prevfile {} {
8306     global difffilestart ctext cmitmode
8307
8308     if {$cmitmode eq "tree"} return
8309     set prev 0.0
8310     set here [$ctext index @0,0]
8311     foreach loc $difffilestart {
8312         if {[$ctext compare $loc >= $here]} {
8313             $ctext yview $prev
8314             return
8315         }
8316         set prev $loc
8317     }
8318     $ctext yview $prev
8319 }
8320
8321 proc nextfile {} {
8322     global difffilestart ctext cmitmode
8323
8324     if {$cmitmode eq "tree"} return
8325     set here [$ctext index @0,0]
8326     foreach loc $difffilestart {
8327         if {[$ctext compare $loc > $here]} {
8328             $ctext yview $loc
8329             return
8330         }
8331     }
8332 }
8333
8334 proc clear_ctext {{first 1.0}} {
8335     global ctext smarktop smarkbot
8336     global ctext_file_names ctext_file_lines
8337     global pendinglinks
8338
8339     set l [lindex [split $first .] 0]
8340     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
8341         set smarktop $l
8342     }
8343     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
8344         set smarkbot $l
8345     }
8346     $ctext delete $first end
8347     if {$first eq "1.0"} {
8348         unset -nocomplain pendinglinks
8349     }
8350     set ctext_file_names {}
8351     set ctext_file_lines {}
8352 }
8353
8354 proc settabs {{firstab {}}} {
8355     global firsttabstop tabstop ctext have_tk85
8356
8357     if {$firstab ne {} && $have_tk85} {
8358         set firsttabstop $firstab
8359     }
8360     set w [font measure textfont "0"]
8361     if {$firsttabstop != 0} {
8362         $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
8363                                [expr {($firsttabstop + 2 * $tabstop) * $w}]]
8364     } elseif {$have_tk85 || $tabstop != 8} {
8365         $ctext conf -tabs [expr {$tabstop * $w}]
8366     } else {
8367         $ctext conf -tabs {}
8368     }
8369 }
8370
8371 proc incrsearch {name ix op} {
8372     global ctext searchstring searchdirn
8373
8374     if {[catch {$ctext index anchor}]} {
8375         # no anchor set, use start of selection, or of visible area
8376         set sel [$ctext tag ranges sel]
8377         if {$sel ne {}} {
8378             $ctext mark set anchor [lindex $sel 0]
8379         } elseif {$searchdirn eq "-forwards"} {
8380             $ctext mark set anchor @0,0
8381         } else {
8382             $ctext mark set anchor @0,[winfo height $ctext]
8383         }
8384     }
8385     if {$searchstring ne {}} {
8386         set here [$ctext search -count mlen $searchdirn -- $searchstring anchor]
8387         if {$here ne {}} {
8388             $ctext see $here
8389             set mend "$here + $mlen c"
8390             $ctext tag remove sel 1.0 end
8391             $ctext tag add sel $here $mend
8392             suppress_highlighting_file_for_current_scrollpos
8393             highlightfile_for_scrollpos $here
8394         }
8395     }
8396     rehighlight_search_results
8397 }
8398
8399 proc dosearch {} {
8400     global sstring ctext searchstring searchdirn
8401
8402     focus $sstring
8403     $sstring icursor end
8404     set searchdirn -forwards
8405     if {$searchstring ne {}} {
8406         set sel [$ctext tag ranges sel]
8407         if {$sel ne {}} {
8408             set start "[lindex $sel 0] + 1c"
8409         } elseif {[catch {set start [$ctext index anchor]}]} {
8410             set start "@0,0"
8411         }
8412         set match [$ctext search -count mlen -- $searchstring $start]
8413         $ctext tag remove sel 1.0 end
8414         if {$match eq {}} {
8415             bell
8416             return
8417         }
8418         $ctext see $match
8419         suppress_highlighting_file_for_current_scrollpos
8420         highlightfile_for_scrollpos $match
8421         set mend "$match + $mlen c"
8422         $ctext tag add sel $match $mend
8423         $ctext mark unset anchor
8424         rehighlight_search_results
8425     }
8426 }
8427
8428 proc dosearchback {} {
8429     global sstring ctext searchstring searchdirn
8430
8431     focus $sstring
8432     $sstring icursor end
8433     set searchdirn -backwards
8434     if {$searchstring ne {}} {
8435         set sel [$ctext tag ranges sel]
8436         if {$sel ne {}} {
8437             set start [lindex $sel 0]
8438         } elseif {[catch {set start [$ctext index anchor]}]} {
8439             set start @0,[winfo height $ctext]
8440         }
8441         set match [$ctext search -backwards -count ml -- $searchstring $start]
8442         $ctext tag remove sel 1.0 end
8443         if {$match eq {}} {
8444             bell
8445             return
8446         }
8447         $ctext see $match
8448         suppress_highlighting_file_for_current_scrollpos
8449         highlightfile_for_scrollpos $match
8450         set mend "$match + $ml c"
8451         $ctext tag add sel $match $mend
8452         $ctext mark unset anchor
8453         rehighlight_search_results
8454     }
8455 }
8456
8457 proc rehighlight_search_results {} {
8458     global ctext searchstring
8459
8460     $ctext tag remove found 1.0 end
8461     $ctext tag remove currentsearchhit 1.0 end
8462
8463     if {$searchstring ne {}} {
8464         searchmarkvisible 1
8465     }
8466 }
8467
8468 proc searchmark {first last} {
8469     global ctext searchstring
8470
8471     set sel [$ctext tag ranges sel]
8472
8473     set mend $first.0
8474     while {1} {
8475         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8476         if {$match eq {}} break
8477         set mend "$match + $mlen c"
8478         if {$sel ne {} && [$ctext compare $match == [lindex $sel 0]]} {
8479             $ctext tag add currentsearchhit $match $mend
8480         } else {
8481             $ctext tag add found $match $mend
8482         }
8483     }
8484 }
8485
8486 proc searchmarkvisible {doall} {
8487     global ctext smarktop smarkbot
8488
8489     set topline [lindex [split [$ctext index @0,0] .] 0]
8490     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8491     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
8492         # no overlap with previous
8493         searchmark $topline $botline
8494         set smarktop $topline
8495         set smarkbot $botline
8496     } else {
8497         if {$topline < $smarktop} {
8498             searchmark $topline [expr {$smarktop-1}]
8499             set smarktop $topline
8500         }
8501         if {$botline > $smarkbot} {
8502             searchmark [expr {$smarkbot+1}] $botline
8503             set smarkbot $botline
8504         }
8505     }
8506 }
8507
8508 proc suppress_highlighting_file_for_current_scrollpos {} {
8509     global ctext suppress_highlighting_file_for_this_scrollpos
8510
8511     set suppress_highlighting_file_for_this_scrollpos [$ctext index @0,0]
8512 }
8513
8514 proc scrolltext {f0 f1} {
8515     global searchstring cmitmode ctext
8516     global suppress_highlighting_file_for_this_scrollpos
8517
8518     set topidx [$ctext index @0,0]
8519     if {![info exists suppress_highlighting_file_for_this_scrollpos]
8520         || $topidx ne $suppress_highlighting_file_for_this_scrollpos} {
8521         highlightfile_for_scrollpos $topidx
8522     }
8523
8524     unset -nocomplain suppress_highlighting_file_for_this_scrollpos
8525
8526     .bleft.bottom.sb set $f0 $f1
8527     if {$searchstring ne {}} {
8528         searchmarkvisible 0
8529     }
8530 }
8531
8532 proc setcoords {} {
8533     global linespc charspc canvx0 canvy0
8534     global xspc1 xspc2 lthickness
8535
8536     set linespc [font metrics mainfont -linespace]
8537     set charspc [font measure mainfont "m"]
8538     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8539     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
8540     set lthickness [expr {int($linespc / 9) + 1}]
8541     set xspc1(0) $linespc
8542     set xspc2 $linespc
8543 }
8544
8545 proc redisplay {} {
8546     global canv
8547     global selectedline
8548
8549     set ymax [lindex [$canv cget -scrollregion] 3]
8550     if {$ymax eq {} || $ymax == 0} return
8551     set span [$canv yview]
8552     clear_display
8553     setcanvscroll
8554     allcanvs yview moveto [lindex $span 0]
8555     drawvisible
8556     if {$selectedline ne {}} {
8557         selectline $selectedline 0
8558         allcanvs yview moveto [lindex $span 0]
8559     }
8560 }
8561
8562 proc parsefont {f n} {
8563     global fontattr
8564
8565     set fontattr($f,family) [lindex $n 0]
8566     set s [lindex $n 1]
8567     if {$s eq {} || $s == 0} {
8568         set s 10
8569     } elseif {$s < 0} {
8570         set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
8571     }
8572     set fontattr($f,size) $s
8573     set fontattr($f,weight) normal
8574     set fontattr($f,slant) roman
8575     foreach style [lrange $n 2 end] {
8576         switch -- $style {
8577             "normal" -
8578             "bold"   {set fontattr($f,weight) $style}
8579             "roman" -
8580             "italic" {set fontattr($f,slant) $style}
8581         }
8582     }
8583 }
8584
8585 proc fontflags {f {isbold 0}} {
8586     global fontattr
8587
8588     return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8589                 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8590                 -slant $fontattr($f,slant)]
8591 }
8592
8593 proc fontname {f} {
8594     global fontattr
8595
8596     set n [list $fontattr($f,family) $fontattr($f,size)]
8597     if {$fontattr($f,weight) eq "bold"} {
8598         lappend n "bold"
8599     }
8600     if {$fontattr($f,slant) eq "italic"} {
8601         lappend n "italic"
8602     }
8603     return $n
8604 }
8605
8606 proc incrfont {inc} {
8607     global mainfont textfont ctext canv cflist showrefstop
8608     global stopped entries fontattr
8609
8610     unmarkmatches
8611     set s $fontattr(mainfont,size)
8612     incr s $inc
8613     if {$s < 1} {
8614         set s 1
8615     }
8616     set fontattr(mainfont,size) $s
8617     font config mainfont -size $s
8618     font config mainfontbold -size $s
8619     set mainfont [fontname mainfont]
8620     set s $fontattr(textfont,size)
8621     incr s $inc
8622     if {$s < 1} {
8623         set s 1
8624     }
8625     set fontattr(textfont,size) $s
8626     font config textfont -size $s
8627     font config textfontbold -size $s
8628     set textfont [fontname textfont]
8629     setcoords
8630     settabs
8631     redisplay
8632 }
8633
8634 proc clearsha1 {} {
8635     global sha1entry sha1string
8636     if {[string length $sha1string] == 40} {
8637         $sha1entry delete 0 end
8638     }
8639 }
8640
8641 proc sha1change {n1 n2 op} {
8642     global sha1string currentid sha1but
8643     if {$sha1string == {}
8644         || ([info exists currentid] && $sha1string == $currentid)} {
8645         set state disabled
8646     } else {
8647         set state normal
8648     }
8649     if {[$sha1but cget -state] == $state} return
8650     if {$state == "normal"} {
8651         $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
8652     } else {
8653         $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
8654     }
8655 }
8656
8657 proc gotocommit {} {
8658     global sha1string tagids headids curview varcid
8659
8660     if {$sha1string == {}
8661         || ([info exists currentid] && $sha1string == $currentid)} return
8662     if {[info exists tagids($sha1string)]} {
8663         set id $tagids($sha1string)
8664     } elseif {[info exists headids($sha1string)]} {
8665         set id $headids($sha1string)
8666     } else {
8667         set id [string tolower $sha1string]
8668         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
8669             set matches [longid $id]
8670             if {$matches ne {}} {
8671                 if {[llength $matches] > 1} {
8672                     error_popup [mc "Short SHA1 id %s is ambiguous" $id]
8673                     return
8674                 }
8675                 set id [lindex $matches 0]
8676             }
8677         } else {
8678             if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8679                 error_popup [mc "Revision %s is not known" $sha1string]
8680                 return
8681             }
8682         }
8683     }
8684     if {[commitinview $id $curview]} {
8685         selectline [rowofcommit $id] 1
8686         return
8687     }
8688     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
8689         set msg [mc "SHA1 id %s is not known" $sha1string]
8690     } else {
8691         set msg [mc "Revision %s is not in the current view" $sha1string]
8692     }
8693     error_popup $msg
8694 }
8695
8696 proc lineenter {x y id} {
8697     global hoverx hovery hoverid hovertimer
8698     global commitinfo canv
8699
8700     if {![info exists commitinfo($id)] && ![getcommit $id]} return
8701     set hoverx $x
8702     set hovery $y
8703     set hoverid $id
8704     if {[info exists hovertimer]} {
8705         after cancel $hovertimer
8706     }
8707     set hovertimer [after 500 linehover]
8708     $canv delete hover
8709 }
8710
8711 proc linemotion {x y id} {
8712     global hoverx hovery hoverid hovertimer
8713
8714     if {[info exists hoverid] && $id == $hoverid} {
8715         set hoverx $x
8716         set hovery $y
8717         if {[info exists hovertimer]} {
8718             after cancel $hovertimer
8719         }
8720         set hovertimer [after 500 linehover]
8721     }
8722 }
8723
8724 proc lineleave {id} {
8725     global hoverid hovertimer canv
8726
8727     if {[info exists hoverid] && $id == $hoverid} {
8728         $canv delete hover
8729         if {[info exists hovertimer]} {
8730             after cancel $hovertimer
8731             unset hovertimer
8732         }
8733         unset hoverid
8734     }
8735 }
8736
8737 proc linehover {} {
8738     global hoverx hovery hoverid hovertimer
8739     global canv linespc lthickness
8740     global linehoverbgcolor linehoverfgcolor linehoveroutlinecolor
8741
8742     global commitinfo
8743
8744     set text [lindex $commitinfo($hoverid) 0]
8745     set ymax [lindex [$canv cget -scrollregion] 3]
8746     if {$ymax == {}} return
8747     set yfrac [lindex [$canv yview] 0]
8748     set x [expr {$hoverx + 2 * $linespc}]
8749     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8750     set x0 [expr {$x - 2 * $lthickness}]
8751     set y0 [expr {$y - 2 * $lthickness}]
8752     set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
8753     set y1 [expr {$y + $linespc + 2 * $lthickness}]
8754     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8755                -fill $linehoverbgcolor -outline $linehoveroutlinecolor \
8756                -width 1 -tags hover]
8757     $canv raise $t
8758     set t [$canv create text $x $y -anchor nw -text $text -tags hover \
8759                -font mainfont -fill $linehoverfgcolor]
8760     $canv raise $t
8761 }
8762
8763 proc clickisonarrow {id y} {
8764     global lthickness
8765
8766     set ranges [rowranges $id]
8767     set thresh [expr {2 * $lthickness + 6}]
8768     set n [expr {[llength $ranges] - 1}]
8769     for {set i 1} {$i < $n} {incr i} {
8770         set row [lindex $ranges $i]
8771         if {abs([yc $row] - $y) < $thresh} {
8772             return $i
8773         }
8774     }
8775     return {}
8776 }
8777
8778 proc arrowjump {id n y} {
8779     global canv
8780
8781     # 1 <-> 2, 3 <-> 4, etc...
8782     set n [expr {(($n - 1) ^ 1) + 1}]
8783     set row [lindex [rowranges $id] $n]
8784     set yt [yc $row]
8785     set ymax [lindex [$canv cget -scrollregion] 3]
8786     if {$ymax eq {} || $ymax <= 0} return
8787     set view [$canv yview]
8788     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8789     set yfrac [expr {$yt / $ymax - $yspan / 2}]
8790     if {$yfrac < 0} {
8791         set yfrac 0
8792     }
8793     allcanvs yview moveto $yfrac
8794 }
8795
8796 proc lineclick {x y id isnew} {
8797     global ctext commitinfo children canv thickerline curview
8798
8799     if {![info exists commitinfo($id)] && ![getcommit $id]} return
8800     unmarkmatches
8801     unselectline
8802     normalline
8803     $canv delete hover
8804     # draw this line thicker than normal
8805     set thickerline $id
8806     drawlines $id
8807     if {$isnew} {
8808         set ymax [lindex [$canv cget -scrollregion] 3]
8809         if {$ymax eq {}} return
8810         set yfrac [lindex [$canv yview] 0]
8811         set y [expr {$y + $yfrac * $ymax}]
8812     }
8813     set dirn [clickisonarrow $id $y]
8814     if {$dirn ne {}} {
8815         arrowjump $id $dirn $y
8816         return
8817     }
8818
8819     if {$isnew} {
8820         addtohistory [list lineclick $x $y $id 0] savectextpos
8821     }
8822     # fill the details pane with info about this line
8823     $ctext conf -state normal
8824     clear_ctext
8825     settabs 0
8826     $ctext insert end "[mc "Parent"]:\t"
8827     $ctext insert end $id link0
8828     setlink $id link0
8829     set info $commitinfo($id)
8830     $ctext insert end "\n\t[lindex $info 0]\n"
8831     $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8832     set date [formatdate [lindex $info 2]]
8833     $ctext insert end "\t[mc "Date"]:\t$date\n"
8834     set kids $children($curview,$id)
8835     if {$kids ne {}} {
8836         $ctext insert end "\n[mc "Children"]:"
8837         set i 0
8838         foreach child $kids {
8839             incr i
8840             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8841             set info $commitinfo($child)
8842             $ctext insert end "\n\t"
8843             $ctext insert end $child link$i
8844             setlink $child link$i
8845             $ctext insert end "\n\t[lindex $info 0]"
8846             $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8847             set date [formatdate [lindex $info 2]]
8848             $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8849         }
8850     }
8851     maybe_scroll_ctext 1
8852     $ctext conf -state disabled
8853     init_flist {}
8854 }
8855
8856 proc normalline {} {
8857     global thickerline
8858     if {[info exists thickerline]} {
8859         set id $thickerline
8860         unset thickerline
8861         drawlines $id
8862     }
8863 }
8864
8865 proc selbyid {id {isnew 1}} {
8866     global curview
8867     if {[commitinview $id $curview]} {
8868         selectline [rowofcommit $id] $isnew
8869     }
8870 }
8871
8872 proc mstime {} {
8873     global startmstime
8874     if {![info exists startmstime]} {
8875         set startmstime [clock clicks -milliseconds]
8876     }
8877     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8878 }
8879
8880 proc rowmenu {x y id} {
8881     global rowctxmenu selectedline rowmenuid curview
8882     global nullid nullid2 fakerowmenu mainhead markedid
8883
8884     stopfinding
8885     set rowmenuid $id
8886     if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8887         set state disabled
8888     } else {
8889         set state normal
8890     }
8891     if {[info exists markedid] && $markedid ne $id} {
8892         set mstate normal
8893     } else {
8894         set mstate disabled
8895     }
8896     if {$id ne $nullid && $id ne $nullid2} {
8897         set menu $rowctxmenu
8898         if {$mainhead ne {}} {
8899             $menu entryconfigure 8 -label [mc "Reset %s branch to here" $mainhead] -state normal
8900         } else {
8901             $menu entryconfigure 8 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8902         }
8903         $menu entryconfigure 10 -state $mstate
8904         $menu entryconfigure 11 -state $mstate
8905         $menu entryconfigure 12 -state $mstate
8906     } else {
8907         set menu $fakerowmenu
8908     }
8909     $menu entryconfigure [mca "Diff this -> selected"] -state $state
8910     $menu entryconfigure [mca "Diff selected -> this"] -state $state
8911     $menu entryconfigure [mca "Make patch"] -state $state
8912     $menu entryconfigure [mca "Diff this -> marked commit"] -state $mstate
8913     $menu entryconfigure [mca "Diff marked commit -> this"] -state $mstate
8914     tk_popup $menu $x $y
8915 }
8916
8917 proc markhere {} {
8918     global rowmenuid markedid canv
8919
8920     set markedid $rowmenuid
8921     make_idmark $markedid
8922 }
8923
8924 proc gotomark {} {
8925     global markedid
8926
8927     if {[info exists markedid]} {
8928         selbyid $markedid
8929     }
8930 }
8931
8932 proc replace_by_kids {l r} {
8933     global curview children
8934
8935     set id [commitonrow $r]
8936     set l [lreplace $l 0 0]
8937     foreach kid $children($curview,$id) {
8938         lappend l [rowofcommit $kid]
8939     }
8940     return [lsort -integer -decreasing -unique $l]
8941 }
8942
8943 proc find_common_desc {} {
8944     global markedid rowmenuid curview children
8945
8946     if {![info exists markedid]} return
8947     if {![commitinview $markedid $curview] ||
8948         ![commitinview $rowmenuid $curview]} return
8949     #set t1 [clock clicks -milliseconds]
8950     set l1 [list [rowofcommit $markedid]]
8951     set l2 [list [rowofcommit $rowmenuid]]
8952     while 1 {
8953         set r1 [lindex $l1 0]
8954         set r2 [lindex $l2 0]
8955         if {$r1 eq {} || $r2 eq {}} break
8956         if {$r1 == $r2} {
8957             selectline $r1 1
8958             break
8959         }
8960         if {$r1 > $r2} {
8961             set l1 [replace_by_kids $l1 $r1]
8962         } else {
8963             set l2 [replace_by_kids $l2 $r2]
8964         }
8965     }
8966     #set t2 [clock clicks -milliseconds]
8967     #puts "took [expr {$t2-$t1}]ms"
8968 }
8969
8970 proc compare_commits {} {
8971     global markedid rowmenuid curview children
8972
8973     if {![info exists markedid]} return
8974     if {![commitinview $markedid $curview]} return
8975     addtohistory [list do_cmp_commits $markedid $rowmenuid]
8976     do_cmp_commits $markedid $rowmenuid
8977 }
8978
8979 proc getpatchid {id} {
8980     global patchids
8981
8982     if {![info exists patchids($id)]} {
8983         set cmd [diffcmd [list $id] {-p --root}]
8984         # trim off the initial "|"
8985         set cmd [lrange $cmd 1 end]
8986         if {[catch {
8987             set x [eval exec $cmd | git patch-id]
8988             set patchids($id) [lindex $x 0]
8989         }]} {
8990             set patchids($id) "error"
8991         }
8992     }
8993     return $patchids($id)
8994 }
8995
8996 proc do_cmp_commits {a b} {
8997     global ctext curview parents children patchids commitinfo
8998
8999     $ctext conf -state normal
9000     clear_ctext
9001     init_flist {}
9002     for {set i 0} {$i < 100} {incr i} {
9003         set skipa 0
9004         set skipb 0
9005         if {[llength $parents($curview,$a)] > 1} {
9006             appendshortlink $a [mc "Skipping merge commit "] "\n"
9007             set skipa 1
9008         } else {
9009             set patcha [getpatchid $a]
9010         }
9011         if {[llength $parents($curview,$b)] > 1} {
9012             appendshortlink $b [mc "Skipping merge commit "] "\n"
9013             set skipb 1
9014         } else {
9015             set patchb [getpatchid $b]
9016         }
9017         if {!$skipa && !$skipb} {
9018             set heada [lindex $commitinfo($a) 0]
9019             set headb [lindex $commitinfo($b) 0]
9020             if {$patcha eq "error"} {
9021                 appendshortlink $a [mc "Error getting patch ID for "] \
9022                     [mc " - stopping\n"]
9023                 break
9024             }
9025             if {$patchb eq "error"} {
9026                 appendshortlink $b [mc "Error getting patch ID for "] \
9027                     [mc " - stopping\n"]
9028                 break
9029             }
9030             if {$patcha eq $patchb} {
9031                 if {$heada eq $headb} {
9032                     appendshortlink $a [mc "Commit "]
9033                     appendshortlink $b " == " "  $heada\n"
9034                 } else {
9035                     appendshortlink $a [mc "Commit "] "  $heada\n"
9036                     appendshortlink $b [mc " is the same patch as\n       "] \
9037                         "  $headb\n"
9038                 }
9039                 set skipa 1
9040                 set skipb 1
9041             } else {
9042                 $ctext insert end "\n"
9043                 appendshortlink $a [mc "Commit "] "  $heada\n"
9044                 appendshortlink $b [mc " differs from\n       "] \
9045                     "  $headb\n"
9046                 $ctext insert end [mc "Diff of commits:\n\n"]
9047                 $ctext conf -state disabled
9048                 update
9049                 diffcommits $a $b
9050                 return
9051             }
9052         }
9053         if {$skipa} {
9054             set kids [real_children $curview,$a]
9055             if {[llength $kids] != 1} {
9056                 $ctext insert end "\n"
9057                 appendshortlink $a [mc "Commit "] \
9058                     [mc " has %s children - stopping\n" [llength $kids]]
9059                 break
9060             }
9061             set a [lindex $kids 0]
9062         }
9063         if {$skipb} {
9064             set kids [real_children $curview,$b]
9065             if {[llength $kids] != 1} {
9066                 appendshortlink $b [mc "Commit "] \
9067                     [mc " has %s children - stopping\n" [llength $kids]]
9068                 break
9069             }
9070             set b [lindex $kids 0]
9071         }
9072     }
9073     $ctext conf -state disabled
9074 }
9075
9076 proc diffcommits {a b} {
9077     global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
9078
9079     set tmpdir [gitknewtmpdir]
9080     set fna [file join $tmpdir "commit-[string range $a 0 7]"]
9081     set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
9082     if {[catch {
9083         exec git diff-tree -p --pretty $a >$fna
9084         exec git diff-tree -p --pretty $b >$fnb
9085     } err]} {
9086         error_popup [mc "Error writing commit to file: %s" $err]
9087         return
9088     }
9089     if {[catch {
9090         set fd [open "| diff -U$diffcontext $fna $fnb" r]
9091     } err]} {
9092         error_popup [mc "Error diffing commits: %s" $err]
9093         return
9094     }
9095     set diffids [list commits $a $b]
9096     set blobdifffd($diffids) $fd
9097     set diffinhdr 0
9098     set currdiffsubmod ""
9099     filerun $fd [list getblobdiffline $fd $diffids]
9100 }
9101
9102 proc diffvssel {dirn} {
9103     global rowmenuid selectedline
9104
9105     if {$selectedline eq {}} return
9106     if {$dirn} {
9107         set oldid [commitonrow $selectedline]
9108         set newid $rowmenuid
9109     } else {
9110         set oldid $rowmenuid
9111         set newid [commitonrow $selectedline]
9112     }
9113     addtohistory [list doseldiff $oldid $newid] savectextpos
9114     doseldiff $oldid $newid
9115 }
9116
9117 proc diffvsmark {dirn} {
9118     global rowmenuid markedid
9119
9120     if {![info exists markedid]} return
9121     if {$dirn} {
9122         set oldid $markedid
9123         set newid $rowmenuid
9124     } else {
9125         set oldid $rowmenuid
9126         set newid $markedid
9127     }
9128     addtohistory [list doseldiff $oldid $newid] savectextpos
9129     doseldiff $oldid $newid
9130 }
9131
9132 proc doseldiff {oldid newid} {
9133     global ctext
9134     global commitinfo
9135
9136     $ctext conf -state normal
9137     clear_ctext
9138     init_flist [mc "Top"]
9139     $ctext insert end "[mc "From"] "
9140     $ctext insert end $oldid link0
9141     setlink $oldid link0
9142     $ctext insert end "\n     "
9143     $ctext insert end [lindex $commitinfo($oldid) 0]
9144     $ctext insert end "\n\n[mc "To"]   "
9145     $ctext insert end $newid link1
9146     setlink $newid link1
9147     $ctext insert end "\n     "
9148     $ctext insert end [lindex $commitinfo($newid) 0]
9149     $ctext insert end "\n"
9150     $ctext conf -state disabled
9151     $ctext tag remove found 1.0 end
9152     startdiff [list $oldid $newid]
9153 }
9154
9155 proc mkpatch {} {
9156     global rowmenuid currentid commitinfo patchtop patchnum NS
9157
9158     if {![info exists currentid]} return
9159     set oldid $currentid
9160     set oldhead [lindex $commitinfo($oldid) 0]
9161     set newid $rowmenuid
9162     set newhead [lindex $commitinfo($newid) 0]
9163     set top .patch
9164     set patchtop $top
9165     catch {destroy $top}
9166     ttk_toplevel $top
9167     make_transient $top .
9168     ${NS}::label $top.title -text [mc "Generate patch"]
9169     grid $top.title - -pady 10
9170     ${NS}::label $top.from -text [mc "From:"]
9171     ${NS}::entry $top.fromsha1 -width 40
9172     $top.fromsha1 insert 0 $oldid
9173     $top.fromsha1 conf -state readonly
9174     grid $top.from $top.fromsha1 -sticky w
9175     ${NS}::entry $top.fromhead -width 60
9176     $top.fromhead insert 0 $oldhead
9177     $top.fromhead conf -state readonly
9178     grid x $top.fromhead -sticky w
9179     ${NS}::label $top.to -text [mc "To:"]
9180     ${NS}::entry $top.tosha1 -width 40
9181     $top.tosha1 insert 0 $newid
9182     $top.tosha1 conf -state readonly
9183     grid $top.to $top.tosha1 -sticky w
9184     ${NS}::entry $top.tohead -width 60
9185     $top.tohead insert 0 $newhead
9186     $top.tohead conf -state readonly
9187     grid x $top.tohead -sticky w
9188     ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
9189     grid $top.rev x -pady 10 -padx 5
9190     ${NS}::label $top.flab -text [mc "Output file:"]
9191     ${NS}::entry $top.fname -width 60
9192     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
9193     incr patchnum
9194     grid $top.flab $top.fname -sticky w
9195     ${NS}::frame $top.buts
9196     ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
9197     ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
9198     bind $top <Key-Return> mkpatchgo
9199     bind $top <Key-Escape> mkpatchcan
9200     grid $top.buts.gen $top.buts.can
9201     grid columnconfigure $top.buts 0 -weight 1 -uniform a
9202     grid columnconfigure $top.buts 1 -weight 1 -uniform a
9203     grid $top.buts - -pady 10 -sticky ew
9204     focus $top.fname
9205 }
9206
9207 proc mkpatchrev {} {
9208     global patchtop
9209
9210     set oldid [$patchtop.fromsha1 get]
9211     set oldhead [$patchtop.fromhead get]
9212     set newid [$patchtop.tosha1 get]
9213     set newhead [$patchtop.tohead get]
9214     foreach e [list fromsha1 fromhead tosha1 tohead] \
9215             v [list $newid $newhead $oldid $oldhead] {
9216         $patchtop.$e conf -state normal
9217         $patchtop.$e delete 0 end
9218         $patchtop.$e insert 0 $v
9219         $patchtop.$e conf -state readonly
9220     }
9221 }
9222
9223 proc mkpatchgo {} {
9224     global patchtop nullid nullid2
9225
9226     set oldid [$patchtop.fromsha1 get]
9227     set newid [$patchtop.tosha1 get]
9228     set fname [$patchtop.fname get]
9229     set cmd [diffcmd [list $oldid $newid] -p]
9230     # trim off the initial "|"
9231     set cmd [lrange $cmd 1 end]
9232     lappend cmd >$fname &
9233     if {[catch {eval exec $cmd} err]} {
9234         error_popup "[mc "Error creating patch:"] $err" $patchtop
9235     }
9236     catch {destroy $patchtop}
9237     unset patchtop
9238 }
9239
9240 proc mkpatchcan {} {
9241     global patchtop
9242
9243     catch {destroy $patchtop}
9244     unset patchtop
9245 }
9246
9247 proc mktag {} {
9248     global rowmenuid mktagtop commitinfo NS
9249
9250     set top .maketag
9251     set mktagtop $top
9252     catch {destroy $top}
9253     ttk_toplevel $top
9254     make_transient $top .
9255     ${NS}::label $top.title -text [mc "Create tag"]
9256     grid $top.title - -pady 10
9257     ${NS}::label $top.id -text [mc "ID:"]
9258     ${NS}::entry $top.sha1 -width 40
9259     $top.sha1 insert 0 $rowmenuid
9260     $top.sha1 conf -state readonly
9261     grid $top.id $top.sha1 -sticky w
9262     ${NS}::entry $top.head -width 60
9263     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9264     $top.head conf -state readonly
9265     grid x $top.head -sticky w
9266     ${NS}::label $top.tlab -text [mc "Tag name:"]
9267     ${NS}::entry $top.tag -width 60
9268     grid $top.tlab $top.tag -sticky w
9269     ${NS}::label $top.op -text [mc "Tag message is optional"]
9270     grid $top.op -columnspan 2 -sticky we
9271     ${NS}::label $top.mlab -text [mc "Tag message:"]
9272     ${NS}::entry $top.msg -width 60
9273     grid $top.mlab $top.msg -sticky w
9274     ${NS}::frame $top.buts
9275     ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
9276     ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
9277     bind $top <Key-Return> mktaggo
9278     bind $top <Key-Escape> mktagcan
9279     grid $top.buts.gen $top.buts.can
9280     grid columnconfigure $top.buts 0 -weight 1 -uniform a
9281     grid columnconfigure $top.buts 1 -weight 1 -uniform a
9282     grid $top.buts - -pady 10 -sticky ew
9283     focus $top.tag
9284 }
9285
9286 proc domktag {} {
9287     global mktagtop env tagids idtags
9288
9289     set id [$mktagtop.sha1 get]
9290     set tag [$mktagtop.tag get]
9291     set msg [$mktagtop.msg get]
9292     if {$tag == {}} {
9293         error_popup [mc "No tag name specified"] $mktagtop
9294         return 0
9295     }
9296     if {[info exists tagids($tag)]} {
9297         error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
9298         return 0
9299     }
9300     if {[catch {
9301         if {$msg != {}} {
9302             exec git tag -a -m $msg $tag $id
9303         } else {
9304             exec git tag $tag $id
9305         }
9306     } err]} {
9307         error_popup "[mc "Error creating tag:"] $err" $mktagtop
9308         return 0
9309     }
9310
9311     set tagids($tag) $id
9312     lappend idtags($id) $tag
9313     redrawtags $id
9314     addedtag $id
9315     dispneartags 0
9316     run refill_reflist
9317     return 1
9318 }
9319
9320 proc redrawtags {id} {
9321     global canv linehtag idpos currentid curview cmitlisted markedid
9322     global canvxmax iddrawn circleitem mainheadid circlecolors
9323     global mainheadcirclecolor
9324
9325     if {![commitinview $id $curview]} return
9326     if {![info exists iddrawn($id)]} return
9327     set row [rowofcommit $id]
9328     if {$id eq $mainheadid} {
9329         set ofill $mainheadcirclecolor
9330     } else {
9331         set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
9332     }
9333     $canv itemconf $circleitem($row) -fill $ofill
9334     $canv delete tag.$id
9335     set xt [eval drawtags $id $idpos($id)]
9336     $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
9337     set text [$canv itemcget $linehtag($id) -text]
9338     set font [$canv itemcget $linehtag($id) -font]
9339     set xr [expr {$xt + [font measure $font $text]}]
9340     if {$xr > $canvxmax} {
9341         set canvxmax $xr
9342         setcanvscroll
9343     }
9344     if {[info exists currentid] && $currentid == $id} {
9345         make_secsel $id
9346     }
9347     if {[info exists markedid] && $markedid eq $id} {
9348         make_idmark $id
9349     }
9350 }
9351
9352 proc mktagcan {} {
9353     global mktagtop
9354
9355     catch {destroy $mktagtop}
9356     unset mktagtop
9357 }
9358
9359 proc mktaggo {} {
9360     if {![domktag]} return
9361     mktagcan
9362 }
9363
9364 proc copysummary {} {
9365     global rowmenuid autosellen
9366
9367     set format "%h (\"%s\", %ad)"
9368     set cmd [list git show -s --pretty=format:$format --date=short]
9369     if {$autosellen < 40} {
9370         lappend cmd --abbrev=$autosellen
9371     }
9372     set summary [eval exec $cmd $rowmenuid]
9373
9374     clipboard clear
9375     clipboard append $summary
9376 }
9377
9378 proc writecommit {} {
9379     global rowmenuid wrcomtop commitinfo wrcomcmd NS
9380
9381     set top .writecommit
9382     set wrcomtop $top
9383     catch {destroy $top}
9384     ttk_toplevel $top
9385     make_transient $top .
9386     ${NS}::label $top.title -text [mc "Write commit to file"]
9387     grid $top.title - -pady 10
9388     ${NS}::label $top.id -text [mc "ID:"]
9389     ${NS}::entry $top.sha1 -width 40
9390     $top.sha1 insert 0 $rowmenuid
9391     $top.sha1 conf -state readonly
9392     grid $top.id $top.sha1 -sticky w
9393     ${NS}::entry $top.head -width 60
9394     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
9395     $top.head conf -state readonly
9396     grid x $top.head -sticky w
9397     ${NS}::label $top.clab -text [mc "Command:"]
9398     ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
9399     grid $top.clab $top.cmd -sticky w -pady 10
9400     ${NS}::label $top.flab -text [mc "Output file:"]
9401     ${NS}::entry $top.fname -width 60
9402     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
9403     grid $top.flab $top.fname -sticky w
9404     ${NS}::frame $top.buts
9405     ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
9406     ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
9407     bind $top <Key-Return> wrcomgo
9408     bind $top <Key-Escape> wrcomcan
9409     grid $top.buts.gen $top.buts.can
9410     grid columnconfigure $top.buts 0 -weight 1 -uniform a
9411     grid columnconfigure $top.buts 1 -weight 1 -uniform a
9412     grid $top.buts - -pady 10 -sticky ew
9413     focus $top.fname
9414 }
9415
9416 proc wrcomgo {} {
9417     global wrcomtop
9418
9419     set id [$wrcomtop.sha1 get]
9420     set cmd "echo $id | [$wrcomtop.cmd get]"
9421     set fname [$wrcomtop.fname get]
9422     if {[catch {exec sh -c $cmd >$fname &} err]} {
9423         error_popup "[mc "Error writing commit:"] $err" $wrcomtop
9424     }
9425     catch {destroy $wrcomtop}
9426     unset wrcomtop
9427 }
9428
9429 proc wrcomcan {} {
9430     global wrcomtop
9431
9432     catch {destroy $wrcomtop}
9433     unset wrcomtop
9434 }
9435
9436 proc mkbranch {} {
9437     global rowmenuid mkbrtop NS
9438
9439     set top .makebranch
9440     catch {destroy $top}
9441     ttk_toplevel $top
9442     make_transient $top .
9443     ${NS}::label $top.title -text [mc "Create new branch"]
9444     grid $top.title - -pady 10
9445     ${NS}::label $top.id -text [mc "ID:"]
9446     ${NS}::entry $top.sha1 -width 40
9447     $top.sha1 insert 0 $rowmenuid
9448     $top.sha1 conf -state readonly
9449     grid $top.id $top.sha1 -sticky w
9450     ${NS}::label $top.nlab -text [mc "Name:"]
9451     ${NS}::entry $top.name -width 40
9452     grid $top.nlab $top.name -sticky w
9453     ${NS}::frame $top.buts
9454     ${NS}::button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
9455     ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
9456     bind $top <Key-Return> [list mkbrgo $top]
9457     bind $top <Key-Escape> "catch {destroy $top}"
9458     grid $top.buts.go $top.buts.can
9459     grid columnconfigure $top.buts 0 -weight 1 -uniform a
9460     grid columnconfigure $top.buts 1 -weight 1 -uniform a
9461     grid $top.buts - -pady 10 -sticky ew
9462     focus $top.name
9463 }
9464
9465 proc mkbrgo {top} {
9466     global headids idheads
9467
9468     set name [$top.name get]
9469     set id [$top.sha1 get]
9470     set cmdargs {}
9471     set old_id {}
9472     if {$name eq {}} {
9473         error_popup [mc "Please specify a name for the new branch"] $top
9474         return
9475     }
9476     if {[info exists headids($name)]} {
9477         if {![confirm_popup [mc \
9478                 "Branch '%s' already exists. Overwrite?" $name] $top]} {
9479             return
9480         }
9481         set old_id $headids($name)
9482         lappend cmdargs -f
9483     }
9484     catch {destroy $top}
9485     lappend cmdargs $name $id
9486     nowbusy newbranch
9487     update
9488     if {[catch {
9489         eval exec git branch $cmdargs
9490     } err]} {
9491         notbusy newbranch
9492         error_popup $err
9493     } else {
9494         notbusy newbranch
9495         if {$old_id ne {}} {
9496             movehead $id $name
9497             movedhead $id $name
9498             redrawtags $old_id
9499             redrawtags $id
9500         } else {
9501             set headids($name) $id
9502             lappend idheads($id) $name
9503             addedhead $id $name
9504             redrawtags $id
9505         }
9506         dispneartags 0
9507         run refill_reflist
9508     }
9509 }
9510
9511 proc exec_citool {tool_args {baseid {}}} {
9512     global commitinfo env
9513
9514     set save_env [array get env GIT_AUTHOR_*]
9515
9516     if {$baseid ne {}} {
9517         if {![info exists commitinfo($baseid)]} {
9518             getcommit $baseid
9519         }
9520         set author [lindex $commitinfo($baseid) 1]
9521         set date [lindex $commitinfo($baseid) 2]
9522         if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9523                     $author author name email]
9524             && $date ne {}} {
9525             set env(GIT_AUTHOR_NAME) $name
9526             set env(GIT_AUTHOR_EMAIL) $email
9527             set env(GIT_AUTHOR_DATE) $date
9528         }
9529     }
9530
9531     eval exec git citool $tool_args &
9532
9533     array unset env GIT_AUTHOR_*
9534     array set env $save_env
9535 }
9536
9537 proc cherrypick {} {
9538     global rowmenuid curview
9539     global mainhead mainheadid
9540     global gitdir
9541
9542     set oldhead [exec git rev-parse HEAD]
9543     set dheads [descheads $rowmenuid]
9544     if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
9545         set ok [confirm_popup [mc "Commit %s is already\
9546                 included in branch %s -- really re-apply it?" \
9547                                    [string range $rowmenuid 0 7] $mainhead]]
9548         if {!$ok} return
9549     }
9550     nowbusy cherrypick [mc "Cherry-picking"]
9551     update
9552     # Unfortunately git-cherry-pick writes stuff to stderr even when
9553     # no error occurs, and exec takes that as an indication of error...
9554     if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9555         notbusy cherrypick
9556         if {[regexp -line \
9557                  {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9558                  $err msg fname]} {
9559             error_popup [mc "Cherry-pick failed because of local changes\
9560                         to file '%s'.\nPlease commit, reset or stash\
9561                         your changes and try again." $fname]
9562         } elseif {[regexp -line \
9563                        {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
9564                        $err]} {
9565             if {[confirm_popup [mc "Cherry-pick failed because of merge\
9566                         conflict.\nDo you wish to run git citool to\
9567                         resolve it?"]]} {
9568                 # Force citool to read MERGE_MSG
9569                 file delete [file join $gitdir "GITGUI_MSG"]
9570                 exec_citool {} $rowmenuid
9571             }
9572         } else {
9573             error_popup $err
9574         }
9575         run updatecommits
9576         return
9577     }
9578     set newhead [exec git rev-parse HEAD]
9579     if {$newhead eq $oldhead} {
9580         notbusy cherrypick
9581         error_popup [mc "No changes committed"]
9582         return
9583     }
9584     addnewchild $newhead $oldhead
9585     if {[commitinview $oldhead $curview]} {
9586         # XXX this isn't right if we have a path limit...
9587         insertrow $newhead $oldhead $curview
9588         if {$mainhead ne {}} {
9589             movehead $newhead $mainhead
9590             movedhead $newhead $mainhead
9591         }
9592         set mainheadid $newhead
9593         redrawtags $oldhead
9594         redrawtags $newhead
9595         selbyid $newhead
9596     }
9597     notbusy cherrypick
9598 }
9599
9600 proc revert {} {
9601     global rowmenuid curview
9602     global mainhead mainheadid
9603     global gitdir
9604
9605     set oldhead [exec git rev-parse HEAD]
9606     set dheads [descheads $rowmenuid]
9607     if { $dheads eq {} || [lsearch -exact $dheads $oldhead] == -1 } {
9608        set ok [confirm_popup [mc "Commit %s is not\
9609            included in branch %s -- really revert it?" \
9610                       [string range $rowmenuid 0 7] $mainhead]]
9611        if {!$ok} return
9612     }
9613     nowbusy revert [mc "Reverting"]
9614     update
9615
9616     if [catch {exec git revert --no-edit $rowmenuid} err] {
9617         notbusy revert
9618         if [regexp {files would be overwritten by merge:(\n(( |\t)+[^\n]+\n)+)}\
9619                 $err match files] {
9620             regsub {\n( |\t)+} $files "\n" files
9621             error_popup [mc "Revert failed because of local changes to\
9622                 the following files:%s Please commit, reset or stash \
9623                 your changes and try again." $files]
9624         } elseif [regexp {error: could not revert} $err] {
9625             if [confirm_popup [mc "Revert failed because of merge conflict.\n\
9626                 Do you wish to run git citool to resolve it?"]] {
9627                 # Force citool to read MERGE_MSG
9628                 file delete [file join $gitdir "GITGUI_MSG"]
9629                 exec_citool {} $rowmenuid
9630             }
9631         } else { error_popup $err }
9632         run updatecommits
9633         return
9634     }
9635
9636     set newhead [exec git rev-parse HEAD]
9637     if { $newhead eq $oldhead } {
9638         notbusy revert
9639         error_popup [mc "No changes committed"]
9640         return
9641     }
9642
9643     addnewchild $newhead $oldhead
9644
9645     if [commitinview $oldhead $curview] {
9646         # XXX this isn't right if we have a path limit...
9647         insertrow $newhead $oldhead $curview
9648         if {$mainhead ne {}} {
9649             movehead $newhead $mainhead
9650             movedhead $newhead $mainhead
9651         }
9652         set mainheadid $newhead
9653         redrawtags $oldhead
9654         redrawtags $newhead
9655         selbyid $newhead
9656     }
9657
9658     notbusy revert
9659 }
9660
9661 proc resethead {} {
9662     global mainhead rowmenuid confirm_ok resettype NS
9663
9664     set confirm_ok 0
9665     set w ".confirmreset"
9666     ttk_toplevel $w
9667     make_transient $w .
9668     wm title $w [mc "Confirm reset"]
9669     ${NS}::label $w.m -text \
9670         [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
9671     pack $w.m -side top -fill x -padx 20 -pady 20
9672     ${NS}::labelframe $w.f -text [mc "Reset type:"]
9673     set resettype mixed
9674     ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
9675         -text [mc "Soft: Leave working tree and index untouched"]
9676     grid $w.f.soft -sticky w
9677     ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
9678         -text [mc "Mixed: Leave working tree untouched, reset index"]
9679     grid $w.f.mixed -sticky w
9680     ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
9681         -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
9682     grid $w.f.hard -sticky w
9683     pack $w.f -side top -fill x -padx 4
9684     ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
9685     pack $w.ok -side left -fill x -padx 20 -pady 20
9686     ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
9687     bind $w <Key-Escape> [list destroy $w]
9688     pack $w.cancel -side right -fill x -padx 20 -pady 20
9689     bind $w <Visibility> "grab $w; focus $w"
9690     tkwait window $w
9691     if {!$confirm_ok} return
9692     if {[catch {set fd [open \
9693             [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
9694         error_popup $err
9695     } else {
9696         dohidelocalchanges
9697         filerun $fd [list readresetstat $fd]
9698         nowbusy reset [mc "Resetting"]
9699         selbyid $rowmenuid
9700     }
9701 }
9702
9703 proc readresetstat {fd} {
9704     global mainhead mainheadid showlocalchanges rprogcoord
9705
9706     if {[gets $fd line] >= 0} {
9707         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9708             set rprogcoord [expr {1.0 * $m / $n}]
9709             adjustprogress
9710         }
9711         return 1
9712     }
9713     set rprogcoord 0
9714     adjustprogress
9715     notbusy reset
9716     if {[catch {close $fd} err]} {
9717         error_popup $err
9718     }
9719     set oldhead $mainheadid
9720     set newhead [exec git rev-parse HEAD]
9721     if {$newhead ne $oldhead} {
9722         movehead $newhead $mainhead
9723         movedhead $newhead $mainhead
9724         set mainheadid $newhead
9725         redrawtags $oldhead
9726         redrawtags $newhead
9727     }
9728     if {$showlocalchanges} {
9729         doshowlocalchanges
9730     }
9731     return 0
9732 }
9733
9734 # context menu for a head
9735 proc headmenu {x y id head} {
9736     global headmenuid headmenuhead headctxmenu mainhead
9737
9738     stopfinding
9739     set headmenuid $id
9740     set headmenuhead $head
9741     set state normal
9742     if {[string match "remotes/*" $head]} {
9743         set state disabled
9744     }
9745     if {$head eq $mainhead} {
9746         set state disabled
9747     }
9748     $headctxmenu entryconfigure 0 -state $state
9749     $headctxmenu entryconfigure 1 -state $state
9750     tk_popup $headctxmenu $x $y
9751 }
9752
9753 proc cobranch {} {
9754     global headmenuid headmenuhead headids
9755     global showlocalchanges
9756
9757     # check the tree is clean first??
9758     nowbusy checkout [mc "Checking out"]
9759     update
9760     dohidelocalchanges
9761     if {[catch {
9762         set fd [open [list | git checkout $headmenuhead 2>@1] r]
9763     } err]} {
9764         notbusy checkout
9765         error_popup $err
9766         if {$showlocalchanges} {
9767             dodiffindex
9768         }
9769     } else {
9770         filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
9771     }
9772 }
9773
9774 proc readcheckoutstat {fd newhead newheadid} {
9775     global mainhead mainheadid headids showlocalchanges progresscoords
9776     global viewmainheadid curview
9777
9778     if {[gets $fd line] >= 0} {
9779         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9780             set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9781             adjustprogress
9782         }
9783         return 1
9784     }
9785     set progresscoords {0 0}
9786     adjustprogress
9787     notbusy checkout
9788     if {[catch {close $fd} err]} {
9789         error_popup $err
9790     }
9791     set oldmainid $mainheadid
9792     set mainhead $newhead
9793     set mainheadid $newheadid
9794     set viewmainheadid($curview) $newheadid
9795     redrawtags $oldmainid
9796     redrawtags $newheadid
9797     selbyid $newheadid
9798     if {$showlocalchanges} {
9799         dodiffindex
9800     }
9801 }
9802
9803 proc rmbranch {} {
9804     global headmenuid headmenuhead mainhead
9805     global idheads
9806
9807     set head $headmenuhead
9808     set id $headmenuid
9809     # this check shouldn't be needed any more...
9810     if {$head eq $mainhead} {
9811         error_popup [mc "Cannot delete the currently checked-out branch"]
9812         return
9813     }
9814     set dheads [descheads $id]
9815     if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
9816         # the stuff on this branch isn't on any other branch
9817         if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9818                         branch.\nReally delete branch %s?" $head $head]]} return
9819     }
9820     nowbusy rmbranch
9821     update
9822     if {[catch {exec git branch -D $head} err]} {
9823         notbusy rmbranch
9824         error_popup $err
9825         return
9826     }
9827     removehead $id $head
9828     removedhead $id $head
9829     redrawtags $id
9830     notbusy rmbranch
9831     dispneartags 0
9832     run refill_reflist
9833 }
9834
9835 # Display a list of tags and heads
9836 proc showrefs {} {
9837     global showrefstop bgcolor fgcolor selectbgcolor NS
9838     global bglist fglist reflistfilter reflist maincursor
9839
9840     set top .showrefs
9841     set showrefstop $top
9842     if {[winfo exists $top]} {
9843         raise $top
9844         refill_reflist
9845         return
9846     }
9847     ttk_toplevel $top
9848     wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
9849     make_transient $top .
9850     text $top.list -background $bgcolor -foreground $fgcolor \
9851         -selectbackground $selectbgcolor -font mainfont \
9852         -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
9853         -width 30 -height 20 -cursor $maincursor \
9854         -spacing1 1 -spacing3 1 -state disabled
9855     $top.list tag configure highlight -background $selectbgcolor
9856     if {![lsearch -exact $bglist $top.list]} {
9857         lappend bglist $top.list
9858         lappend fglist $top.list
9859     }
9860     ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
9861     ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
9862     grid $top.list $top.ysb -sticky nsew
9863     grid $top.xsb x -sticky ew
9864     ${NS}::frame $top.f
9865     ${NS}::label $top.f.l -text "[mc "Filter"]: "
9866     ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
9867     set reflistfilter "*"
9868     trace add variable reflistfilter write reflistfilter_change
9869     pack $top.f.e -side right -fill x -expand 1
9870     pack $top.f.l -side left
9871     grid $top.f - -sticky ew -pady 2
9872     ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
9873     bind $top <Key-Escape> [list destroy $top]
9874     grid $top.close -
9875     grid columnconfigure $top 0 -weight 1
9876     grid rowconfigure $top 0 -weight 1
9877     bind $top.list <1> {break}
9878     bind $top.list <B1-Motion> {break}
9879     bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
9880     set reflist {}
9881     refill_reflist
9882 }
9883
9884 proc sel_reflist {w x y} {
9885     global showrefstop reflist headids tagids otherrefids
9886
9887     if {![winfo exists $showrefstop]} return
9888     set l [lindex [split [$w index "@$x,$y"] "."] 0]
9889     set ref [lindex $reflist [expr {$l-1}]]
9890     set n [lindex $ref 0]
9891     switch -- [lindex $ref 1] {
9892         "H" {selbyid $headids($n)}
9893         "T" {selbyid $tagids($n)}
9894         "o" {selbyid $otherrefids($n)}
9895     }
9896     $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
9897 }
9898
9899 proc unsel_reflist {} {
9900     global showrefstop
9901
9902     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9903     $showrefstop.list tag remove highlight 0.0 end
9904 }
9905
9906 proc reflistfilter_change {n1 n2 op} {
9907     global reflistfilter
9908
9909     after cancel refill_reflist
9910     after 200 refill_reflist
9911 }
9912
9913 proc refill_reflist {} {
9914     global reflist reflistfilter showrefstop headids tagids otherrefids
9915     global curview
9916
9917     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9918     set refs {}
9919     foreach n [array names headids] {
9920         if {[string match $reflistfilter $n]} {
9921             if {[commitinview $headids($n) $curview]} {
9922                 lappend refs [list $n H]
9923             } else {
9924                 interestedin $headids($n) {run refill_reflist}
9925             }
9926         }
9927     }
9928     foreach n [array names tagids] {
9929         if {[string match $reflistfilter $n]} {
9930             if {[commitinview $tagids($n) $curview]} {
9931                 lappend refs [list $n T]
9932             } else {
9933                 interestedin $tagids($n) {run refill_reflist}
9934             }
9935         }
9936     }
9937     foreach n [array names otherrefids] {
9938         if {[string match $reflistfilter $n]} {
9939             if {[commitinview $otherrefids($n) $curview]} {
9940                 lappend refs [list $n o]
9941             } else {
9942                 interestedin $otherrefids($n) {run refill_reflist}
9943             }
9944         }
9945     }
9946     set refs [lsort -index 0 $refs]
9947     if {$refs eq $reflist} return
9948
9949     # Update the contents of $showrefstop.list according to the
9950     # differences between $reflist (old) and $refs (new)
9951     $showrefstop.list conf -state normal
9952     $showrefstop.list insert end "\n"
9953     set i 0
9954     set j 0
9955     while {$i < [llength $reflist] || $j < [llength $refs]} {
9956         if {$i < [llength $reflist]} {
9957             if {$j < [llength $refs]} {
9958                 set cmp [string compare [lindex $reflist $i 0] \
9959                              [lindex $refs $j 0]]
9960                 if {$cmp == 0} {
9961                     set cmp [string compare [lindex $reflist $i 1] \
9962                                  [lindex $refs $j 1]]
9963                 }
9964             } else {
9965                 set cmp -1
9966             }
9967         } else {
9968             set cmp 1
9969         }
9970         switch -- $cmp {
9971             -1 {
9972                 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
9973                 incr i
9974             }
9975             0 {
9976                 incr i
9977                 incr j
9978             }
9979             1 {
9980                 set l [expr {$j + 1}]
9981                 $showrefstop.list image create $l.0 -align baseline \
9982                     -image reficon-[lindex $refs $j 1] -padx 2
9983                 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
9984                 incr j
9985             }
9986         }
9987     }
9988     set reflist $refs
9989     # delete last newline
9990     $showrefstop.list delete end-2c end-1c
9991     $showrefstop.list conf -state disabled
9992 }
9993
9994 # Stuff for finding nearby tags
9995 proc getallcommits {} {
9996     global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
9997     global idheads idtags idotherrefs allparents tagobjid
9998     global gitdir
9999
10000     if {![info exists allcommits]} {
10001         set nextarc 0
10002         set allcommits 0
10003         set seeds {}
10004         set allcwait 0
10005         set cachedarcs 0
10006         set allccache [file join $gitdir "gitk.cache"]
10007         if {![catch {
10008             set f [open $allccache r]
10009             set allcwait 1
10010             getcache $f
10011         }]} return
10012     }
10013
10014     if {$allcwait} {
10015         return
10016     }
10017     set cmd [list | git rev-list --parents]
10018     set allcupdate [expr {$seeds ne {}}]
10019     if {!$allcupdate} {
10020         set ids "--all"
10021     } else {
10022         set refs [concat [array names idheads] [array names idtags] \
10023                       [array names idotherrefs]]
10024         set ids {}
10025         set tagobjs {}
10026         foreach name [array names tagobjid] {
10027             lappend tagobjs $tagobjid($name)
10028         }
10029         foreach id [lsort -unique $refs] {
10030             if {![info exists allparents($id)] &&
10031                 [lsearch -exact $tagobjs $id] < 0} {
10032                 lappend ids $id
10033             }
10034         }
10035         if {$ids ne {}} {
10036             foreach id $seeds {
10037                 lappend ids "^$id"
10038             }
10039         }
10040     }
10041     if {$ids ne {}} {
10042         set fd [open [concat $cmd $ids] r]
10043         fconfigure $fd -blocking 0
10044         incr allcommits
10045         nowbusy allcommits
10046         filerun $fd [list getallclines $fd]
10047     } else {
10048         dispneartags 0
10049     }
10050 }
10051
10052 # Since most commits have 1 parent and 1 child, we group strings of
10053 # such commits into "arcs" joining branch/merge points (BMPs), which
10054 # are commits that either don't have 1 parent or don't have 1 child.
10055 #
10056 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
10057 # arcout(id) - outgoing arcs for BMP
10058 # arcids(a) - list of IDs on arc including end but not start
10059 # arcstart(a) - BMP ID at start of arc
10060 # arcend(a) - BMP ID at end of arc
10061 # growing(a) - arc a is still growing
10062 # arctags(a) - IDs out of arcids (excluding end) that have tags
10063 # archeads(a) - IDs out of arcids (excluding end) that have heads
10064 # The start of an arc is at the descendent end, so "incoming" means
10065 # coming from descendents, and "outgoing" means going towards ancestors.
10066
10067 proc getallclines {fd} {
10068     global allparents allchildren idtags idheads nextarc
10069     global arcnos arcids arctags arcout arcend arcstart archeads growing
10070     global seeds allcommits cachedarcs allcupdate
10071
10072     set nid 0
10073     while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
10074         set id [lindex $line 0]
10075         if {[info exists allparents($id)]} {
10076             # seen it already
10077             continue
10078         }
10079         set cachedarcs 0
10080         set olds [lrange $line 1 end]
10081         set allparents($id) $olds
10082         if {![info exists allchildren($id)]} {
10083             set allchildren($id) {}
10084             set arcnos($id) {}
10085             lappend seeds $id
10086         } else {
10087             set a $arcnos($id)
10088             if {[llength $olds] == 1 && [llength $a] == 1} {
10089                 lappend arcids($a) $id
10090                 if {[info exists idtags($id)]} {
10091                     lappend arctags($a) $id
10092                 }
10093                 if {[info exists idheads($id)]} {
10094                     lappend archeads($a) $id
10095                 }
10096                 if {[info exists allparents($olds)]} {
10097                     # seen parent already
10098                     if {![info exists arcout($olds)]} {
10099                         splitarc $olds
10100                     }
10101                     lappend arcids($a) $olds
10102                     set arcend($a) $olds
10103                     unset growing($a)
10104                 }
10105                 lappend allchildren($olds) $id
10106                 lappend arcnos($olds) $a
10107                 continue
10108             }
10109         }
10110         foreach a $arcnos($id) {
10111             lappend arcids($a) $id
10112             set arcend($a) $id
10113             unset growing($a)
10114         }
10115
10116         set ao {}
10117         foreach p $olds {
10118             lappend allchildren($p) $id
10119             set a [incr nextarc]
10120             set arcstart($a) $id
10121             set archeads($a) {}
10122             set arctags($a) {}
10123             set archeads($a) {}
10124             set arcids($a) {}
10125             lappend ao $a
10126             set growing($a) 1
10127             if {[info exists allparents($p)]} {
10128                 # seen it already, may need to make a new branch
10129                 if {![info exists arcout($p)]} {
10130                     splitarc $p
10131                 }
10132                 lappend arcids($a) $p
10133                 set arcend($a) $p
10134                 unset growing($a)
10135             }
10136             lappend arcnos($p) $a
10137         }
10138         set arcout($id) $ao
10139     }
10140     if {$nid > 0} {
10141         global cached_dheads cached_dtags cached_atags
10142         unset -nocomplain cached_dheads
10143         unset -nocomplain cached_dtags
10144         unset -nocomplain cached_atags
10145     }
10146     if {![eof $fd]} {
10147         return [expr {$nid >= 1000? 2: 1}]
10148     }
10149     set cacheok 1
10150     if {[catch {
10151         fconfigure $fd -blocking 1
10152         close $fd
10153     } err]} {
10154         # got an error reading the list of commits
10155         # if we were updating, try rereading the whole thing again
10156         if {$allcupdate} {
10157             incr allcommits -1
10158             dropcache $err
10159             return
10160         }
10161         error_popup "[mc "Error reading commit topology information;\
10162                 branch and preceding/following tag information\
10163                 will be incomplete."]\n($err)"
10164         set cacheok 0
10165     }
10166     if {[incr allcommits -1] == 0} {
10167         notbusy allcommits
10168         if {$cacheok} {
10169             run savecache
10170         }
10171     }
10172     dispneartags 0
10173     return 0
10174 }
10175
10176 proc recalcarc {a} {
10177     global arctags archeads arcids idtags idheads
10178
10179     set at {}
10180     set ah {}
10181     foreach id [lrange $arcids($a) 0 end-1] {
10182         if {[info exists idtags($id)]} {
10183             lappend at $id
10184         }
10185         if {[info exists idheads($id)]} {
10186             lappend ah $id
10187         }
10188     }
10189     set arctags($a) $at
10190     set archeads($a) $ah
10191 }
10192
10193 proc splitarc {p} {
10194     global arcnos arcids nextarc arctags archeads idtags idheads
10195     global arcstart arcend arcout allparents growing
10196
10197     set a $arcnos($p)
10198     if {[llength $a] != 1} {
10199         puts "oops splitarc called but [llength $a] arcs already"
10200         return
10201     }
10202     set a [lindex $a 0]
10203     set i [lsearch -exact $arcids($a) $p]
10204     if {$i < 0} {
10205         puts "oops splitarc $p not in arc $a"
10206         return
10207     }
10208     set na [incr nextarc]
10209     if {[info exists arcend($a)]} {
10210         set arcend($na) $arcend($a)
10211     } else {
10212         set l [lindex $allparents([lindex $arcids($a) end]) 0]
10213         set j [lsearch -exact $arcnos($l) $a]
10214         set arcnos($l) [lreplace $arcnos($l) $j $j $na]
10215     }
10216     set tail [lrange $arcids($a) [expr {$i+1}] end]
10217     set arcids($a) [lrange $arcids($a) 0 $i]
10218     set arcend($a) $p
10219     set arcstart($na) $p
10220     set arcout($p) $na
10221     set arcids($na) $tail
10222     if {[info exists growing($a)]} {
10223         set growing($na) 1
10224         unset growing($a)
10225     }
10226
10227     foreach id $tail {
10228         if {[llength $arcnos($id)] == 1} {
10229             set arcnos($id) $na
10230         } else {
10231             set j [lsearch -exact $arcnos($id) $a]
10232             set arcnos($id) [lreplace $arcnos($id) $j $j $na]
10233         }
10234     }
10235
10236     # reconstruct tags and heads lists
10237     if {$arctags($a) ne {} || $archeads($a) ne {}} {
10238         recalcarc $a
10239         recalcarc $na
10240     } else {
10241         set arctags($na) {}
10242         set archeads($na) {}
10243     }
10244 }
10245
10246 # Update things for a new commit added that is a child of one
10247 # existing commit.  Used when cherry-picking.
10248 proc addnewchild {id p} {
10249     global allparents allchildren idtags nextarc
10250     global arcnos arcids arctags arcout arcend arcstart archeads growing
10251     global seeds allcommits
10252
10253     if {![info exists allcommits] || ![info exists arcnos($p)]} return
10254     set allparents($id) [list $p]
10255     set allchildren($id) {}
10256     set arcnos($id) {}
10257     lappend seeds $id
10258     lappend allchildren($p) $id
10259     set a [incr nextarc]
10260     set arcstart($a) $id
10261     set archeads($a) {}
10262     set arctags($a) {}
10263     set arcids($a) [list $p]
10264     set arcend($a) $p
10265     if {![info exists arcout($p)]} {
10266         splitarc $p
10267     }
10268     lappend arcnos($p) $a
10269     set arcout($id) [list $a]
10270 }
10271
10272 # This implements a cache for the topology information.
10273 # The cache saves, for each arc, the start and end of the arc,
10274 # the ids on the arc, and the outgoing arcs from the end.
10275 proc readcache {f} {
10276     global arcnos arcids arcout arcstart arcend arctags archeads nextarc
10277     global idtags idheads allparents cachedarcs possible_seeds seeds growing
10278     global allcwait
10279
10280     set a $nextarc
10281     set lim $cachedarcs
10282     if {$lim - $a > 500} {
10283         set lim [expr {$a + 500}]
10284     }
10285     if {[catch {
10286         if {$a == $lim} {
10287             # finish reading the cache and setting up arctags, etc.
10288             set line [gets $f]
10289             if {$line ne "1"} {error "bad final version"}
10290             close $f
10291             foreach id [array names idtags] {
10292                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10293                     [llength $allparents($id)] == 1} {
10294                     set a [lindex $arcnos($id) 0]
10295                     if {$arctags($a) eq {}} {
10296                         recalcarc $a
10297                     }
10298                 }
10299             }
10300             foreach id [array names idheads] {
10301                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
10302                     [llength $allparents($id)] == 1} {
10303                     set a [lindex $arcnos($id) 0]
10304                     if {$archeads($a) eq {}} {
10305                         recalcarc $a
10306                     }
10307                 }
10308             }
10309             foreach id [lsort -unique $possible_seeds] {
10310                 if {$arcnos($id) eq {}} {
10311                     lappend seeds $id
10312                 }
10313             }
10314             set allcwait 0
10315         } else {
10316             while {[incr a] <= $lim} {
10317                 set line [gets $f]
10318                 if {[llength $line] != 3} {error "bad line"}
10319                 set s [lindex $line 0]
10320                 set arcstart($a) $s
10321                 lappend arcout($s) $a
10322                 if {![info exists arcnos($s)]} {
10323                     lappend possible_seeds $s
10324                     set arcnos($s) {}
10325                 }
10326                 set e [lindex $line 1]
10327                 if {$e eq {}} {
10328                     set growing($a) 1
10329                 } else {
10330                     set arcend($a) $e
10331                     if {![info exists arcout($e)]} {
10332                         set arcout($e) {}
10333                     }
10334                 }
10335                 set arcids($a) [lindex $line 2]
10336                 foreach id $arcids($a) {
10337                     lappend allparents($s) $id
10338                     set s $id
10339                     lappend arcnos($id) $a
10340                 }
10341                 if {![info exists allparents($s)]} {
10342                     set allparents($s) {}
10343                 }
10344                 set arctags($a) {}
10345                 set archeads($a) {}
10346             }
10347             set nextarc [expr {$a - 1}]
10348         }
10349     } err]} {
10350         dropcache $err
10351         return 0
10352     }
10353     if {!$allcwait} {
10354         getallcommits
10355     }
10356     return $allcwait
10357 }
10358
10359 proc getcache {f} {
10360     global nextarc cachedarcs possible_seeds
10361
10362     if {[catch {
10363         set line [gets $f]
10364         if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
10365         # make sure it's an integer
10366         set cachedarcs [expr {int([lindex $line 1])}]
10367         if {$cachedarcs < 0} {error "bad number of arcs"}
10368         set nextarc 0
10369         set possible_seeds {}
10370         run readcache $f
10371     } err]} {
10372         dropcache $err
10373     }
10374     return 0
10375 }
10376
10377 proc dropcache {err} {
10378     global allcwait nextarc cachedarcs seeds
10379
10380     #puts "dropping cache ($err)"
10381     foreach v {arcnos arcout arcids arcstart arcend growing \
10382                    arctags archeads allparents allchildren} {
10383         global $v
10384         unset -nocomplain $v
10385     }
10386     set allcwait 0
10387     set nextarc 0
10388     set cachedarcs 0
10389     set seeds {}
10390     getallcommits
10391 }
10392
10393 proc writecache {f} {
10394     global cachearc cachedarcs allccache
10395     global arcstart arcend arcnos arcids arcout
10396
10397     set a $cachearc
10398     set lim $cachedarcs
10399     if {$lim - $a > 1000} {
10400         set lim [expr {$a + 1000}]
10401     }
10402     if {[catch {
10403         while {[incr a] <= $lim} {
10404             if {[info exists arcend($a)]} {
10405                 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
10406             } else {
10407                 puts $f [list $arcstart($a) {} $arcids($a)]
10408             }
10409         }
10410     } err]} {
10411         catch {close $f}
10412         catch {file delete $allccache}
10413         #puts "writing cache failed ($err)"
10414         return 0
10415     }
10416     set cachearc [expr {$a - 1}]
10417     if {$a > $cachedarcs} {
10418         puts $f "1"
10419         close $f
10420         return 0
10421     }
10422     return 1
10423 }
10424
10425 proc savecache {} {
10426     global nextarc cachedarcs cachearc allccache
10427
10428     if {$nextarc == $cachedarcs} return
10429     set cachearc 0
10430     set cachedarcs $nextarc
10431     catch {
10432         set f [open $allccache w]
10433         puts $f [list 1 $cachedarcs]
10434         run writecache $f
10435     }
10436 }
10437
10438 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
10439 # or 0 if neither is true.
10440 proc anc_or_desc {a b} {
10441     global arcout arcstart arcend arcnos cached_isanc
10442
10443     if {$arcnos($a) eq $arcnos($b)} {
10444         # Both are on the same arc(s); either both are the same BMP,
10445         # or if one is not a BMP, the other is also not a BMP or is
10446         # the BMP at end of the arc (and it only has 1 incoming arc).
10447         # Or both can be BMPs with no incoming arcs.
10448         if {$a eq $b || $arcnos($a) eq {}} {
10449             return 0
10450         }
10451         # assert {[llength $arcnos($a)] == 1}
10452         set arc [lindex $arcnos($a) 0]
10453         set i [lsearch -exact $arcids($arc) $a]
10454         set j [lsearch -exact $arcids($arc) $b]
10455         if {$i < 0 || $i > $j} {
10456             return 1
10457         } else {
10458             return -1
10459         }
10460     }
10461
10462     if {![info exists arcout($a)]} {
10463         set arc [lindex $arcnos($a) 0]
10464         if {[info exists arcend($arc)]} {
10465             set aend $arcend($arc)
10466         } else {
10467             set aend {}
10468         }
10469         set a $arcstart($arc)
10470     } else {
10471         set aend $a
10472     }
10473     if {![info exists arcout($b)]} {
10474         set arc [lindex $arcnos($b) 0]
10475         if {[info exists arcend($arc)]} {
10476             set bend $arcend($arc)
10477         } else {
10478             set bend {}
10479         }
10480         set b $arcstart($arc)
10481     } else {
10482         set bend $b
10483     }
10484     if {$a eq $bend} {
10485         return 1
10486     }
10487     if {$b eq $aend} {
10488         return -1
10489     }
10490     if {[info exists cached_isanc($a,$bend)]} {
10491         if {$cached_isanc($a,$bend)} {
10492             return 1
10493         }
10494     }
10495     if {[info exists cached_isanc($b,$aend)]} {
10496         if {$cached_isanc($b,$aend)} {
10497             return -1
10498         }
10499         if {[info exists cached_isanc($a,$bend)]} {
10500             return 0
10501         }
10502     }
10503
10504     set todo [list $a $b]
10505     set anc($a) a
10506     set anc($b) b
10507     for {set i 0} {$i < [llength $todo]} {incr i} {
10508         set x [lindex $todo $i]
10509         if {$anc($x) eq {}} {
10510             continue
10511         }
10512         foreach arc $arcnos($x) {
10513             set xd $arcstart($arc)
10514             if {$xd eq $bend} {
10515                 set cached_isanc($a,$bend) 1
10516                 set cached_isanc($b,$aend) 0
10517                 return 1
10518             } elseif {$xd eq $aend} {
10519                 set cached_isanc($b,$aend) 1
10520                 set cached_isanc($a,$bend) 0
10521                 return -1
10522             }
10523             if {![info exists anc($xd)]} {
10524                 set anc($xd) $anc($x)
10525                 lappend todo $xd
10526             } elseif {$anc($xd) ne $anc($x)} {
10527                 set anc($xd) {}
10528             }
10529         }
10530     }
10531     set cached_isanc($a,$bend) 0
10532     set cached_isanc($b,$aend) 0
10533     return 0
10534 }
10535
10536 # This identifies whether $desc has an ancestor that is
10537 # a growing tip of the graph and which is not an ancestor of $anc
10538 # and returns 0 if so and 1 if not.
10539 # If we subsequently discover a tag on such a growing tip, and that
10540 # turns out to be a descendent of $anc (which it could, since we
10541 # don't necessarily see children before parents), then $desc
10542 # isn't a good choice to display as a descendent tag of
10543 # $anc (since it is the descendent of another tag which is
10544 # a descendent of $anc).  Similarly, $anc isn't a good choice to
10545 # display as a ancestor tag of $desc.
10546 #
10547 proc is_certain {desc anc} {
10548     global arcnos arcout arcstart arcend growing problems
10549
10550     set certain {}
10551     if {[llength $arcnos($anc)] == 1} {
10552         # tags on the same arc are certain
10553         if {$arcnos($desc) eq $arcnos($anc)} {
10554             return 1
10555         }
10556         if {![info exists arcout($anc)]} {
10557             # if $anc is partway along an arc, use the start of the arc instead
10558             set a [lindex $arcnos($anc) 0]
10559             set anc $arcstart($a)
10560         }
10561     }
10562     if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
10563         set x $desc
10564     } else {
10565         set a [lindex $arcnos($desc) 0]
10566         set x $arcend($a)
10567     }
10568     if {$x == $anc} {
10569         return 1
10570     }
10571     set anclist [list $x]
10572     set dl($x) 1
10573     set nnh 1
10574     set ngrowanc 0
10575     for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
10576         set x [lindex $anclist $i]
10577         if {$dl($x)} {
10578             incr nnh -1
10579         }
10580         set done($x) 1
10581         foreach a $arcout($x) {
10582             if {[info exists growing($a)]} {
10583                 if {![info exists growanc($x)] && $dl($x)} {
10584                     set growanc($x) 1
10585                     incr ngrowanc
10586                 }
10587             } else {
10588                 set y $arcend($a)
10589                 if {[info exists dl($y)]} {
10590                     if {$dl($y)} {
10591                         if {!$dl($x)} {
10592                             set dl($y) 0
10593                             if {![info exists done($y)]} {
10594                                 incr nnh -1
10595                             }
10596                             if {[info exists growanc($x)]} {
10597                                 incr ngrowanc -1
10598                             }
10599                             set xl [list $y]
10600                             for {set k 0} {$k < [llength $xl]} {incr k} {
10601                                 set z [lindex $xl $k]
10602                                 foreach c $arcout($z) {
10603                                     if {[info exists arcend($c)]} {
10604                                         set v $arcend($c)
10605                                         if {[info exists dl($v)] && $dl($v)} {
10606                                             set dl($v) 0
10607                                             if {![info exists done($v)]} {
10608                                                 incr nnh -1
10609                                             }
10610                                             if {[info exists growanc($v)]} {
10611                                                 incr ngrowanc -1
10612                                             }
10613                                             lappend xl $v
10614                                         }
10615                                     }
10616                                 }
10617                             }
10618                         }
10619                     }
10620                 } elseif {$y eq $anc || !$dl($x)} {
10621                     set dl($y) 0
10622                     lappend anclist $y
10623                 } else {
10624                     set dl($y) 1
10625                     lappend anclist $y
10626                     incr nnh
10627                 }
10628             }
10629         }
10630     }
10631     foreach x [array names growanc] {
10632         if {$dl($x)} {
10633             return 0
10634         }
10635         return 0
10636     }
10637     return 1
10638 }
10639
10640 proc validate_arctags {a} {
10641     global arctags idtags
10642
10643     set i -1
10644     set na $arctags($a)
10645     foreach id $arctags($a) {
10646         incr i
10647         if {![info exists idtags($id)]} {
10648             set na [lreplace $na $i $i]
10649             incr i -1
10650         }
10651     }
10652     set arctags($a) $na
10653 }
10654
10655 proc validate_archeads {a} {
10656     global archeads idheads
10657
10658     set i -1
10659     set na $archeads($a)
10660     foreach id $archeads($a) {
10661         incr i
10662         if {![info exists idheads($id)]} {
10663             set na [lreplace $na $i $i]
10664             incr i -1
10665         }
10666     }
10667     set archeads($a) $na
10668 }
10669
10670 # Return the list of IDs that have tags that are descendents of id,
10671 # ignoring IDs that are descendents of IDs already reported.
10672 proc desctags {id} {
10673     global arcnos arcstart arcids arctags idtags allparents
10674     global growing cached_dtags
10675
10676     if {![info exists allparents($id)]} {
10677         return {}
10678     }
10679     set t1 [clock clicks -milliseconds]
10680     set argid $id
10681     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10682         # part-way along an arc; check that arc first
10683         set a [lindex $arcnos($id) 0]
10684         if {$arctags($a) ne {}} {
10685             validate_arctags $a
10686             set i [lsearch -exact $arcids($a) $id]
10687             set tid {}
10688             foreach t $arctags($a) {
10689                 set j [lsearch -exact $arcids($a) $t]
10690                 if {$j >= $i} break
10691                 set tid $t
10692             }
10693             if {$tid ne {}} {
10694                 return $tid
10695             }
10696         }
10697         set id $arcstart($a)
10698         if {[info exists idtags($id)]} {
10699             return $id
10700         }
10701     }
10702     if {[info exists cached_dtags($id)]} {
10703         return $cached_dtags($id)
10704     }
10705
10706     set origid $id
10707     set todo [list $id]
10708     set queued($id) 1
10709     set nc 1
10710     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10711         set id [lindex $todo $i]
10712         set done($id) 1
10713         set ta [info exists hastaggedancestor($id)]
10714         if {!$ta} {
10715             incr nc -1
10716         }
10717         # ignore tags on starting node
10718         if {!$ta && $i > 0} {
10719             if {[info exists idtags($id)]} {
10720                 set tagloc($id) $id
10721                 set ta 1
10722             } elseif {[info exists cached_dtags($id)]} {
10723                 set tagloc($id) $cached_dtags($id)
10724                 set ta 1
10725             }
10726         }
10727         foreach a $arcnos($id) {
10728             set d $arcstart($a)
10729             if {!$ta && $arctags($a) ne {}} {
10730                 validate_arctags $a
10731                 if {$arctags($a) ne {}} {
10732                     lappend tagloc($id) [lindex $arctags($a) end]
10733                 }
10734             }
10735             if {$ta || $arctags($a) ne {}} {
10736                 set tomark [list $d]
10737                 for {set j 0} {$j < [llength $tomark]} {incr j} {
10738                     set dd [lindex $tomark $j]
10739                     if {![info exists hastaggedancestor($dd)]} {
10740                         if {[info exists done($dd)]} {
10741                             foreach b $arcnos($dd) {
10742                                 lappend tomark $arcstart($b)
10743                             }
10744                             if {[info exists tagloc($dd)]} {
10745                                 unset tagloc($dd)
10746                             }
10747                         } elseif {[info exists queued($dd)]} {
10748                             incr nc -1
10749                         }
10750                         set hastaggedancestor($dd) 1
10751                     }
10752                 }
10753             }
10754             if {![info exists queued($d)]} {
10755                 lappend todo $d
10756                 set queued($d) 1
10757                 if {![info exists hastaggedancestor($d)]} {
10758                     incr nc
10759                 }
10760             }
10761         }
10762     }
10763     set tags {}
10764     foreach id [array names tagloc] {
10765         if {![info exists hastaggedancestor($id)]} {
10766             foreach t $tagloc($id) {
10767                 if {[lsearch -exact $tags $t] < 0} {
10768                     lappend tags $t
10769                 }
10770             }
10771         }
10772     }
10773     set t2 [clock clicks -milliseconds]
10774     set loopix $i
10775
10776     # remove tags that are descendents of other tags
10777     for {set i 0} {$i < [llength $tags]} {incr i} {
10778         set a [lindex $tags $i]
10779         for {set j 0} {$j < $i} {incr j} {
10780             set b [lindex $tags $j]
10781             set r [anc_or_desc $a $b]
10782             if {$r == 1} {
10783                 set tags [lreplace $tags $j $j]
10784                 incr j -1
10785                 incr i -1
10786             } elseif {$r == -1} {
10787                 set tags [lreplace $tags $i $i]
10788                 incr i -1
10789                 break
10790             }
10791         }
10792     }
10793
10794     if {[array names growing] ne {}} {
10795         # graph isn't finished, need to check if any tag could get
10796         # eclipsed by another tag coming later.  Simply ignore any
10797         # tags that could later get eclipsed.
10798         set ctags {}
10799         foreach t $tags {
10800             if {[is_certain $t $origid]} {
10801                 lappend ctags $t
10802             }
10803         }
10804         if {$tags eq $ctags} {
10805             set cached_dtags($origid) $tags
10806         } else {
10807             set tags $ctags
10808         }
10809     } else {
10810         set cached_dtags($origid) $tags
10811     }
10812     set t3 [clock clicks -milliseconds]
10813     if {0 && $t3 - $t1 >= 100} {
10814         puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10815             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10816     }
10817     return $tags
10818 }
10819
10820 proc anctags {id} {
10821     global arcnos arcids arcout arcend arctags idtags allparents
10822     global growing cached_atags
10823
10824     if {![info exists allparents($id)]} {
10825         return {}
10826     }
10827     set t1 [clock clicks -milliseconds]
10828     set argid $id
10829     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10830         # part-way along an arc; check that arc first
10831         set a [lindex $arcnos($id) 0]
10832         if {$arctags($a) ne {}} {
10833             validate_arctags $a
10834             set i [lsearch -exact $arcids($a) $id]
10835             foreach t $arctags($a) {
10836                 set j [lsearch -exact $arcids($a) $t]
10837                 if {$j > $i} {
10838                     return $t
10839                 }
10840             }
10841         }
10842         if {![info exists arcend($a)]} {
10843             return {}
10844         }
10845         set id $arcend($a)
10846         if {[info exists idtags($id)]} {
10847             return $id
10848         }
10849     }
10850     if {[info exists cached_atags($id)]} {
10851         return $cached_atags($id)
10852     }
10853
10854     set origid $id
10855     set todo [list $id]
10856     set queued($id) 1
10857     set taglist {}
10858     set nc 1
10859     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10860         set id [lindex $todo $i]
10861         set done($id) 1
10862         set td [info exists hastaggeddescendent($id)]
10863         if {!$td} {
10864             incr nc -1
10865         }
10866         # ignore tags on starting node
10867         if {!$td && $i > 0} {
10868             if {[info exists idtags($id)]} {
10869                 set tagloc($id) $id
10870                 set td 1
10871             } elseif {[info exists cached_atags($id)]} {
10872                 set tagloc($id) $cached_atags($id)
10873                 set td 1
10874             }
10875         }
10876         foreach a $arcout($id) {
10877             if {!$td && $arctags($a) ne {}} {
10878                 validate_arctags $a
10879                 if {$arctags($a) ne {}} {
10880                     lappend tagloc($id) [lindex $arctags($a) 0]
10881                 }
10882             }
10883             if {![info exists arcend($a)]} continue
10884             set d $arcend($a)
10885             if {$td || $arctags($a) ne {}} {
10886                 set tomark [list $d]
10887                 for {set j 0} {$j < [llength $tomark]} {incr j} {
10888                     set dd [lindex $tomark $j]
10889                     if {![info exists hastaggeddescendent($dd)]} {
10890                         if {[info exists done($dd)]} {
10891                             foreach b $arcout($dd) {
10892                                 if {[info exists arcend($b)]} {
10893                                     lappend tomark $arcend($b)
10894                                 }
10895                             }
10896                             if {[info exists tagloc($dd)]} {
10897                                 unset tagloc($dd)
10898                             }
10899                         } elseif {[info exists queued($dd)]} {
10900                             incr nc -1
10901                         }
10902                         set hastaggeddescendent($dd) 1
10903                     }
10904                 }
10905             }
10906             if {![info exists queued($d)]} {
10907                 lappend todo $d
10908                 set queued($d) 1
10909                 if {![info exists hastaggeddescendent($d)]} {
10910                     incr nc
10911                 }
10912             }
10913         }
10914     }
10915     set t2 [clock clicks -milliseconds]
10916     set loopix $i
10917     set tags {}
10918     foreach id [array names tagloc] {
10919         if {![info exists hastaggeddescendent($id)]} {
10920             foreach t $tagloc($id) {
10921                 if {[lsearch -exact $tags $t] < 0} {
10922                     lappend tags $t
10923                 }
10924             }
10925         }
10926     }
10927
10928     # remove tags that are ancestors of other tags
10929     for {set i 0} {$i < [llength $tags]} {incr i} {
10930         set a [lindex $tags $i]
10931         for {set j 0} {$j < $i} {incr j} {
10932             set b [lindex $tags $j]
10933             set r [anc_or_desc $a $b]
10934             if {$r == -1} {
10935                 set tags [lreplace $tags $j $j]
10936                 incr j -1
10937                 incr i -1
10938             } elseif {$r == 1} {
10939                 set tags [lreplace $tags $i $i]
10940                 incr i -1
10941                 break
10942             }
10943         }
10944     }
10945
10946     if {[array names growing] ne {}} {
10947         # graph isn't finished, need to check if any tag could get
10948         # eclipsed by another tag coming later.  Simply ignore any
10949         # tags that could later get eclipsed.
10950         set ctags {}
10951         foreach t $tags {
10952             if {[is_certain $origid $t]} {
10953                 lappend ctags $t
10954             }
10955         }
10956         if {$tags eq $ctags} {
10957             set cached_atags($origid) $tags
10958         } else {
10959             set tags $ctags
10960         }
10961     } else {
10962         set cached_atags($origid) $tags
10963     }
10964     set t3 [clock clicks -milliseconds]
10965     if {0 && $t3 - $t1 >= 100} {
10966         puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
10967             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10968     }
10969     return $tags
10970 }
10971
10972 # Return the list of IDs that have heads that are descendents of id,
10973 # including id itself if it has a head.
10974 proc descheads {id} {
10975     global arcnos arcstart arcids archeads idheads cached_dheads
10976     global allparents arcout
10977
10978     if {![info exists allparents($id)]} {
10979         return {}
10980     }
10981     set aret {}
10982     if {![info exists arcout($id)]} {
10983         # part-way along an arc; check it first
10984         set a [lindex $arcnos($id) 0]
10985         if {$archeads($a) ne {}} {
10986             validate_archeads $a
10987             set i [lsearch -exact $arcids($a) $id]
10988             foreach t $archeads($a) {
10989                 set j [lsearch -exact $arcids($a) $t]
10990                 if {$j > $i} break
10991                 lappend aret $t
10992             }
10993         }
10994         set id $arcstart($a)
10995     }
10996     set origid $id
10997     set todo [list $id]
10998     set seen($id) 1
10999     set ret {}
11000     for {set i 0} {$i < [llength $todo]} {incr i} {
11001         set id [lindex $todo $i]
11002         if {[info exists cached_dheads($id)]} {
11003             set ret [concat $ret $cached_dheads($id)]
11004         } else {
11005             if {[info exists idheads($id)]} {
11006                 lappend ret $id
11007             }
11008             foreach a $arcnos($id) {
11009                 if {$archeads($a) ne {}} {
11010                     validate_archeads $a
11011                     if {$archeads($a) ne {}} {
11012                         set ret [concat $ret $archeads($a)]
11013                     }
11014                 }
11015                 set d $arcstart($a)
11016                 if {![info exists seen($d)]} {
11017                     lappend todo $d
11018                     set seen($d) 1
11019                 }
11020             }
11021         }
11022     }
11023     set ret [lsort -unique $ret]
11024     set cached_dheads($origid) $ret
11025     return [concat $ret $aret]
11026 }
11027
11028 proc addedtag {id} {
11029     global arcnos arcout cached_dtags cached_atags
11030
11031     if {![info exists arcnos($id)]} return
11032     if {![info exists arcout($id)]} {
11033         recalcarc [lindex $arcnos($id) 0]
11034     }
11035     unset -nocomplain cached_dtags
11036     unset -nocomplain cached_atags
11037 }
11038
11039 proc addedhead {hid head} {
11040     global arcnos arcout cached_dheads
11041
11042     if {![info exists arcnos($hid)]} return
11043     if {![info exists arcout($hid)]} {
11044         recalcarc [lindex $arcnos($hid) 0]
11045     }
11046     unset -nocomplain cached_dheads
11047 }
11048
11049 proc removedhead {hid head} {
11050     global cached_dheads
11051
11052     unset -nocomplain cached_dheads
11053 }
11054
11055 proc movedhead {hid head} {
11056     global arcnos arcout cached_dheads
11057
11058     if {![info exists arcnos($hid)]} return
11059     if {![info exists arcout($hid)]} {
11060         recalcarc [lindex $arcnos($hid) 0]
11061     }
11062     unset -nocomplain cached_dheads
11063 }
11064
11065 proc changedrefs {} {
11066     global cached_dheads cached_dtags cached_atags cached_tagcontent
11067     global arctags archeads arcnos arcout idheads idtags
11068
11069     foreach id [concat [array names idheads] [array names idtags]] {
11070         if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
11071             set a [lindex $arcnos($id) 0]
11072             if {![info exists donearc($a)]} {
11073                 recalcarc $a
11074                 set donearc($a) 1
11075             }
11076         }
11077     }
11078     unset -nocomplain cached_tagcontent
11079     unset -nocomplain cached_dtags
11080     unset -nocomplain cached_atags
11081     unset -nocomplain cached_dheads
11082 }
11083
11084 proc rereadrefs {} {
11085     global idtags idheads idotherrefs mainheadid
11086
11087     set refids [concat [array names idtags] \
11088                     [array names idheads] [array names idotherrefs]]
11089     foreach id $refids {
11090         if {![info exists ref($id)]} {
11091             set ref($id) [listrefs $id]
11092         }
11093     }
11094     set oldmainhead $mainheadid
11095     readrefs
11096     changedrefs
11097     set refids [lsort -unique [concat $refids [array names idtags] \
11098                         [array names idheads] [array names idotherrefs]]]
11099     foreach id $refids {
11100         set v [listrefs $id]
11101         if {![info exists ref($id)] || $ref($id) != $v} {
11102             redrawtags $id
11103         }
11104     }
11105     if {$oldmainhead ne $mainheadid} {
11106         redrawtags $oldmainhead
11107         redrawtags $mainheadid
11108     }
11109     run refill_reflist
11110 }
11111
11112 proc listrefs {id} {
11113     global idtags idheads idotherrefs
11114
11115     set x {}
11116     if {[info exists idtags($id)]} {
11117         set x $idtags($id)
11118     }
11119     set y {}
11120     if {[info exists idheads($id)]} {
11121         set y $idheads($id)
11122     }
11123     set z {}
11124     if {[info exists idotherrefs($id)]} {
11125         set z $idotherrefs($id)
11126     }
11127     return [list $x $y $z]
11128 }
11129
11130 proc add_tag_ctext {tag} {
11131     global ctext cached_tagcontent tagids
11132
11133     if {![info exists cached_tagcontent($tag)]} {
11134         catch {
11135             set cached_tagcontent($tag) [exec git cat-file -p $tag]
11136         }
11137     }
11138     $ctext insert end "[mc "Tag"]: $tag\n" bold
11139     if {[info exists cached_tagcontent($tag)]} {
11140         set text $cached_tagcontent($tag)
11141     } else {
11142         set text "[mc "Id"]:  $tagids($tag)"
11143     }
11144     appendwithlinks $text {}
11145 }
11146
11147 proc showtag {tag isnew} {
11148     global ctext cached_tagcontent tagids linknum tagobjid
11149
11150     if {$isnew} {
11151         addtohistory [list showtag $tag 0] savectextpos
11152     }
11153     $ctext conf -state normal
11154     clear_ctext
11155     settabs 0
11156     set linknum 0
11157     add_tag_ctext $tag
11158     maybe_scroll_ctext 1
11159     $ctext conf -state disabled
11160     init_flist {}
11161 }
11162
11163 proc showtags {id isnew} {
11164     global idtags ctext linknum
11165
11166     if {$isnew} {
11167         addtohistory [list showtags $id 0] savectextpos
11168     }
11169     $ctext conf -state normal
11170     clear_ctext
11171     settabs 0
11172     set linknum 0
11173     set sep {}
11174     foreach tag $idtags($id) {
11175         $ctext insert end $sep
11176         add_tag_ctext $tag
11177         set sep "\n\n"
11178     }
11179     maybe_scroll_ctext 1
11180     $ctext conf -state disabled
11181     init_flist {}
11182 }
11183
11184 proc doquit {} {
11185     global stopped
11186     global gitktmpdir
11187
11188     set stopped 100
11189     savestuff .
11190     destroy .
11191
11192     if {[info exists gitktmpdir]} {
11193         catch {file delete -force $gitktmpdir}
11194     }
11195 }
11196
11197 proc mkfontdisp {font top which} {
11198     global fontattr fontpref $font NS use_ttk
11199
11200     set fontpref($font) [set $font]
11201     ${NS}::button $top.${font}but -text $which \
11202         -command [list choosefont $font $which]
11203     ${NS}::label $top.$font -relief flat -font $font \
11204         -text $fontattr($font,family) -justify left
11205     grid x $top.${font}but $top.$font -sticky w
11206 }
11207
11208 proc choosefont {font which} {
11209     global fontparam fontlist fonttop fontattr
11210     global prefstop NS
11211
11212     set fontparam(which) $which
11213     set fontparam(font) $font
11214     set fontparam(family) [font actual $font -family]
11215     set fontparam(size) $fontattr($font,size)
11216     set fontparam(weight) $fontattr($font,weight)
11217     set fontparam(slant) $fontattr($font,slant)
11218     set top .gitkfont
11219     set fonttop $top
11220     if {![winfo exists $top]} {
11221         font create sample
11222         eval font config sample [font actual $font]
11223         ttk_toplevel $top
11224         make_transient $top $prefstop
11225         wm title $top [mc "Gitk font chooser"]
11226         ${NS}::label $top.l -textvariable fontparam(which)
11227         pack $top.l -side top
11228         set fontlist [lsort [font families]]
11229         ${NS}::frame $top.f
11230         listbox $top.f.fam -listvariable fontlist \
11231             -yscrollcommand [list $top.f.sb set]
11232         bind $top.f.fam <<ListboxSelect>> selfontfam
11233         ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
11234         pack $top.f.sb -side right -fill y
11235         pack $top.f.fam -side left -fill both -expand 1
11236         pack $top.f -side top -fill both -expand 1
11237         ${NS}::frame $top.g
11238         spinbox $top.g.size -from 4 -to 40 -width 4 \
11239             -textvariable fontparam(size) \
11240             -validatecommand {string is integer -strict %s}
11241         checkbutton $top.g.bold -padx 5 \
11242             -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
11243             -variable fontparam(weight) -onvalue bold -offvalue normal
11244         checkbutton $top.g.ital -padx 5 \
11245             -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
11246             -variable fontparam(slant) -onvalue italic -offvalue roman
11247         pack $top.g.size $top.g.bold $top.g.ital -side left
11248         pack $top.g -side top
11249         canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
11250             -background white
11251         $top.c create text 100 25 -anchor center -text $which -font sample \
11252             -fill black -tags text
11253         bind $top.c <Configure> [list centertext $top.c]
11254         pack $top.c -side top -fill x
11255         ${NS}::frame $top.buts
11256         ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
11257         ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
11258         bind $top <Key-Return> fontok
11259         bind $top <Key-Escape> fontcan
11260         grid $top.buts.ok $top.buts.can
11261         grid columnconfigure $top.buts 0 -weight 1 -uniform a
11262         grid columnconfigure $top.buts 1 -weight 1 -uniform a
11263         pack $top.buts -side bottom -fill x
11264         trace add variable fontparam write chg_fontparam
11265     } else {
11266         raise $top
11267         $top.c itemconf text -text $which
11268     }
11269     set i [lsearch -exact $fontlist $fontparam(family)]
11270     if {$i >= 0} {
11271         $top.f.fam selection set $i
11272         $top.f.fam see $i
11273     }
11274 }
11275
11276 proc centertext {w} {
11277     $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
11278 }
11279
11280 proc fontok {} {
11281     global fontparam fontpref prefstop
11282
11283     set f $fontparam(font)
11284     set fontpref($f) [list $fontparam(family) $fontparam(size)]
11285     if {$fontparam(weight) eq "bold"} {
11286         lappend fontpref($f) "bold"
11287     }
11288     if {$fontparam(slant) eq "italic"} {
11289         lappend fontpref($f) "italic"
11290     }
11291     set w $prefstop.notebook.fonts.$f
11292     $w conf -text $fontparam(family) -font $fontpref($f)
11293
11294     fontcan
11295 }
11296
11297 proc fontcan {} {
11298     global fonttop fontparam
11299
11300     if {[info exists fonttop]} {
11301         catch {destroy $fonttop}
11302         catch {font delete sample}
11303         unset fonttop
11304         unset fontparam
11305     }
11306 }
11307
11308 if {[package vsatisfies [package provide Tk] 8.6]} {
11309     # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
11310     # function to make use of it.
11311     proc choosefont {font which} {
11312         tk fontchooser configure -title $which -font $font \
11313             -command [list on_choosefont $font $which]
11314         tk fontchooser show
11315     }
11316     proc on_choosefont {font which newfont} {
11317         global fontparam
11318         puts stderr "$font $newfont"
11319         array set f [font actual $newfont]
11320         set fontparam(which) $which
11321         set fontparam(font) $font
11322         set fontparam(family) $f(-family)
11323         set fontparam(size) $f(-size)
11324         set fontparam(weight) $f(-weight)
11325         set fontparam(slant) $f(-slant)
11326         fontok
11327     }
11328 }
11329
11330 proc selfontfam {} {
11331     global fonttop fontparam
11332
11333     set i [$fonttop.f.fam curselection]
11334     if {$i ne {}} {
11335         set fontparam(family) [$fonttop.f.fam get $i]
11336     }
11337 }
11338
11339 proc chg_fontparam {v sub op} {
11340     global fontparam
11341
11342     font config sample -$sub $fontparam($sub)
11343 }
11344
11345 # Create a property sheet tab page
11346 proc create_prefs_page {w} {
11347     global NS
11348     set parent [join [lrange [split $w .] 0 end-1] .]
11349     if {[winfo class $parent] eq "TNotebook"} {
11350         ${NS}::frame $w
11351     } else {
11352         ${NS}::labelframe $w
11353     }
11354 }
11355
11356 proc prefspage_general {notebook} {
11357     global NS maxwidth maxgraphpct showneartags showlocalchanges
11358     global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11359     global hideremotes want_ttk have_ttk maxrefs
11360
11361     set page [create_prefs_page $notebook.general]
11362
11363     ${NS}::label $page.ldisp -text [mc "Commit list display options"]
11364     grid $page.ldisp - -sticky w -pady 10
11365     ${NS}::label $page.spacer -text " "
11366     ${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
11367     spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
11368     grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w
11369                                          #xgettext:no-tcl-format
11370     ${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
11371     spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
11372     grid x $page.maxpctl $page.maxpct -sticky w
11373     ${NS}::checkbutton $page.showlocal -text [mc "Show local changes"] \
11374         -variable showlocalchanges
11375     grid x $page.showlocal -sticky w
11376     ${NS}::checkbutton $page.autoselect -text [mc "Auto-select SHA1 (length)"] \
11377         -variable autoselect
11378     spinbox $page.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
11379     grid x $page.autoselect $page.autosellen -sticky w
11380     ${NS}::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \
11381         -variable hideremotes
11382     grid x $page.hideremotes -sticky w
11383
11384     ${NS}::label $page.ddisp -text [mc "Diff display options"]
11385     grid $page.ddisp - -sticky w -pady 10
11386     ${NS}::label $page.tabstopl -text [mc "Tab spacing"]
11387     spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
11388     grid x $page.tabstopl $page.tabstop -sticky w
11389     ${NS}::checkbutton $page.ntag -text [mc "Display nearby tags/heads"] \
11390         -variable showneartags
11391     grid x $page.ntag -sticky w
11392     ${NS}::label $page.maxrefsl -text [mc "Maximum # tags/heads to show"]
11393     spinbox $page.maxrefs -from 1 -to 1000 -width 4 -textvariable maxrefs
11394     grid x $page.maxrefsl $page.maxrefs -sticky w
11395     ${NS}::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \
11396         -variable limitdiffs
11397     grid x $page.ldiff -sticky w
11398     ${NS}::checkbutton $page.lattr -text [mc "Support per-file encodings"] \
11399         -variable perfile_attrs
11400     grid x $page.lattr -sticky w
11401
11402     ${NS}::entry $page.extdifft -textvariable extdifftool
11403     ${NS}::frame $page.extdifff
11404     ${NS}::label $page.extdifff.l -text [mc "External diff tool" ]
11405     ${NS}::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff
11406     pack $page.extdifff.l $page.extdifff.b -side left
11407     pack configure $page.extdifff.l -padx 10
11408     grid x $page.extdifff $page.extdifft -sticky ew
11409
11410     ${NS}::label $page.lgen -text [mc "General options"]
11411     grid $page.lgen - -sticky w -pady 10
11412     ${NS}::checkbutton $page.want_ttk -variable want_ttk \
11413         -text [mc "Use themed widgets"]
11414     if {$have_ttk} {
11415         ${NS}::label $page.ttk_note -text [mc "(change requires restart)"]
11416     } else {
11417         ${NS}::label $page.ttk_note -text [mc "(currently unavailable)"]
11418     }
11419     grid x $page.want_ttk $page.ttk_note -sticky w
11420     return $page
11421 }
11422
11423 proc prefspage_colors {notebook} {
11424     global NS uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11425
11426     set page [create_prefs_page $notebook.colors]
11427
11428     ${NS}::label $page.cdisp -text [mc "Colors: press to choose"]
11429     grid $page.cdisp - -sticky w -pady 10
11430     label $page.ui -padx 40 -relief sunk -background $uicolor
11431     ${NS}::button $page.uibut -text [mc "Interface"] \
11432        -command [list choosecolor uicolor {} $page.ui [mc "interface"] setui]
11433     grid x $page.uibut $page.ui -sticky w
11434     label $page.bg -padx 40 -relief sunk -background $bgcolor
11435     ${NS}::button $page.bgbut -text [mc "Background"] \
11436         -command [list choosecolor bgcolor {} $page.bg [mc "background"] setbg]
11437     grid x $page.bgbut $page.bg -sticky w
11438     label $page.fg -padx 40 -relief sunk -background $fgcolor
11439     ${NS}::button $page.fgbut -text [mc "Foreground"] \
11440         -command [list choosecolor fgcolor {} $page.fg [mc "foreground"] setfg]
11441     grid x $page.fgbut $page.fg -sticky w
11442     label $page.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
11443     ${NS}::button $page.diffoldbut -text [mc "Diff: old lines"] \
11444         -command [list choosecolor diffcolors 0 $page.diffold [mc "diff old lines"] \
11445                       [list $ctext tag conf d0 -foreground]]
11446     grid x $page.diffoldbut $page.diffold -sticky w
11447     label $page.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
11448     ${NS}::button $page.diffnewbut -text [mc "Diff: new lines"] \
11449         -command [list choosecolor diffcolors 1 $page.diffnew [mc "diff new lines"] \
11450                       [list $ctext tag conf dresult -foreground]]
11451     grid x $page.diffnewbut $page.diffnew -sticky w
11452     label $page.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
11453     ${NS}::button $page.hunksepbut -text [mc "Diff: hunk header"] \
11454         -command [list choosecolor diffcolors 2 $page.hunksep \
11455                       [mc "diff hunk header"] \
11456                       [list $ctext tag conf hunksep -foreground]]
11457     grid x $page.hunksepbut $page.hunksep -sticky w
11458     label $page.markbgsep -padx 40 -relief sunk -background $markbgcolor
11459     ${NS}::button $page.markbgbut -text [mc "Marked line bg"] \
11460         -command [list choosecolor markbgcolor {} $page.markbgsep \
11461                       [mc "marked line background"] \
11462                       [list $ctext tag conf omark -background]]
11463     grid x $page.markbgbut $page.markbgsep -sticky w
11464     label $page.selbgsep -padx 40 -relief sunk -background $selectbgcolor
11465     ${NS}::button $page.selbgbut -text [mc "Select bg"] \
11466         -command [list choosecolor selectbgcolor {} $page.selbgsep [mc "background"] setselbg]
11467     grid x $page.selbgbut $page.selbgsep -sticky w
11468     return $page
11469 }
11470
11471 proc prefspage_fonts {notebook} {
11472     global NS
11473     set page [create_prefs_page $notebook.fonts]
11474     ${NS}::label $page.cfont -text [mc "Fonts: press to choose"]
11475     grid $page.cfont - -sticky w -pady 10
11476     mkfontdisp mainfont $page [mc "Main font"]
11477     mkfontdisp textfont $page [mc "Diff display font"]
11478     mkfontdisp uifont $page [mc "User interface font"]
11479     return $page
11480 }
11481
11482 proc doprefs {} {
11483     global maxwidth maxgraphpct use_ttk NS
11484     global oldprefs prefstop showneartags showlocalchanges
11485     global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
11486     global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
11487     global hideremotes want_ttk have_ttk
11488
11489     set top .gitkprefs
11490     set prefstop $top
11491     if {[winfo exists $top]} {
11492         raise $top
11493         return
11494     }
11495     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11496                    limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11497         set oldprefs($v) [set $v]
11498     }
11499     ttk_toplevel $top
11500     wm title $top [mc "Gitk preferences"]
11501     make_transient $top .
11502
11503     if {[set use_notebook [expr {$use_ttk && [info command ::ttk::notebook] ne ""}]]} {
11504         set notebook [ttk::notebook $top.notebook]
11505     } else {
11506         set notebook [${NS}::frame $top.notebook -borderwidth 0 -relief flat]
11507     }
11508
11509     lappend pages [prefspage_general $notebook] [mc "General"]
11510     lappend pages [prefspage_colors $notebook] [mc "Colors"]
11511     lappend pages [prefspage_fonts $notebook] [mc "Fonts"]
11512     set col 0
11513     foreach {page title} $pages {
11514         if {$use_notebook} {
11515             $notebook add $page -text $title
11516         } else {
11517             set btn [${NS}::button $notebook.b_[string map {. X} $page] \
11518                          -text $title -command [list raise $page]]
11519             $page configure -text $title
11520             grid $btn -row 0 -column [incr col] -sticky w
11521             grid $page -row 1 -column 0 -sticky news -columnspan 100
11522         }
11523     }
11524
11525     if {!$use_notebook} {
11526         grid columnconfigure $notebook 0 -weight 1
11527         grid rowconfigure $notebook 1 -weight 1
11528         raise [lindex $pages 0]
11529     }
11530
11531     grid $notebook -sticky news -padx 2 -pady 2
11532     grid rowconfigure $top 0 -weight 1
11533     grid columnconfigure $top 0 -weight 1
11534
11535     ${NS}::frame $top.buts
11536     ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
11537     ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
11538     bind $top <Key-Return> prefsok
11539     bind $top <Key-Escape> prefscan
11540     grid $top.buts.ok $top.buts.can
11541     grid columnconfigure $top.buts 0 -weight 1 -uniform a
11542     grid columnconfigure $top.buts 1 -weight 1 -uniform a
11543     grid $top.buts - - -pady 10 -sticky ew
11544     grid columnconfigure $top 2 -weight 1
11545     bind $top <Visibility> [list focus $top.buts.ok]
11546 }
11547
11548 proc choose_extdiff {} {
11549     global extdifftool
11550
11551     set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
11552     if {$prog ne {}} {
11553         set extdifftool $prog
11554     }
11555 }
11556
11557 proc choosecolor {v vi w x cmd} {
11558     global $v
11559
11560     set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
11561                -title [mc "Gitk: choose color for %s" $x]]
11562     if {$c eq {}} return
11563     $w conf -background $c
11564     lset $v $vi $c
11565     eval $cmd $c
11566 }
11567
11568 proc setselbg {c} {
11569     global bglist cflist
11570     foreach w $bglist {
11571         if {[winfo exists $w]} {
11572             $w configure -selectbackground $c
11573         }
11574     }
11575     $cflist tag configure highlight \
11576         -background [$cflist cget -selectbackground]
11577     allcanvs itemconf secsel -fill $c
11578 }
11579
11580 # This sets the background color and the color scheme for the whole UI.
11581 # For some reason, tk_setPalette chooses a nasty dark red for selectColor
11582 # if we don't specify one ourselves, which makes the checkbuttons and
11583 # radiobuttons look bad.  This chooses white for selectColor if the
11584 # background color is light, or black if it is dark.
11585 proc setui {c} {
11586     if {[tk windowingsystem] eq "win32"} { return }
11587     set bg [winfo rgb . $c]
11588     set selc black
11589     if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
11590         set selc white
11591     }
11592     tk_setPalette background $c selectColor $selc
11593 }
11594
11595 proc setbg {c} {
11596     global bglist
11597
11598     foreach w $bglist {
11599         if {[winfo exists $w]} {
11600             $w conf -background $c
11601         }
11602     }
11603 }
11604
11605 proc setfg {c} {
11606     global fglist canv
11607
11608     foreach w $fglist {
11609         if {[winfo exists $w]} {
11610             $w conf -foreground $c
11611         }
11612     }
11613     allcanvs itemconf text -fill $c
11614     $canv itemconf circle -outline $c
11615     $canv itemconf markid -outline $c
11616 }
11617
11618 proc prefscan {} {
11619     global oldprefs prefstop
11620
11621     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11622                    limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11623         global $v
11624         set $v $oldprefs($v)
11625     }
11626     catch {destroy $prefstop}
11627     unset prefstop
11628     fontcan
11629 }
11630
11631 proc prefsok {} {
11632     global maxwidth maxgraphpct
11633     global oldprefs prefstop showneartags showlocalchanges
11634     global fontpref mainfont textfont uifont
11635     global limitdiffs treediffs perfile_attrs
11636     global hideremotes
11637
11638     catch {destroy $prefstop}
11639     unset prefstop
11640     fontcan
11641     set fontchanged 0
11642     if {$mainfont ne $fontpref(mainfont)} {
11643         set mainfont $fontpref(mainfont)
11644         parsefont mainfont $mainfont
11645         eval font configure mainfont [fontflags mainfont]
11646         eval font configure mainfontbold [fontflags mainfont 1]
11647         setcoords
11648         set fontchanged 1
11649     }
11650     if {$textfont ne $fontpref(textfont)} {
11651         set textfont $fontpref(textfont)
11652         parsefont textfont $textfont
11653         eval font configure textfont [fontflags textfont]
11654         eval font configure textfontbold [fontflags textfont 1]
11655     }
11656     if {$uifont ne $fontpref(uifont)} {
11657         set uifont $fontpref(uifont)
11658         parsefont uifont $uifont
11659         eval font configure uifont [fontflags uifont]
11660     }
11661     settabs
11662     if {$showlocalchanges != $oldprefs(showlocalchanges)} {
11663         if {$showlocalchanges} {
11664             doshowlocalchanges
11665         } else {
11666             dohidelocalchanges
11667         }
11668     }
11669     if {$limitdiffs != $oldprefs(limitdiffs) ||
11670         ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11671         # treediffs elements are limited by path;
11672         # won't have encodings cached if perfile_attrs was just turned on
11673         unset -nocomplain treediffs
11674     }
11675     if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
11676         || $maxgraphpct != $oldprefs(maxgraphpct)} {
11677         redisplay
11678     } elseif {$showneartags != $oldprefs(showneartags) ||
11679           $limitdiffs != $oldprefs(limitdiffs)} {
11680         reselectline
11681     }
11682     if {$hideremotes != $oldprefs(hideremotes)} {
11683         rereadrefs
11684     }
11685 }
11686
11687 proc formatdate {d} {
11688     global datetimeformat
11689     if {$d ne {}} {
11690         # If $datetimeformat includes a timezone, display in the
11691         # timezone of the argument.  Otherwise, display in local time.
11692         if {[string match {*%[zZ]*} $datetimeformat]} {
11693             if {[catch {set d [clock format [lindex $d 0] -timezone [lindex $d 1] -format $datetimeformat]}]} {
11694                 # Tcl < 8.5 does not support -timezone.  Emulate it by
11695                 # setting TZ (e.g. TZ=<-0430>+04:30).
11696                 global env
11697                 if {[info exists env(TZ)]} {
11698                     set savedTZ $env(TZ)
11699                 }
11700                 set zone [lindex $d 1]
11701                 set sign [string map {+ - - +} [string index $zone 0]]
11702                 set env(TZ) <$zone>$sign[string range $zone 1 2]:[string range $zone 3 4]
11703                 set d [clock format [lindex $d 0] -format $datetimeformat]
11704                 if {[info exists savedTZ]} {
11705                     set env(TZ) $savedTZ
11706                 } else {
11707                     unset env(TZ)
11708                 }
11709             }
11710         } else {
11711             set d [clock format [lindex $d 0] -format $datetimeformat]
11712         }
11713     }
11714     return $d
11715 }
11716
11717 # This list of encoding names and aliases is distilled from
11718 # http://www.iana.org/assignments/character-sets.
11719 # Not all of them are supported by Tcl.
11720 set encoding_aliases {
11721     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11722       ISO646-US US-ASCII us IBM367 cp367 csASCII }
11723     { ISO-10646-UTF-1 csISO10646UTF1 }
11724     { ISO_646.basic:1983 ref csISO646basic1983 }
11725     { INVARIANT csINVARIANT }
11726     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11727     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11728     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11729     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11730     { NATS-DANO iso-ir-9-1 csNATSDANO }
11731     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11732     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11733     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11734     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11735     { ISO-2022-KR csISO2022KR }
11736     { EUC-KR csEUCKR }
11737     { ISO-2022-JP csISO2022JP }
11738     { ISO-2022-JP-2 csISO2022JP2 }
11739     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11740       csISO13JISC6220jp }
11741     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11742     { IT iso-ir-15 ISO646-IT csISO15Italian }
11743     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11744     { ES iso-ir-17 ISO646-ES csISO17Spanish }
11745     { greek7-old iso-ir-18 csISO18Greek7Old }
11746     { latin-greek iso-ir-19 csISO19LatinGreek }
11747     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11748     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11749     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11750     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11751     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11752     { BS_viewdata iso-ir-47 csISO47BSViewdata }
11753     { INIS iso-ir-49 csISO49INIS }
11754     { INIS-8 iso-ir-50 csISO50INIS8 }
11755     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11756     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11757     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11758     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11759     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11760     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11761       csISO60Norwegian1 }
11762     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11763     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11764     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11765     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11766     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11767     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11768     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11769     { greek7 iso-ir-88 csISO88Greek7 }
11770     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11771     { iso-ir-90 csISO90 }
11772     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11773     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11774       csISO92JISC62991984b }
11775     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11776     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11777     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11778       csISO95JIS62291984handadd }
11779     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11780     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11781     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11782     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11783       CP819 csISOLatin1 }
11784     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11785     { T.61-7bit iso-ir-102 csISO102T617bit }
11786     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11787     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
11788     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
11789     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
11790     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
11791     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
11792     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
11793     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
11794       arabic csISOLatinArabic }
11795     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
11796     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
11797     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
11798       greek greek8 csISOLatinGreek }
11799     { T.101-G2 iso-ir-128 csISO128T101G2 }
11800     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
11801       csISOLatinHebrew }
11802     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
11803     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
11804     { CSN_369103 iso-ir-139 csISO139CSN369103 }
11805     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
11806     { ISO_6937-2-add iso-ir-142 csISOTextComm }
11807     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
11808     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
11809       csISOLatinCyrillic }
11810     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
11811     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
11812     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
11813     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
11814     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
11815     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
11816     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
11817     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
11818     { ISO_10367-box iso-ir-155 csISO10367Box }
11819     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
11820     { latin-lap lap iso-ir-158 csISO158Lap }
11821     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
11822     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
11823     { us-dk csUSDK }
11824     { dk-us csDKUS }
11825     { JIS_X0201 X0201 csHalfWidthKatakana }
11826     { KSC5636 ISO646-KR csKSC5636 }
11827     { ISO-10646-UCS-2 csUnicode }
11828     { ISO-10646-UCS-4 csUCS4 }
11829     { DEC-MCS dec csDECMCS }
11830     { hp-roman8 roman8 r8 csHPRoman8 }
11831     { macintosh mac csMacintosh }
11832     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
11833       csIBM037 }
11834     { IBM038 EBCDIC-INT cp038 csIBM038 }
11835     { IBM273 CP273 csIBM273 }
11836     { IBM274 EBCDIC-BE CP274 csIBM274 }
11837     { IBM275 EBCDIC-BR cp275 csIBM275 }
11838     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
11839     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
11840     { IBM280 CP280 ebcdic-cp-it csIBM280 }
11841     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
11842     { IBM284 CP284 ebcdic-cp-es csIBM284 }
11843     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
11844     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
11845     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
11846     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
11847     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
11848     { IBM424 cp424 ebcdic-cp-he csIBM424 }
11849     { IBM437 cp437 437 csPC8CodePage437 }
11850     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
11851     { IBM775 cp775 csPC775Baltic }
11852     { IBM850 cp850 850 csPC850Multilingual }
11853     { IBM851 cp851 851 csIBM851 }
11854     { IBM852 cp852 852 csPCp852 }
11855     { IBM855 cp855 855 csIBM855 }
11856     { IBM857 cp857 857 csIBM857 }
11857     { IBM860 cp860 860 csIBM860 }
11858     { IBM861 cp861 861 cp-is csIBM861 }
11859     { IBM862 cp862 862 csPC862LatinHebrew }
11860     { IBM863 cp863 863 csIBM863 }
11861     { IBM864 cp864 csIBM864 }
11862     { IBM865 cp865 865 csIBM865 }
11863     { IBM866 cp866 866 csIBM866 }
11864     { IBM868 CP868 cp-ar csIBM868 }
11865     { IBM869 cp869 869 cp-gr csIBM869 }
11866     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
11867     { IBM871 CP871 ebcdic-cp-is csIBM871 }
11868     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
11869     { IBM891 cp891 csIBM891 }
11870     { IBM903 cp903 csIBM903 }
11871     { IBM904 cp904 904 csIBBM904 }
11872     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
11873     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
11874     { IBM1026 CP1026 csIBM1026 }
11875     { EBCDIC-AT-DE csIBMEBCDICATDE }
11876     { EBCDIC-AT-DE-A csEBCDICATDEA }
11877     { EBCDIC-CA-FR csEBCDICCAFR }
11878     { EBCDIC-DK-NO csEBCDICDKNO }
11879     { EBCDIC-DK-NO-A csEBCDICDKNOA }
11880     { EBCDIC-FI-SE csEBCDICFISE }
11881     { EBCDIC-FI-SE-A csEBCDICFISEA }
11882     { EBCDIC-FR csEBCDICFR }
11883     { EBCDIC-IT csEBCDICIT }
11884     { EBCDIC-PT csEBCDICPT }
11885     { EBCDIC-ES csEBCDICES }
11886     { EBCDIC-ES-A csEBCDICESA }
11887     { EBCDIC-ES-S csEBCDICESS }
11888     { EBCDIC-UK csEBCDICUK }
11889     { EBCDIC-US csEBCDICUS }
11890     { UNKNOWN-8BIT csUnknown8BiT }
11891     { MNEMONIC csMnemonic }
11892     { MNEM csMnem }
11893     { VISCII csVISCII }
11894     { VIQR csVIQR }
11895     { KOI8-R csKOI8R }
11896     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
11897     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
11898     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
11899     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
11900     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
11901     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
11902     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
11903     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
11904     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
11905     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
11906     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
11907     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
11908     { IBM1047 IBM-1047 }
11909     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
11910     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
11911     { UNICODE-1-1 csUnicode11 }
11912     { CESU-8 csCESU-8 }
11913     { BOCU-1 csBOCU-1 }
11914     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
11915     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
11916       l8 }
11917     { ISO-8859-15 ISO_8859-15 Latin-9 }
11918     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
11919     { GBK CP936 MS936 windows-936 }
11920     { JIS_Encoding csJISEncoding }
11921     { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
11922     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
11923       EUC-JP }
11924     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
11925     { ISO-10646-UCS-Basic csUnicodeASCII }
11926     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
11927     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
11928     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
11929     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
11930     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
11931     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
11932     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
11933     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
11934     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
11935     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
11936     { Adobe-Standard-Encoding csAdobeStandardEncoding }
11937     { Ventura-US csVenturaUS }
11938     { Ventura-International csVenturaInternational }
11939     { PC8-Danish-Norwegian csPC8DanishNorwegian }
11940     { PC8-Turkish csPC8Turkish }
11941     { IBM-Symbols csIBMSymbols }
11942     { IBM-Thai csIBMThai }
11943     { HP-Legal csHPLegal }
11944     { HP-Pi-font csHPPiFont }
11945     { HP-Math8 csHPMath8 }
11946     { Adobe-Symbol-Encoding csHPPSMath }
11947     { HP-DeskTop csHPDesktop }
11948     { Ventura-Math csVenturaMath }
11949     { Microsoft-Publishing csMicrosoftPublishing }
11950     { Windows-31J csWindows31J }
11951     { GB2312 csGB2312 }
11952     { Big5 csBig5 }
11953 }
11954
11955 proc tcl_encoding {enc} {
11956     global encoding_aliases tcl_encoding_cache
11957     if {[info exists tcl_encoding_cache($enc)]} {
11958         return $tcl_encoding_cache($enc)
11959     }
11960     set names [encoding names]
11961     set lcnames [string tolower $names]
11962     set enc [string tolower $enc]
11963     set i [lsearch -exact $lcnames $enc]
11964     if {$i < 0} {
11965         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
11966         if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
11967             set i [lsearch -exact $lcnames $encx]
11968         }
11969     }
11970     if {$i < 0} {
11971         foreach l $encoding_aliases {
11972             set ll [string tolower $l]
11973             if {[lsearch -exact $ll $enc] < 0} continue
11974             # look through the aliases for one that tcl knows about
11975             foreach e $ll {
11976                 set i [lsearch -exact $lcnames $e]
11977                 if {$i < 0} {
11978                     if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
11979                         set i [lsearch -exact $lcnames $ex]
11980                     }
11981                 }
11982                 if {$i >= 0} break
11983             }
11984             break
11985         }
11986     }
11987     set tclenc {}
11988     if {$i >= 0} {
11989         set tclenc [lindex $names $i]
11990     }
11991     set tcl_encoding_cache($enc) $tclenc
11992     return $tclenc
11993 }
11994
11995 proc gitattr {path attr default} {
11996     global path_attr_cache
11997     if {[info exists path_attr_cache($attr,$path)]} {
11998         set r $path_attr_cache($attr,$path)
11999     } else {
12000         set r "unspecified"
12001         if {![catch {set line [exec git check-attr $attr -- $path]}]} {
12002             regexp "(.*): $attr: (.*)" $line m f r
12003         }
12004         set path_attr_cache($attr,$path) $r
12005     }
12006     if {$r eq "unspecified"} {
12007         return $default
12008     }
12009     return $r
12010 }
12011
12012 proc cache_gitattr {attr pathlist} {
12013     global path_attr_cache
12014     set newlist {}
12015     foreach path $pathlist {
12016         if {![info exists path_attr_cache($attr,$path)]} {
12017             lappend newlist $path
12018         }
12019     }
12020     set lim 1000
12021     if {[tk windowingsystem] == "win32"} {
12022         # windows has a 32k limit on the arguments to a command...
12023         set lim 30
12024     }
12025     while {$newlist ne {}} {
12026         set head [lrange $newlist 0 [expr {$lim - 1}]]
12027         set newlist [lrange $newlist $lim end]
12028         if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
12029             foreach row [split $rlist "\n"] {
12030                 if {[regexp "(.*): $attr: (.*)" $row m path value]} {
12031                     if {[string index $path 0] eq "\""} {
12032                         set path [encoding convertfrom [lindex $path 0]]
12033                     }
12034                     set path_attr_cache($attr,$path) $value
12035                 }
12036             }
12037         }
12038     }
12039 }
12040
12041 proc get_path_encoding {path} {
12042     global gui_encoding perfile_attrs
12043     set tcl_enc $gui_encoding
12044     if {$path ne {} && $perfile_attrs} {
12045         set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
12046         if {$enc2 ne {}} {
12047             set tcl_enc $enc2
12048         }
12049     }
12050     return $tcl_enc
12051 }
12052
12053 ## For msgcat loading, first locate the installation location.
12054 if { [info exists ::env(GITK_MSGSDIR)] } {
12055     ## Msgsdir was manually set in the environment.
12056     set gitk_msgsdir $::env(GITK_MSGSDIR)
12057 } else {
12058     ## Let's guess the prefix from argv0.
12059     set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
12060     set gitk_libdir [file join $gitk_prefix share gitk lib]
12061     set gitk_msgsdir [file join $gitk_libdir msgs]
12062     unset gitk_prefix
12063 }
12064
12065 ## Internationalization (i18n) through msgcat and gettext. See
12066 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
12067 package require msgcat
12068 namespace import ::msgcat::mc
12069 ## And eventually load the actual message catalog
12070 ::msgcat::mcload $gitk_msgsdir
12071
12072 # First check that Tcl/Tk is recent enough
12073 if {[catch {package require Tk 8.4} err]} {
12074     show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
12075                          Gitk requires at least Tcl/Tk 8.4."]
12076     exit 1
12077 }
12078
12079 # on OSX bring the current Wish process window to front
12080 if {[tk windowingsystem] eq "aqua"} {
12081     exec osascript -e [format {
12082         tell application "System Events"
12083             set frontmost of processes whose unix id is %d to true
12084         end tell
12085     } [pid] ]
12086 }
12087
12088 # Unset GIT_TRACE var if set
12089 if { [info exists ::env(GIT_TRACE)] } {
12090     unset ::env(GIT_TRACE)
12091 }
12092
12093 # defaults...
12094 set wrcomcmd "git diff-tree --stdin -p --pretty=email"
12095
12096 set gitencoding {}
12097 catch {
12098     set gitencoding [exec git config --get i18n.commitencoding]
12099 }
12100 catch {
12101     set gitencoding [exec git config --get i18n.logoutputencoding]
12102 }
12103 if {$gitencoding == ""} {
12104     set gitencoding "utf-8"
12105 }
12106 set tclencoding [tcl_encoding $gitencoding]
12107 if {$tclencoding == {}} {
12108     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
12109 }
12110
12111 set gui_encoding [encoding system]
12112 catch {
12113     set enc [exec git config --get gui.encoding]
12114     if {$enc ne {}} {
12115         set tclenc [tcl_encoding $enc]
12116         if {$tclenc ne {}} {
12117             set gui_encoding $tclenc
12118         } else {
12119             puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
12120         }
12121     }
12122 }
12123
12124 set log_showroot true
12125 catch {
12126     set log_showroot [exec git config --bool --get log.showroot]
12127 }
12128
12129 if {[tk windowingsystem] eq "aqua"} {
12130     set mainfont {{Lucida Grande} 9}
12131     set textfont {Monaco 9}
12132     set uifont {{Lucida Grande} 9 bold}
12133 } elseif {![catch {::tk::pkgconfig get fontsystem} xft] && $xft eq "xft"} {
12134     # fontconfig!
12135     set mainfont {sans 9}
12136     set textfont {monospace 9}
12137     set uifont {sans 9 bold}
12138 } else {
12139     set mainfont {Helvetica 9}
12140     set textfont {Courier 9}
12141     set uifont {Helvetica 9 bold}
12142 }
12143 set tabstop 8
12144 set findmergefiles 0
12145 set maxgraphpct 50
12146 set maxwidth 16
12147 set revlistorder 0
12148 set fastdate 0
12149 set uparrowlen 5
12150 set downarrowlen 5
12151 set mingaplen 100
12152 set cmitmode "patch"
12153 set wrapcomment "none"
12154 set showneartags 1
12155 set hideremotes 0
12156 set maxrefs 20
12157 set visiblerefs {"master"}
12158 set maxlinelen 200
12159 set showlocalchanges 1
12160 set limitdiffs 1
12161 set datetimeformat "%Y-%m-%d %H:%M:%S"
12162 set autoselect 1
12163 set autosellen 40
12164 set perfile_attrs 0
12165 set want_ttk 1
12166
12167 if {[tk windowingsystem] eq "aqua"} {
12168     set extdifftool "opendiff"
12169 } else {
12170     set extdifftool "meld"
12171 }
12172
12173 set colors {green red blue magenta darkgrey brown orange}
12174 if {[tk windowingsystem] eq "win32"} {
12175     set uicolor SystemButtonFace
12176     set uifgcolor SystemButtonText
12177     set uifgdisabledcolor SystemDisabledText
12178     set bgcolor SystemWindow
12179     set fgcolor SystemWindowText
12180     set selectbgcolor SystemHighlight
12181 } else {
12182     set uicolor grey85
12183     set uifgcolor black
12184     set uifgdisabledcolor "#999"
12185     set bgcolor white
12186     set fgcolor black
12187     set selectbgcolor gray85
12188 }
12189 set diffcolors {red "#00a000" blue}
12190 set diffcontext 3
12191 set mergecolors {red blue green purple brown "#009090" magenta "#808000" "#009000" "#ff0080" cyan "#b07070" "#70b0f0" "#70f0b0" "#f0b070" "#ff70b0"}
12192 set ignorespace 0
12193 set worddiff ""
12194 set markbgcolor "#e0e0ff"
12195
12196 set headbgcolor green
12197 set headfgcolor black
12198 set headoutlinecolor black
12199 set remotebgcolor #ffddaa
12200 set tagbgcolor yellow
12201 set tagfgcolor black
12202 set tagoutlinecolor black
12203 set reflinecolor black
12204 set filesepbgcolor #aaaaaa
12205 set filesepfgcolor black
12206 set linehoverbgcolor #ffff80
12207 set linehoverfgcolor black
12208 set linehoveroutlinecolor black
12209 set mainheadcirclecolor yellow
12210 set workingfilescirclecolor red
12211 set indexcirclecolor green
12212 set circlecolors {white blue gray blue blue}
12213 set linkfgcolor blue
12214 set circleoutlinecolor $fgcolor
12215 set foundbgcolor yellow
12216 set currentsearchhitbgcolor orange
12217
12218 # button for popping up context menus
12219 if {[tk windowingsystem] eq "aqua"} {
12220     set ctxbut <Button-2>
12221 } else {
12222     set ctxbut <Button-3>
12223 }
12224
12225 catch {
12226     # follow the XDG base directory specification by default. See
12227     # http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html
12228     if {[info exists env(XDG_CONFIG_HOME)] && $env(XDG_CONFIG_HOME) ne ""} {
12229         # XDG_CONFIG_HOME environment variable is set
12230         set config_file [file join $env(XDG_CONFIG_HOME) git gitk]
12231         set config_file_tmp [file join $env(XDG_CONFIG_HOME) git gitk-tmp]
12232     } else {
12233         # default XDG_CONFIG_HOME
12234         set config_file "~/.config/git/gitk"
12235         set config_file_tmp "~/.config/git/gitk-tmp"
12236     }
12237     if {![file exists $config_file]} {
12238         # for backward compatibility use the old config file if it exists
12239         if {[file exists "~/.gitk"]} {
12240             set config_file "~/.gitk"
12241             set config_file_tmp "~/.gitk-tmp"
12242         } elseif {![file exists [file dirname $config_file]]} {
12243             file mkdir [file dirname $config_file]
12244         }
12245     }
12246     source $config_file
12247 }
12248 config_check_tmp_exists 50
12249
12250 set config_variables {
12251     mainfont textfont uifont tabstop findmergefiles maxgraphpct maxwidth
12252     cmitmode wrapcomment autoselect autosellen showneartags maxrefs visiblerefs
12253     hideremotes showlocalchanges datetimeformat limitdiffs uicolor want_ttk
12254     bgcolor fgcolor uifgcolor uifgdisabledcolor colors diffcolors mergecolors
12255     markbgcolor diffcontext selectbgcolor foundbgcolor currentsearchhitbgcolor
12256     extdifftool perfile_attrs headbgcolor headfgcolor headoutlinecolor
12257     remotebgcolor tagbgcolor tagfgcolor tagoutlinecolor reflinecolor
12258     filesepbgcolor filesepfgcolor linehoverbgcolor linehoverfgcolor
12259     linehoveroutlinecolor mainheadcirclecolor workingfilescirclecolor
12260     indexcirclecolor circlecolors linkfgcolor circleoutlinecolor
12261 }
12262 foreach var $config_variables {
12263     config_init_trace $var
12264     trace add variable $var write config_variable_change_cb
12265 }
12266
12267 parsefont mainfont $mainfont
12268 eval font create mainfont [fontflags mainfont]
12269 eval font create mainfontbold [fontflags mainfont 1]
12270
12271 parsefont textfont $textfont
12272 eval font create textfont [fontflags textfont]
12273 eval font create textfontbold [fontflags textfont 1]
12274
12275 parsefont uifont $uifont
12276 eval font create uifont [fontflags uifont]
12277
12278 setui $uicolor
12279
12280 setoptions
12281
12282 # check that we can find a .git directory somewhere...
12283 if {[catch {set gitdir [exec git rev-parse --git-dir]}]} {
12284     show_error {} . [mc "Cannot find a git repository here."]
12285     exit 1
12286 }
12287
12288 set selecthead {}
12289 set selectheadid {}
12290
12291 set revtreeargs {}
12292 set cmdline_files {}
12293 set i 0
12294 set revtreeargscmd {}
12295 foreach arg $argv {
12296     switch -glob -- $arg {
12297         "" { }
12298         "--" {
12299             set cmdline_files [lrange $argv [expr {$i + 1}] end]
12300             break
12301         }
12302         "--select-commit=*" {
12303             set selecthead [string range $arg 16 end]
12304         }
12305         "--argscmd=*" {
12306             set revtreeargscmd [string range $arg 10 end]
12307         }
12308         default {
12309             lappend revtreeargs $arg
12310         }
12311     }
12312     incr i
12313 }
12314
12315 if {$selecthead eq "HEAD"} {
12316     set selecthead {}
12317 }
12318
12319 if {$i >= [llength $argv] && $revtreeargs ne {}} {
12320     # no -- on command line, but some arguments (other than --argscmd)
12321     if {[catch {
12322         set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
12323         set cmdline_files [split $f "\n"]
12324         set n [llength $cmdline_files]
12325         set revtreeargs [lrange $revtreeargs 0 end-$n]
12326         # Unfortunately git rev-parse doesn't produce an error when
12327         # something is both a revision and a filename.  To be consistent
12328         # with git log and git rev-list, check revtreeargs for filenames.
12329         foreach arg $revtreeargs {
12330             if {[file exists $arg]} {
12331                 show_error {} . [mc "Ambiguous argument '%s': both revision\
12332                                  and filename" $arg]
12333                 exit 1
12334             }
12335         }
12336     } err]} {
12337         # unfortunately we get both stdout and stderr in $err,
12338         # so look for "fatal:".
12339         set i [string first "fatal:" $err]
12340         if {$i > 0} {
12341             set err [string range $err [expr {$i + 6}] end]
12342         }
12343         show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
12344         exit 1
12345     }
12346 }
12347
12348 set nullid "0000000000000000000000000000000000000000"
12349 set nullid2 "0000000000000000000000000000000000000001"
12350 set nullfile "/dev/null"
12351
12352 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
12353 if {![info exists have_ttk]} {
12354     set have_ttk [llength [info commands ::ttk::style]]
12355 }
12356 set use_ttk [expr {$have_ttk && $want_ttk}]
12357 set NS [expr {$use_ttk ? "ttk" : ""}]
12358
12359 regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
12360
12361 set show_notes {}
12362 if {[package vcompare $git_version "1.6.6.2"] >= 0} {
12363     set show_notes "--show-notes"
12364 }
12365
12366 set appname "gitk"
12367
12368 set runq {}
12369 set history {}
12370 set historyindex 0
12371 set fh_serial 0
12372 set nhl_names {}
12373 set highlight_paths {}
12374 set findpattern {}
12375 set searchdirn -forwards
12376 set boldids {}
12377 set boldnameids {}
12378 set diffelide {0 0}
12379 set markingmatches 0
12380 set linkentercount 0
12381 set need_redisplay 0
12382 set nrows_drawn 0
12383 set firsttabstop 0
12384
12385 set nextviewnum 1
12386 set curview 0
12387 set selectedview 0
12388 set selectedhlview [mc "None"]
12389 set highlight_related [mc "None"]
12390 set highlight_files {}
12391 set viewfiles(0) {}
12392 set viewperm(0) 0
12393 set viewchanged(0) 0
12394 set viewargs(0) {}
12395 set viewargscmd(0) {}
12396
12397 set selectedline {}
12398 set numcommits 0
12399 set loginstance 0
12400 set cmdlineok 0
12401 set stopped 0
12402 set stuffsaved 0
12403 set patchnum 0
12404 set lserial 0
12405 set hasworktree [hasworktree]
12406 set cdup {}
12407 if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} {
12408     set cdup [exec git rev-parse --show-cdup]
12409 }
12410 set worktree [exec git rev-parse --show-toplevel]
12411 setcoords
12412 makewindow
12413 catch {
12414     image create photo gitlogo      -width 16 -height 16
12415
12416     image create photo gitlogominus -width  4 -height  2
12417     gitlogominus put #C00000 -to 0 0 4 2
12418     gitlogo copy gitlogominus -to  1 5
12419     gitlogo copy gitlogominus -to  6 5
12420     gitlogo copy gitlogominus -to 11 5
12421     image delete gitlogominus
12422
12423     image create photo gitlogoplus  -width  4 -height  4
12424     gitlogoplus  put #008000 -to 1 0 3 4
12425     gitlogoplus  put #008000 -to 0 1 4 3
12426     gitlogo copy gitlogoplus  -to  1 9
12427     gitlogo copy gitlogoplus  -to  6 9
12428     gitlogo copy gitlogoplus  -to 11 9
12429     image delete gitlogoplus
12430
12431     image create photo gitlogo32    -width 32 -height 32
12432     gitlogo32 copy gitlogo -zoom 2 2
12433
12434     wm iconphoto . -default gitlogo gitlogo32
12435 }
12436 # wait for the window to become visible
12437 tkwait visibility .
12438 set_window_title
12439 update
12440 readrefs
12441
12442 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
12443     # create a view for the files/dirs specified on the command line
12444     set curview 1
12445     set selectedview 1
12446     set nextviewnum 2
12447     set viewname(1) [mc "Command line"]
12448     set viewfiles(1) $cmdline_files
12449     set viewargs(1) $revtreeargs
12450     set viewargscmd(1) $revtreeargscmd
12451     set viewperm(1) 0
12452     set viewchanged(1) 0
12453     set vdatemode(1) 0
12454     addviewmenu 1
12455     .bar.view entryconf [mca "Edit view..."] -state normal
12456     .bar.view entryconf [mca "Delete view"] -state normal
12457 }
12458
12459 if {[info exists permviews]} {
12460     foreach v $permviews {
12461         set n $nextviewnum
12462         incr nextviewnum
12463         set viewname($n) [lindex $v 0]
12464         set viewfiles($n) [lindex $v 1]
12465         set viewargs($n) [lindex $v 2]
12466         set viewargscmd($n) [lindex $v 3]
12467         set viewperm($n) 1
12468         set viewchanged($n) 0
12469         addviewmenu $n
12470     }
12471 }
12472
12473 if {[tk windowingsystem] eq "win32"} {
12474     focus -force .
12475 }
12476
12477 getcommits {}
12478
12479 # Local variables:
12480 # mode: tcl
12481 # indent-tabs-mode: t
12482 # tab-width: 8
12483 # End: