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