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