git.oblomov.eu Git - git/blob - gitk-git/gitk

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