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