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 Date] [mc Committer] [mc CDate] [mc Comments]]
4663     foreach f $info ty $fldtypes {
4664         if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
4665             [doesmatch $f]} {
4666             if {$ty eq [mc "Author"]} {
4667                 set isbold 2
4668                 break
4669             }
4670             set isbold 1
4671         }
4672     }
4673     if {$isbold && [info exists iddrawn($id)]} {
4674         if {![ishighlighted $id]} {
4675             bolden $id mainfontbold
4676             if {$isbold > 1} {
4677                 bolden_name $id mainfontbold
4678             }
4679         }
4680         if {$markingmatches} {
4681             markrowmatches $row $id
4682         }
4683     }
4684     set nhighlights($id) $isbold
4685 }
4686
4687 proc markrowmatches {row id} {
4688     global canv canv2 linehtag linentag commitinfo findloc
4689
4690     set headline [lindex $commitinfo($id) 0]
4691     set author [lindex $commitinfo($id) 1]
4692     $canv delete match$row
4693     $canv2 delete match$row
4694     if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} {
4695         set m [findmatches $headline]
4696         if {$m ne {}} {
4697             markmatches $canv $row $headline $linehtag($id) $m \
4698                 [$canv itemcget $linehtag($id) -font] $row
4699         }
4700     }
4701     if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} {
4702         set m [findmatches $author]
4703         if {$m ne {}} {
4704             markmatches $canv2 $row $author $linentag($id) $m \
4705                 [$canv2 itemcget $linentag($id) -font] $row
4706         }
4707     }
4708 }
4709
4710 proc vrel_change {name ix op} {
4711     global highlight_related
4712
4713     rhighlight_none
4714     if {$highlight_related ne [mc "None"]} {
4715         run drawvisible
4716     }
4717 }
4718
4719 # prepare for testing whether commits are descendents or ancestors of a
4720 proc rhighlight_sel {a} {
4721     global descendent desc_todo ancestor anc_todo
4722     global highlight_related
4723
4724     catch {unset descendent}
4725     set desc_todo [list $a]
4726     catch {unset ancestor}
4727     set anc_todo [list $a]
4728     if {$highlight_related ne [mc "None"]} {
4729         rhighlight_none
4730         run drawvisible
4731     }
4732 }
4733
4734 proc rhighlight_none {} {
4735     global rhighlights
4736
4737     catch {unset rhighlights}
4738     unbolden
4739 }
4740
4741 proc is_descendent {a} {
4742     global curview children descendent desc_todo
4743
4744     set v $curview
4745     set la [rowofcommit $a]
4746     set todo $desc_todo
4747     set leftover {}
4748     set done 0
4749     for {set i 0} {$i < [llength $todo]} {incr i} {
4750         set do [lindex $todo $i]
4751         if {[rowofcommit $do] < $la} {
4752             lappend leftover $do
4753             continue
4754         }
4755         foreach nk $children($v,$do) {
4756             if {![info exists descendent($nk)]} {
4757                 set descendent($nk) 1
4758                 lappend todo $nk
4759                 if {$nk eq $a} {
4760                     set done 1
4761                 }
4762             }
4763         }
4764         if {$done} {
4765             set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4766             return
4767         }
4768     }
4769     set descendent($a) 0
4770     set desc_todo $leftover
4771 }
4772
4773 proc is_ancestor {a} {
4774     global curview parents ancestor anc_todo
4775
4776     set v $curview
4777     set la [rowofcommit $a]
4778     set todo $anc_todo
4779     set leftover {}
4780     set done 0
4781     for {set i 0} {$i < [llength $todo]} {incr i} {
4782         set do [lindex $todo $i]
4783         if {![commitinview $do $v] || [rowofcommit $do] > $la} {
4784             lappend leftover $do
4785             continue
4786         }
4787         foreach np $parents($v,$do) {
4788             if {![info exists ancestor($np)]} {
4789                 set ancestor($np) 1
4790                 lappend todo $np
4791                 if {$np eq $a} {
4792                     set done 1
4793                 }
4794             }
4795         }
4796         if {$done} {
4797             set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
4798             return
4799         }
4800     }
4801     set ancestor($a) 0
4802     set anc_todo $leftover
4803 }
4804
4805 proc askrelhighlight {row id} {
4806     global descendent highlight_related iddrawn rhighlights
4807     global selectedline ancestor
4808
4809     if {$selectedline eq {}} return
4810     set isbold 0
4811     if {$highlight_related eq [mc "Descendant"] ||
4812         $highlight_related eq [mc "Not descendant"]} {
4813         if {![info exists descendent($id)]} {
4814             is_descendent $id
4815         }
4816         if {$descendent($id) == ($highlight_related eq [mc "Descendant"])} {
4817             set isbold 1
4818         }
4819     } elseif {$highlight_related eq [mc "Ancestor"] ||
4820               $highlight_related eq [mc "Not ancestor"]} {
4821         if {![info exists ancestor($id)]} {
4822             is_ancestor $id
4823         }
4824         if {$ancestor($id) == ($highlight_related eq [mc "Ancestor"])} {
4825             set isbold 1
4826         }
4827     }
4828     if {[info exists iddrawn($id)]} {
4829         if {$isbold && ![ishighlighted $id]} {
4830             bolden $id mainfontbold
4831         }
4832     }
4833     set rhighlights($id) $isbold
4834 }
4835
4836 # Graph layout functions
4837
4838 proc shortids {ids} {
4839     set res {}
4840     foreach id $ids {
4841         if {[llength $id] > 1} {
4842             lappend res [shortids $id]
4843         } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
4844             lappend res [string range $id 0 7]
4845         } else {
4846             lappend res $id
4847         }
4848     }
4849     return $res
4850 }
4851
4852 proc ntimes {n o} {
4853     set ret {}
4854     set o [list $o]
4855     for {set mask 1} {$mask <= $n} {incr mask $mask} {
4856         if {($n & $mask) != 0} {
4857             set ret [concat $ret $o]
4858         }
4859         set o [concat $o $o]
4860     }
4861     return $ret
4862 }
4863
4864 proc ordertoken {id} {
4865     global ordertok curview varcid varcstart varctok curview parents children
4866     global nullid nullid2
4867
4868     if {[info exists ordertok($id)]} {
4869         return $ordertok($id)
4870     }
4871     set origid $id
4872     set todo {}
4873     while {1} {
4874         if {[info exists varcid($curview,$id)]} {
4875             set a $varcid($curview,$id)
4876             set p [lindex $varcstart($curview) $a]
4877         } else {
4878             set p [lindex $children($curview,$id) 0]
4879         }
4880         if {[info exists ordertok($p)]} {
4881             set tok $ordertok($p)
4882             break
4883         }
4884         set id [first_real_child $curview,$p]
4885         if {$id eq {}} {
4886             # it's a root
4887             set tok [lindex $varctok($curview) $varcid($curview,$p)]
4888             break
4889         }
4890         if {[llength $parents($curview,$id)] == 1} {
4891             lappend todo [list $p {}]
4892         } else {
4893             set j [lsearch -exact $parents($curview,$id) $p]
4894             if {$j < 0} {
4895                 puts "oops didn't find [shortids $p] in parents of [shortids $id]"
4896             }
4897             lappend todo [list $p [strrep $j]]
4898         }
4899     }
4900     for {set i [llength $todo]} {[incr i -1] >= 0} {} {
4901         set p [lindex $todo $i 0]
4902         append tok [lindex $todo $i 1]
4903         set ordertok($p) $tok
4904     }
4905     set ordertok($origid) $tok
4906     return $tok
4907 }
4908
4909 # Work out where id should go in idlist so that order-token
4910 # values increase from left to right
4911 proc idcol {idlist id {i 0}} {
4912     set t [ordertoken $id]
4913     if {$i < 0} {
4914         set i 0
4915     }
4916     if {$i >= [llength $idlist] || $t < [ordertoken [lindex $idlist $i]]} {
4917         if {$i > [llength $idlist]} {
4918             set i [llength $idlist]
4919         }
4920         while {[incr i -1] >= 0 && $t < [ordertoken [lindex $idlist $i]]} {}
4921         incr i
4922     } else {
4923         if {$t > [ordertoken [lindex $idlist $i]]} {
4924             while {[incr i] < [llength $idlist] &&
4925                    $t >= [ordertoken [lindex $idlist $i]]} {}
4926         }
4927     }
4928     return $i
4929 }
4930
4931 proc initlayout {} {
4932     global rowidlist rowisopt rowfinal displayorder parentlist
4933     global numcommits canvxmax canv
4934     global nextcolor
4935     global colormap rowtextx
4936
4937     set numcommits 0
4938     set displayorder {}
4939     set parentlist {}
4940     set nextcolor 0
4941     set rowidlist {}
4942     set rowisopt {}
4943     set rowfinal {}
4944     set canvxmax [$canv cget -width]
4945     catch {unset colormap}
4946     catch {unset rowtextx}
4947     setcanvscroll
4948 }
4949
4950 proc setcanvscroll {} {
4951     global canv canv2 canv3 numcommits linespc canvxmax canvy0
4952     global lastscrollset lastscrollrows
4953
4954     set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
4955     $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
4956     $canv2 conf -scrollregion [list 0 0 0 $ymax]
4957     $canv3 conf -scrollregion [list 0 0 0 $ymax]
4958     set lastscrollset [clock clicks -milliseconds]
4959     set lastscrollrows $numcommits
4960 }
4961
4962 proc visiblerows {} {
4963     global canv numcommits linespc
4964
4965     set ymax [lindex [$canv cget -scrollregion] 3]
4966     if {$ymax eq {} || $ymax == 0} return
4967     set f [$canv yview]
4968     set y0 [expr {int([lindex $f 0] * $ymax)}]
4969     set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
4970     if {$r0 < 0} {
4971         set r0 0
4972     }
4973     set y1 [expr {int([lindex $f 1] * $ymax)}]
4974     set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
4975     if {$r1 >= $numcommits} {
4976         set r1 [expr {$numcommits - 1}]
4977     }
4978     return [list $r0 $r1]
4979 }
4980
4981 proc layoutmore {} {
4982     global commitidx viewcomplete curview
4983     global numcommits pending_select curview
4984     global lastscrollset lastscrollrows
4985
4986     if {$lastscrollrows < 100 || $viewcomplete($curview) ||
4987         [clock clicks -milliseconds] - $lastscrollset > 500} {
4988         setcanvscroll
4989     }
4990     if {[info exists pending_select] &&
4991         [commitinview $pending_select $curview]} {
4992         update
4993         selectline [rowofcommit $pending_select] 1
4994     }
4995     drawvisible
4996 }
4997
4998 # With path limiting, we mightn't get the actual HEAD commit,
4999 # so ask git rev-list what is the first ancestor of HEAD that
5000 # touches a file in the path limit.
5001 proc get_viewmainhead {view} {
5002     global viewmainheadid vfilelimit viewinstances mainheadid
5003
5004     catch {
5005         set rfd [open [concat | git rev-list -1 $mainheadid \
5006                            -- $vfilelimit($view)] r]
5007         set j [reg_instance $rfd]
5008         lappend viewinstances($view) $j
5009         fconfigure $rfd -blocking 0
5010         filerun $rfd [list getviewhead $rfd $j $view]
5011         set viewmainheadid($curview) {}
5012     }
5013 }
5014
5015 # git rev-list should give us just 1 line to use as viewmainheadid($view)
5016 proc getviewhead {fd inst view} {
5017     global viewmainheadid commfd curview viewinstances showlocalchanges
5018
5019     set id {}
5020     if {[gets $fd line] < 0} {
5021         if {![eof $fd]} {
5022             return 1
5023         }
5024     } elseif {[string length $line] == 40 && [string is xdigit $line]} {
5025         set id $line
5026     }
5027     set viewmainheadid($view) $id
5028     close $fd
5029     unset commfd($inst)
5030     set i [lsearch -exact $viewinstances($view) $inst]
5031     if {$i >= 0} {
5032         set viewinstances($view) [lreplace $viewinstances($view) $i $i]
5033     }
5034     if {$showlocalchanges && $id ne {} && $view == $curview} {
5035         doshowlocalchanges
5036     }
5037     return 0
5038 }
5039
5040 proc doshowlocalchanges {} {
5041     global curview viewmainheadid
5042
5043     if {$viewmainheadid($curview) eq {}} return
5044     if {[commitinview $viewmainheadid($curview) $curview]} {
5045         dodiffindex
5046     } else {
5047         interestedin $viewmainheadid($curview) dodiffindex
5048     }
5049 }
5050
5051 proc dohidelocalchanges {} {
5052     global nullid nullid2 lserial curview
5053
5054     if {[commitinview $nullid $curview]} {
5055         removefakerow $nullid
5056     }
5057     if {[commitinview $nullid2 $curview]} {
5058         removefakerow $nullid2
5059     }
5060     incr lserial
5061 }
5062
5063 # spawn off a process to do git diff-index --cached HEAD
5064 proc dodiffindex {} {
5065     global lserial showlocalchanges vfilelimit curview
5066     global hasworktree
5067
5068     if {!$showlocalchanges || !$hasworktree} return
5069     incr lserial
5070     set cmd "|git diff-index --cached HEAD"
5071     if {$vfilelimit($curview) ne {}} {
5072         set cmd [concat $cmd -- $vfilelimit($curview)]
5073     }
5074     set fd [open $cmd r]
5075     fconfigure $fd -blocking 0
5076     set i [reg_instance $fd]
5077     filerun $fd [list readdiffindex $fd $lserial $i]
5078 }
5079
5080 proc readdiffindex {fd serial inst} {
5081     global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial
5082     global vfilelimit
5083
5084     set isdiff 1
5085     if {[gets $fd line] < 0} {
5086         if {![eof $fd]} {
5087             return 1
5088         }
5089         set isdiff 0
5090     }
5091     # we only need to see one line and we don't really care what it says...
5092     stop_instance $inst
5093
5094     if {$serial != $lserial} {
5095         return 0
5096     }
5097
5098     # now see if there are any local changes not checked in to the index
5099     set cmd "|git diff-files"
5100     if {$vfilelimit($curview) ne {}} {
5101         set cmd [concat $cmd -- $vfilelimit($curview)]
5102     }
5103     set fd [open $cmd r]
5104     fconfigure $fd -blocking 0
5105     set i [reg_instance $fd]
5106     filerun $fd [list readdifffiles $fd $serial $i]
5107
5108     if {$isdiff && ![commitinview $nullid2 $curview]} {
5109         # add the line for the changes in the index to the graph
5110         set hl [mc "Local changes checked in to index but not committed"]
5111         set commitinfo($nullid2) [list  $hl {} {} {} {} "    $hl\n"]
5112         set commitdata($nullid2) "\n    $hl\n"
5113         if {[commitinview $nullid $curview]} {
5114             removefakerow $nullid
5115         }
5116         insertfakerow $nullid2 $viewmainheadid($curview)
5117     } elseif {!$isdiff && [commitinview $nullid2 $curview]} {
5118         if {[commitinview $nullid $curview]} {
5119             removefakerow $nullid
5120         }
5121         removefakerow $nullid2
5122     }
5123     return 0
5124 }
5125
5126 proc readdifffiles {fd serial inst} {
5127     global viewmainheadid nullid nullid2 curview
5128     global commitinfo commitdata lserial
5129
5130     set isdiff 1
5131     if {[gets $fd line] < 0} {
5132         if {![eof $fd]} {
5133             return 1
5134         }
5135         set isdiff 0
5136     }
5137     # we only need to see one line and we don't really care what it says...
5138     stop_instance $inst
5139
5140     if {$serial != $lserial} {
5141         return 0
5142     }
5143
5144     if {$isdiff && ![commitinview $nullid $curview]} {
5145         # add the line for the local diff to the graph
5146         set hl [mc "Local uncommitted changes, not checked in to index"]
5147         set commitinfo($nullid) [list  $hl {} {} {} {} "    $hl\n"]
5148         set commitdata($nullid) "\n    $hl\n"
5149         if {[commitinview $nullid2 $curview]} {
5150             set p $nullid2
5151         } else {
5152             set p $viewmainheadid($curview)
5153         }
5154         insertfakerow $nullid $p
5155     } elseif {!$isdiff && [commitinview $nullid $curview]} {
5156         removefakerow $nullid
5157     }
5158     return 0
5159 }
5160
5161 proc nextuse {id row} {
5162     global curview children
5163
5164     if {[info exists children($curview,$id)]} {
5165         foreach kid $children($curview,$id) {
5166             if {![commitinview $kid $curview]} {
5167                 return -1
5168             }
5169             if {[rowofcommit $kid] > $row} {
5170                 return [rowofcommit $kid]
5171             }
5172         }
5173     }
5174     if {[commitinview $id $curview]} {
5175         return [rowofcommit $id]
5176     }
5177     return -1
5178 }
5179
5180 proc prevuse {id row} {
5181     global curview children
5182
5183     set ret -1
5184     if {[info exists children($curview,$id)]} {
5185         foreach kid $children($curview,$id) {
5186             if {![commitinview $kid $curview]} break
5187             if {[rowofcommit $kid] < $row} {
5188                 set ret [rowofcommit $kid]
5189             }
5190         }
5191     }
5192     return $ret
5193 }
5194
5195 proc make_idlist {row} {
5196     global displayorder parentlist uparrowlen downarrowlen mingaplen
5197     global commitidx curview children
5198
5199     set r [expr {$row - $mingaplen - $downarrowlen - 1}]
5200     if {$r < 0} {
5201         set r 0
5202     }
5203     set ra [expr {$row - $downarrowlen}]
5204     if {$ra < 0} {
5205         set ra 0
5206     }
5207     set rb [expr {$row + $uparrowlen}]
5208     if {$rb > $commitidx($curview)} {
5209         set rb $commitidx($curview)
5210     }
5211     make_disporder $r [expr {$rb + 1}]
5212     set ids {}
5213     for {} {$r < $ra} {incr r} {
5214         set nextid [lindex $displayorder [expr {$r + 1}]]
5215         foreach p [lindex $parentlist $r] {
5216             if {$p eq $nextid} continue
5217             set rn [nextuse $p $r]
5218             if {$rn >= $row &&
5219                 $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
5220                 lappend ids [list [ordertoken $p] $p]
5221             }
5222         }
5223     }
5224     for {} {$r < $row} {incr r} {
5225         set nextid [lindex $displayorder [expr {$r + 1}]]
5226         foreach p [lindex $parentlist $r] {
5227             if {$p eq $nextid} continue
5228             set rn [nextuse $p $r]
5229             if {$rn < 0 || $rn >= $row} {
5230                 lappend ids [list [ordertoken $p] $p]
5231             }
5232         }
5233     }
5234     set id [lindex $displayorder $row]
5235     lappend ids [list [ordertoken $id] $id]
5236     while {$r < $rb} {
5237         foreach p [lindex $parentlist $r] {
5238             set firstkid [lindex $children($curview,$p) 0]
5239             if {[rowofcommit $firstkid] < $row} {
5240                 lappend ids [list [ordertoken $p] $p]
5241             }
5242         }
5243         incr r
5244         set id [lindex $displayorder $r]
5245         if {$id ne {}} {
5246             set firstkid [lindex $children($curview,$id) 0]
5247             if {$firstkid ne {} && [rowofcommit $firstkid] < $row} {
5248                 lappend ids [list [ordertoken $id] $id]
5249             }
5250         }
5251     }
5252     set idlist {}
5253     foreach idx [lsort -unique $ids] {
5254         lappend idlist [lindex $idx 1]
5255     }
5256     return $idlist
5257 }
5258
5259 proc rowsequal {a b} {
5260     while {[set i [lsearch -exact $a {}]] >= 0} {
5261         set a [lreplace $a $i $i]
5262     }
5263     while {[set i [lsearch -exact $b {}]] >= 0} {
5264         set b [lreplace $b $i $i]
5265     }
5266     return [expr {$a eq $b}]
5267 }
5268
5269 proc makeupline {id row rend col} {
5270     global rowidlist uparrowlen downarrowlen mingaplen
5271
5272     for {set r $rend} {1} {set r $rstart} {
5273         set rstart [prevuse $id $r]
5274         if {$rstart < 0} return
5275         if {$rstart < $row} break
5276     }
5277     if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
5278         set rstart [expr {$rend - $uparrowlen - 1}]
5279     }
5280     for {set r $rstart} {[incr r] <= $row} {} {
5281         set idlist [lindex $rowidlist $r]
5282         if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
5283             set col [idcol $idlist $id $col]
5284             lset rowidlist $r [linsert $idlist $col $id]
5285             changedrow $r
5286         }
5287     }
5288 }
5289
5290 proc layoutrows {row endrow} {
5291     global rowidlist rowisopt rowfinal displayorder
5292     global uparrowlen downarrowlen maxwidth mingaplen
5293     global children parentlist
5294     global commitidx viewcomplete curview
5295
5296     make_disporder [expr {$row - 1}] [expr {$endrow + $uparrowlen}]
5297     set idlist {}
5298     if {$row > 0} {
5299         set rm1 [expr {$row - 1}]
5300         foreach id [lindex $rowidlist $rm1] {
5301             if {$id ne {}} {
5302                 lappend idlist $id
5303             }
5304         }
5305         set final [lindex $rowfinal $rm1]
5306     }
5307     for {} {$row < $endrow} {incr row} {
5308         set rm1 [expr {$row - 1}]
5309         if {$rm1 < 0 || $idlist eq {}} {
5310             set idlist [make_idlist $row]
5311             set final 1
5312         } else {
5313             set id [lindex $displayorder $rm1]
5314             set col [lsearch -exact $idlist $id]
5315             set idlist [lreplace $idlist $col $col]
5316             foreach p [lindex $parentlist $rm1] {
5317                 if {[lsearch -exact $idlist $p] < 0} {
5318                     set col [idcol $idlist $p $col]
5319                     set idlist [linsert $idlist $col $p]
5320                     # if not the first child, we have to insert a line going up
5321                     if {$id ne [lindex $children($curview,$p) 0]} {
5322                         makeupline $p $rm1 $row $col
5323                     }
5324                 }
5325             }
5326             set id [lindex $displayorder $row]
5327             if {$row > $downarrowlen} {
5328                 set termrow [expr {$row - $downarrowlen - 1}]
5329                 foreach p [lindex $parentlist $termrow] {
5330                     set i [lsearch -exact $idlist $p]
5331                     if {$i < 0} continue
5332                     set nr [nextuse $p $termrow]
5333                     if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
5334                         set idlist [lreplace $idlist $i $i]
5335                     }
5336                 }
5337             }
5338             set col [lsearch -exact $idlist $id]
5339             if {$col < 0} {
5340                 set col [idcol $idlist $id]
5341                 set idlist [linsert $idlist $col $id]
5342                 if {$children($curview,$id) ne {}} {
5343                     makeupline $id $rm1 $row $col
5344                 }
5345             }
5346             set r [expr {$row + $uparrowlen - 1}]
5347             if {$r < $commitidx($curview)} {
5348                 set x $col
5349                 foreach p [lindex $parentlist $r] {
5350                     if {[lsearch -exact $idlist $p] >= 0} continue
5351                     set fk [lindex $children($curview,$p) 0]
5352                     if {[rowofcommit $fk] < $row} {
5353                         set x [idcol $idlist $p $x]
5354                         set idlist [linsert $idlist $x $p]
5355                     }
5356                 }
5357                 if {[incr r] < $commitidx($curview)} {
5358                     set p [lindex $displayorder $r]
5359                     if {[lsearch -exact $idlist $p] < 0} {
5360                         set fk [lindex $children($curview,$p) 0]
5361                         if {$fk ne {} && [rowofcommit $fk] < $row} {
5362                             set x [idcol $idlist $p $x]
5363                             set idlist [linsert $idlist $x $p]
5364                         }
5365                     }
5366                 }
5367             }
5368         }
5369         if {$final && !$viewcomplete($curview) &&
5370             $row + $uparrowlen + $mingaplen + $downarrowlen
5371                 >= $commitidx($curview)} {
5372             set final 0
5373         }
5374         set l [llength $rowidlist]
5375         if {$row == $l} {
5376             lappend rowidlist $idlist
5377             lappend rowisopt 0
5378             lappend rowfinal $final
5379         } elseif {$row < $l} {
5380             if {![rowsequal $idlist [lindex $rowidlist $row]]} {
5381                 lset rowidlist $row $idlist
5382                 changedrow $row
5383             }
5384             lset rowfinal $row $final
5385         } else {
5386             set pad [ntimes [expr {$row - $l}] {}]
5387             set rowidlist [concat $rowidlist $pad]
5388             lappend rowidlist $idlist
5389             set rowfinal [concat $rowfinal $pad]
5390             lappend rowfinal $final
5391             set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
5392         }
5393     }
5394     return $row
5395 }
5396
5397 proc changedrow {row} {
5398     global displayorder iddrawn rowisopt need_redisplay
5399
5400     set l [llength $rowisopt]
5401     if {$row < $l} {
5402         lset rowisopt $row 0
5403         if {$row + 1 < $l} {
5404             lset rowisopt [expr {$row + 1}] 0
5405             if {$row + 2 < $l} {
5406                 lset rowisopt [expr {$row + 2}] 0
5407             }
5408         }
5409     }
5410     set id [lindex $displayorder $row]
5411     if {[info exists iddrawn($id)]} {
5412         set need_redisplay 1
5413     }
5414 }
5415
5416 proc insert_pad {row col npad} {
5417     global rowidlist
5418
5419     set pad [ntimes $npad {}]
5420     set idlist [lindex $rowidlist $row]
5421     set bef [lrange $idlist 0 [expr {$col - 1}]]
5422     set aft [lrange $idlist $col end]
5423     set i [lsearch -exact $aft {}]
5424     if {$i > 0} {
5425         set aft [lreplace $aft $i $i]
5426     }
5427     lset rowidlist $row [concat $bef $pad $aft]
5428     changedrow $row
5429 }
5430
5431 proc optimize_rows {row col endrow} {
5432     global rowidlist rowisopt displayorder curview children
5433
5434     if {$row < 1} {
5435         set row 1
5436     }
5437     for {} {$row < $endrow} {incr row; set col 0} {
5438         if {[lindex $rowisopt $row]} continue
5439         set haspad 0
5440         set y0 [expr {$row - 1}]
5441         set ym [expr {$row - 2}]
5442         set idlist [lindex $rowidlist $row]
5443         set previdlist [lindex $rowidlist $y0]
5444         if {$idlist eq {} || $previdlist eq {}} continue
5445         if {$ym >= 0} {
5446             set pprevidlist [lindex $rowidlist $ym]
5447             if {$pprevidlist eq {}} continue
5448         } else {
5449             set pprevidlist {}
5450         }
5451         set x0 -1
5452         set xm -1
5453         for {} {$col < [llength $idlist]} {incr col} {
5454             set id [lindex $idlist $col]
5455             if {[lindex $previdlist $col] eq $id} continue
5456             if {$id eq {}} {
5457                 set haspad 1
5458                 continue
5459             }
5460             set x0 [lsearch -exact $previdlist $id]
5461             if {$x0 < 0} continue
5462             set z [expr {$x0 - $col}]
5463             set isarrow 0
5464             set z0 {}
5465             if {$ym >= 0} {
5466                 set xm [lsearch -exact $pprevidlist $id]
5467                 if {$xm >= 0} {
5468                     set z0 [expr {$xm - $x0}]
5469                 }
5470             }
5471             if {$z0 eq {}} {
5472                 # if row y0 is the first child of $id then it's not an arrow
5473                 if {[lindex $children($curview,$id) 0] ne
5474                     [lindex $displayorder $y0]} {
5475                     set isarrow 1
5476                 }
5477             }
5478             if {!$isarrow && $id ne [lindex $displayorder $row] &&
5479                 [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
5480                 set isarrow 1
5481             }
5482             # Looking at lines from this row to the previous row,
5483             # make them go straight up if they end in an arrow on
5484             # the previous row; otherwise make them go straight up
5485             # or at 45 degrees.
5486             if {$z < -1 || ($z < 0 && $isarrow)} {
5487                 # Line currently goes left too much;
5488                 # insert pads in the previous row, then optimize it
5489                 set npad [expr {-1 - $z + $isarrow}]
5490                 insert_pad $y0 $x0 $npad
5491                 if {$y0 > 0} {
5492                     optimize_rows $y0 $x0 $row
5493                 }
5494                 set previdlist [lindex $rowidlist $y0]
5495                 set x0 [lsearch -exact $previdlist $id]
5496                 set z [expr {$x0 - $col}]
5497                 if {$z0 ne {}} {
5498                     set pprevidlist [lindex $rowidlist $ym]
5499                     set xm [lsearch -exact $pprevidlist $id]
5500                     set z0 [expr {$xm - $x0}]
5501                 }
5502             } elseif {$z > 1 || ($z > 0 && $isarrow)} {
5503                 # Line currently goes right too much;
5504                 # insert pads in this line
5505                 set npad [expr {$z - 1 + $isarrow}]
5506                 insert_pad $row $col $npad
5507                 set idlist [lindex $rowidlist $row]
5508                 incr col $npad
5509                 set z [expr {$x0 - $col}]
5510                 set haspad 1
5511             }
5512             if {$z0 eq {} && !$isarrow && $ym >= 0} {
5513                 # this line links to its first child on row $row-2
5514                 set id [lindex $displayorder $ym]
5515                 set xc [lsearch -exact $pprevidlist $id]
5516                 if {$xc >= 0} {
5517                     set z0 [expr {$xc - $x0}]
5518                 }
5519             }
5520             # avoid lines jigging left then immediately right
5521             if {$z0 ne {} && $z < 0 && $z0 > 0} {
5522                 insert_pad $y0 $x0 1
5523                 incr x0
5524                 optimize_rows $y0 $x0 $row
5525                 set previdlist [lindex $rowidlist $y0]
5526             }
5527         }
5528         if {!$haspad} {
5529             # Find the first column that doesn't have a line going right
5530             for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
5531                 set id [lindex $idlist $col]
5532                 if {$id eq {}} break
5533                 set x0 [lsearch -exact $previdlist $id]
5534                 if {$x0 < 0} {
5535                     # check if this is the link to the first child
5536                     set kid [lindex $displayorder $y0]
5537                     if {[lindex $children($curview,$id) 0] eq $kid} {
5538                         # it is, work out offset to child
5539                         set x0 [lsearch -exact $previdlist $kid]
5540                     }
5541                 }
5542                 if {$x0 <= $col} break
5543             }
5544             # Insert a pad at that column as long as it has a line and
5545             # isn't the last column
5546             if {$x0 >= 0 && [incr col] < [llength $idlist]} {
5547                 set idlist [linsert $idlist $col {}]
5548                 lset rowidlist $row $idlist
5549                 changedrow $row
5550             }
5551         }
5552     }
5553 }
5554
5555 proc xc {row col} {
5556     global canvx0 linespc
5557     return [expr {$canvx0 + $col * $linespc}]
5558 }
5559
5560 proc yc {row} {
5561     global canvy0 linespc
5562     return [expr {$canvy0 + $row * $linespc}]
5563 }
5564
5565 proc linewidth {id} {
5566     global thickerline lthickness
5567
5568     set wid $lthickness
5569     if {[info exists thickerline] && $id eq $thickerline} {
5570         set wid [expr {2 * $lthickness}]
5571     }
5572     return $wid
5573 }
5574
5575 proc rowranges {id} {
5576     global curview children uparrowlen downarrowlen
5577     global rowidlist
5578
5579     set kids $children($curview,$id)
5580     if {$kids eq {}} {
5581         return {}
5582     }
5583     set ret {}
5584     lappend kids $id
5585     foreach child $kids {
5586         if {![commitinview $child $curview]} break
5587         set row [rowofcommit $child]
5588         if {![info exists prev]} {
5589             lappend ret [expr {$row + 1}]
5590         } else {
5591             if {$row <= $prevrow} {
5592                 puts "oops children of [shortids $id] out of order [shortids $child] $row <= [shortids $prev] $prevrow"
5593             }
5594             # see if the line extends the whole way from prevrow to row
5595             if {$row > $prevrow + $uparrowlen + $downarrowlen &&
5596                 [lsearch -exact [lindex $rowidlist \
5597                             [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
5598                 # it doesn't, see where it ends
5599                 set r [expr {$prevrow + $downarrowlen}]
5600                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5601                     while {[incr r -1] > $prevrow &&
5602                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5603                 } else {
5604                     while {[incr r] <= $row &&
5605                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5606                     incr r -1
5607                 }
5608                 lappend ret $r
5609                 # see where it starts up again
5610                 set r [expr {$row - $uparrowlen}]
5611                 if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
5612                     while {[incr r] < $row &&
5613                            [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
5614                 } else {
5615                     while {[incr r -1] >= $prevrow &&
5616                            [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
5617                     incr r
5618                 }
5619                 lappend ret $r
5620             }
5621         }
5622         if {$child eq $id} {
5623             lappend ret $row
5624         }
5625         set prev $child
5626         set prevrow $row
5627     }
5628     return $ret
5629 }
5630
5631 proc drawlineseg {id row endrow arrowlow} {
5632     global rowidlist displayorder iddrawn linesegs
5633     global canv colormap linespc curview maxlinelen parentlist
5634
5635     set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
5636     set le [expr {$row + 1}]
5637     set arrowhigh 1
5638     while {1} {
5639         set c [lsearch -exact [lindex $rowidlist $le] $id]
5640         if {$c < 0} {
5641             incr le -1
5642             break
5643         }
5644         lappend cols $c
5645         set x [lindex $displayorder $le]
5646         if {$x eq $id} {
5647             set arrowhigh 0
5648             break
5649         }
5650         if {[info exists iddrawn($x)] || $le == $endrow} {
5651             set c [lsearch -exact [lindex $rowidlist [expr {$le+1}]] $id]
5652             if {$c >= 0} {
5653                 lappend cols $c
5654                 set arrowhigh 0
5655             }
5656             break
5657         }
5658         incr le
5659     }
5660     if {$le <= $row} {
5661         return $row
5662     }
5663
5664     set lines {}
5665     set i 0
5666     set joinhigh 0
5667     if {[info exists linesegs($id)]} {
5668         set lines $linesegs($id)
5669         foreach li $lines {
5670             set r0 [lindex $li 0]
5671             if {$r0 > $row} {
5672                 if {$r0 == $le && [lindex $li 1] - $row <= $maxlinelen} {
5673                     set joinhigh 1
5674                 }
5675                 break
5676             }
5677             incr i
5678         }
5679     }
5680     set joinlow 0
5681     if {$i > 0} {
5682         set li [lindex $lines [expr {$i-1}]]
5683         set r1 [lindex $li 1]
5684         if {$r1 == $row && $le - [lindex $li 0] <= $maxlinelen} {
5685             set joinlow 1
5686         }
5687     }
5688
5689     set x [lindex $cols [expr {$le - $row}]]
5690     set xp [lindex $cols [expr {$le - 1 - $row}]]
5691     set dir [expr {$xp - $x}]
5692     if {$joinhigh} {
5693         set ith [lindex $lines $i 2]
5694         set coords [$canv coords $ith]
5695         set ah [$canv itemcget $ith -arrow]
5696         set arrowhigh [expr {$ah eq "first" || $ah eq "both"}]
5697         set x2 [lindex $cols [expr {$le + 1 - $row}]]
5698         if {$x2 ne {} && $x - $x2 == $dir} {
5699             set coords [lrange $coords 0 end-2]
5700         }
5701     } else {
5702         set coords [list [xc $le $x] [yc $le]]
5703     }
5704     if {$joinlow} {
5705         set itl [lindex $lines [expr {$i-1}] 2]
5706         set al [$canv itemcget $itl -arrow]
5707         set arrowlow [expr {$al eq "last" || $al eq "both"}]
5708     } elseif {$arrowlow} {
5709         if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
5710             [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
5711             set arrowlow 0
5712         }
5713     }
5714     set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
5715     for {set y $le} {[incr y -1] > $row} {} {
5716         set x $xp
5717         set xp [lindex $cols [expr {$y - 1 - $row}]]
5718         set ndir [expr {$xp - $x}]
5719         if {$dir != $ndir || $xp < 0} {
5720             lappend coords [xc $y $x] [yc $y]
5721         }
5722         set dir $ndir
5723     }
5724     if {!$joinlow} {
5725         if {$xp < 0} {
5726             # join parent line to first child
5727             set ch [lindex $displayorder $row]
5728             set xc [lsearch -exact [lindex $rowidlist $row] $ch]
5729             if {$xc < 0} {
5730                 puts "oops: drawlineseg: child $ch not on row $row"
5731             } elseif {$xc != $x} {
5732                 if {($arrowhigh && $le == $row + 1) || $dir == 0} {
5733                     set d [expr {int(0.5 * $linespc)}]
5734                     set x1 [xc $row $x]
5735                     if {$xc < $x} {
5736                         set x2 [expr {$x1 - $d}]
5737                     } else {
5738                         set x2 [expr {$x1 + $d}]
5739                     }
5740                     set y2 [yc $row]
5741                     set y1 [expr {$y2 + $d}]
5742                     lappend coords $x1 $y1 $x2 $y2
5743                 } elseif {$xc < $x - 1} {
5744                     lappend coords [xc $row [expr {$x-1}]] [yc $row]
5745                 } elseif {$xc > $x + 1} {
5746                     lappend coords [xc $row [expr {$x+1}]] [yc $row]
5747                 }
5748                 set x $xc
5749             }
5750             lappend coords [xc $row $x] [yc $row]
5751         } else {
5752             set xn [xc $row $xp]
5753             set yn [yc $row]
5754             lappend coords $xn $yn
5755         }
5756         if {!$joinhigh} {
5757             assigncolor $id
5758             set t [$canv create line $coords -width [linewidth $id] \
5759                        -fill $colormap($id) -tags lines.$id -arrow $arrow]
5760             $canv lower $t
5761             bindline $t $id
5762             set lines [linsert $lines $i [list $row $le $t]]
5763         } else {
5764             $canv coords $ith $coords
5765             if {$arrow ne $ah} {
5766                 $canv itemconf $ith -arrow $arrow
5767             }
5768             lset lines $i 0 $row
5769         }
5770     } else {
5771         set xo [lsearch -exact [lindex $rowidlist [expr {$row - 1}]] $id]
5772         set ndir [expr {$xo - $xp}]
5773         set clow [$canv coords $itl]
5774         if {$dir == $ndir} {
5775             set clow [lrange $clow 2 end]
5776         }
5777         set coords [concat $coords $clow]
5778         if {!$joinhigh} {
5779             lset lines [expr {$i-1}] 1 $le
5780         } else {
5781             # coalesce two pieces
5782             $canv delete $ith
5783             set b [lindex $lines [expr {$i-1}] 0]
5784             set e [lindex $lines $i 1]
5785             set lines [lreplace $lines [expr {$i-1}] $i [list $b $e $itl]]
5786         }
5787         $canv coords $itl $coords
5788         if {$arrow ne $al} {
5789             $canv itemconf $itl -arrow $arrow
5790         }
5791     }
5792
5793     set linesegs($id) $lines
5794     return $le
5795 }
5796
5797 proc drawparentlinks {id row} {
5798     global rowidlist canv colormap curview parentlist
5799     global idpos linespc
5800
5801     set rowids [lindex $rowidlist $row]
5802     set col [lsearch -exact $rowids $id]
5803     if {$col < 0} return
5804     set olds [lindex $parentlist $row]
5805     set row2 [expr {$row + 1}]
5806     set x [xc $row $col]
5807     set y [yc $row]
5808     set y2 [yc $row2]
5809     set d [expr {int(0.5 * $linespc)}]
5810     set ymid [expr {$y + $d}]
5811     set ids [lindex $rowidlist $row2]
5812     # rmx = right-most X coord used
5813     set rmx 0
5814     foreach p $olds {
5815         set i [lsearch -exact $ids $p]
5816         if {$i < 0} {
5817             puts "oops, parent $p of $id not in list"
5818             continue
5819         }
5820         set x2 [xc $row2 $i]
5821         if {$x2 > $rmx} {
5822             set rmx $x2
5823         }
5824         set j [lsearch -exact $rowids $p]
5825         if {$j < 0} {
5826             # drawlineseg will do this one for us
5827             continue
5828         }
5829         assigncolor $p
5830         # should handle duplicated parents here...
5831         set coords [list $x $y]
5832         if {$i != $col} {
5833             # if attaching to a vertical segment, draw a smaller
5834             # slant for visual distinctness
5835             if {$i == $j} {
5836                 if {$i < $col} {
5837                     lappend coords [expr {$x2 + $d}] $y $x2 $ymid
5838                 } else {
5839                     lappend coords [expr {$x2 - $d}] $y $x2 $ymid
5840                 }
5841             } elseif {$i < $col && $i < $j} {
5842                 # segment slants towards us already
5843                 lappend coords [xc $row $j] $y
5844             } else {
5845                 if {$i < $col - 1} {
5846                     lappend coords [expr {$x2 + $linespc}] $y
5847                 } elseif {$i > $col + 1} {
5848                     lappend coords [expr {$x2 - $linespc}] $y
5849                 }
5850                 lappend coords $x2 $y2
5851             }
5852         } else {
5853             lappend coords $x2 $y2
5854         }
5855         set t [$canv create line $coords -width [linewidth $p] \
5856                    -fill $colormap($p) -tags lines.$p]
5857         $canv lower $t
5858         bindline $t $p
5859     }
5860     if {$rmx > [lindex $idpos($id) 1]} {
5861         lset idpos($id) 1 $rmx
5862         redrawtags $id
5863     }
5864 }
5865
5866 proc drawlines {id} {
5867     global canv
5868
5869     $canv itemconf lines.$id -width [linewidth $id]
5870 }
5871
5872 proc drawcmittext {id row col} {
5873     global linespc canv canv2 canv3 fgcolor curview
5874     global cmitlisted commitinfo rowidlist parentlist
5875     global rowtextx idpos idtags idheads idotherrefs
5876     global linehtag linentag linedtag selectedline
5877     global canvxmax boldids boldnameids fgcolor markedid
5878     global mainheadid nullid nullid2 circleitem circlecolors ctxbut
5879
5880     # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right
5881     set listed $cmitlisted($curview,$id)
5882     if {$id eq $nullid} {
5883         set ofill red
5884     } elseif {$id eq $nullid2} {
5885         set ofill green
5886     } elseif {$id eq $mainheadid} {
5887         set ofill yellow
5888     } else {
5889         set ofill [lindex $circlecolors $listed]
5890     }
5891     set x [xc $row $col]
5892     set y [yc $row]
5893     set orad [expr {$linespc / 3}]
5894     if {$listed <= 2} {
5895         set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
5896                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5897                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
5898     } elseif {$listed == 3} {
5899         # triangle pointing left for left-side commits
5900         set t [$canv create polygon \
5901                    [expr {$x - $orad}] $y \
5902                    [expr {$x + $orad - 1}] [expr {$y - $orad}] \
5903                    [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
5904                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
5905     } else {
5906         # triangle pointing right for right-side commits
5907         set t [$canv create polygon \
5908                    [expr {$x + $orad - 1}] $y \
5909                    [expr {$x - $orad}] [expr {$y - $orad}] \
5910                    [expr {$x - $orad}] [expr {$y + $orad - 1}] \
5911                    -fill $ofill -outline $fgcolor -width 1 -tags circle]
5912     }
5913     set circleitem($row) $t
5914     $canv raise $t
5915     $canv bind $t <1> {selcanvline {} %x %y}
5916     set rmx [llength [lindex $rowidlist $row]]
5917     set olds [lindex $parentlist $row]
5918     if {$olds ne {}} {
5919         set nextids [lindex $rowidlist [expr {$row + 1}]]
5920         foreach p $olds {
5921             set i [lsearch -exact $nextids $p]
5922             if {$i > $rmx} {
5923                 set rmx $i
5924             }
5925         }
5926     }
5927     set xt [xc $row $rmx]
5928     set rowtextx($row) $xt
5929     set idpos($id) [list $x $xt $y]
5930     if {[info exists idtags($id)] || [info exists idheads($id)]
5931         || [info exists idotherrefs($id)]} {
5932         set xt [drawtags $id $x $xt $y]
5933     }
5934     if {[lindex $commitinfo($id) 6] > 0} {
5935         set xt [drawnotesign $xt $y]
5936     }
5937     set headline [lindex $commitinfo($id) 0]
5938     set name [lindex $commitinfo($id) 1]
5939     set date [lindex $commitinfo($id) 2]
5940     set date [formatdate $date]
5941     set font mainfont
5942     set nfont mainfont
5943     set isbold [ishighlighted $id]
5944     if {$isbold > 0} {
5945         lappend boldids $id
5946         set font mainfontbold
5947         if {$isbold > 1} {
5948             lappend boldnameids $id
5949             set nfont mainfontbold
5950         }
5951     }
5952     set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \
5953                            -text $headline -font $font -tags text]
5954     $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id"
5955     set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
5956                            -text $name -font $nfont -tags text]
5957     set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
5958                            -text $date -font mainfont -tags text]
5959     if {$selectedline == $row} {
5960         make_secsel $id
5961     }
5962     if {[info exists markedid] && $markedid eq $id} {
5963         make_idmark $id
5964     }
5965     set xr [expr {$xt + [font measure $font $headline]}]
5966     if {$xr > $canvxmax} {
5967         set canvxmax $xr
5968         setcanvscroll
5969     }
5970 }
5971
5972 proc drawcmitrow {row} {
5973     global displayorder rowidlist nrows_drawn
5974     global iddrawn markingmatches
5975     global commitinfo numcommits
5976     global filehighlight fhighlights findpattern nhighlights
5977     global hlview vhighlights
5978     global highlight_related rhighlights
5979
5980     if {$row >= $numcommits} return
5981
5982     set id [lindex $displayorder $row]
5983     if {[info exists hlview] && ![info exists vhighlights($id)]} {
5984         askvhighlight $row $id
5985     }
5986     if {[info exists filehighlight] && ![info exists fhighlights($id)]} {
5987         askfilehighlight $row $id
5988     }
5989     if {$findpattern ne {} && ![info exists nhighlights($id)]} {
5990         askfindhighlight $row $id
5991     }
5992     if {$highlight_related ne [mc "None"] && ![info exists rhighlights($id)]} {
5993         askrelhighlight $row $id
5994     }
5995     if {![info exists iddrawn($id)]} {
5996         set col [lsearch -exact [lindex $rowidlist $row] $id]
5997         if {$col < 0} {
5998             puts "oops, row $row id $id not in list"
5999             return
6000         }
6001         if {![info exists commitinfo($id)]} {
6002             getcommit $id
6003         }
6004         assigncolor $id
6005         drawcmittext $id $row $col
6006         set iddrawn($id) 1
6007         incr nrows_drawn
6008     }
6009     if {$markingmatches} {
6010         markrowmatches $row $id
6011     }
6012 }
6013
6014 proc drawcommits {row {endrow {}}} {
6015     global numcommits iddrawn displayorder curview need_redisplay
6016     global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
6017
6018     if {$row < 0} {
6019         set row 0
6020     }
6021     if {$endrow eq {}} {
6022         set endrow $row
6023     }
6024     if {$endrow >= $numcommits} {
6025         set endrow [expr {$numcommits - 1}]
6026     }
6027
6028     set rl1 [expr {$row - $downarrowlen - 3}]
6029     if {$rl1 < 0} {
6030         set rl1 0
6031     }
6032     set ro1 [expr {$row - 3}]
6033     if {$ro1 < 0} {
6034         set ro1 0
6035     }
6036     set r2 [expr {$endrow + $uparrowlen + 3}]
6037     if {$r2 > $numcommits} {
6038         set r2 $numcommits
6039     }
6040     for {set r $rl1} {$r < $r2} {incr r} {
6041         if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
6042             if {$rl1 < $r} {
6043                 layoutrows $rl1 $r
6044             }
6045             set rl1 [expr {$r + 1}]
6046         }
6047     }
6048     if {$rl1 < $r} {
6049         layoutrows $rl1 $r
6050     }
6051     optimize_rows $ro1 0 $r2
6052     if {$need_redisplay || $nrows_drawn > 2000} {
6053         clear_display
6054     }
6055
6056     # make the lines join to already-drawn rows either side
6057     set r [expr {$row - 1}]
6058     if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
6059         set r $row
6060     }
6061     set er [expr {$endrow + 1}]
6062     if {$er >= $numcommits ||
6063         ![info exists iddrawn([lindex $displayorder $er])]} {
6064         set er $endrow
6065     }
6066     for {} {$r <= $er} {incr r} {
6067         set id [lindex $displayorder $r]
6068         set wasdrawn [info exists iddrawn($id)]
6069         drawcmitrow $r
6070         if {$r == $er} break
6071         set nextid [lindex $displayorder [expr {$r + 1}]]
6072         if {$wasdrawn && [info exists iddrawn($nextid)]} continue
6073         drawparentlinks $id $r
6074
6075         set rowids [lindex $rowidlist $r]
6076         foreach lid $rowids {
6077             if {$lid eq {}} continue
6078             if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
6079             if {$lid eq $id} {
6080                 # see if this is the first child of any of its parents
6081                 foreach p [lindex $parentlist $r] {
6082                     if {[lsearch -exact $rowids $p] < 0} {
6083                         # make this line extend up to the child
6084                         set lineend($p) [drawlineseg $p $r $er 0]
6085                     }
6086                 }
6087             } else {
6088                 set lineend($lid) [drawlineseg $lid $r $er 1]
6089             }
6090         }
6091     }
6092 }
6093
6094 proc undolayout {row} {
6095     global uparrowlen mingaplen downarrowlen
6096     global rowidlist rowisopt rowfinal need_redisplay
6097
6098     set r [expr {$row - ($uparrowlen + $mingaplen + $downarrowlen)}]
6099     if {$r < 0} {
6100         set r 0
6101     }
6102     if {[llength $rowidlist] > $r} {
6103         incr r -1
6104         set rowidlist [lrange $rowidlist 0 $r]
6105         set rowfinal [lrange $rowfinal 0 $r]
6106         set rowisopt [lrange $rowisopt 0 $r]
6107         set need_redisplay 1
6108         run drawvisible
6109     }
6110 }
6111
6112 proc drawvisible {} {
6113     global canv linespc curview vrowmod selectedline targetrow targetid
6114     global need_redisplay cscroll numcommits
6115
6116     set fs [$canv yview]
6117     set ymax [lindex [$canv cget -scrollregion] 3]
6118     if {$ymax eq {} || $ymax == 0 || $numcommits == 0} return
6119     set f0 [lindex $fs 0]
6120     set f1 [lindex $fs 1]
6121     set y0 [expr {int($f0 * $ymax)}]
6122     set y1 [expr {int($f1 * $ymax)}]
6123
6124     if {[info exists targetid]} {
6125         if {[commitinview $targetid $curview]} {
6126             set r [rowofcommit $targetid]
6127             if {$r != $targetrow} {
6128                 # Fix up the scrollregion and change the scrolling position
6129                 # now that our target row has moved.
6130                 set diff [expr {($r - $targetrow) * $linespc}]
6131                 set targetrow $r
6132                 setcanvscroll
6133                 set ymax [lindex [$canv cget -scrollregion] 3]
6134                 incr y0 $diff
6135                 incr y1 $diff
6136                 set f0 [expr {$y0 / $ymax}]
6137                 set f1 [expr {$y1 / $ymax}]
6138                 allcanvs yview moveto $f0
6139                 $cscroll set $f0 $f1
6140                 set need_redisplay 1
6141             }
6142         } else {
6143             unset targetid
6144         }
6145     }
6146
6147     set row [expr {int(($y0 - 3) / $linespc) - 1}]
6148     set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
6149     if {$endrow >= $vrowmod($curview)} {
6150         update_arcrows $curview
6151     }
6152     if {$selectedline ne {} &&
6153         $row <= $selectedline && $selectedline <= $endrow} {
6154         set targetrow $selectedline
6155     } elseif {[info exists targetid]} {
6156         set targetrow [expr {int(($row + $endrow) / 2)}]
6157     }
6158     if {[info exists targetrow]} {
6159         if {$targetrow >= $numcommits} {
6160             set targetrow [expr {$numcommits - 1}]
6161         }
6162         set targetid [commitonrow $targetrow]
6163     }
6164     drawcommits $row $endrow
6165 }
6166
6167 proc clear_display {} {
6168     global iddrawn linesegs need_redisplay nrows_drawn
6169     global vhighlights fhighlights nhighlights rhighlights
6170     global linehtag linentag linedtag boldids boldnameids
6171
6172     allcanvs delete all
6173     catch {unset iddrawn}
6174     catch {unset linesegs}
6175     catch {unset linehtag}
6176     catch {unset linentag}
6177     catch {unset linedtag}
6178     set boldids {}
6179     set boldnameids {}
6180     catch {unset vhighlights}
6181     catch {unset fhighlights}
6182     catch {unset nhighlights}
6183     catch {unset rhighlights}
6184     set need_redisplay 0
6185     set nrows_drawn 0
6186 }
6187
6188 proc findcrossings {id} {
6189     global rowidlist parentlist numcommits displayorder
6190
6191     set cross {}
6192     set ccross {}
6193     foreach {s e} [rowranges $id] {
6194         if {$e >= $numcommits} {
6195             set e [expr {$numcommits - 1}]
6196         }
6197         if {$e <= $s} continue
6198         for {set row $e} {[incr row -1] >= $s} {} {
6199             set x [lsearch -exact [lindex $rowidlist $row] $id]
6200             if {$x < 0} break
6201             set olds [lindex $parentlist $row]
6202             set kid [lindex $displayorder $row]
6203             set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
6204             if {$kidx < 0} continue
6205             set nextrow [lindex $rowidlist [expr {$row + 1}]]
6206             foreach p $olds {
6207                 set px [lsearch -exact $nextrow $p]
6208                 if {$px < 0} continue
6209                 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
6210                     if {[lsearch -exact $ccross $p] >= 0} continue
6211                     if {$x == $px + ($kidx < $px? -1: 1)} {
6212                         lappend ccross $p
6213                     } elseif {[lsearch -exact $cross $p] < 0} {
6214                         lappend cross $p
6215                     }
6216                 }
6217             }
6218         }
6219     }
6220     return [concat $ccross {{}} $cross]
6221 }
6222
6223 proc assigncolor {id} {
6224     global colormap colors nextcolor
6225     global parents children children curview
6226
6227     if {[info exists colormap($id)]} return
6228     set ncolors [llength $colors]
6229     if {[info exists children($curview,$id)]} {
6230         set kids $children($curview,$id)
6231     } else {
6232         set kids {}
6233     }
6234     if {[llength $kids] == 1} {
6235         set child [lindex $kids 0]
6236         if {[info exists colormap($child)]
6237             && [llength $parents($curview,$child)] == 1} {
6238             set colormap($id) $colormap($child)
6239             return
6240         }
6241     }
6242     set badcolors {}
6243     set origbad {}
6244     foreach x [findcrossings $id] {
6245         if {$x eq {}} {
6246             # delimiter between corner crossings and other crossings
6247             if {[llength $badcolors] >= $ncolors - 1} break
6248             set origbad $badcolors
6249         }
6250         if {[info exists colormap($x)]
6251             && [lsearch -exact $badcolors $colormap($x)] < 0} {
6252             lappend badcolors $colormap($x)
6253         }
6254     }
6255     if {[llength $badcolors] >= $ncolors} {
6256         set badcolors $origbad
6257     }
6258     set origbad $badcolors
6259     if {[llength $badcolors] < $ncolors - 1} {
6260         foreach child $kids {
6261             if {[info exists colormap($child)]
6262                 && [lsearch -exact $badcolors $colormap($child)] < 0} {
6263                 lappend badcolors $colormap($child)
6264             }
6265             foreach p $parents($curview,$child) {
6266                 if {[info exists colormap($p)]
6267                     && [lsearch -exact $badcolors $colormap($p)] < 0} {
6268                     lappend badcolors $colormap($p)
6269                 }
6270             }
6271         }
6272         if {[llength $badcolors] >= $ncolors} {
6273             set badcolors $origbad
6274         }
6275     }
6276     for {set i 0} {$i <= $ncolors} {incr i} {
6277         set c [lindex $colors $nextcolor]
6278         if {[incr nextcolor] >= $ncolors} {
6279             set nextcolor 0
6280         }
6281         if {[lsearch -exact $badcolors $c]} break
6282     }
6283     set colormap($id) $c
6284 }
6285
6286 proc bindline {t id} {
6287     global canv
6288
6289     $canv bind $t <Enter> "lineenter %x %y $id"
6290     $canv bind $t <Motion> "linemotion %x %y $id"
6291     $canv bind $t <Leave> "lineleave $id"
6292     $canv bind $t <Button-1> "lineclick %x %y $id 1"
6293 }
6294
6295 proc drawtags {id x xt y1} {
6296     global idtags idheads idotherrefs mainhead
6297     global linespc lthickness
6298     global canv rowtextx curview fgcolor bgcolor ctxbut
6299
6300     set marks {}
6301     set ntags 0
6302     set nheads 0
6303     if {[info exists idtags($id)]} {
6304         set marks $idtags($id)
6305         set ntags [llength $marks]
6306     }
6307     if {[info exists idheads($id)]} {
6308         set marks [concat $marks $idheads($id)]
6309         set nheads [llength $idheads($id)]
6310     }
6311     if {[info exists idotherrefs($id)]} {
6312         set marks [concat $marks $idotherrefs($id)]
6313     }
6314     if {$marks eq {}} {
6315         return $xt
6316     }
6317
6318     set delta [expr {int(0.5 * ($linespc - $lthickness))}]
6319     set yt [expr {$y1 - 0.5 * $linespc}]
6320     set yb [expr {$yt + $linespc - 1}]
6321     set xvals {}
6322     set wvals {}
6323     set i -1
6324     foreach tag $marks {
6325         incr i
6326         if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
6327             set wid [font measure mainfontbold $tag]
6328         } else {
6329             set wid [font measure mainfont $tag]
6330         }
6331         lappend xvals $xt
6332         lappend wvals $wid
6333         set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
6334     }
6335     set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
6336                -width $lthickness -fill black -tags tag.$id]
6337     $canv lower $t
6338     foreach tag $marks x $xvals wid $wvals {
6339         set tag_quoted [string map {% %%} $tag]
6340         set xl [expr {$x + $delta}]
6341         set xr [expr {$x + $delta + $wid + $lthickness}]
6342         set font mainfont
6343         if {[incr ntags -1] >= 0} {
6344             # draw a tag
6345             set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
6346                        $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
6347                        -width 1 -outline black -fill yellow -tags tag.$id]
6348             $canv bind $t <1> [list showtag $tag_quoted 1]
6349             set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}]
6350         } else {
6351             # draw a head or other ref
6352             if {[incr nheads -1] >= 0} {
6353                 set col green
6354                 if {$tag eq $mainhead} {
6355                     set font mainfontbold
6356                 }
6357             } else {
6358                 set col "#ddddff"
6359             }
6360             set xl [expr {$xl - $delta/2}]
6361             $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
6362                 -width 1 -outline black -fill $col -tags tag.$id
6363             if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
6364                 set rwid [font measure mainfont $remoteprefix]
6365                 set xi [expr {$x + 1}]
6366                 set yti [expr {$yt + 1}]
6367                 set xri [expr {$x + $rwid}]
6368                 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
6369                         -width 0 -fill "#ffddaa" -tags tag.$id
6370             }
6371         }
6372         set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
6373                    -font $font -tags [list tag.$id text]]
6374         if {$ntags >= 0} {
6375             $canv bind $t <1> [list showtag $tag_quoted 1]
6376         } elseif {$nheads >= 0} {
6377             $canv bind $t $ctxbut [list headmenu %X %Y $id $tag_quoted]
6378         }
6379     }
6380     return $xt
6381 }
6382
6383 proc drawnotesign {xt y} {
6384     global linespc canv fgcolor
6385
6386     set orad [expr {$linespc / 3}]
6387     set t [$canv create rectangle [expr {$xt - $orad}] [expr {$y - $orad}] \
6388                [expr {$xt + $orad - 1}] [expr {$y + $orad - 1}] \
6389                -fill yellow -outline $fgcolor -width 1 -tags circle]
6390     set xt [expr {$xt + $orad * 3}]
6391     return $xt
6392 }
6393
6394 proc xcoord {i level ln} {
6395     global canvx0 xspc1 xspc2
6396
6397     set x [expr {$canvx0 + $i * $xspc1($ln)}]
6398     if {$i > 0 && $i == $level} {
6399         set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
6400     } elseif {$i > $level} {
6401         set x [expr {$x + $xspc2 - $xspc1($ln)}]
6402     }
6403     return $x
6404 }
6405
6406 proc show_status {msg} {
6407     global canv fgcolor
6408
6409     clear_display
6410     $canv create text 3 3 -anchor nw -text $msg -font mainfont \
6411         -tags text -fill $fgcolor
6412 }
6413
6414 # Don't change the text pane cursor if it is currently the hand cursor,
6415 # showing that we are over a sha1 ID link.
6416 proc settextcursor {c} {
6417     global ctext curtextcursor
6418
6419     if {[$ctext cget -cursor] == $curtextcursor} {
6420         $ctext config -cursor $c
6421     }
6422     set curtextcursor $c
6423 }
6424
6425 proc nowbusy {what {name {}}} {
6426     global isbusy busyname statusw
6427
6428     if {[array names isbusy] eq {}} {
6429         . config -cursor watch
6430         settextcursor watch
6431     }
6432     set isbusy($what) 1
6433     set busyname($what) $name
6434     if {$name ne {}} {
6435         $statusw conf -text $name
6436     }
6437 }
6438
6439 proc notbusy {what} {
6440     global isbusy maincursor textcursor busyname statusw
6441
6442     catch {
6443         unset isbusy($what)
6444         if {$busyname($what) ne {} &&
6445             [$statusw cget -text] eq $busyname($what)} {
6446             $statusw conf -text {}
6447         }
6448     }
6449     if {[array names isbusy] eq {}} {
6450         . config -cursor $maincursor
6451         settextcursor $textcursor
6452     }
6453 }
6454
6455 proc findmatches {f} {
6456     global findtype findstring
6457     if {$findtype == [mc "Regexp"]} {
6458         set matches [regexp -indices -all -inline $findstring $f]
6459     } else {
6460         set fs $findstring
6461         if {$findtype == [mc "IgnCase"]} {
6462             set f [string tolower $f]
6463             set fs [string tolower $fs]
6464         }
6465         set matches {}
6466         set i 0
6467         set l [string length $fs]
6468         while {[set j [string first $fs $f $i]] >= 0} {
6469             lappend matches [list $j [expr {$j+$l-1}]]
6470             set i [expr {$j + $l}]
6471         }
6472     }
6473     return $matches
6474 }
6475
6476 proc dofind {{dirn 1} {wrap 1}} {
6477     global findstring findstartline findcurline selectedline numcommits
6478     global gdttype filehighlight fh_serial find_dirn findallowwrap
6479
6480     if {[info exists find_dirn]} {
6481         if {$find_dirn == $dirn} return
6482         stopfinding
6483     }
6484     focus .
6485     if {$findstring eq {} || $numcommits == 0} return
6486     if {$selectedline eq {}} {
6487         set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
6488     } else {
6489         set findstartline $selectedline
6490     }
6491     set findcurline $findstartline
6492     nowbusy finding [mc "Searching"]
6493     if {$gdttype ne [mc "containing:"] && ![info exists filehighlight]} {
6494         after cancel do_file_hl $fh_serial
6495         do_file_hl $fh_serial
6496     }
6497     set find_dirn $dirn
6498     set findallowwrap $wrap
6499     run findmore
6500 }
6501
6502 proc stopfinding {} {
6503     global find_dirn findcurline fprogcoord
6504
6505     if {[info exists find_dirn]} {
6506         unset find_dirn
6507         unset findcurline
6508         notbusy finding
6509         set fprogcoord 0
6510         adjustprogress
6511     }
6512     stopblaming
6513 }
6514
6515 proc findmore {} {
6516     global commitdata commitinfo numcommits findpattern findloc
6517     global findstartline findcurline findallowwrap
6518     global find_dirn gdttype fhighlights fprogcoord
6519     global curview varcorder vrownum varccommits vrowmod
6520
6521     if {![info exists find_dirn]} {
6522         return 0
6523     }
6524     set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]]
6525     set l $findcurline
6526     set moretodo 0
6527     if {$find_dirn > 0} {
6528         incr l
6529         if {$l >= $numcommits} {
6530             set l 0
6531         }
6532         if {$l <= $findstartline} {
6533             set lim [expr {$findstartline + 1}]
6534         } else {
6535             set lim $numcommits
6536             set moretodo $findallowwrap
6537         }
6538     } else {
6539         if {$l == 0} {
6540             set l $numcommits
6541         }
6542         incr l -1
6543         if {$l >= $findstartline} {
6544             set lim [expr {$findstartline - 1}]
6545         } else {
6546             set lim -1
6547             set moretodo $findallowwrap
6548         }
6549     }
6550     set n [expr {($lim - $l) * $find_dirn}]
6551     if {$n > 500} {
6552         set n 500
6553         set moretodo 1
6554     }
6555     if {$l + ($find_dirn > 0? $n: 1) > $vrowmod($curview)} {
6556         update_arcrows $curview
6557     }
6558     set found 0
6559     set domore 1
6560     set ai [bsearch $vrownum($curview) $l]
6561     set a [lindex $varcorder($curview) $ai]
6562     set arow [lindex $vrownum($curview) $ai]
6563     set ids [lindex $varccommits($curview,$a)]
6564     set arowend [expr {$arow + [llength $ids]}]
6565     if {$gdttype eq [mc "containing:"]} {
6566         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6567             if {$l < $arow || $l >= $arowend} {
6568                 incr ai $find_dirn
6569                 set a [lindex $varcorder($curview) $ai]
6570                 set arow [lindex $vrownum($curview) $ai]
6571                 set ids [lindex $varccommits($curview,$a)]
6572                 set arowend [expr {$arow + [llength $ids]}]
6573             }
6574             set id [lindex $ids [expr {$l - $arow}]]
6575             # shouldn't happen unless git log doesn't give all the commits...
6576             if {![info exists commitdata($id)] ||
6577                 ![doesmatch $commitdata($id)]} {
6578                 continue
6579             }
6580             if {![info exists commitinfo($id)]} {
6581                 getcommit $id
6582             }
6583             set info $commitinfo($id)
6584             foreach f $info ty $fldtypes {
6585                 if {($findloc eq [mc "All fields"] || $findloc eq $ty) &&
6586                     [doesmatch $f]} {
6587                     set found 1
6588                     break
6589                 }
6590             }
6591             if {$found} break
6592         }
6593     } else {
6594         for {} {$n > 0} {incr n -1; incr l $find_dirn} {
6595             if {$l < $arow || $l >= $arowend} {
6596                 incr ai $find_dirn
6597                 set a [lindex $varcorder($curview) $ai]
6598                 set arow [lindex $vrownum($curview) $ai]
6599                 set ids [lindex $varccommits($curview,$a)]
6600                 set arowend [expr {$arow + [llength $ids]}]
6601             }
6602             set id [lindex $ids [expr {$l - $arow}]]
6603             if {![info exists fhighlights($id)]} {
6604                 # this sets fhighlights($id) to -1
6605                 askfilehighlight $l $id
6606             }
6607             if {$fhighlights($id) > 0} {
6608                 set found $domore
6609                 break
6610             }
6611             if {$fhighlights($id) < 0} {
6612                 if {$domore} {
6613                     set domore 0
6614                     set findcurline [expr {$l - $find_dirn}]
6615                 }
6616             }
6617         }
6618     }
6619     if {$found || ($domore && !$moretodo)} {
6620         unset findcurline
6621         unset find_dirn
6622         notbusy finding
6623         set fprogcoord 0
6624         adjustprogress
6625         if {$found} {
6626             findselectline $l
6627         } else {
6628             bell
6629         }
6630         return 0
6631     }
6632     if {!$domore} {
6633         flushhighlights
6634     } else {
6635         set findcurline [expr {$l - $find_dirn}]
6636     }
6637     set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
6638     if {$n < 0} {
6639         incr n $numcommits
6640     }
6641     set fprogcoord [expr {$n * 1.0 / $numcommits}]
6642     adjustprogress
6643     return $domore
6644 }
6645
6646 proc findselectline {l} {
6647     global findloc commentend ctext findcurline markingmatches gdttype
6648
6649     set markingmatches [expr {$gdttype eq [mc "containing:"]}]
6650     set findcurline $l
6651     selectline $l 1
6652     if {$markingmatches &&
6653         ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} {
6654         # highlight the matches in the comments
6655         set f [$ctext get 1.0 $commentend]
6656         set matches [findmatches $f]
6657         foreach match $matches {
6658             set start [lindex $match 0]
6659             set end [expr {[lindex $match 1] + 1}]
6660             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
6661         }
6662     }
6663     drawvisible
6664 }
6665
6666 # mark the bits of a headline or author that match a find string
6667 proc markmatches {canv l str tag matches font row} {
6668     global selectedline
6669
6670     set bbox [$canv bbox $tag]
6671     set x0 [lindex $bbox 0]
6672     set y0 [lindex $bbox 1]
6673     set y1 [lindex $bbox 3]
6674     foreach match $matches {
6675         set start [lindex $match 0]
6676         set end [lindex $match 1]
6677         if {$start > $end} continue
6678         set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
6679         set xlen [font measure $font [string range $str 0 [expr {$end}]]]
6680         set t [$canv create rect [expr {$x0+$xoff}] $y0 \
6681                    [expr {$x0+$xlen+2}] $y1 \
6682                    -outline {} -tags [list match$l matches] -fill yellow]
6683         $canv lower $t
6684         if {$row == $selectedline} {
6685             $canv raise $t secsel
6686         }
6687     }
6688 }
6689
6690 proc unmarkmatches {} {
6691     global markingmatches
6692
6693     allcanvs delete matches
6694     set markingmatches 0
6695     stopfinding
6696 }
6697
6698 proc selcanvline {w x y} {
6699     global canv canvy0 ctext linespc
6700     global rowtextx
6701     set ymax [lindex [$canv cget -scrollregion] 3]
6702     if {$ymax == {}} return
6703     set yfrac [lindex [$canv yview] 0]
6704     set y [expr {$y + $yfrac * $ymax}]
6705     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
6706     if {$l < 0} {
6707         set l 0
6708     }
6709     if {$w eq $canv} {
6710         set xmax [lindex [$canv cget -scrollregion] 2]
6711         set xleft [expr {[lindex [$canv xview] 0] * $xmax}]
6712         if {![info exists rowtextx($l)] || $xleft + $x < $rowtextx($l)} return
6713     }
6714     unmarkmatches
6715     selectline $l 1
6716 }
6717
6718 proc commit_descriptor {p} {
6719     global commitinfo
6720     if {![info exists commitinfo($p)]} {
6721         getcommit $p
6722     }
6723     set l "..."
6724     if {[llength $commitinfo($p)] > 1} {
6725         set l [lindex $commitinfo($p) 0]
6726     }
6727     return "$p ($l)\n"
6728 }
6729
6730 # append some text to the ctext widget, and make any SHA1 ID
6731 # that we know about be a clickable link.
6732 proc appendwithlinks {text tags} {
6733     global ctext linknum curview
6734
6735     set start [$ctext index "end - 1c"]
6736     $ctext insert end $text $tags
6737     set links [regexp -indices -all -inline {\m[0-9a-f]{6,40}\M} $text]
6738     foreach l $links {
6739         set s [lindex $l 0]
6740         set e [lindex $l 1]
6741         set linkid [string range $text $s $e]
6742         incr e
6743         $ctext tag delete link$linknum
6744         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
6745         setlink $linkid link$linknum
6746         incr linknum
6747     }
6748 }
6749
6750 proc setlink {id lk} {
6751     global curview ctext pendinglinks
6752
6753     set known 0
6754     if {[string length $id] < 40} {
6755         set matches [longid $id]
6756         if {[llength $matches] > 0} {
6757             if {[llength $matches] > 1} return
6758             set known 1
6759             set id [lindex $matches 0]
6760         }
6761     } else {
6762         set known [commitinview $id $curview]
6763     }
6764     if {$known} {
6765         $ctext tag conf $lk -foreground blue -underline 1
6766         $ctext tag bind $lk <1> [list selbyid $id]
6767         $ctext tag bind $lk <Enter> {linkcursor %W 1}
6768         $ctext tag bind $lk <Leave> {linkcursor %W -1}
6769     } else {
6770         lappend pendinglinks($id) $lk
6771         interestedin $id {makelink %P}
6772     }
6773 }
6774
6775 proc appendshortlink {id {pre {}} {post {}}} {
6776     global ctext linknum
6777
6778     $ctext insert end $pre
6779     $ctext tag delete link$linknum
6780     $ctext insert end [string range $id 0 7] link$linknum
6781     $ctext insert end $post
6782     setlink $id link$linknum
6783     incr linknum
6784 }
6785
6786 proc makelink {id} {
6787     global pendinglinks
6788
6789     if {![info exists pendinglinks($id)]} return
6790     foreach lk $pendinglinks($id) {
6791         setlink $id $lk
6792     }
6793     unset pendinglinks($id)
6794 }
6795
6796 proc linkcursor {w inc} {
6797     global linkentercount curtextcursor
6798
6799     if {[incr linkentercount $inc] > 0} {
6800         $w configure -cursor hand2
6801     } else {
6802         $w configure -cursor $curtextcursor
6803         if {$linkentercount < 0} {
6804             set linkentercount 0
6805         }
6806     }
6807 }
6808
6809 proc viewnextline {dir} {
6810     global canv linespc
6811
6812     $canv delete hover
6813     set ymax [lindex [$canv cget -scrollregion] 3]
6814     set wnow [$canv yview]
6815     set wtop [expr {[lindex $wnow 0] * $ymax}]
6816     set newtop [expr {$wtop + $dir * $linespc}]
6817     if {$newtop < 0} {
6818         set newtop 0
6819     } elseif {$newtop > $ymax} {
6820         set newtop $ymax
6821     }
6822     allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6823 }
6824
6825 # add a list of tag or branch names at position pos
6826 # returns the number of names inserted
6827 proc appendrefs {pos ids var} {
6828     global ctext linknum curview $var maxrefs
6829
6830     if {[catch {$ctext index $pos}]} {
6831         return 0
6832     }
6833     $ctext conf -state normal
6834     $ctext delete $pos "$pos lineend"
6835     set tags {}
6836     foreach id $ids {
6837         foreach tag [set $var\($id\)] {
6838             lappend tags [list $tag $id]
6839         }
6840     }
6841     if {[llength $tags] > $maxrefs} {
6842         $ctext insert $pos "[mc "many"] ([llength $tags])"
6843     } else {
6844         set tags [lsort -index 0 -decreasing $tags]
6845         set sep {}
6846         foreach ti $tags {
6847             set id [lindex $ti 1]
6848             set lk link$linknum
6849             incr linknum
6850             $ctext tag delete $lk
6851             $ctext insert $pos $sep
6852             $ctext insert $pos [lindex $ti 0] $lk
6853             setlink $id $lk
6854             set sep ", "
6855         }
6856     }
6857     $ctext conf -state disabled
6858     return [llength $tags]
6859 }
6860
6861 # called when we have finished computing the nearby tags
6862 proc dispneartags {delay} {
6863     global selectedline currentid showneartags tagphase
6864
6865     if {$selectedline eq {} || !$showneartags} return
6866     after cancel dispnexttag
6867     if {$delay} {
6868         after 200 dispnexttag
6869         set tagphase -1
6870     } else {
6871         after idle dispnexttag
6872         set tagphase 0
6873     }
6874 }
6875
6876 proc dispnexttag {} {
6877     global selectedline currentid showneartags tagphase ctext
6878
6879     if {$selectedline eq {} || !$showneartags} return
6880     switch -- $tagphase {
6881         0 {
6882             set dtags [desctags $currentid]
6883             if {$dtags ne {}} {
6884                 appendrefs precedes $dtags idtags
6885             }
6886         }
6887         1 {
6888             set atags [anctags $currentid]
6889             if {$atags ne {}} {
6890                 appendrefs follows $atags idtags
6891             }
6892         }
6893         2 {
6894             set dheads [descheads $currentid]
6895             if {$dheads ne {}} {
6896                 if {[appendrefs branch $dheads idheads] > 1
6897                     && [$ctext get "branch -3c"] eq "h"} {
6898                     # turn "Branch" into "Branches"
6899                     $ctext conf -state normal
6900                     $ctext insert "branch -2c" "es"
6901                     $ctext conf -state disabled
6902                 }
6903             }
6904         }
6905     }
6906     if {[incr tagphase] <= 2} {
6907         after idle dispnexttag
6908     }
6909 }
6910
6911 proc make_secsel {id} {
6912     global linehtag linentag linedtag canv canv2 canv3
6913
6914     if {![info exists linehtag($id)]} return
6915     $canv delete secsel
6916     set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
6917                -tags secsel -fill [$canv cget -selectbackground]]
6918     $canv lower $t
6919     $canv2 delete secsel
6920     set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
6921                -tags secsel -fill [$canv2 cget -selectbackground]]
6922     $canv2 lower $t
6923     $canv3 delete secsel
6924     set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
6925                -tags secsel -fill [$canv3 cget -selectbackground]]
6926     $canv3 lower $t
6927 }
6928
6929 proc make_idmark {id} {
6930     global linehtag canv fgcolor
6931
6932     if {![info exists linehtag($id)]} return
6933     $canv delete markid
6934     set t [eval $canv create rect [$canv bbox $linehtag($id)] \
6935                -tags markid -outline $fgcolor]
6936     $canv raise $t
6937 }
6938
6939 proc selectline {l isnew {desired_loc {}}} {
6940     global canv ctext commitinfo selectedline
6941     global canvy0 linespc parents children curview
6942     global currentid sha1entry
6943     global commentend idtags linknum
6944     global mergemax numcommits pending_select
6945     global cmitmode showneartags allcommits
6946     global targetrow targetid lastscrollrows
6947     global autoselect autosellen jump_to_here
6948
6949     catch {unset pending_select}
6950     $canv delete hover
6951     normalline
6952     unsel_reflist
6953     stopfinding
6954     if {$l < 0 || $l >= $numcommits} return
6955     set id [commitonrow $l]
6956     set targetid $id
6957     set targetrow $l
6958     set selectedline $l
6959     set currentid $id
6960     if {$lastscrollrows < $numcommits} {
6961         setcanvscroll
6962     }
6963
6964     set y [expr {$canvy0 + $l * $linespc}]
6965     set ymax [lindex [$canv cget -scrollregion] 3]
6966     set ytop [expr {$y - $linespc - 1}]
6967     set ybot [expr {$y + $linespc + 1}]
6968     set wnow [$canv yview]
6969     set wtop [expr {[lindex $wnow 0] * $ymax}]
6970     set wbot [expr {[lindex $wnow 1] * $ymax}]
6971     set wh [expr {$wbot - $wtop}]
6972     set newtop $wtop
6973     if {$ytop < $wtop} {
6974         if {$ybot < $wtop} {
6975             set newtop [expr {$y - $wh / 2.0}]
6976         } else {
6977             set newtop $ytop
6978             if {$newtop > $wtop - $linespc} {
6979                 set newtop [expr {$wtop - $linespc}]
6980             }
6981         }
6982     } elseif {$ybot > $wbot} {
6983         if {$ytop > $wbot} {
6984             set newtop [expr {$y - $wh / 2.0}]
6985         } else {
6986             set newtop [expr {$ybot - $wh}]
6987             if {$newtop < $wtop + $linespc} {
6988                 set newtop [expr {$wtop + $linespc}]
6989             }
6990         }
6991     }
6992     if {$newtop != $wtop} {
6993         if {$newtop < 0} {
6994             set newtop 0
6995         }
6996         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6997         drawvisible
6998     }
6999
7000     make_secsel $id
7001
7002     if {$isnew} {
7003         addtohistory [list selbyid $id 0] savecmitpos
7004     }
7005
7006     $sha1entry delete 0 end
7007     $sha1entry insert 0 $id
7008     if {$autoselect} {
7009         $sha1entry selection range 0 $autosellen
7010     }
7011     rhighlight_sel $id
7012
7013     $ctext conf -state normal
7014     clear_ctext
7015     set linknum 0
7016     if {![info exists commitinfo($id)]} {
7017         getcommit $id
7018     }
7019     set info $commitinfo($id)
7020     set date [formatdate [lindex $info 2]]
7021     $ctext insert end "[mc "Author"]: [lindex $info 1]  $date\n"
7022     set date [formatdate [lindex $info 4]]
7023     $ctext insert end "[mc "Committer"]: [lindex $info 3]  $date\n"
7024     if {[info exists idtags($id)]} {
7025         $ctext insert end [mc "Tags:"]
7026         foreach tag $idtags($id) {
7027             $ctext insert end " $tag"
7028         }
7029         $ctext insert end "\n"
7030     }
7031
7032     set headers {}
7033     set olds $parents($curview,$id)
7034     if {[llength $olds] > 1} {
7035         set np 0
7036         foreach p $olds {
7037             if {$np >= $mergemax} {
7038                 set tag mmax
7039             } else {
7040                 set tag m$np
7041             }
7042             $ctext insert end "[mc "Parent"]: " $tag
7043             appendwithlinks [commit_descriptor $p] {}
7044             incr np
7045         }
7046     } else {
7047         foreach p $olds {
7048             append headers "[mc "Parent"]: [commit_descriptor $p]"
7049         }
7050     }
7051
7052     foreach c $children($curview,$id) {
7053         append headers "[mc "Child"]:  [commit_descriptor $c]"
7054     }
7055
7056     # make anything that looks like a SHA1 ID be a clickable link
7057     appendwithlinks $headers {}
7058     if {$showneartags} {
7059         if {![info exists allcommits]} {
7060             getallcommits
7061         }
7062         $ctext insert end "[mc "Branch"]: "
7063         $ctext mark set branch "end -1c"
7064         $ctext mark gravity branch left
7065         $ctext insert end "\n[mc "Follows"]: "
7066         $ctext mark set follows "end -1c"
7067         $ctext mark gravity follows left
7068         $ctext insert end "\n[mc "Precedes"]: "
7069         $ctext mark set precedes "end -1c"
7070         $ctext mark gravity precedes left
7071         $ctext insert end "\n"
7072         dispneartags 1
7073     }
7074     $ctext insert end "\n"
7075     set comment [lindex $info 5]
7076     if {[string first "\r" $comment] >= 0} {
7077         set comment [string map {"\r" "\n    "} $comment]
7078     }
7079     appendwithlinks $comment {comment}
7080
7081     $ctext tag remove found 1.0 end
7082     $ctext conf -state disabled
7083     set commentend [$ctext index "end - 1c"]
7084
7085     set jump_to_here $desired_loc
7086     init_flist [mc "Comments"]
7087     if {$cmitmode eq "tree"} {
7088         gettree $id
7089     } elseif {[llength $olds] <= 1} {
7090         startdiff $id
7091     } else {
7092         mergediff $id
7093     }
7094 }
7095
7096 proc selfirstline {} {
7097     unmarkmatches
7098     selectline 0 1
7099 }
7100
7101 proc sellastline {} {
7102     global numcommits
7103     unmarkmatches
7104     set l [expr {$numcommits - 1}]
7105     selectline $l 1
7106 }
7107
7108 proc selnextline {dir} {
7109     global selectedline
7110     focus .
7111     if {$selectedline eq {}} return
7112     set l [expr {$selectedline + $dir}]
7113     unmarkmatches
7114     selectline $l 1
7115 }
7116
7117 proc selnextpage {dir} {
7118     global canv linespc selectedline numcommits
7119
7120     set lpp [expr {([winfo height $canv] - 2) / $linespc}]
7121     if {$lpp < 1} {
7122         set lpp 1
7123     }
7124     allcanvs yview scroll [expr {$dir * $lpp}] units
7125     drawvisible
7126     if {$selectedline eq {}} return
7127     set l [expr {$selectedline + $dir * $lpp}]
7128     if {$l < 0} {
7129         set l 0
7130     } elseif {$l >= $numcommits} {
7131         set l [expr $numcommits - 1]
7132     }
7133     unmarkmatches
7134     selectline $l 1
7135 }
7136
7137 proc unselectline {} {
7138     global selectedline currentid
7139
7140     set selectedline {}
7141     catch {unset currentid}
7142     allcanvs delete secsel
7143     rhighlight_none
7144 }
7145
7146 proc reselectline {} {
7147     global selectedline
7148
7149     if {$selectedline ne {}} {
7150         selectline $selectedline 0
7151     }
7152 }
7153
7154 proc addtohistory {cmd {saveproc {}}} {
7155     global history historyindex curview
7156
7157     unset_posvars
7158     save_position
7159     set elt [list $curview $cmd $saveproc {}]
7160     if {$historyindex > 0
7161         && [lindex $history [expr {$historyindex - 1}]] == $elt} {
7162         return
7163     }
7164
7165     if {$historyindex < [llength $history]} {
7166         set history [lreplace $history $historyindex end $elt]
7167     } else {
7168         lappend history $elt
7169     }
7170     incr historyindex
7171     if {$historyindex > 1} {
7172         .tf.bar.leftbut conf -state normal
7173     } else {
7174         .tf.bar.leftbut conf -state disabled
7175     }
7176     .tf.bar.rightbut conf -state disabled
7177 }
7178
7179 # save the scrolling position of the diff display pane
7180 proc save_position {} {
7181     global historyindex history
7182
7183     if {$historyindex < 1} return
7184     set hi [expr {$historyindex - 1}]
7185     set fn [lindex $history $hi 2]
7186     if {$fn ne {}} {
7187         lset history $hi 3 [eval $fn]
7188     }
7189 }
7190
7191 proc unset_posvars {} {
7192     global last_posvars
7193
7194     if {[info exists last_posvars]} {
7195         foreach {var val} $last_posvars {
7196             global $var
7197             catch {unset $var}
7198         }
7199         unset last_posvars
7200     }
7201 }
7202
7203 proc godo {elt} {
7204     global curview last_posvars
7205
7206     set view [lindex $elt 0]
7207     set cmd [lindex $elt 1]
7208     set pv [lindex $elt 3]
7209     if {$curview != $view} {
7210         showview $view
7211     }
7212     unset_posvars
7213     foreach {var val} $pv {
7214         global $var
7215         set $var $val
7216     }
7217     set last_posvars $pv
7218     eval $cmd
7219 }
7220
7221 proc goback {} {
7222     global history historyindex
7223     focus .
7224
7225     if {$historyindex > 1} {
7226         save_position
7227         incr historyindex -1
7228         godo [lindex $history [expr {$historyindex - 1}]]
7229         .tf.bar.rightbut conf -state normal
7230     }
7231     if {$historyindex <= 1} {
7232         .tf.bar.leftbut conf -state disabled
7233     }
7234 }
7235
7236 proc goforw {} {
7237     global history historyindex
7238     focus .
7239
7240     if {$historyindex < [llength $history]} {
7241         save_position
7242         set cmd [lindex $history $historyindex]
7243         incr historyindex
7244         godo $cmd
7245         .tf.bar.leftbut conf -state normal
7246     }
7247     if {$historyindex >= [llength $history]} {
7248         .tf.bar.rightbut conf -state disabled
7249     }
7250 }
7251
7252 proc gettree {id} {
7253     global treefilelist treeidlist diffids diffmergeid treepending
7254     global nullid nullid2
7255
7256     set diffids $id
7257     catch {unset diffmergeid}
7258     if {![info exists treefilelist($id)]} {
7259         if {![info exists treepending]} {
7260             if {$id eq $nullid} {
7261                 set cmd [list | git ls-files]
7262             } elseif {$id eq $nullid2} {
7263                 set cmd [list | git ls-files --stage -t]
7264             } else {
7265                 set cmd [list | git ls-tree -r $id]
7266             }
7267             if {[catch {set gtf [open $cmd r]}]} {
7268                 return
7269             }
7270             set treepending $id
7271             set treefilelist($id) {}
7272             set treeidlist($id) {}
7273             fconfigure $gtf -blocking 0 -encoding binary
7274             filerun $gtf [list gettreeline $gtf $id]
7275         }
7276     } else {
7277         setfilelist $id
7278     }
7279 }
7280
7281 proc gettreeline {gtf id} {
7282     global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
7283
7284     set nl 0
7285     while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
7286         if {$diffids eq $nullid} {
7287             set fname $line
7288         } else {
7289             set i [string first "\t" $line]
7290             if {$i < 0} continue
7291             set fname [string range $line [expr {$i+1}] end]
7292             set line [string range $line 0 [expr {$i-1}]]
7293             if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7294             set sha1 [lindex $line 2]
7295             lappend treeidlist($id) $sha1
7296         }
7297         if {[string index $fname 0] eq "\""} {
7298             set fname [lindex $fname 0]
7299         }
7300         set fname [encoding convertfrom $fname]
7301         lappend treefilelist($id) $fname
7302     }
7303     if {![eof $gtf]} {
7304         return [expr {$nl >= 1000? 2: 1}]
7305     }
7306     close $gtf
7307     unset treepending
7308     if {$cmitmode ne "tree"} {
7309         if {![info exists diffmergeid]} {
7310             gettreediffs $diffids
7311         }
7312     } elseif {$id ne $diffids} {
7313         gettree $diffids
7314     } else {
7315         setfilelist $id
7316     }
7317     return 0
7318 }
7319
7320 proc showfile {f} {
7321     global treefilelist treeidlist diffids nullid nullid2
7322     global ctext_file_names ctext_file_lines
7323     global ctext commentend
7324
7325     set i [lsearch -exact $treefilelist($diffids) $f]
7326     if {$i < 0} {
7327         puts "oops, $f not in list for id $diffids"
7328         return
7329     }
7330     if {$diffids eq $nullid} {
7331         if {[catch {set bf [open $f r]} err]} {
7332             puts "oops, can't read $f: $err"
7333             return
7334         }
7335     } else {
7336         set blob [lindex $treeidlist($diffids) $i]
7337         if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7338             puts "oops, error reading blob $blob: $err"
7339             return
7340         }
7341     }
7342     fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7343     filerun $bf [list getblobline $bf $diffids]
7344     $ctext config -state normal
7345     clear_ctext $commentend
7346     lappend ctext_file_names $f
7347     lappend ctext_file_lines [lindex [split $commentend "."] 0]
7348     $ctext insert end "\n"
7349     $ctext insert end "$f\n" filesep
7350     $ctext config -state disabled
7351     $ctext yview $commentend
7352     settabs 0
7353 }
7354
7355 proc getblobline {bf id} {
7356     global diffids cmitmode ctext
7357
7358     if {$id ne $diffids || $cmitmode ne "tree"} {
7359         catch {close $bf}
7360         return 0
7361     }
7362     $ctext config -state normal
7363     set nl 0
7364     while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7365         $ctext insert end "$line\n"
7366     }
7367     if {[eof $bf]} {
7368         global jump_to_here ctext_file_names commentend
7369
7370         # delete last newline
7371         $ctext delete "end - 2c" "end - 1c"
7372         close $bf
7373         if {$jump_to_here ne {} &&
7374             [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7375             set lnum [expr {[lindex $jump_to_here 1] +
7376                             [lindex [split $commentend .] 0]}]
7377             mark_ctext_line $lnum
7378         }
7379         $ctext config -state disabled
7380         return 0
7381     }
7382     $ctext config -state disabled
7383     return [expr {$nl >= 1000? 2: 1}]
7384 }
7385
7386 proc mark_ctext_line {lnum} {
7387     global ctext markbgcolor
7388
7389     $ctext tag delete omark
7390     $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7391     $ctext tag conf omark -background $markbgcolor
7392     $ctext see $lnum.0
7393 }
7394
7395 proc mergediff {id} {
7396     global diffmergeid
7397     global diffids treediffs
7398     global parents curview
7399
7400     set diffmergeid $id
7401     set diffids $id
7402     set treediffs($id) {}
7403     set np [llength $parents($curview,$id)]
7404     settabs $np
7405     getblobdiffs $id
7406 }
7407
7408 proc startdiff {ids} {
7409     global treediffs diffids treepending diffmergeid nullid nullid2
7410
7411     settabs 1
7412     set diffids $ids
7413     catch {unset diffmergeid}
7414     if {![info exists treediffs($ids)] ||
7415         [lsearch -exact $ids $nullid] >= 0 ||
7416         [lsearch -exact $ids $nullid2] >= 0} {
7417         if {![info exists treepending]} {
7418             gettreediffs $ids
7419         }
7420     } else {
7421         addtocflist $ids
7422     }
7423 }
7424
7425 # If the filename (name) is under any of the passed filter paths
7426 # then return true to include the file in the listing.
7427 proc path_filter {filter name} {
7428     set worktree [gitworktree]
7429     foreach p $filter {
7430         set fq_p [file normalize $p]
7431         set fq_n [file normalize [file join $worktree $name]]
7432         if {[string match [file normalize $fq_p]* $fq_n]} {
7433             return 1
7434         }
7435     }
7436     return 0
7437 }
7438
7439 proc addtocflist {ids} {
7440     global treediffs
7441
7442     add_flist $treediffs($ids)
7443     getblobdiffs $ids
7444 }
7445
7446 proc diffcmd {ids flags} {
7447     global nullid nullid2
7448
7449     set i [lsearch -exact $ids $nullid]
7450     set j [lsearch -exact $ids $nullid2]
7451     if {$i >= 0} {
7452         if {[llength $ids] > 1 && $j < 0} {
7453             # comparing working directory with some specific revision
7454             set cmd [concat | git diff-index $flags]
7455             if {$i == 0} {
7456                 lappend cmd -R [lindex $ids 1]
7457             } else {
7458                 lappend cmd [lindex $ids 0]
7459             }
7460         } else {
7461             # comparing working directory with index
7462             set cmd [concat | git diff-files $flags]
7463             if {$j == 1} {
7464                 lappend cmd -R
7465             }
7466         }
7467     } elseif {$j >= 0} {
7468         set cmd [concat | git diff-index --cached $flags]
7469         if {[llength $ids] > 1} {
7470             # comparing index with specific revision
7471             if {$j == 0} {
7472                 lappend cmd -R [lindex $ids 1]
7473             } else {
7474                 lappend cmd [lindex $ids 0]
7475             }
7476         } else {
7477             # comparing index with HEAD
7478             lappend cmd HEAD
7479         }
7480     } else {
7481         set cmd [concat | git diff-tree -r $flags $ids]
7482     }
7483     return $cmd
7484 }
7485
7486 proc gettreediffs {ids} {
7487     global treediff treepending
7488
7489     if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
7490
7491     set treepending $ids
7492     set treediff {}
7493     fconfigure $gdtf -blocking 0 -encoding binary
7494     filerun $gdtf [list gettreediffline $gdtf $ids]
7495 }
7496
7497 proc gettreediffline {gdtf ids} {
7498     global treediff treediffs treepending diffids diffmergeid
7499     global cmitmode vfilelimit curview limitdiffs perfile_attrs
7500
7501     set nr 0
7502     set sublist {}
7503     set max 1000
7504     if {$perfile_attrs} {
7505         # cache_gitattr is slow, and even slower on win32 where we
7506         # have to invoke it for only about 30 paths at a time
7507         set max 500
7508         if {[tk windowingsystem] == "win32"} {
7509             set max 120
7510         }
7511     }
7512     while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7513         set i [string first "\t" $line]
7514         if {$i >= 0} {
7515             set file [string range $line [expr {$i+1}] end]
7516             if {[string index $file 0] eq "\""} {
7517                 set file [lindex $file 0]
7518             }
7519             set file [encoding convertfrom $file]
7520             if {$file ne [lindex $treediff end]} {
7521                 lappend treediff $file
7522                 lappend sublist $file
7523             }
7524         }
7525     }
7526     if {$perfile_attrs} {
7527         cache_gitattr encoding $sublist
7528     }
7529     if {![eof $gdtf]} {
7530         return [expr {$nr >= $max? 2: 1}]
7531     }
7532     close $gdtf
7533     if {$limitdiffs && $vfilelimit($curview) ne {}} {
7534         set flist {}
7535         foreach f $treediff {
7536             if {[path_filter $vfilelimit($curview) $f]} {
7537                 lappend flist $f
7538             }
7539         }
7540         set treediffs($ids) $flist
7541     } else {
7542         set treediffs($ids) $treediff
7543     }
7544     unset treepending
7545     if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7546         gettree $diffids
7547     } elseif {$ids != $diffids} {
7548         if {![info exists diffmergeid]} {
7549             gettreediffs $diffids
7550         }
7551     } else {
7552         addtocflist $ids
7553     }
7554     return 0
7555 }
7556
7557 # empty string or positive integer
7558 proc diffcontextvalidate {v} {
7559     return [regexp {^(|[1-9][0-9]*)$} $v]
7560 }
7561
7562 proc diffcontextchange {n1 n2 op} {
7563     global diffcontextstring diffcontext
7564
7565     if {[string is integer -strict $diffcontextstring]} {
7566         if {$diffcontextstring >= 0} {
7567             set diffcontext $diffcontextstring
7568             reselectline
7569         }
7570     }
7571 }
7572
7573 proc changeignorespace {} {
7574     reselectline
7575 }
7576
7577 proc changeworddiff {name ix op} {
7578     reselectline
7579 }
7580
7581 proc getblobdiffs {ids} {
7582     global blobdifffd diffids env
7583     global diffinhdr treediffs
7584     global diffcontext
7585     global ignorespace
7586     global worddiff
7587     global limitdiffs vfilelimit curview
7588     global diffencoding targetline diffnparents
7589     global git_version currdiffsubmod
7590
7591     set textconv {}
7592     if {[package vcompare $git_version "1.6.1"] >= 0} {
7593         set textconv "--textconv"
7594     }
7595     set submodule {}
7596     if {[package vcompare $git_version "1.6.6"] >= 0} {
7597         set submodule "--submodule"
7598     }
7599     set cmd [diffcmd $ids "-p $textconv $submodule  -C --cc --no-commit-id -U$diffcontext"]
7600     if {$ignorespace} {
7601         append cmd " -w"
7602     }
7603     if {$worddiff ne [mc "Line diff"]} {
7604         append cmd " --word-diff=porcelain"
7605     }
7606     if {$limitdiffs && $vfilelimit($curview) ne {}} {
7607         set cmd [concat $cmd -- $vfilelimit($curview)]
7608     }
7609     if {[catch {set bdf [open $cmd r]} err]} {
7610         error_popup [mc "Error getting diffs: %s" $err]
7611         return
7612     }
7613     set targetline {}
7614     set diffnparents 0
7615     set diffinhdr 0
7616     set diffencoding [get_path_encoding {}]
7617     fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
7618     set blobdifffd($ids) $bdf
7619     set currdiffsubmod ""
7620     filerun $bdf [list getblobdiffline $bdf $diffids]
7621 }
7622
7623 proc savecmitpos {} {
7624     global ctext cmitmode
7625
7626     if {$cmitmode eq "tree"} {
7627         return {}
7628     }
7629     return [list target_scrollpos [$ctext index @0,0]]
7630 }
7631
7632 proc savectextpos {} {
7633     global ctext
7634
7635     return [list target_scrollpos [$ctext index @0,0]]
7636 }
7637
7638 proc maybe_scroll_ctext {ateof} {
7639     global ctext target_scrollpos
7640
7641     if {![info exists target_scrollpos]} return
7642     if {!$ateof} {
7643         set nlines [expr {[winfo height $ctext]
7644                           / [font metrics textfont -linespace]}]
7645         if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
7646     }
7647     $ctext yview $target_scrollpos
7648     unset target_scrollpos
7649 }
7650
7651 proc setinlist {var i val} {
7652     global $var
7653
7654     while {[llength [set $var]] < $i} {
7655         lappend $var {}
7656     }
7657     if {[llength [set $var]] == $i} {
7658         lappend $var $val
7659     } else {
7660         lset $var $i $val
7661     }
7662 }
7663
7664 proc makediffhdr {fname ids} {
7665     global ctext curdiffstart treediffs diffencoding
7666     global ctext_file_names jump_to_here targetline diffline
7667
7668     set fname [encoding convertfrom $fname]
7669     set diffencoding [get_path_encoding $fname]
7670     set i [lsearch -exact $treediffs($ids) $fname]
7671     if {$i >= 0} {
7672         setinlist difffilestart $i $curdiffstart
7673     }
7674     lset ctext_file_names end $fname
7675     set l [expr {(78 - [string length $fname]) / 2}]
7676     set pad [string range "----------------------------------------" 1 $l]
7677     $ctext insert $curdiffstart "$pad $fname $pad" filesep
7678     set targetline {}
7679     if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
7680         set targetline [lindex $jump_to_here 1]
7681     }
7682     set diffline 0
7683 }
7684
7685 proc getblobdiffline {bdf ids} {
7686     global diffids blobdifffd ctext curdiffstart
7687     global diffnexthead diffnextnote difffilestart
7688     global ctext_file_names ctext_file_lines
7689     global diffinhdr treediffs mergemax diffnparents
7690     global diffencoding jump_to_here targetline diffline currdiffsubmod
7691     global worddiff
7692
7693     set nr 0
7694     $ctext conf -state normal
7695     while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
7696         if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
7697             catch {close $bdf}
7698             return 0
7699         }
7700         if {![string compare -length 5 "diff " $line]} {
7701             if {![regexp {^diff (--cc|--git) } $line m type]} {
7702                 set line [encoding convertfrom $line]
7703                 $ctext insert end "$line\n" hunksep
7704                 continue
7705             }
7706             # start of a new file
7707             set diffinhdr 1
7708             $ctext insert end "\n"
7709             set curdiffstart [$ctext index "end - 1c"]
7710             lappend ctext_file_names ""
7711             lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7712             $ctext insert end "\n" filesep
7713
7714             if {$type eq "--cc"} {
7715                 # start of a new file in a merge diff
7716                 set fname [string range $line 10 end]
7717                 if {[lsearch -exact $treediffs($ids) $fname] < 0} {
7718                     lappend treediffs($ids) $fname
7719                     add_flist [list $fname]
7720                 }
7721
7722             } else {
7723                 set line [string range $line 11 end]
7724                 # If the name hasn't changed the length will be odd,
7725                 # the middle char will be a space, and the two bits either
7726                 # side will be a/name and b/name, or "a/name" and "b/name".
7727                 # If the name has changed we'll get "rename from" and
7728                 # "rename to" or "copy from" and "copy to" lines following
7729                 # this, and we'll use them to get the filenames.
7730                 # This complexity is necessary because spaces in the
7731                 # filename(s) don't get escaped.
7732                 set l [string length $line]
7733                 set i [expr {$l / 2}]
7734                 if {!(($l & 1) && [string index $line $i] eq " " &&
7735                       [string range $line 2 [expr {$i - 1}]] eq \
7736                           [string range $line [expr {$i + 3}] end])} {
7737                     continue
7738                 }
7739                 # unescape if quoted and chop off the a/ from the front
7740                 if {[string index $line 0] eq "\""} {
7741                     set fname [string range [lindex $line 0] 2 end]
7742                 } else {
7743                     set fname [string range $line 2 [expr {$i - 1}]]
7744                 }
7745             }
7746             makediffhdr $fname $ids
7747
7748         } elseif {![string compare -length 16 "* Unmerged path " $line]} {
7749             set fname [encoding convertfrom [string range $line 16 end]]
7750             $ctext insert end "\n"
7751             set curdiffstart [$ctext index "end - 1c"]
7752             lappend ctext_file_names $fname
7753             lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7754             $ctext insert end "$line\n" filesep
7755             set i [lsearch -exact $treediffs($ids) $fname]
7756             if {$i >= 0} {
7757                 setinlist difffilestart $i $curdiffstart
7758             }
7759
7760         } elseif {![string compare -length 2 "@@" $line]} {
7761             regexp {^@@+} $line ats
7762             set line [encoding convertfrom $diffencoding $line]
7763             $ctext insert end "$line\n" hunksep
7764             if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
7765                 set diffline $nl
7766             }
7767             set diffnparents [expr {[string length $ats] - 1}]
7768             set diffinhdr 0
7769
7770         } elseif {![string compare -length 10 "Submodule " $line]} {
7771             # start of a new submodule
7772             if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
7773                 set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
7774             } else {
7775                 set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
7776             }
7777             if {$currdiffsubmod != $fname} {
7778                 $ctext insert end "\n";     # Add newline after commit message
7779             }
7780             set curdiffstart [$ctext index "end - 1c"]
7781             lappend ctext_file_names ""
7782             if {$currdiffsubmod != $fname} {
7783                 lappend ctext_file_lines $fname
7784                 makediffhdr $fname $ids
7785                 set currdiffsubmod $fname
7786                 $ctext insert end "\n$line\n" filesep
7787             } else {
7788                 $ctext insert end "$line\n" filesep
7789             }
7790         } elseif {![string compare -length 3 "  >" $line]} {
7791             set $currdiffsubmod ""
7792             set line [encoding convertfrom $diffencoding $line]
7793             $ctext insert end "$line\n" dresult
7794         } elseif {![string compare -length 3 "  <" $line]} {
7795             set $currdiffsubmod ""
7796             set line [encoding convertfrom $diffencoding $line]
7797             $ctext insert end "$line\n" d0
7798         } elseif {$diffinhdr} {
7799             if {![string compare -length 12 "rename from " $line]} {
7800                 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
7801                 if {[string index $fname 0] eq "\""} {
7802                     set fname [lindex $fname 0]
7803                 }
7804                 set fname [encoding convertfrom $fname]
7805                 set i [lsearch -exact $treediffs($ids) $fname]
7806                 if {$i >= 0} {
7807                     setinlist difffilestart $i $curdiffstart
7808                 }
7809             } elseif {![string compare -length 10 $line "rename to "] ||
7810                       ![string compare -length 8 $line "copy to "]} {
7811                 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
7812                 if {[string index $fname 0] eq "\""} {
7813                     set fname [lindex $fname 0]
7814                 }
7815                 makediffhdr $fname $ids
7816             } elseif {[string compare -length 3 $line "---"] == 0} {
7817                 # do nothing
7818                 continue
7819             } elseif {[string compare -length 3 $line "+++"] == 0} {
7820                 set diffinhdr 0
7821                 continue
7822             }
7823             $ctext insert end "$line\n" filesep
7824
7825         } else {
7826             set line [string map {\x1A ^Z} \
7827                           [encoding convertfrom $diffencoding $line]]
7828             # parse the prefix - one ' ', '-' or '+' for each parent
7829             set prefix [string range $line 0 [expr {$diffnparents - 1}]]
7830             set tag [expr {$diffnparents > 1? "m": "d"}]
7831             set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
7832             set words_pre_markup ""
7833             set words_post_markup ""
7834             if {[string trim $prefix " -+"] eq {}} {
7835                 # prefix only has " ", "-" and "+" in it: normal diff line
7836                 set num [string first "-" $prefix]
7837                 if {$dowords} {
7838                     set line [string range $line 1 end]
7839                 }
7840                 if {$num >= 0} {
7841                     # removed line, first parent with line is $num
7842                     if {$num >= $mergemax} {
7843                         set num "max"
7844                     }
7845                     if {$dowords && $worddiff eq [mc "Markup words"]} {
7846                         $ctext insert end "\[-$line-\]" $tag$num
7847                     } else {
7848                         $ctext insert end "$line" $tag$num
7849                     }
7850                     if {!$dowords} {
7851                         $ctext insert end "\n" $tag$num
7852                     }
7853                 } else {
7854                     set tags {}
7855                     if {[string first "+" $prefix] >= 0} {
7856                         # added line
7857                         lappend tags ${tag}result
7858                         if {$diffnparents > 1} {
7859                             set num [string first " " $prefix]
7860                             if {$num >= 0} {
7861                                 if {$num >= $mergemax} {
7862                                     set num "max"
7863                                 }
7864                                 lappend tags m$num
7865                             }
7866                         }
7867                         set words_pre_markup "{+"
7868                         set words_post_markup "+}"
7869                     }
7870                     if {$targetline ne {}} {
7871                         if {$diffline == $targetline} {
7872                             set seehere [$ctext index "end - 1 chars"]
7873                             set targetline {}
7874                         } else {
7875                             incr diffline
7876                         }
7877                     }
7878                     if {$dowords && $worddiff eq [mc "Markup words"]} {
7879                         $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
7880                     } else {
7881                         $ctext insert end "$line" $tags
7882                     }
7883                     if {!$dowords} {
7884                         $ctext insert end "\n" $tags
7885                     }
7886                 }
7887             } elseif {$dowords && $prefix eq "~"} {
7888                 $ctext insert end "\n" {}
7889             } else {
7890                 # "\ No newline at end of file",
7891                 # or something else we don't recognize
7892                 $ctext insert end "$line\n" hunksep
7893             }
7894         }
7895     }
7896     if {[info exists seehere]} {
7897         mark_ctext_line [lindex [split $seehere .] 0]
7898     }
7899     maybe_scroll_ctext [eof $bdf]
7900     $ctext conf -state disabled
7901     if {[eof $bdf]} {
7902         catch {close $bdf}
7903         return 0
7904     }
7905     return [expr {$nr >= 1000? 2: 1}]
7906 }
7907
7908 proc changediffdisp {} {
7909     global ctext diffelide
7910
7911     $ctext tag conf d0 -elide [lindex $diffelide 0]
7912     $ctext tag conf dresult -elide [lindex $diffelide 1]
7913 }
7914
7915 proc highlightfile {loc cline} {
7916     global ctext cflist cflist_top
7917
7918     $ctext yview $loc
7919     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
7920     $cflist tag add highlight $cline.0 "$cline.0 lineend"
7921     $cflist see $cline.0
7922     set cflist_top $cline
7923 }
7924
7925 proc prevfile {} {
7926     global difffilestart ctext cmitmode
7927
7928     if {$cmitmode eq "tree"} return
7929     set prev 0.0
7930     set prevline 1
7931     set here [$ctext index @0,0]
7932     foreach loc $difffilestart {
7933         if {[$ctext compare $loc >= $here]} {
7934             highlightfile $prev $prevline
7935             return
7936         }
7937         set prev $loc
7938         incr prevline
7939     }
7940     highlightfile $prev $prevline
7941 }
7942
7943 proc nextfile {} {
7944     global difffilestart ctext cmitmode
7945
7946     if {$cmitmode eq "tree"} return
7947     set here [$ctext index @0,0]
7948     set line 1
7949     foreach loc $difffilestart {
7950         incr line
7951         if {[$ctext compare $loc > $here]} {
7952             highlightfile $loc $line
7953             return
7954         }
7955     }
7956 }
7957
7958 proc clear_ctext {{first 1.0}} {
7959     global ctext smarktop smarkbot
7960     global ctext_file_names ctext_file_lines
7961     global pendinglinks
7962
7963     set l [lindex [split $first .] 0]
7964     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
7965         set smarktop $l
7966     }
7967     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
7968         set smarkbot $l
7969     }
7970     $ctext delete $first end
7971     if {$first eq "1.0"} {
7972         catch {unset pendinglinks}
7973     }
7974     set ctext_file_names {}
7975     set ctext_file_lines {}
7976 }
7977
7978 proc settabs {{firstab {}}} {
7979     global firsttabstop tabstop ctext have_tk85
7980
7981     if {$firstab ne {} && $have_tk85} {
7982         set firsttabstop $firstab
7983     }
7984     set w [font measure textfont "0"]
7985     if {$firsttabstop != 0} {
7986         $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
7987                                [expr {($firsttabstop + 2 * $tabstop) * $w}]]
7988     } elseif {$have_tk85 || $tabstop != 8} {
7989         $ctext conf -tabs [expr {$tabstop * $w}]
7990     } else {
7991         $ctext conf -tabs {}
7992     }
7993 }
7994
7995 proc incrsearch {name ix op} {
7996     global ctext searchstring searchdirn
7997
7998     $ctext tag remove found 1.0 end
7999     if {[catch {$ctext index anchor}]} {
8000         # no anchor set, use start of selection, or of visible area
8001         set sel [$ctext tag ranges sel]
8002         if {$sel ne {}} {
8003             $ctext mark set anchor [lindex $sel 0]
8004         } elseif {$searchdirn eq "-forwards"} {
8005             $ctext mark set anchor @0,0
8006         } else {
8007             $ctext mark set anchor @0,[winfo height $ctext]
8008         }
8009     }
8010     if {$searchstring ne {}} {
8011         set here [$ctext search $searchdirn -- $searchstring anchor]
8012         if {$here ne {}} {
8013             $ctext see $here
8014         }
8015         searchmarkvisible 1
8016     }
8017 }
8018
8019 proc dosearch {} {
8020     global sstring ctext searchstring searchdirn
8021
8022     focus $sstring
8023     $sstring icursor end
8024     set searchdirn -forwards
8025     if {$searchstring ne {}} {
8026         set sel [$ctext tag ranges sel]
8027         if {$sel ne {}} {
8028             set start "[lindex $sel 0] + 1c"
8029         } elseif {[catch {set start [$ctext index anchor]}]} {
8030             set start "@0,0"
8031         }
8032         set match [$ctext search -count mlen -- $searchstring $start]
8033         $ctext tag remove sel 1.0 end
8034         if {$match eq {}} {
8035             bell
8036             return
8037         }
8038         $ctext see $match
8039         set mend "$match + $mlen c"
8040         $ctext tag add sel $match $mend
8041         $ctext mark unset anchor
8042     }
8043 }
8044
8045 proc dosearchback {} {
8046     global sstring ctext searchstring searchdirn
8047
8048     focus $sstring
8049     $sstring icursor end
8050     set searchdirn -backwards
8051     if {$searchstring ne {}} {
8052         set sel [$ctext tag ranges sel]
8053         if {$sel ne {}} {
8054             set start [lindex $sel 0]
8055         } elseif {[catch {set start [$ctext index anchor]}]} {
8056             set start @0,[winfo height $ctext]
8057         }
8058         set match [$ctext search -backwards -count ml -- $searchstring $start]
8059         $ctext tag remove sel 1.0 end
8060         if {$match eq {}} {
8061             bell
8062             return
8063         }
8064         $ctext see $match
8065         set mend "$match + $ml c"
8066         $ctext tag add sel $match $mend
8067         $ctext mark unset anchor
8068     }
8069 }
8070
8071 proc searchmark {first last} {
8072     global ctext searchstring
8073
8074     set mend $first.0
8075     while {1} {
8076         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8077         if {$match eq {}} break
8078         set mend "$match + $mlen c"
8079         $ctext tag add found $match $mend
8080     }
8081 }
8082
8083 proc searchmarkvisible {doall} {
8084     global ctext smarktop smarkbot
8085
8086     set topline [lindex [split [$ctext index @0,0] .] 0]
8087     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8088     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
8089         # no overlap with previous
8090         searchmark $topline $botline
8091         set smarktop $topline
8092         set smarkbot $botline
8093     } else {
8094         if {$topline < $smarktop} {
8095             searchmark $topline [expr {$smarktop-1}]
8096             set smarktop $topline
8097         }
8098         if {$botline > $smarkbot} {
8099             searchmark [expr {$smarkbot+1}] $botline
8100             set smarkbot $botline
8101         }
8102     }
8103 }
8104
8105 proc scrolltext {f0 f1} {
8106     global searchstring
8107
8108     .bleft.bottom.sb set $f0 $f1
8109     if {$searchstring ne {}} {
8110         searchmarkvisible 0
8111     }
8112 }
8113
8114 proc setcoords {} {
8115     global linespc charspc canvx0 canvy0
8116     global xspc1 xspc2 lthickness
8117
8118     set linespc [font metrics mainfont -linespace]
8119     set charspc [font measure mainfont "m"]
8120     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8121     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
8122     set lthickness [expr {int($linespc / 9) + 1}]
8123     set xspc1(0) $linespc
8124     set xspc2 $linespc
8125 }
8126
8127 proc redisplay {} {
8128     global canv
8129     global selectedline
8130
8131     set ymax [lindex [$canv cget -scrollregion] 3]
8132     if {$ymax eq {} || $ymax == 0} return
8133     set span [$canv yview]
8134     clear_display
8135     setcanvscroll
8136     allcanvs yview moveto [lindex $span 0]
8137     drawvisible
8138     if {$selectedline ne {}} {
8139         selectline $selectedline 0
8140         allcanvs yview moveto [lindex $span 0]
8141     }
8142 }
8143
8144 proc parsefont {f n} {
8145     global fontattr
8146
8147     set fontattr($f,family) [lindex $n 0]
8148     set s [lindex $n 1]
8149     if {$s eq {} || $s == 0} {
8150         set s 10
8151     } elseif {$s < 0} {
8152         set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
8153     }
8154     set fontattr($f,size) $s
8155     set fontattr($f,weight) normal
8156     set fontattr($f,slant) roman
8157     foreach style [lrange $n 2 end] {
8158         switch -- $style {
8159             "normal" -
8160             "bold"   {set fontattr($f,weight) $style}
8161             "roman" -
8162             "italic" {set fontattr($f,slant) $style}
8163         }
8164     }
8165 }
8166
8167 proc fontflags {f {isbold 0}} {
8168     global fontattr
8169
8170     return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8171                 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8172                 -slant $fontattr($f,slant)]
8173 }
8174
8175 proc fontname {f} {
8176     global fontattr
8177
8178     set n [list $fontattr($f,family) $fontattr($f,size)]
8179     if {$fontattr($f,weight) eq "bold"} {
8180         lappend n "bold"
8181     }
8182     if {$fontattr($f,slant) eq "italic"} {
8183         lappend n "italic"
8184     }
8185     return $n
8186 }
8187
8188 proc incrfont {inc} {
8189     global mainfont textfont ctext canv cflist showrefstop
8190     global stopped entries fontattr
8191
8192     unmarkmatches
8193     set s $fontattr(mainfont,size)
8194     incr s $inc
8195     if {$s < 1} {
8196         set s 1
8197     }
8198     set fontattr(mainfont,size) $s
8199     font config mainfont -size $s
8200     font config mainfontbold -size $s
8201     set mainfont [fontname mainfont]
8202     set s $fontattr(textfont,size)
8203     incr s $inc
8204     if {$s < 1} {
8205         set s 1
8206     }
8207     set fontattr(textfont,size) $s
8208     font config textfont -size $s
8209     font config textfontbold -size $s
8210     set textfont [fontname textfont]
8211     setcoords
8212     settabs
8213     redisplay
8214 }
8215
8216 proc clearsha1 {} {
8217     global sha1entry sha1string
8218     if {[string length $sha1string] == 40} {
8219         $sha1entry delete 0 end
8220     }
8221 }
8222
8223 proc sha1change {n1 n2 op} {
8224     global sha1string currentid sha1but
8225     if {$sha1string == {}
8226         || ([info exists currentid] && $sha1string == $currentid)} {
8227         set state disabled
8228     } else {
8229         set state normal
8230     }
8231     if {[$sha1but cget -state] == $state} return
8232     if {$state == "normal"} {
8233         $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
8234     } else {
8235         $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
8236     }
8237 }
8238
8239 proc gotocommit {} {
8240     global sha1string tagids headids curview varcid
8241
8242     if {$sha1string == {}
8243         || ([info exists currentid] && $sha1string == $currentid)} return
8244     if {[info exists tagids($sha1string)]} {
8245         set id $tagids($sha1string)
8246     } elseif {[info exists headids($sha1string)]} {
8247         set id $headids($sha1string)
8248     } else {
8249         set id [string tolower $sha1string]
8250         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
8251             set matches [longid $id]
8252             if {$matches ne {}} {
8253                 if {[llength $matches] > 1} {
8254                     error_popup [mc "Short SHA1 id %s is ambiguous" $id]
8255                     return
8256                 }
8257                 set id [lindex $matches 0]
8258             }
8259         } else {
8260             if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8261                 error_popup [mc "Revision %s is not known" $sha1string]
8262                 return
8263             }
8264         }
8265     }
8266     if {[commitinview $id $curview]} {
8267         selectline [rowofcommit $id] 1
8268         return
8269     }
8270     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
8271         set msg [mc "SHA1 id %s is not known" $sha1string]
8272     } else {
8273         set msg [mc "Revision %s is not in the current view" $sha1string]
8274     }
8275     error_popup $msg
8276 }
8277
8278 proc lineenter {x y id} {
8279     global hoverx hovery hoverid hovertimer
8280     global commitinfo canv
8281
8282     if {![info exists commitinfo($id)] && ![getcommit $id]} return
8283     set hoverx $x
8284     set hovery $y
8285     set hoverid $id
8286     if {[info exists hovertimer]} {
8287         after cancel $hovertimer
8288     }
8289     set hovertimer [after 500 linehover]
8290     $canv delete hover
8291 }
8292
8293 proc linemotion {x y id} {
8294     global hoverx hovery hoverid hovertimer
8295
8296     if {[info exists hoverid] && $id == $hoverid} {
8297         set hoverx $x
8298         set hovery $y
8299         if {[info exists hovertimer]} {
8300             after cancel $hovertimer
8301         }
8302         set hovertimer [after 500 linehover]
8303     }
8304 }
8305
8306 proc lineleave {id} {
8307     global hoverid hovertimer canv
8308
8309     if {[info exists hoverid] && $id == $hoverid} {
8310         $canv delete hover
8311         if {[info exists hovertimer]} {
8312             after cancel $hovertimer
8313             unset hovertimer
8314         }
8315         unset hoverid
8316     }
8317 }
8318
8319 proc linehover {} {
8320     global hoverx hovery hoverid hovertimer
8321     global canv linespc lthickness
8322     global commitinfo
8323
8324     set text [lindex $commitinfo($hoverid) 0]
8325     set ymax [lindex [$canv cget -scrollregion] 3]
8326     if {$ymax == {}} return
8327     set yfrac [lindex [$canv yview] 0]
8328     set x [expr {$hoverx + 2 * $linespc}]
8329     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8330     set x0 [expr {$x - 2 * $lthickness}]
8331     set y0 [expr {$y - 2 * $lthickness}]
8332     set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
8333     set y1 [expr {$y + $linespc + 2 * $lthickness}]
8334     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8335                -fill \#ffff80 -outline black -width 1 -tags hover]
8336     $canv raise $t
8337     set t [$canv create text $x $y -anchor nw -text $text -tags hover \
8338                -font mainfont]
8339     $canv raise $t
8340 }
8341
8342 proc clickisonarrow {id y} {
8343     global lthickness
8344
8345     set ranges [rowranges $id]
8346     set thresh [expr {2 * $lthickness + 6}]
8347     set n [expr {[llength $ranges] - 1}]
8348     for {set i 1} {$i < $n} {incr i} {
8349         set row [lindex $ranges $i]
8350         if {abs([yc $row] - $y) < $thresh} {
8351             return $i
8352         }
8353     }
8354     return {}
8355 }
8356
8357 proc arrowjump {id n y} {
8358     global canv
8359
8360     # 1 <-> 2, 3 <-> 4, etc...
8361     set n [expr {(($n - 1) ^ 1) + 1}]
8362     set row [lindex [rowranges $id] $n]
8363     set yt [yc $row]
8364     set ymax [lindex [$canv cget -scrollregion] 3]
8365     if {$ymax eq {} || $ymax <= 0} return
8366     set view [$canv yview]
8367     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8368     set yfrac [expr {$yt / $ymax - $yspan / 2}]
8369     if {$yfrac < 0} {
8370         set yfrac 0
8371     }
8372     allcanvs yview moveto $yfrac
8373 }
8374
8375 proc lineclick {x y id isnew} {
8376     global ctext commitinfo children canv thickerline curview
8377
8378     if {![info exists commitinfo($id)] && ![getcommit $id]} return
8379     unmarkmatches
8380     unselectline
8381     normalline
8382     $canv delete hover
8383     # draw this line thicker than normal
8384     set thickerline $id
8385     drawlines $id
8386     if {$isnew} {
8387         set ymax [lindex [$canv cget -scrollregion] 3]
8388         if {$ymax eq {}} return
8389         set yfrac [lindex [$canv yview] 0]
8390         set y [expr {$y + $yfrac * $ymax}]
8391     }
8392     set dirn [clickisonarrow $id $y]
8393     if {$dirn ne {}} {
8394         arrowjump $id $dirn $y
8395         return
8396     }
8397
8398     if {$isnew} {
8399         addtohistory [list lineclick $x $y $id 0] savectextpos
8400     }
8401     # fill the details pane with info about this line
8402     $ctext conf -state normal
8403     clear_ctext
8404     settabs 0
8405     $ctext insert end "[mc "Parent"]:\t"
8406     $ctext insert end $id link0
8407     setlink $id link0
8408     set info $commitinfo($id)
8409     $ctext insert end "\n\t[lindex $info 0]\n"
8410     $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8411     set date [formatdate [lindex $info 2]]
8412     $ctext insert end "\t[mc "Date"]:\t$date\n"
8413     set kids $children($curview,$id)
8414     if {$kids ne {}} {
8415         $ctext insert end "\n[mc "Children"]:"
8416         set i 0
8417         foreach child $kids {
8418             incr i
8419             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8420             set info $commitinfo($child)
8421             $ctext insert end "\n\t"
8422             $ctext insert end $child link$i
8423             setlink $child link$i
8424             $ctext insert end "\n\t[lindex $info 0]"
8425             $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8426             set date [formatdate [lindex $info 2]]
8427             $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8428         }
8429     }
8430     maybe_scroll_ctext 1
8431     $ctext conf -state disabled
8432     init_flist {}
8433 }
8434
8435 proc normalline {} {
8436     global thickerline
8437     if {[info exists thickerline]} {
8438         set id $thickerline
8439         unset thickerline
8440         drawlines $id
8441     }
8442 }
8443
8444 proc selbyid {id {isnew 1}} {
8445     global curview
8446     if {[commitinview $id $curview]} {
8447         selectline [rowofcommit $id] $isnew
8448     }
8449 }
8450
8451 proc mstime {} {
8452     global startmstime
8453     if {![info exists startmstime]} {
8454         set startmstime [clock clicks -milliseconds]
8455     }
8456     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8457 }
8458
8459 proc rowmenu {x y id} {
8460     global rowctxmenu selectedline rowmenuid curview
8461     global nullid nullid2 fakerowmenu mainhead markedid
8462
8463     stopfinding
8464     set rowmenuid $id
8465     if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8466         set state disabled
8467     } else {
8468         set state normal
8469     }
8470     if {$id ne $nullid && $id ne $nullid2} {
8471         set menu $rowctxmenu
8472         if {$mainhead ne {}} {
8473             $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead] -state normal
8474         } else {
8475             $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8476         }
8477         if {[info exists markedid] && $markedid ne $id} {
8478             $menu entryconfigure 9 -state normal
8479             $menu entryconfigure 10 -state normal
8480             $menu entryconfigure 11 -state normal
8481         } else {
8482             $menu entryconfigure 9 -state disabled
8483             $menu entryconfigure 10 -state disabled
8484             $menu entryconfigure 11 -state disabled
8485         }
8486     } else {
8487         set menu $fakerowmenu
8488     }
8489     $menu entryconfigure [mca "Diff this -> selected"] -state $state
8490     $menu entryconfigure [mca "Diff selected -> this"] -state $state
8491     $menu entryconfigure [mca "Make patch"] -state $state
8492     tk_popup $menu $x $y
8493 }
8494
8495 proc markhere {} {
8496     global rowmenuid markedid canv
8497
8498     set markedid $rowmenuid
8499     make_idmark $markedid
8500 }
8501
8502 proc gotomark {} {
8503     global markedid
8504
8505     if {[info exists markedid]} {
8506         selbyid $markedid
8507     }
8508 }
8509
8510 proc replace_by_kids {l r} {
8511     global curview children
8512
8513     set id [commitonrow $r]
8514     set l [lreplace $l 0 0]
8515     foreach kid $children($curview,$id) {
8516         lappend l [rowofcommit $kid]
8517     }
8518     return [lsort -integer -decreasing -unique $l]
8519 }
8520
8521 proc find_common_desc {} {
8522     global markedid rowmenuid curview children
8523
8524     if {![info exists markedid]} return
8525     if {![commitinview $markedid $curview] ||
8526         ![commitinview $rowmenuid $curview]} return
8527     #set t1 [clock clicks -milliseconds]
8528     set l1 [list [rowofcommit $markedid]]
8529     set l2 [list [rowofcommit $rowmenuid]]
8530     while 1 {
8531         set r1 [lindex $l1 0]
8532         set r2 [lindex $l2 0]
8533         if {$r1 eq {} || $r2 eq {}} break
8534         if {$r1 == $r2} {
8535             selectline $r1 1
8536             break
8537         }
8538         if {$r1 > $r2} {
8539             set l1 [replace_by_kids $l1 $r1]
8540         } else {
8541             set l2 [replace_by_kids $l2 $r2]
8542         }
8543     }
8544     #set t2 [clock clicks -milliseconds]
8545     #puts "took [expr {$t2-$t1}]ms"
8546 }
8547
8548 proc compare_commits {} {
8549     global markedid rowmenuid curview children
8550
8551     if {![info exists markedid]} return
8552     if {![commitinview $markedid $curview]} return
8553     addtohistory [list do_cmp_commits $markedid $rowmenuid]
8554     do_cmp_commits $markedid $rowmenuid
8555 }
8556
8557 proc getpatchid {id} {
8558     global patchids
8559
8560     if {![info exists patchids($id)]} {
8561         set cmd [diffcmd [list $id] {-p --root}]
8562         # trim off the initial "|"
8563         set cmd [lrange $cmd 1 end]
8564         if {[catch {
8565             set x [eval exec $cmd | git patch-id]
8566             set patchids($id) [lindex $x 0]
8567         }]} {
8568             set patchids($id) "error"
8569         }
8570     }
8571     return $patchids($id)
8572 }
8573
8574 proc do_cmp_commits {a b} {
8575     global ctext curview parents children patchids commitinfo
8576
8577     $ctext conf -state normal
8578     clear_ctext
8579     init_flist {}
8580     for {set i 0} {$i < 100} {incr i} {
8581         set skipa 0
8582         set skipb 0
8583         if {[llength $parents($curview,$a)] > 1} {
8584             appendshortlink $a [mc "Skipping merge commit "] "\n"
8585             set skipa 1
8586         } else {
8587             set patcha [getpatchid $a]
8588         }
8589         if {[llength $parents($curview,$b)] > 1} {
8590             appendshortlink $b [mc "Skipping merge commit "] "\n"
8591             set skipb 1
8592         } else {
8593             set patchb [getpatchid $b]
8594         }
8595         if {!$skipa && !$skipb} {
8596             set heada [lindex $commitinfo($a) 0]
8597             set headb [lindex $commitinfo($b) 0]
8598             if {$patcha eq "error"} {
8599                 appendshortlink $a [mc "Error getting patch ID for "] \
8600                     [mc " - stopping\n"]
8601                 break
8602             }
8603             if {$patchb eq "error"} {
8604                 appendshortlink $b [mc "Error getting patch ID for "] \
8605                     [mc " - stopping\n"]
8606                 break
8607             }
8608             if {$patcha eq $patchb} {
8609                 if {$heada eq $headb} {
8610                     appendshortlink $a [mc "Commit "]
8611                     appendshortlink $b " == " "  $heada\n"
8612                 } else {
8613                     appendshortlink $a [mc "Commit "] "  $heada\n"
8614                     appendshortlink $b [mc " is the same patch as\n       "] \
8615                         "  $headb\n"
8616                 }
8617                 set skipa 1
8618                 set skipb 1
8619             } else {
8620                 $ctext insert end "\n"
8621                 appendshortlink $a [mc "Commit "] "  $heada\n"
8622                 appendshortlink $b [mc " differs from\n       "] \
8623                     "  $headb\n"
8624                 $ctext insert end [mc "Diff of commits:\n\n"]
8625                 $ctext conf -state disabled
8626                 update
8627                 diffcommits $a $b
8628                 return
8629             }
8630         }
8631         if {$skipa} {
8632             set kids [real_children $curview,$a]
8633             if {[llength $kids] != 1} {
8634                 $ctext insert end "\n"
8635                 appendshortlink $a [mc "Commit "] \
8636                     [mc " has %s children - stopping\n" [llength $kids]]
8637                 break
8638             }
8639             set a [lindex $kids 0]
8640         }
8641         if {$skipb} {
8642             set kids [real_children $curview,$b]
8643             if {[llength $kids] != 1} {
8644                 appendshortlink $b [mc "Commit "] \
8645                     [mc " has %s children - stopping\n" [llength $kids]]
8646                 break
8647             }
8648             set b [lindex $kids 0]
8649         }
8650     }
8651     $ctext conf -state disabled
8652 }
8653
8654 proc diffcommits {a b} {
8655     global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
8656
8657     set tmpdir [gitknewtmpdir]
8658     set fna [file join $tmpdir "commit-[string range $a 0 7]"]
8659     set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
8660     if {[catch {
8661         exec git diff-tree -p --pretty $a >$fna
8662         exec git diff-tree -p --pretty $b >$fnb
8663     } err]} {
8664         error_popup [mc "Error writing commit to file: %s" $err]
8665         return
8666     }
8667     if {[catch {
8668         set fd [open "| diff -U$diffcontext $fna $fnb" r]
8669     } err]} {
8670         error_popup [mc "Error diffing commits: %s" $err]
8671         return
8672     }
8673     set diffids [list commits $a $b]
8674     set blobdifffd($diffids) $fd
8675     set diffinhdr 0
8676     set currdiffsubmod ""
8677     filerun $fd [list getblobdiffline $fd $diffids]
8678 }
8679
8680 proc diffvssel {dirn} {
8681     global rowmenuid selectedline
8682
8683     if {$selectedline eq {}} return
8684     if {$dirn} {
8685         set oldid [commitonrow $selectedline]
8686         set newid $rowmenuid
8687     } else {
8688         set oldid $rowmenuid
8689         set newid [commitonrow $selectedline]
8690     }
8691     addtohistory [list doseldiff $oldid $newid] savectextpos
8692     doseldiff $oldid $newid
8693 }
8694
8695 proc doseldiff {oldid newid} {
8696     global ctext
8697     global commitinfo
8698
8699     $ctext conf -state normal
8700     clear_ctext
8701     init_flist [mc "Top"]
8702     $ctext insert end "[mc "From"] "
8703     $ctext insert end $oldid link0
8704     setlink $oldid link0
8705     $ctext insert end "\n     "
8706     $ctext insert end [lindex $commitinfo($oldid) 0]
8707     $ctext insert end "\n\n[mc "To"]   "
8708     $ctext insert end $newid link1
8709     setlink $newid link1
8710     $ctext insert end "\n     "
8711     $ctext insert end [lindex $commitinfo($newid) 0]
8712     $ctext insert end "\n"
8713     $ctext conf -state disabled
8714     $ctext tag remove found 1.0 end
8715     startdiff [list $oldid $newid]
8716 }
8717
8718 proc mkpatch {} {
8719     global rowmenuid currentid commitinfo patchtop patchnum NS
8720
8721     if {![info exists currentid]} return
8722     set oldid $currentid
8723     set oldhead [lindex $commitinfo($oldid) 0]
8724     set newid $rowmenuid
8725     set newhead [lindex $commitinfo($newid) 0]
8726     set top .patch
8727     set patchtop $top
8728     catch {destroy $top}
8729     ttk_toplevel $top
8730     make_transient $top .
8731     ${NS}::label $top.title -text [mc "Generate patch"]
8732     grid $top.title - -pady 10
8733     ${NS}::label $top.from -text [mc "From:"]
8734     ${NS}::entry $top.fromsha1 -width 40
8735     $top.fromsha1 insert 0 $oldid
8736     $top.fromsha1 conf -state readonly
8737     grid $top.from $top.fromsha1 -sticky w
8738     ${NS}::entry $top.fromhead -width 60
8739     $top.fromhead insert 0 $oldhead
8740     $top.fromhead conf -state readonly
8741     grid x $top.fromhead -sticky w
8742     ${NS}::label $top.to -text [mc "To:"]
8743     ${NS}::entry $top.tosha1 -width 40
8744     $top.tosha1 insert 0 $newid
8745     $top.tosha1 conf -state readonly
8746     grid $top.to $top.tosha1 -sticky w
8747     ${NS}::entry $top.tohead -width 60
8748     $top.tohead insert 0 $newhead
8749     $top.tohead conf -state readonly
8750     grid x $top.tohead -sticky w
8751     ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
8752     grid $top.rev x -pady 10 -padx 5
8753     ${NS}::label $top.flab -text [mc "Output file:"]
8754     ${NS}::entry $top.fname -width 60
8755     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
8756     incr patchnum
8757     grid $top.flab $top.fname -sticky w
8758     ${NS}::frame $top.buts
8759     ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
8760     ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
8761     bind $top <Key-Return> mkpatchgo
8762     bind $top <Key-Escape> mkpatchcan
8763     grid $top.buts.gen $top.buts.can
8764     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8765     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8766     grid $top.buts - -pady 10 -sticky ew
8767     focus $top.fname
8768 }
8769
8770 proc mkpatchrev {} {
8771     global patchtop
8772
8773     set oldid [$patchtop.fromsha1 get]
8774     set oldhead [$patchtop.fromhead get]
8775     set newid [$patchtop.tosha1 get]
8776     set newhead [$patchtop.tohead get]
8777     foreach e [list fromsha1 fromhead tosha1 tohead] \
8778             v [list $newid $newhead $oldid $oldhead] {
8779         $patchtop.$e conf -state normal
8780         $patchtop.$e delete 0 end
8781         $patchtop.$e insert 0 $v
8782         $patchtop.$e conf -state readonly
8783     }
8784 }
8785
8786 proc mkpatchgo {} {
8787     global patchtop nullid nullid2
8788
8789     set oldid [$patchtop.fromsha1 get]
8790     set newid [$patchtop.tosha1 get]
8791     set fname [$patchtop.fname get]
8792     set cmd [diffcmd [list $oldid $newid] -p]
8793     # trim off the initial "|"
8794     set cmd [lrange $cmd 1 end]
8795     lappend cmd >$fname &
8796     if {[catch {eval exec $cmd} err]} {
8797         error_popup "[mc "Error creating patch:"] $err" $patchtop
8798     }
8799     catch {destroy $patchtop}
8800     unset patchtop
8801 }
8802
8803 proc mkpatchcan {} {
8804     global patchtop
8805
8806     catch {destroy $patchtop}
8807     unset patchtop
8808 }
8809
8810 proc mktag {} {
8811     global rowmenuid mktagtop commitinfo NS
8812
8813     set top .maketag
8814     set mktagtop $top
8815     catch {destroy $top}
8816     ttk_toplevel $top
8817     make_transient $top .
8818     ${NS}::label $top.title -text [mc "Create tag"]
8819     grid $top.title - -pady 10
8820     ${NS}::label $top.id -text [mc "ID:"]
8821     ${NS}::entry $top.sha1 -width 40
8822     $top.sha1 insert 0 $rowmenuid
8823     $top.sha1 conf -state readonly
8824     grid $top.id $top.sha1 -sticky w
8825     ${NS}::entry $top.head -width 60
8826     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8827     $top.head conf -state readonly
8828     grid x $top.head -sticky w
8829     ${NS}::label $top.tlab -text [mc "Tag name:"]
8830     ${NS}::entry $top.tag -width 60
8831     grid $top.tlab $top.tag -sticky w
8832     ${NS}::label $top.op -text [mc "Tag message is optional"]
8833     grid $top.op -columnspan 2 -sticky we
8834     ${NS}::label $top.mlab -text [mc "Tag message:"]
8835     ${NS}::entry $top.msg -width 60
8836     grid $top.mlab $top.msg -sticky w
8837     ${NS}::frame $top.buts
8838     ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
8839     ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
8840     bind $top <Key-Return> mktaggo
8841     bind $top <Key-Escape> mktagcan
8842     grid $top.buts.gen $top.buts.can
8843     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8844     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8845     grid $top.buts - -pady 10 -sticky ew
8846     focus $top.tag
8847 }
8848
8849 proc domktag {} {
8850     global mktagtop env tagids idtags
8851
8852     set id [$mktagtop.sha1 get]
8853     set tag [$mktagtop.tag get]
8854     set msg [$mktagtop.msg get]
8855     if {$tag == {}} {
8856         error_popup [mc "No tag name specified"] $mktagtop
8857         return 0
8858     }
8859     if {[info exists tagids($tag)]} {
8860         error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
8861         return 0
8862     }
8863     if {[catch {
8864         if {$msg != {}} {
8865             exec git tag -a -m $msg $tag $id
8866         } else {
8867             exec git tag $tag $id
8868         }
8869     } err]} {
8870         error_popup "[mc "Error creating tag:"] $err" $mktagtop
8871         return 0
8872     }
8873
8874     set tagids($tag) $id
8875     lappend idtags($id) $tag
8876     redrawtags $id
8877     addedtag $id
8878     dispneartags 0
8879     run refill_reflist
8880     return 1
8881 }
8882
8883 proc redrawtags {id} {
8884     global canv linehtag idpos currentid curview cmitlisted markedid
8885     global canvxmax iddrawn circleitem mainheadid circlecolors
8886
8887     if {![commitinview $id $curview]} return
8888     if {![info exists iddrawn($id)]} return
8889     set row [rowofcommit $id]
8890     if {$id eq $mainheadid} {
8891         set ofill yellow
8892     } else {
8893         set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
8894     }
8895     $canv itemconf $circleitem($row) -fill $ofill
8896     $canv delete tag.$id
8897     set xt [eval drawtags $id $idpos($id)]
8898     $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
8899     set text [$canv itemcget $linehtag($id) -text]
8900     set font [$canv itemcget $linehtag($id) -font]
8901     set xr [expr {$xt + [font measure $font $text]}]
8902     if {$xr > $canvxmax} {
8903         set canvxmax $xr
8904         setcanvscroll
8905     }
8906     if {[info exists currentid] && $currentid == $id} {
8907         make_secsel $id
8908     }
8909     if {[info exists markedid] && $markedid eq $id} {
8910         make_idmark $id
8911     }
8912 }
8913
8914 proc mktagcan {} {
8915     global mktagtop
8916
8917     catch {destroy $mktagtop}
8918     unset mktagtop
8919 }
8920
8921 proc mktaggo {} {
8922     if {![domktag]} return
8923     mktagcan
8924 }
8925
8926 proc writecommit {} {
8927     global rowmenuid wrcomtop commitinfo wrcomcmd NS
8928
8929     set top .writecommit
8930     set wrcomtop $top
8931     catch {destroy $top}
8932     ttk_toplevel $top
8933     make_transient $top .
8934     ${NS}::label $top.title -text [mc "Write commit to file"]
8935     grid $top.title - -pady 10
8936     ${NS}::label $top.id -text [mc "ID:"]
8937     ${NS}::entry $top.sha1 -width 40
8938     $top.sha1 insert 0 $rowmenuid
8939     $top.sha1 conf -state readonly
8940     grid $top.id $top.sha1 -sticky w
8941     ${NS}::entry $top.head -width 60
8942     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8943     $top.head conf -state readonly
8944     grid x $top.head -sticky w
8945     ${NS}::label $top.clab -text [mc "Command:"]
8946     ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
8947     grid $top.clab $top.cmd -sticky w -pady 10
8948     ${NS}::label $top.flab -text [mc "Output file:"]
8949     ${NS}::entry $top.fname -width 60
8950     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
8951     grid $top.flab $top.fname -sticky w
8952     ${NS}::frame $top.buts
8953     ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
8954     ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
8955     bind $top <Key-Return> wrcomgo
8956     bind $top <Key-Escape> wrcomcan
8957     grid $top.buts.gen $top.buts.can
8958     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8959     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8960     grid $top.buts - -pady 10 -sticky ew
8961     focus $top.fname
8962 }
8963
8964 proc wrcomgo {} {
8965     global wrcomtop
8966
8967     set id [$wrcomtop.sha1 get]
8968     set cmd "echo $id | [$wrcomtop.cmd get]"
8969     set fname [$wrcomtop.fname get]
8970     if {[catch {exec sh -c $cmd >$fname &} err]} {
8971         error_popup "[mc "Error writing commit:"] $err" $wrcomtop
8972     }
8973     catch {destroy $wrcomtop}
8974     unset wrcomtop
8975 }
8976
8977 proc wrcomcan {} {
8978     global wrcomtop
8979
8980     catch {destroy $wrcomtop}
8981     unset wrcomtop
8982 }
8983
8984 proc mkbranch {} {
8985     global rowmenuid mkbrtop NS
8986
8987     set top .makebranch
8988     catch {destroy $top}
8989     ttk_toplevel $top
8990     make_transient $top .
8991     ${NS}::label $top.title -text [mc "Create new branch"]
8992     grid $top.title - -pady 10
8993     ${NS}::label $top.id -text [mc "ID:"]
8994     ${NS}::entry $top.sha1 -width 40
8995     $top.sha1 insert 0 $rowmenuid
8996     $top.sha1 conf -state readonly
8997     grid $top.id $top.sha1 -sticky w
8998     ${NS}::label $top.nlab -text [mc "Name:"]
8999     ${NS}::entry $top.name -width 40
9000     grid $top.nlab $top.name -sticky w
9001     ${NS}::frame $top.buts
9002     ${NS}::button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
9003     ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
9004     bind $top <Key-Return> [list mkbrgo $top]
9005     bind $top <Key-Escape> "catch {destroy $top}"
9006     grid $top.buts.go $top.buts.can
9007     grid columnconfigure $top.buts 0 -weight 1 -uniform a
9008     grid columnconfigure $top.buts 1 -weight 1 -uniform a
9009     grid $top.buts - -pady 10 -sticky ew
9010     focus $top.name
9011 }
9012
9013 proc mkbrgo {top} {
9014     global headids idheads
9015
9016     set name [$top.name get]
9017     set id [$top.sha1 get]
9018     set cmdargs {}
9019     set old_id {}
9020     if {$name eq {}} {
9021         error_popup [mc "Please specify a name for the new branch"] $top
9022         return
9023     }
9024     if {[info exists headids($name)]} {
9025         if {![confirm_popup [mc \
9026                 "Branch '%s' already exists. Overwrite?" $name] $top]} {
9027             return
9028         }
9029         set old_id $headids($name)
9030         lappend cmdargs -f
9031     }
9032     catch {destroy $top}
9033     lappend cmdargs $name $id
9034     nowbusy newbranch
9035     update
9036     if {[catch {
9037         eval exec git branch $cmdargs
9038     } err]} {
9039         notbusy newbranch
9040         error_popup $err
9041     } else {
9042         notbusy newbranch
9043         if {$old_id ne {}} {
9044             movehead $id $name
9045             movedhead $id $name
9046             redrawtags $old_id
9047             redrawtags $id
9048         } else {
9049             set headids($name) $id
9050             lappend idheads($id) $name
9051             addedhead $id $name
9052             redrawtags $id
9053         }
9054         dispneartags 0
9055         run refill_reflist
9056     }
9057 }
9058
9059 proc exec_citool {tool_args {baseid {}}} {
9060     global commitinfo env
9061
9062     set save_env [array get env GIT_AUTHOR_*]
9063
9064     if {$baseid ne {}} {
9065         if {![info exists commitinfo($baseid)]} {
9066             getcommit $baseid
9067         }
9068         set author [lindex $commitinfo($baseid) 1]
9069         set date [lindex $commitinfo($baseid) 2]
9070         if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9071                     $author author name email]
9072             && $date ne {}} {
9073             set env(GIT_AUTHOR_NAME) $name
9074             set env(GIT_AUTHOR_EMAIL) $email
9075             set env(GIT_AUTHOR_DATE) $date
9076         }
9077     }
9078
9079     eval exec git citool $tool_args &
9080
9081     array unset env GIT_AUTHOR_*
9082     array set env $save_env
9083 }
9084
9085 proc cherrypick {} {
9086     global rowmenuid curview
9087     global mainhead mainheadid
9088     global gitdir
9089
9090     set oldhead [exec git rev-parse HEAD]
9091     set dheads [descheads $rowmenuid]
9092     if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
9093         set ok [confirm_popup [mc "Commit %s is already\
9094                 included in branch %s -- really re-apply it?" \
9095                                    [string range $rowmenuid 0 7] $mainhead]]
9096         if {!$ok} return
9097     }
9098     nowbusy cherrypick [mc "Cherry-picking"]
9099     update
9100     # Unfortunately git-cherry-pick writes stuff to stderr even when
9101     # no error occurs, and exec takes that as an indication of error...
9102     if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9103         notbusy cherrypick
9104         if {[regexp -line \
9105                  {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9106                  $err msg fname]} {
9107             error_popup [mc "Cherry-pick failed because of local changes\
9108                         to file '%s'.\nPlease commit, reset or stash\
9109                         your changes and try again." $fname]
9110         } elseif {[regexp -line \
9111                        {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
9112                        $err]} {
9113             if {[confirm_popup [mc "Cherry-pick failed because of merge\
9114                         conflict.\nDo you wish to run git citool to\
9115                         resolve it?"]]} {
9116                 # Force citool to read MERGE_MSG
9117                 file delete [file join $gitdir "GITGUI_MSG"]
9118                 exec_citool {} $rowmenuid
9119             }
9120         } else {
9121             error_popup $err
9122         }
9123         run updatecommits
9124         return
9125     }
9126     set newhead [exec git rev-parse HEAD]
9127     if {$newhead eq $oldhead} {
9128         notbusy cherrypick
9129         error_popup [mc "No changes committed"]
9130         return
9131     }
9132     addnewchild $newhead $oldhead
9133     if {[commitinview $oldhead $curview]} {
9134         # XXX this isn't right if we have a path limit...
9135         insertrow $newhead $oldhead $curview
9136         if {$mainhead ne {}} {
9137             movehead $newhead $mainhead
9138             movedhead $newhead $mainhead
9139         }
9140         set mainheadid $newhead
9141         redrawtags $oldhead
9142         redrawtags $newhead
9143         selbyid $newhead
9144     }
9145     notbusy cherrypick
9146 }
9147
9148 proc resethead {} {
9149     global mainhead rowmenuid confirm_ok resettype NS
9150
9151     set confirm_ok 0
9152     set w ".confirmreset"
9153     ttk_toplevel $w
9154     make_transient $w .
9155     wm title $w [mc "Confirm reset"]
9156     ${NS}::label $w.m -text \
9157         [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
9158     pack $w.m -side top -fill x -padx 20 -pady 20
9159     ${NS}::labelframe $w.f -text [mc "Reset type:"]
9160     set resettype mixed
9161     ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
9162         -text [mc "Soft: Leave working tree and index untouched"]
9163     grid $w.f.soft -sticky w
9164     ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
9165         -text [mc "Mixed: Leave working tree untouched, reset index"]
9166     grid $w.f.mixed -sticky w
9167     ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
9168         -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
9169     grid $w.f.hard -sticky w
9170     pack $w.f -side top -fill x -padx 4
9171     ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
9172     pack $w.ok -side left -fill x -padx 20 -pady 20
9173     ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
9174     bind $w <Key-Escape> [list destroy $w]
9175     pack $w.cancel -side right -fill x -padx 20 -pady 20
9176     bind $w <Visibility> "grab $w; focus $w"
9177     tkwait window $w
9178     if {!$confirm_ok} return
9179     if {[catch {set fd [open \
9180             [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
9181         error_popup $err
9182     } else {
9183         dohidelocalchanges
9184         filerun $fd [list readresetstat $fd]
9185         nowbusy reset [mc "Resetting"]
9186         selbyid $rowmenuid
9187     }
9188 }
9189
9190 proc readresetstat {fd} {
9191     global mainhead mainheadid showlocalchanges rprogcoord
9192
9193     if {[gets $fd line] >= 0} {
9194         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9195             set rprogcoord [expr {1.0 * $m / $n}]
9196             adjustprogress
9197         }
9198         return 1
9199     }
9200     set rprogcoord 0
9201     adjustprogress
9202     notbusy reset
9203     if {[catch {close $fd} err]} {
9204         error_popup $err
9205     }
9206     set oldhead $mainheadid
9207     set newhead [exec git rev-parse HEAD]
9208     if {$newhead ne $oldhead} {
9209         movehead $newhead $mainhead
9210         movedhead $newhead $mainhead
9211         set mainheadid $newhead
9212         redrawtags $oldhead
9213         redrawtags $newhead
9214     }
9215     if {$showlocalchanges} {
9216         doshowlocalchanges
9217     }
9218     return 0
9219 }
9220
9221 # context menu for a head
9222 proc headmenu {x y id head} {
9223     global headmenuid headmenuhead headctxmenu mainhead
9224
9225     stopfinding
9226     set headmenuid $id
9227     set headmenuhead $head
9228     set state normal
9229     if {[string match "remotes/*" $head]} {
9230         set state disabled
9231     }
9232     if {$head eq $mainhead} {
9233         set state disabled
9234     }
9235     $headctxmenu entryconfigure 0 -state $state
9236     $headctxmenu entryconfigure 1 -state $state
9237     tk_popup $headctxmenu $x $y
9238 }
9239
9240 proc cobranch {} {
9241     global headmenuid headmenuhead headids
9242     global showlocalchanges
9243
9244     # check the tree is clean first??
9245     nowbusy checkout [mc "Checking out"]
9246     update
9247     dohidelocalchanges
9248     if {[catch {
9249         set fd [open [list | git checkout $headmenuhead 2>@1] r]
9250     } err]} {
9251         notbusy checkout
9252         error_popup $err
9253         if {$showlocalchanges} {
9254             dodiffindex
9255         }
9256     } else {
9257         filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
9258     }
9259 }
9260
9261 proc readcheckoutstat {fd newhead newheadid} {
9262     global mainhead mainheadid headids showlocalchanges progresscoords
9263     global viewmainheadid curview
9264
9265     if {[gets $fd line] >= 0} {
9266         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9267             set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9268             adjustprogress
9269         }
9270         return 1
9271     }
9272     set progresscoords {0 0}
9273     adjustprogress
9274     notbusy checkout
9275     if {[catch {close $fd} err]} {
9276         error_popup $err
9277     }
9278     set oldmainid $mainheadid
9279     set mainhead $newhead
9280     set mainheadid $newheadid
9281     set viewmainheadid($curview) $newheadid
9282     redrawtags $oldmainid
9283     redrawtags $newheadid
9284     selbyid $newheadid
9285     if {$showlocalchanges} {
9286         dodiffindex
9287     }
9288 }
9289
9290 proc rmbranch {} {
9291     global headmenuid headmenuhead mainhead
9292     global idheads
9293
9294     set head $headmenuhead
9295     set id $headmenuid
9296     # this check shouldn't be needed any more...
9297     if {$head eq $mainhead} {
9298         error_popup [mc "Cannot delete the currently checked-out branch"]
9299         return
9300     }
9301     set dheads [descheads $id]
9302     if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
9303         # the stuff on this branch isn't on any other branch
9304         if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9305                         branch.\nReally delete branch %s?" $head $head]]} return
9306     }
9307     nowbusy rmbranch
9308     update
9309     if {[catch {exec git branch -D $head} err]} {
9310         notbusy rmbranch
9311         error_popup $err
9312         return
9313     }
9314     removehead $id $head
9315     removedhead $id $head
9316     redrawtags $id
9317     notbusy rmbranch
9318     dispneartags 0
9319     run refill_reflist
9320 }
9321
9322 # Display a list of tags and heads
9323 proc showrefs {} {
9324     global showrefstop bgcolor fgcolor selectbgcolor NS
9325     global bglist fglist reflistfilter reflist maincursor
9326
9327     set top .showrefs
9328     set showrefstop $top
9329     if {[winfo exists $top]} {
9330         raise $top
9331         refill_reflist
9332         return
9333     }
9334     ttk_toplevel $top
9335     wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
9336     make_transient $top .
9337     text $top.list -background $bgcolor -foreground $fgcolor \
9338         -selectbackground $selectbgcolor -font mainfont \
9339         -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
9340         -width 30 -height 20 -cursor $maincursor \
9341         -spacing1 1 -spacing3 1 -state disabled
9342     $top.list tag configure highlight -background $selectbgcolor
9343     lappend bglist $top.list
9344     lappend fglist $top.list
9345     ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
9346     ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
9347     grid $top.list $top.ysb -sticky nsew
9348     grid $top.xsb x -sticky ew
9349     ${NS}::frame $top.f
9350     ${NS}::label $top.f.l -text "[mc "Filter"]: "
9351     ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
9352     set reflistfilter "*"
9353     trace add variable reflistfilter write reflistfilter_change
9354     pack $top.f.e -side right -fill x -expand 1
9355     pack $top.f.l -side left
9356     grid $top.f - -sticky ew -pady 2
9357     ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
9358     bind $top <Key-Escape> [list destroy $top]
9359     grid $top.close -
9360     grid columnconfigure $top 0 -weight 1
9361     grid rowconfigure $top 0 -weight 1
9362     bind $top.list <1> {break}
9363     bind $top.list <B1-Motion> {break}
9364     bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
9365     set reflist {}
9366     refill_reflist
9367 }
9368
9369 proc sel_reflist {w x y} {
9370     global showrefstop reflist headids tagids otherrefids
9371
9372     if {![winfo exists $showrefstop]} return
9373     set l [lindex [split [$w index "@$x,$y"] "."] 0]
9374     set ref [lindex $reflist [expr {$l-1}]]
9375     set n [lindex $ref 0]
9376     switch -- [lindex $ref 1] {
9377         "H" {selbyid $headids($n)}
9378         "T" {selbyid $tagids($n)}
9379         "o" {selbyid $otherrefids($n)}
9380     }
9381     $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
9382 }
9383
9384 proc unsel_reflist {} {
9385     global showrefstop
9386
9387     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9388     $showrefstop.list tag remove highlight 0.0 end
9389 }
9390
9391 proc reflistfilter_change {n1 n2 op} {
9392     global reflistfilter
9393
9394     after cancel refill_reflist
9395     after 200 refill_reflist
9396 }
9397
9398 proc refill_reflist {} {
9399     global reflist reflistfilter showrefstop headids tagids otherrefids
9400     global curview
9401
9402     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9403     set refs {}
9404     foreach n [array names headids] {
9405         if {[string match $reflistfilter $n]} {
9406             if {[commitinview $headids($n) $curview]} {
9407                 lappend refs [list $n H]
9408             } else {
9409                 interestedin $headids($n) {run refill_reflist}
9410             }
9411         }
9412     }
9413     foreach n [array names tagids] {
9414         if {[string match $reflistfilter $n]} {
9415             if {[commitinview $tagids($n) $curview]} {
9416                 lappend refs [list $n T]
9417             } else {
9418                 interestedin $tagids($n) {run refill_reflist}
9419             }
9420         }
9421     }
9422     foreach n [array names otherrefids] {
9423         if {[string match $reflistfilter $n]} {
9424             if {[commitinview $otherrefids($n) $curview]} {
9425                 lappend refs [list $n o]
9426             } else {
9427                 interestedin $otherrefids($n) {run refill_reflist}
9428             }
9429         }
9430     }
9431     set refs [lsort -index 0 $refs]
9432     if {$refs eq $reflist} return
9433
9434     # Update the contents of $showrefstop.list according to the
9435     # differences between $reflist (old) and $refs (new)
9436     $showrefstop.list conf -state normal
9437     $showrefstop.list insert end "\n"
9438     set i 0
9439     set j 0
9440     while {$i < [llength $reflist] || $j < [llength $refs]} {
9441         if {$i < [llength $reflist]} {
9442             if {$j < [llength $refs]} {
9443                 set cmp [string compare [lindex $reflist $i 0] \
9444                              [lindex $refs $j 0]]
9445                 if {$cmp == 0} {
9446                     set cmp [string compare [lindex $reflist $i 1] \
9447                                  [lindex $refs $j 1]]
9448                 }
9449             } else {
9450                 set cmp -1
9451             }
9452         } else {
9453             set cmp 1
9454         }
9455         switch -- $cmp {
9456             -1 {
9457                 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
9458                 incr i
9459             }
9460             0 {
9461                 incr i
9462                 incr j
9463             }
9464             1 {
9465                 set l [expr {$j + 1}]
9466                 $showrefstop.list image create $l.0 -align baseline \
9467                     -image reficon-[lindex $refs $j 1] -padx 2
9468                 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
9469                 incr j
9470             }
9471         }
9472     }
9473     set reflist $refs
9474     # delete last newline
9475     $showrefstop.list delete end-2c end-1c
9476     $showrefstop.list conf -state disabled
9477 }
9478
9479 # Stuff for finding nearby tags
9480 proc getallcommits {} {
9481     global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
9482     global idheads idtags idotherrefs allparents tagobjid
9483     global gitdir
9484
9485     if {![info exists allcommits]} {
9486         set nextarc 0
9487         set allcommits 0
9488         set seeds {}
9489         set allcwait 0
9490         set cachedarcs 0
9491         set allccache [file join $gitdir "gitk.cache"]
9492         if {![catch {
9493             set f [open $allccache r]
9494             set allcwait 1
9495             getcache $f
9496         }]} return
9497     }
9498
9499     if {$allcwait} {
9500         return
9501     }
9502     set cmd [list | git rev-list --parents]
9503     set allcupdate [expr {$seeds ne {}}]
9504     if {!$allcupdate} {
9505         set ids "--all"
9506     } else {
9507         set refs [concat [array names idheads] [array names idtags] \
9508                       [array names idotherrefs]]
9509         set ids {}
9510         set tagobjs {}
9511         foreach name [array names tagobjid] {
9512             lappend tagobjs $tagobjid($name)
9513         }
9514         foreach id [lsort -unique $refs] {
9515             if {![info exists allparents($id)] &&
9516                 [lsearch -exact $tagobjs $id] < 0} {
9517                 lappend ids $id
9518             }
9519         }
9520         if {$ids ne {}} {
9521             foreach id $seeds {
9522                 lappend ids "^$id"
9523             }
9524         }
9525     }
9526     if {$ids ne {}} {
9527         set fd [open [concat $cmd $ids] r]
9528         fconfigure $fd -blocking 0
9529         incr allcommits
9530         nowbusy allcommits
9531         filerun $fd [list getallclines $fd]
9532     } else {
9533         dispneartags 0
9534     }
9535 }
9536
9537 # Since most commits have 1 parent and 1 child, we group strings of
9538 # such commits into "arcs" joining branch/merge points (BMPs), which
9539 # are commits that either don't have 1 parent or don't have 1 child.
9540 #
9541 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
9542 # arcout(id) - outgoing arcs for BMP
9543 # arcids(a) - list of IDs on arc including end but not start
9544 # arcstart(a) - BMP ID at start of arc
9545 # arcend(a) - BMP ID at end of arc
9546 # growing(a) - arc a is still growing
9547 # arctags(a) - IDs out of arcids (excluding end) that have tags
9548 # archeads(a) - IDs out of arcids (excluding end) that have heads
9549 # The start of an arc is at the descendent end, so "incoming" means
9550 # coming from descendents, and "outgoing" means going towards ancestors.
9551
9552 proc getallclines {fd} {
9553     global allparents allchildren idtags idheads nextarc
9554     global arcnos arcids arctags arcout arcend arcstart archeads growing
9555     global seeds allcommits cachedarcs allcupdate
9556
9557     set nid 0
9558     while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
9559         set id [lindex $line 0]
9560         if {[info exists allparents($id)]} {
9561             # seen it already
9562             continue
9563         }
9564         set cachedarcs 0
9565         set olds [lrange $line 1 end]
9566         set allparents($id) $olds
9567         if {![info exists allchildren($id)]} {
9568             set allchildren($id) {}
9569             set arcnos($id) {}
9570             lappend seeds $id
9571         } else {
9572             set a $arcnos($id)
9573             if {[llength $olds] == 1 && [llength $a] == 1} {
9574                 lappend arcids($a) $id
9575                 if {[info exists idtags($id)]} {
9576                     lappend arctags($a) $id
9577                 }
9578                 if {[info exists idheads($id)]} {
9579                     lappend archeads($a) $id
9580                 }
9581                 if {[info exists allparents($olds)]} {
9582                     # seen parent already
9583                     if {![info exists arcout($olds)]} {
9584                         splitarc $olds
9585                     }
9586                     lappend arcids($a) $olds
9587                     set arcend($a) $olds
9588                     unset growing($a)
9589                 }
9590                 lappend allchildren($olds) $id
9591                 lappend arcnos($olds) $a
9592                 continue
9593             }
9594         }
9595         foreach a $arcnos($id) {
9596             lappend arcids($a) $id
9597             set arcend($a) $id
9598             unset growing($a)
9599         }
9600
9601         set ao {}
9602         foreach p $olds {
9603             lappend allchildren($p) $id
9604             set a [incr nextarc]
9605             set arcstart($a) $id
9606             set archeads($a) {}
9607             set arctags($a) {}
9608             set archeads($a) {}
9609             set arcids($a) {}
9610             lappend ao $a
9611             set growing($a) 1
9612             if {[info exists allparents($p)]} {
9613                 # seen it already, may need to make a new branch
9614                 if {![info exists arcout($p)]} {
9615                     splitarc $p
9616                 }
9617                 lappend arcids($a) $p
9618                 set arcend($a) $p
9619                 unset growing($a)
9620             }
9621             lappend arcnos($p) $a
9622         }
9623         set arcout($id) $ao
9624     }
9625     if {$nid > 0} {
9626         global cached_dheads cached_dtags cached_atags
9627         catch {unset cached_dheads}
9628         catch {unset cached_dtags}
9629         catch {unset cached_atags}
9630     }
9631     if {![eof $fd]} {
9632         return [expr {$nid >= 1000? 2: 1}]
9633     }
9634     set cacheok 1
9635     if {[catch {
9636         fconfigure $fd -blocking 1
9637         close $fd
9638     } err]} {
9639         # got an error reading the list of commits
9640         # if we were updating, try rereading the whole thing again
9641         if {$allcupdate} {
9642             incr allcommits -1
9643             dropcache $err
9644             return
9645         }
9646         error_popup "[mc "Error reading commit topology information;\
9647                 branch and preceding/following tag information\
9648                 will be incomplete."]\n($err)"
9649         set cacheok 0
9650     }
9651     if {[incr allcommits -1] == 0} {
9652         notbusy allcommits
9653         if {$cacheok} {
9654             run savecache
9655         }
9656     }
9657     dispneartags 0
9658     return 0
9659 }
9660
9661 proc recalcarc {a} {
9662     global arctags archeads arcids idtags idheads
9663
9664     set at {}
9665     set ah {}
9666     foreach id [lrange $arcids($a) 0 end-1] {
9667         if {[info exists idtags($id)]} {
9668             lappend at $id
9669         }
9670         if {[info exists idheads($id)]} {
9671             lappend ah $id
9672         }
9673     }
9674     set arctags($a) $at
9675     set archeads($a) $ah
9676 }
9677
9678 proc splitarc {p} {
9679     global arcnos arcids nextarc arctags archeads idtags idheads
9680     global arcstart arcend arcout allparents growing
9681
9682     set a $arcnos($p)
9683     if {[llength $a] != 1} {
9684         puts "oops splitarc called but [llength $a] arcs already"
9685         return
9686     }
9687     set a [lindex $a 0]
9688     set i [lsearch -exact $arcids($a) $p]
9689     if {$i < 0} {
9690         puts "oops splitarc $p not in arc $a"
9691         return
9692     }
9693     set na [incr nextarc]
9694     if {[info exists arcend($a)]} {
9695         set arcend($na) $arcend($a)
9696     } else {
9697         set l [lindex $allparents([lindex $arcids($a) end]) 0]
9698         set j [lsearch -exact $arcnos($l) $a]
9699         set arcnos($l) [lreplace $arcnos($l) $j $j $na]
9700     }
9701     set tail [lrange $arcids($a) [expr {$i+1}] end]
9702     set arcids($a) [lrange $arcids($a) 0 $i]
9703     set arcend($a) $p
9704     set arcstart($na) $p
9705     set arcout($p) $na
9706     set arcids($na) $tail
9707     if {[info exists growing($a)]} {
9708         set growing($na) 1
9709         unset growing($a)
9710     }
9711
9712     foreach id $tail {
9713         if {[llength $arcnos($id)] == 1} {
9714             set arcnos($id) $na
9715         } else {
9716             set j [lsearch -exact $arcnos($id) $a]
9717             set arcnos($id) [lreplace $arcnos($id) $j $j $na]
9718         }
9719     }
9720
9721     # reconstruct tags and heads lists
9722     if {$arctags($a) ne {} || $archeads($a) ne {}} {
9723         recalcarc $a
9724         recalcarc $na
9725     } else {
9726         set arctags($na) {}
9727         set archeads($na) {}
9728     }
9729 }
9730
9731 # Update things for a new commit added that is a child of one
9732 # existing commit.  Used when cherry-picking.
9733 proc addnewchild {id p} {
9734     global allparents allchildren idtags nextarc
9735     global arcnos arcids arctags arcout arcend arcstart archeads growing
9736     global seeds allcommits
9737
9738     if {![info exists allcommits] || ![info exists arcnos($p)]} return
9739     set allparents($id) [list $p]
9740     set allchildren($id) {}
9741     set arcnos($id) {}
9742     lappend seeds $id
9743     lappend allchildren($p) $id
9744     set a [incr nextarc]
9745     set arcstart($a) $id
9746     set archeads($a) {}
9747     set arctags($a) {}
9748     set arcids($a) [list $p]
9749     set arcend($a) $p
9750     if {![info exists arcout($p)]} {
9751         splitarc $p
9752     }
9753     lappend arcnos($p) $a
9754     set arcout($id) [list $a]
9755 }
9756
9757 # This implements a cache for the topology information.
9758 # The cache saves, for each arc, the start and end of the arc,
9759 # the ids on the arc, and the outgoing arcs from the end.
9760 proc readcache {f} {
9761     global arcnos arcids arcout arcstart arcend arctags archeads nextarc
9762     global idtags idheads allparents cachedarcs possible_seeds seeds growing
9763     global allcwait
9764
9765     set a $nextarc
9766     set lim $cachedarcs
9767     if {$lim - $a > 500} {
9768         set lim [expr {$a + 500}]
9769     }
9770     if {[catch {
9771         if {$a == $lim} {
9772             # finish reading the cache and setting up arctags, etc.
9773             set line [gets $f]
9774             if {$line ne "1"} {error "bad final version"}
9775             close $f
9776             foreach id [array names idtags] {
9777                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9778                     [llength $allparents($id)] == 1} {
9779                     set a [lindex $arcnos($id) 0]
9780                     if {$arctags($a) eq {}} {
9781                         recalcarc $a
9782                     }
9783                 }
9784             }
9785             foreach id [array names idheads] {
9786                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9787                     [llength $allparents($id)] == 1} {
9788                     set a [lindex $arcnos($id) 0]
9789                     if {$archeads($a) eq {}} {
9790                         recalcarc $a
9791                     }
9792                 }
9793             }
9794             foreach id [lsort -unique $possible_seeds] {
9795                 if {$arcnos($id) eq {}} {
9796                     lappend seeds $id
9797                 }
9798             }
9799             set allcwait 0
9800         } else {
9801             while {[incr a] <= $lim} {
9802                 set line [gets $f]
9803                 if {[llength $line] != 3} {error "bad line"}
9804                 set s [lindex $line 0]
9805                 set arcstart($a) $s
9806                 lappend arcout($s) $a
9807                 if {![info exists arcnos($s)]} {
9808                     lappend possible_seeds $s
9809                     set arcnos($s) {}
9810                 }
9811                 set e [lindex $line 1]
9812                 if {$e eq {}} {
9813                     set growing($a) 1
9814                 } else {
9815                     set arcend($a) $e
9816                     if {![info exists arcout($e)]} {
9817                         set arcout($e) {}
9818                     }
9819                 }
9820                 set arcids($a) [lindex $line 2]
9821                 foreach id $arcids($a) {
9822                     lappend allparents($s) $id
9823                     set s $id
9824                     lappend arcnos($id) $a
9825                 }
9826                 if {![info exists allparents($s)]} {
9827                     set allparents($s) {}
9828                 }
9829                 set arctags($a) {}
9830                 set archeads($a) {}
9831             }
9832             set nextarc [expr {$a - 1}]
9833         }
9834     } err]} {
9835         dropcache $err
9836         return 0
9837     }
9838     if {!$allcwait} {
9839         getallcommits
9840     }
9841     return $allcwait
9842 }
9843
9844 proc getcache {f} {
9845     global nextarc cachedarcs possible_seeds
9846
9847     if {[catch {
9848         set line [gets $f]
9849         if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
9850         # make sure it's an integer
9851         set cachedarcs [expr {int([lindex $line 1])}]
9852         if {$cachedarcs < 0} {error "bad number of arcs"}
9853         set nextarc 0
9854         set possible_seeds {}
9855         run readcache $f
9856     } err]} {
9857         dropcache $err
9858     }
9859     return 0
9860 }
9861
9862 proc dropcache {err} {
9863     global allcwait nextarc cachedarcs seeds
9864
9865     #puts "dropping cache ($err)"
9866     foreach v {arcnos arcout arcids arcstart arcend growing \
9867                    arctags archeads allparents allchildren} {
9868         global $v
9869         catch {unset $v}
9870     }
9871     set allcwait 0
9872     set nextarc 0
9873     set cachedarcs 0
9874     set seeds {}
9875     getallcommits
9876 }
9877
9878 proc writecache {f} {
9879     global cachearc cachedarcs allccache
9880     global arcstart arcend arcnos arcids arcout
9881
9882     set a $cachearc
9883     set lim $cachedarcs
9884     if {$lim - $a > 1000} {
9885         set lim [expr {$a + 1000}]
9886     }
9887     if {[catch {
9888         while {[incr a] <= $lim} {
9889             if {[info exists arcend($a)]} {
9890                 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
9891             } else {
9892                 puts $f [list $arcstart($a) {} $arcids($a)]
9893             }
9894         }
9895     } err]} {
9896         catch {close $f}
9897         catch {file delete $allccache}
9898         #puts "writing cache failed ($err)"
9899         return 0
9900     }
9901     set cachearc [expr {$a - 1}]
9902     if {$a > $cachedarcs} {
9903         puts $f "1"
9904         close $f
9905         return 0
9906     }
9907     return 1
9908 }
9909
9910 proc savecache {} {
9911     global nextarc cachedarcs cachearc allccache
9912
9913     if {$nextarc == $cachedarcs} return
9914     set cachearc 0
9915     set cachedarcs $nextarc
9916     catch {
9917         set f [open $allccache w]
9918         puts $f [list 1 $cachedarcs]
9919         run writecache $f
9920     }
9921 }
9922
9923 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
9924 # or 0 if neither is true.
9925 proc anc_or_desc {a b} {
9926     global arcout arcstart arcend arcnos cached_isanc
9927
9928     if {$arcnos($a) eq $arcnos($b)} {
9929         # Both are on the same arc(s); either both are the same BMP,
9930         # or if one is not a BMP, the other is also not a BMP or is
9931         # the BMP at end of the arc (and it only has 1 incoming arc).
9932         # Or both can be BMPs with no incoming arcs.
9933         if {$a eq $b || $arcnos($a) eq {}} {
9934             return 0
9935         }
9936         # assert {[llength $arcnos($a)] == 1}
9937         set arc [lindex $arcnos($a) 0]
9938         set i [lsearch -exact $arcids($arc) $a]
9939         set j [lsearch -exact $arcids($arc) $b]
9940         if {$i < 0 || $i > $j} {
9941             return 1
9942         } else {
9943             return -1
9944         }
9945     }
9946
9947     if {![info exists arcout($a)]} {
9948         set arc [lindex $arcnos($a) 0]
9949         if {[info exists arcend($arc)]} {
9950             set aend $arcend($arc)
9951         } else {
9952             set aend {}
9953         }
9954         set a $arcstart($arc)
9955     } else {
9956         set aend $a
9957     }
9958     if {![info exists arcout($b)]} {
9959         set arc [lindex $arcnos($b) 0]
9960         if {[info exists arcend($arc)]} {
9961             set bend $arcend($arc)
9962         } else {
9963             set bend {}
9964         }
9965         set b $arcstart($arc)
9966     } else {
9967         set bend $b
9968     }
9969     if {$a eq $bend} {
9970         return 1
9971     }
9972     if {$b eq $aend} {
9973         return -1
9974     }
9975     if {[info exists cached_isanc($a,$bend)]} {
9976         if {$cached_isanc($a,$bend)} {
9977             return 1
9978         }
9979     }
9980     if {[info exists cached_isanc($b,$aend)]} {
9981         if {$cached_isanc($b,$aend)} {
9982             return -1
9983         }
9984         if {[info exists cached_isanc($a,$bend)]} {
9985             return 0
9986         }
9987     }
9988
9989     set todo [list $a $b]
9990     set anc($a) a
9991     set anc($b) b
9992     for {set i 0} {$i < [llength $todo]} {incr i} {
9993         set x [lindex $todo $i]
9994         if {$anc($x) eq {}} {
9995             continue
9996         }
9997         foreach arc $arcnos($x) {
9998             set xd $arcstart($arc)
9999             if {$xd eq $bend} {
10000                 set cached_isanc($a,$bend) 1
10001                 set cached_isanc($b,$aend) 0
10002                 return 1
10003             } elseif {$xd eq $aend} {
10004                 set cached_isanc($b,$aend) 1
10005                 set cached_isanc($a,$bend) 0
10006                 return -1
10007             }
10008             if {![info exists anc($xd)]} {
10009                 set anc($xd) $anc($x)
10010                 lappend todo $xd
10011             } elseif {$anc($xd) ne $anc($x)} {
10012                 set anc($xd) {}
10013             }
10014         }
10015     }
10016     set cached_isanc($a,$bend) 0
10017     set cached_isanc($b,$aend) 0
10018     return 0
10019 }
10020
10021 # This identifies whether $desc has an ancestor that is
10022 # a growing tip of the graph and which is not an ancestor of $anc
10023 # and returns 0 if so and 1 if not.
10024 # If we subsequently discover a tag on such a growing tip, and that
10025 # turns out to be a descendent of $anc (which it could, since we
10026 # don't necessarily see children before parents), then $desc
10027 # isn't a good choice to display as a descendent tag of
10028 # $anc (since it is the descendent of another tag which is
10029 # a descendent of $anc).  Similarly, $anc isn't a good choice to
10030 # display as a ancestor tag of $desc.
10031 #
10032 proc is_certain {desc anc} {
10033     global arcnos arcout arcstart arcend growing problems
10034
10035     set certain {}
10036     if {[llength $arcnos($anc)] == 1} {
10037         # tags on the same arc are certain
10038         if {$arcnos($desc) eq $arcnos($anc)} {
10039             return 1
10040         }
10041         if {![info exists arcout($anc)]} {
10042             # if $anc is partway along an arc, use the start of the arc instead
10043             set a [lindex $arcnos($anc) 0]
10044             set anc $arcstart($a)
10045         }
10046     }
10047     if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
10048         set x $desc
10049     } else {
10050         set a [lindex $arcnos($desc) 0]
10051         set x $arcend($a)
10052     }
10053     if {$x == $anc} {
10054         return 1
10055     }
10056     set anclist [list $x]
10057     set dl($x) 1
10058     set nnh 1
10059     set ngrowanc 0
10060     for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
10061         set x [lindex $anclist $i]
10062         if {$dl($x)} {
10063             incr nnh -1
10064         }
10065         set done($x) 1
10066         foreach a $arcout($x) {
10067             if {[info exists growing($a)]} {
10068                 if {![info exists growanc($x)] && $dl($x)} {
10069                     set growanc($x) 1
10070                     incr ngrowanc
10071                 }
10072             } else {
10073                 set y $arcend($a)
10074                 if {[info exists dl($y)]} {
10075                     if {$dl($y)} {
10076                         if {!$dl($x)} {
10077                             set dl($y) 0
10078                             if {![info exists done($y)]} {
10079                                 incr nnh -1
10080                             }
10081                             if {[info exists growanc($x)]} {
10082                                 incr ngrowanc -1
10083                             }
10084                             set xl [list $y]
10085                             for {set k 0} {$k < [llength $xl]} {incr k} {
10086                                 set z [lindex $xl $k]
10087                                 foreach c $arcout($z) {
10088                                     if {[info exists arcend($c)]} {
10089                                         set v $arcend($c)
10090                                         if {[info exists dl($v)] && $dl($v)} {
10091                                             set dl($v) 0
10092                                             if {![info exists done($v)]} {
10093                                                 incr nnh -1
10094                                             }
10095                                             if {[info exists growanc($v)]} {
10096                                                 incr ngrowanc -1
10097                                             }
10098                                             lappend xl $v
10099                                         }
10100                                     }
10101                                 }
10102                             }
10103                         }
10104                     }
10105                 } elseif {$y eq $anc || !$dl($x)} {
10106                     set dl($y) 0
10107                     lappend anclist $y
10108                 } else {
10109                     set dl($y) 1
10110                     lappend anclist $y
10111                     incr nnh
10112                 }
10113             }
10114         }
10115     }
10116     foreach x [array names growanc] {
10117         if {$dl($x)} {
10118             return 0
10119         }
10120         return 0
10121     }
10122     return 1
10123 }
10124
10125 proc validate_arctags {a} {
10126     global arctags idtags
10127
10128     set i -1
10129     set na $arctags($a)
10130     foreach id $arctags($a) {
10131         incr i
10132         if {![info exists idtags($id)]} {
10133             set na [lreplace $na $i $i]
10134             incr i -1
10135         }
10136     }
10137     set arctags($a) $na
10138 }
10139
10140 proc validate_archeads {a} {
10141     global archeads idheads
10142
10143     set i -1
10144     set na $archeads($a)
10145     foreach id $archeads($a) {
10146         incr i
10147         if {![info exists idheads($id)]} {
10148             set na [lreplace $na $i $i]
10149             incr i -1
10150         }
10151     }
10152     set archeads($a) $na
10153 }
10154
10155 # Return the list of IDs that have tags that are descendents of id,
10156 # ignoring IDs that are descendents of IDs already reported.
10157 proc desctags {id} {
10158     global arcnos arcstart arcids arctags idtags allparents
10159     global growing cached_dtags
10160
10161     if {![info exists allparents($id)]} {
10162         return {}
10163     }
10164     set t1 [clock clicks -milliseconds]
10165     set argid $id
10166     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10167         # part-way along an arc; check that arc first
10168         set a [lindex $arcnos($id) 0]
10169         if {$arctags($a) ne {}} {
10170             validate_arctags $a
10171             set i [lsearch -exact $arcids($a) $id]
10172             set tid {}
10173             foreach t $arctags($a) {
10174                 set j [lsearch -exact $arcids($a) $t]
10175                 if {$j >= $i} break
10176                 set tid $t
10177             }
10178             if {$tid ne {}} {
10179                 return $tid
10180             }
10181         }
10182         set id $arcstart($a)
10183         if {[info exists idtags($id)]} {
10184             return $id
10185         }
10186     }
10187     if {[info exists cached_dtags($id)]} {
10188         return $cached_dtags($id)
10189     }
10190
10191     set origid $id
10192     set todo [list $id]
10193     set queued($id) 1
10194     set nc 1
10195     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10196         set id [lindex $todo $i]
10197         set done($id) 1
10198         set ta [info exists hastaggedancestor($id)]
10199         if {!$ta} {
10200             incr nc -1
10201         }
10202         # ignore tags on starting node
10203         if {!$ta && $i > 0} {
10204             if {[info exists idtags($id)]} {
10205                 set tagloc($id) $id
10206                 set ta 1
10207             } elseif {[info exists cached_dtags($id)]} {
10208                 set tagloc($id) $cached_dtags($id)
10209                 set ta 1
10210             }
10211         }
10212         foreach a $arcnos($id) {
10213             set d $arcstart($a)
10214             if {!$ta && $arctags($a) ne {}} {
10215                 validate_arctags $a
10216                 if {$arctags($a) ne {}} {
10217                     lappend tagloc($id) [lindex $arctags($a) end]
10218                 }
10219             }
10220             if {$ta || $arctags($a) ne {}} {
10221                 set tomark [list $d]
10222                 for {set j 0} {$j < [llength $tomark]} {incr j} {
10223                     set dd [lindex $tomark $j]
10224                     if {![info exists hastaggedancestor($dd)]} {
10225                         if {[info exists done($dd)]} {
10226                             foreach b $arcnos($dd) {
10227                                 lappend tomark $arcstart($b)
10228                             }
10229                             if {[info exists tagloc($dd)]} {
10230                                 unset tagloc($dd)
10231                             }
10232                         } elseif {[info exists queued($dd)]} {
10233                             incr nc -1
10234                         }
10235                         set hastaggedancestor($dd) 1
10236                     }
10237                 }
10238             }
10239             if {![info exists queued($d)]} {
10240                 lappend todo $d
10241                 set queued($d) 1
10242                 if {![info exists hastaggedancestor($d)]} {
10243                     incr nc
10244                 }
10245             }
10246         }
10247     }
10248     set tags {}
10249     foreach id [array names tagloc] {
10250         if {![info exists hastaggedancestor($id)]} {
10251             foreach t $tagloc($id) {
10252                 if {[lsearch -exact $tags $t] < 0} {
10253                     lappend tags $t
10254                 }
10255             }
10256         }
10257     }
10258     set t2 [clock clicks -milliseconds]
10259     set loopix $i
10260
10261     # remove tags that are descendents of other tags
10262     for {set i 0} {$i < [llength $tags]} {incr i} {
10263         set a [lindex $tags $i]
10264         for {set j 0} {$j < $i} {incr j} {
10265             set b [lindex $tags $j]
10266             set r [anc_or_desc $a $b]
10267             if {$r == 1} {
10268                 set tags [lreplace $tags $j $j]
10269                 incr j -1
10270                 incr i -1
10271             } elseif {$r == -1} {
10272                 set tags [lreplace $tags $i $i]
10273                 incr i -1
10274                 break
10275             }
10276         }
10277     }
10278
10279     if {[array names growing] ne {}} {
10280         # graph isn't finished, need to check if any tag could get
10281         # eclipsed by another tag coming later.  Simply ignore any
10282         # tags that could later get eclipsed.
10283         set ctags {}
10284         foreach t $tags {
10285             if {[is_certain $t $origid]} {
10286                 lappend ctags $t
10287             }
10288         }
10289         if {$tags eq $ctags} {
10290             set cached_dtags($origid) $tags
10291         } else {
10292             set tags $ctags
10293         }
10294     } else {
10295         set cached_dtags($origid) $tags
10296     }
10297     set t3 [clock clicks -milliseconds]
10298     if {0 && $t3 - $t1 >= 100} {
10299         puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10300             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10301     }
10302     return $tags
10303 }
10304
10305 proc anctags {id} {
10306     global arcnos arcids arcout arcend arctags idtags allparents
10307     global growing cached_atags
10308
10309     if {![info exists allparents($id)]} {
10310         return {}
10311     }
10312     set t1 [clock clicks -milliseconds]
10313     set argid $id
10314     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10315         # part-way along an arc; check that arc first
10316         set a [lindex $arcnos($id) 0]
10317         if {$arctags($a) ne {}} {
10318             validate_arctags $a
10319             set i [lsearch -exact $arcids($a) $id]
10320             foreach t $arctags($a) {
10321                 set j [lsearch -exact $arcids($a) $t]
10322                 if {$j > $i} {
10323                     return $t
10324                 }
10325             }
10326         }
10327         if {![info exists arcend($a)]} {
10328             return {}
10329         }
10330         set id $arcend($a)
10331         if {[info exists idtags($id)]} {
10332             return $id
10333         }
10334     }
10335     if {[info exists cached_atags($id)]} {
10336         return $cached_atags($id)
10337     }
10338
10339     set origid $id
10340     set todo [list $id]
10341     set queued($id) 1
10342     set taglist {}
10343     set nc 1
10344     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10345         set id [lindex $todo $i]
10346         set done($id) 1
10347         set td [info exists hastaggeddescendent($id)]
10348         if {!$td} {
10349             incr nc -1
10350         }
10351         # ignore tags on starting node
10352         if {!$td && $i > 0} {
10353             if {[info exists idtags($id)]} {
10354                 set tagloc($id) $id
10355                 set td 1
10356             } elseif {[info exists cached_atags($id)]} {
10357                 set tagloc($id) $cached_atags($id)
10358                 set td 1
10359             }
10360         }
10361         foreach a $arcout($id) {
10362             if {!$td && $arctags($a) ne {}} {
10363                 validate_arctags $a
10364                 if {$arctags($a) ne {}} {
10365                     lappend tagloc($id) [lindex $arctags($a) 0]
10366                 }
10367             }
10368             if {![info exists arcend($a)]} continue
10369             set d $arcend($a)
10370             if {$td || $arctags($a) ne {}} {
10371                 set tomark [list $d]
10372                 for {set j 0} {$j < [llength $tomark]} {incr j} {
10373                     set dd [lindex $tomark $j]
10374                     if {![info exists hastaggeddescendent($dd)]} {
10375                         if {[info exists done($dd)]} {
10376                             foreach b $arcout($dd) {
10377                                 if {[info exists arcend($b)]} {
10378                                     lappend tomark $arcend($b)
10379                                 }
10380                             }
10381                             if {[info exists tagloc($dd)]} {
10382                                 unset tagloc($dd)
10383                             }
10384                         } elseif {[info exists queued($dd)]} {
10385                             incr nc -1
10386                         }
10387                         set hastaggeddescendent($dd) 1
10388                     }
10389                 }
10390             }
10391             if {![info exists queued($d)]} {
10392                 lappend todo $d
10393                 set queued($d) 1
10394                 if {![info exists hastaggeddescendent($d)]} {
10395                     incr nc
10396                 }
10397             }
10398         }
10399     }
10400     set t2 [clock clicks -milliseconds]
10401     set loopix $i
10402     set tags {}
10403     foreach id [array names tagloc] {
10404         if {![info exists hastaggeddescendent($id)]} {
10405             foreach t $tagloc($id) {
10406                 if {[lsearch -exact $tags $t] < 0} {
10407                     lappend tags $t
10408                 }
10409             }
10410         }
10411     }
10412
10413     # remove tags that are ancestors of other tags
10414     for {set i 0} {$i < [llength $tags]} {incr i} {
10415         set a [lindex $tags $i]
10416         for {set j 0} {$j < $i} {incr j} {
10417             set b [lindex $tags $j]
10418             set r [anc_or_desc $a $b]
10419             if {$r == -1} {
10420                 set tags [lreplace $tags $j $j]
10421                 incr j -1
10422                 incr i -1
10423             } elseif {$r == 1} {
10424                 set tags [lreplace $tags $i $i]
10425                 incr i -1
10426                 break
10427             }
10428         }
10429     }
10430
10431     if {[array names growing] ne {}} {
10432         # graph isn't finished, need to check if any tag could get
10433         # eclipsed by another tag coming later.  Simply ignore any
10434         # tags that could later get eclipsed.
10435         set ctags {}
10436         foreach t $tags {
10437             if {[is_certain $origid $t]} {
10438                 lappend ctags $t
10439             }
10440         }
10441         if {$tags eq $ctags} {
10442             set cached_atags($origid) $tags
10443         } else {
10444             set tags $ctags
10445         }
10446     } else {
10447         set cached_atags($origid) $tags
10448     }
10449     set t3 [clock clicks -milliseconds]
10450     if {0 && $t3 - $t1 >= 100} {
10451         puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
10452             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10453     }
10454     return $tags
10455 }
10456
10457 # Return the list of IDs that have heads that are descendents of id,
10458 # including id itself if it has a head.
10459 proc descheads {id} {
10460     global arcnos arcstart arcids archeads idheads cached_dheads
10461     global allparents
10462
10463     if {![info exists allparents($id)]} {
10464         return {}
10465     }
10466     set aret {}
10467     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10468         # part-way along an arc; check it first
10469         set a [lindex $arcnos($id) 0]
10470         if {$archeads($a) ne {}} {
10471             validate_archeads $a
10472             set i [lsearch -exact $arcids($a) $id]
10473             foreach t $archeads($a) {
10474                 set j [lsearch -exact $arcids($a) $t]
10475                 if {$j > $i} break
10476                 lappend aret $t
10477             }
10478         }
10479         set id $arcstart($a)
10480     }
10481     set origid $id
10482     set todo [list $id]
10483     set seen($id) 1
10484     set ret {}
10485     for {set i 0} {$i < [llength $todo]} {incr i} {
10486         set id [lindex $todo $i]
10487         if {[info exists cached_dheads($id)]} {
10488             set ret [concat $ret $cached_dheads($id)]
10489         } else {
10490             if {[info exists idheads($id)]} {
10491                 lappend ret $id
10492             }
10493             foreach a $arcnos($id) {
10494                 if {$archeads($a) ne {}} {
10495                     validate_archeads $a
10496                     if {$archeads($a) ne {}} {
10497                         set ret [concat $ret $archeads($a)]
10498                     }
10499                 }
10500                 set d $arcstart($a)
10501                 if {![info exists seen($d)]} {
10502                     lappend todo $d
10503                     set seen($d) 1
10504                 }
10505             }
10506         }
10507     }
10508     set ret [lsort -unique $ret]
10509     set cached_dheads($origid) $ret
10510     return [concat $ret $aret]
10511 }
10512
10513 proc addedtag {id} {
10514     global arcnos arcout cached_dtags cached_atags
10515
10516     if {![info exists arcnos($id)]} return
10517     if {![info exists arcout($id)]} {
10518         recalcarc [lindex $arcnos($id) 0]
10519     }
10520     catch {unset cached_dtags}
10521     catch {unset cached_atags}
10522 }
10523
10524 proc addedhead {hid head} {
10525     global arcnos arcout cached_dheads
10526
10527     if {![info exists arcnos($hid)]} return
10528     if {![info exists arcout($hid)]} {
10529         recalcarc [lindex $arcnos($hid) 0]
10530     }
10531     catch {unset cached_dheads}
10532 }
10533
10534 proc removedhead {hid head} {
10535     global cached_dheads
10536
10537     catch {unset cached_dheads}
10538 }
10539
10540 proc movedhead {hid head} {
10541     global arcnos arcout cached_dheads
10542
10543     if {![info exists arcnos($hid)]} return
10544     if {![info exists arcout($hid)]} {
10545         recalcarc [lindex $arcnos($hid) 0]
10546     }
10547     catch {unset cached_dheads}
10548 }
10549
10550 proc changedrefs {} {
10551     global cached_dheads cached_dtags cached_atags
10552     global arctags archeads arcnos arcout idheads idtags
10553
10554     foreach id [concat [array names idheads] [array names idtags]] {
10555         if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
10556             set a [lindex $arcnos($id) 0]
10557             if {![info exists donearc($a)]} {
10558                 recalcarc $a
10559                 set donearc($a) 1
10560             }
10561         }
10562     }
10563     catch {unset cached_dtags}
10564     catch {unset cached_atags}
10565     catch {unset cached_dheads}
10566 }
10567
10568 proc rereadrefs {} {
10569     global idtags idheads idotherrefs mainheadid
10570
10571     set refids [concat [array names idtags] \
10572                     [array names idheads] [array names idotherrefs]]
10573     foreach id $refids {
10574         if {![info exists ref($id)]} {
10575             set ref($id) [listrefs $id]
10576         }
10577     }
10578     set oldmainhead $mainheadid
10579     readrefs
10580     changedrefs
10581     set refids [lsort -unique [concat $refids [array names idtags] \
10582                         [array names idheads] [array names idotherrefs]]]
10583     foreach id $refids {
10584         set v [listrefs $id]
10585         if {![info exists ref($id)] || $ref($id) != $v} {
10586             redrawtags $id
10587         }
10588     }
10589     if {$oldmainhead ne $mainheadid} {
10590         redrawtags $oldmainhead
10591         redrawtags $mainheadid
10592     }
10593     run refill_reflist
10594 }
10595
10596 proc listrefs {id} {
10597     global idtags idheads idotherrefs
10598
10599     set x {}
10600     if {[info exists idtags($id)]} {
10601         set x $idtags($id)
10602     }
10603     set y {}
10604     if {[info exists idheads($id)]} {
10605         set y $idheads($id)
10606     }
10607     set z {}
10608     if {[info exists idotherrefs($id)]} {
10609         set z $idotherrefs($id)
10610     }
10611     return [list $x $y $z]
10612 }
10613
10614 proc showtag {tag isnew} {
10615     global ctext tagcontents tagids linknum tagobjid
10616
10617     if {$isnew} {
10618         addtohistory [list showtag $tag 0] savectextpos
10619     }
10620     $ctext conf -state normal
10621     clear_ctext
10622     settabs 0
10623     set linknum 0
10624     if {![info exists tagcontents($tag)]} {
10625         catch {
10626            set tagcontents($tag) [exec git cat-file tag $tag]
10627         }
10628     }
10629     if {[info exists tagcontents($tag)]} {
10630         set text $tagcontents($tag)
10631     } else {
10632         set text "[mc "Tag"]: $tag\n[mc "Id"]:  $tagids($tag)"
10633     }
10634     appendwithlinks $text {}
10635     maybe_scroll_ctext 1
10636     $ctext conf -state disabled
10637     init_flist {}
10638 }
10639
10640 proc doquit {} {
10641     global stopped
10642     global gitktmpdir
10643
10644     set stopped 100
10645     savestuff .
10646     destroy .
10647
10648     if {[info exists gitktmpdir]} {
10649         catch {file delete -force $gitktmpdir}
10650     }
10651 }
10652
10653 proc mkfontdisp {font top which} {
10654     global fontattr fontpref $font NS use_ttk
10655
10656     set fontpref($font) [set $font]
10657     ${NS}::button $top.${font}but -text $which \
10658         -command [list choosefont $font $which]
10659     ${NS}::label $top.$font -relief flat -font $font \
10660         -text $fontattr($font,family) -justify left
10661     grid x $top.${font}but $top.$font -sticky w
10662 }
10663
10664 proc choosefont {font which} {
10665     global fontparam fontlist fonttop fontattr
10666     global prefstop NS
10667
10668     set fontparam(which) $which
10669     set fontparam(font) $font
10670     set fontparam(family) [font actual $font -family]
10671     set fontparam(size) $fontattr($font,size)
10672     set fontparam(weight) $fontattr($font,weight)
10673     set fontparam(slant) $fontattr($font,slant)
10674     set top .gitkfont
10675     set fonttop $top
10676     if {![winfo exists $top]} {
10677         font create sample
10678         eval font config sample [font actual $font]
10679         ttk_toplevel $top
10680         make_transient $top $prefstop
10681         wm title $top [mc "Gitk font chooser"]
10682         ${NS}::label $top.l -textvariable fontparam(which)
10683         pack $top.l -side top
10684         set fontlist [lsort [font families]]
10685         ${NS}::frame $top.f
10686         listbox $top.f.fam -listvariable fontlist \
10687             -yscrollcommand [list $top.f.sb set]
10688         bind $top.f.fam <<ListboxSelect>> selfontfam
10689         ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
10690         pack $top.f.sb -side right -fill y
10691         pack $top.f.fam -side left -fill both -expand 1
10692         pack $top.f -side top -fill both -expand 1
10693         ${NS}::frame $top.g
10694         spinbox $top.g.size -from 4 -to 40 -width 4 \
10695             -textvariable fontparam(size) \
10696             -validatecommand {string is integer -strict %s}
10697         checkbutton $top.g.bold -padx 5 \
10698             -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
10699             -variable fontparam(weight) -onvalue bold -offvalue normal
10700         checkbutton $top.g.ital -padx 5 \
10701             -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
10702             -variable fontparam(slant) -onvalue italic -offvalue roman
10703         pack $top.g.size $top.g.bold $top.g.ital -side left
10704         pack $top.g -side top
10705         canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
10706             -background white
10707         $top.c create text 100 25 -anchor center -text $which -font sample \
10708             -fill black -tags text
10709         bind $top.c <Configure> [list centertext $top.c]
10710         pack $top.c -side top -fill x
10711         ${NS}::frame $top.buts
10712         ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
10713         ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
10714         bind $top <Key-Return> fontok
10715         bind $top <Key-Escape> fontcan
10716         grid $top.buts.ok $top.buts.can
10717         grid columnconfigure $top.buts 0 -weight 1 -uniform a
10718         grid columnconfigure $top.buts 1 -weight 1 -uniform a
10719         pack $top.buts -side bottom -fill x
10720         trace add variable fontparam write chg_fontparam
10721     } else {
10722         raise $top
10723         $top.c itemconf text -text $which
10724     }
10725     set i [lsearch -exact $fontlist $fontparam(family)]
10726     if {$i >= 0} {
10727         $top.f.fam selection set $i
10728         $top.f.fam see $i
10729     }
10730 }
10731
10732 proc centertext {w} {
10733     $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
10734 }
10735
10736 proc fontok {} {
10737     global fontparam fontpref prefstop
10738
10739     set f $fontparam(font)
10740     set fontpref($f) [list $fontparam(family) $fontparam(size)]
10741     if {$fontparam(weight) eq "bold"} {
10742         lappend fontpref($f) "bold"
10743     }
10744     if {$fontparam(slant) eq "italic"} {
10745         lappend fontpref($f) "italic"
10746     }
10747     set w $prefstop.$f
10748     $w conf -text $fontparam(family) -font $fontpref($f)
10749
10750     fontcan
10751 }
10752
10753 proc fontcan {} {
10754     global fonttop fontparam
10755
10756     if {[info exists fonttop]} {
10757         catch {destroy $fonttop}
10758         catch {font delete sample}
10759         unset fonttop
10760         unset fontparam
10761     }
10762 }
10763
10764 if {[package vsatisfies [package provide Tk] 8.6]} {
10765     # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
10766     # function to make use of it.
10767     proc choosefont {font which} {
10768         tk fontchooser configure -title $which -font $font \
10769             -command [list on_choosefont $font $which]
10770         tk fontchooser show
10771     }
10772     proc on_choosefont {font which newfont} {
10773         global fontparam
10774         puts stderr "$font $newfont"
10775         array set f [font actual $newfont]
10776         set fontparam(which) $which
10777         set fontparam(font) $font
10778         set fontparam(family) $f(-family)
10779         set fontparam(size) $f(-size)
10780         set fontparam(weight) $f(-weight)
10781         set fontparam(slant) $f(-slant)
10782         fontok
10783     }
10784 }
10785
10786 proc selfontfam {} {
10787     global fonttop fontparam
10788
10789     set i [$fonttop.f.fam curselection]
10790     if {$i ne {}} {
10791         set fontparam(family) [$fonttop.f.fam get $i]
10792     }
10793 }
10794
10795 proc chg_fontparam {v sub op} {
10796     global fontparam
10797
10798     font config sample -$sub $fontparam($sub)
10799 }
10800
10801 # Create a property sheet tab page
10802 proc create_prefs_page {w} {
10803     global NS
10804     set parent [join [lrange [split $w .] 0 end-1] .]
10805     if {[winfo class $parent] eq "TNotebook"} {
10806         ${NS}::frame $w
10807     } else {
10808         ${NS}::labelframe $w
10809     }
10810 }
10811
10812 proc prefspage_general {notebook} {
10813     global NS maxwidth maxgraphpct showneartags showlocalchanges
10814     global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
10815     global hideremotes want_ttk have_ttk
10816
10817     set page [create_prefs_page $notebook.general]
10818
10819     ${NS}::label $page.ldisp -text [mc "Commit list display options"]
10820     grid $page.ldisp - -sticky w -pady 10
10821     ${NS}::label $page.spacer -text " "
10822     ${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
10823     spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
10824     grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w
10825     ${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
10826     spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
10827     grid x $page.maxpctl $page.maxpct -sticky w
10828     ${NS}::checkbutton $page.showlocal -text [mc "Show local changes"] \
10829         -variable showlocalchanges
10830     grid x $page.showlocal -sticky w
10831     ${NS}::checkbutton $page.autoselect -text [mc "Auto-select SHA1 (length)"] \
10832         -variable autoselect
10833     spinbox $page.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
10834     grid x $page.autoselect $page.autosellen -sticky w
10835     ${NS}::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \
10836         -variable hideremotes
10837     grid x $page.hideremotes -sticky w
10838
10839     ${NS}::label $page.ddisp -text [mc "Diff display options"]
10840     grid $page.ddisp - -sticky w -pady 10
10841     ${NS}::label $page.tabstopl -text [mc "Tab spacing"]
10842     spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
10843     grid x $page.tabstopl $page.tabstop -sticky w
10844     ${NS}::checkbutton $page.ntag -text [mc "Display nearby tags"] \
10845         -variable showneartags
10846     grid x $page.ntag -sticky w
10847     ${NS}::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \
10848         -variable limitdiffs
10849     grid x $page.ldiff -sticky w
10850     ${NS}::checkbutton $page.lattr -text [mc "Support per-file encodings"] \
10851         -variable perfile_attrs
10852     grid x $page.lattr -sticky w
10853
10854     ${NS}::entry $page.extdifft -textvariable extdifftool
10855     ${NS}::frame $page.extdifff
10856     ${NS}::label $page.extdifff.l -text [mc "External diff tool" ]
10857     ${NS}::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff
10858     pack $page.extdifff.l $page.extdifff.b -side left
10859     pack configure $page.extdifff.l -padx 10
10860     grid x $page.extdifff $page.extdifft -sticky ew
10861
10862     ${NS}::label $page.lgen -text [mc "General options"]
10863     grid $page.lgen - -sticky w -pady 10
10864     ${NS}::checkbutton $page.want_ttk -variable want_ttk \
10865         -text [mc "Use themed widgets"]
10866     if {$have_ttk} {
10867         ${NS}::label $page.ttk_note -text [mc "(change requires restart)"]
10868     } else {
10869         ${NS}::label $page.ttk_note -text [mc "(currently unavailable)"]
10870     }
10871     grid x $page.want_ttk $page.ttk_note -sticky w
10872     return $page
10873 }
10874
10875 proc prefspage_colors {notebook} {
10876     global NS uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
10877
10878     set page [create_prefs_page $notebook.colors]
10879
10880     ${NS}::label $page.cdisp -text [mc "Colors: press to choose"]
10881     grid $page.cdisp - -sticky w -pady 10
10882     label $page.ui -padx 40 -relief sunk -background $uicolor
10883     ${NS}::button $page.uibut -text [mc "Interface"] \
10884        -command [list choosecolor uicolor {} $page.ui [mc "interface"] setui]
10885     grid x $page.uibut $page.ui -sticky w
10886     label $page.bg -padx 40 -relief sunk -background $bgcolor
10887     ${NS}::button $page.bgbut -text [mc "Background"] \
10888         -command [list choosecolor bgcolor {} $page.bg [mc "background"] setbg]
10889     grid x $page.bgbut $page.bg -sticky w
10890     label $page.fg -padx 40 -relief sunk -background $fgcolor
10891     ${NS}::button $page.fgbut -text [mc "Foreground"] \
10892         -command [list choosecolor fgcolor {} $page.fg [mc "foreground"] setfg]
10893     grid x $page.fgbut $page.fg -sticky w
10894     label $page.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
10895     ${NS}::button $page.diffoldbut -text [mc "Diff: old lines"] \
10896         -command [list choosecolor diffcolors 0 $page.diffold [mc "diff old lines"] \
10897                       [list $ctext tag conf d0 -foreground]]
10898     grid x $page.diffoldbut $page.diffold -sticky w
10899     label $page.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
10900     ${NS}::button $page.diffnewbut -text [mc "Diff: new lines"] \
10901         -command [list choosecolor diffcolors 1 $page.diffnew [mc "diff new lines"] \
10902                       [list $ctext tag conf dresult -foreground]]
10903     grid x $page.diffnewbut $page.diffnew -sticky w
10904     label $page.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
10905     ${NS}::button $page.hunksepbut -text [mc "Diff: hunk header"] \
10906         -command [list choosecolor diffcolors 2 $page.hunksep \
10907                       [mc "diff hunk header"] \
10908                       [list $ctext tag conf hunksep -foreground]]
10909     grid x $page.hunksepbut $page.hunksep -sticky w
10910     label $page.markbgsep -padx 40 -relief sunk -background $markbgcolor
10911     ${NS}::button $page.markbgbut -text [mc "Marked line bg"] \
10912         -command [list choosecolor markbgcolor {} $page.markbgsep \
10913                       [mc "marked line background"] \
10914                       [list $ctext tag conf omark -background]]
10915     grid x $page.markbgbut $page.markbgsep -sticky w
10916     label $page.selbgsep -padx 40 -relief sunk -background $selectbgcolor
10917     ${NS}::button $page.selbgbut -text [mc "Select bg"] \
10918         -command [list choosecolor selectbgcolor {} $page.selbgsep [mc "background"] setselbg]
10919     grid x $page.selbgbut $page.selbgsep -sticky w
10920     return $page
10921 }
10922
10923 proc prefspage_fonts {notebook} {
10924     global NS
10925     set page [create_prefs_page $notebook.fonts]
10926     ${NS}::label $page.cfont -text [mc "Fonts: press to choose"]
10927     grid $page.cfont - -sticky w -pady 10
10928     mkfontdisp mainfont $page [mc "Main font"]
10929     mkfontdisp textfont $page [mc "Diff display font"]
10930     mkfontdisp uifont $page [mc "User interface font"]
10931     return $page
10932 }
10933
10934 proc doprefs {} {
10935     global maxwidth maxgraphpct use_ttk NS
10936     global oldprefs prefstop showneartags showlocalchanges
10937     global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
10938     global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
10939     global hideremotes want_ttk have_ttk
10940
10941     set top .gitkprefs
10942     set prefstop $top
10943     if {[winfo exists $top]} {
10944         raise $top
10945         return
10946     }
10947     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
10948                    limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
10949         set oldprefs($v) [set $v]
10950     }
10951     ttk_toplevel $top
10952     wm title $top [mc "Gitk preferences"]
10953     make_transient $top .
10954
10955     if {[set use_notebook [expr {$use_ttk && [info command ::ttk::notebook] ne ""}]]} {
10956         set notebook [ttk::notebook $top.notebook]
10957     } else {
10958         set notebook [${NS}::frame $top.notebook -borderwidth 0 -relief flat]
10959     }
10960
10961     lappend pages [prefspage_general $notebook] [mc "General"]
10962     lappend pages [prefspage_colors $notebook] [mc "Colors"]
10963     lappend pages [prefspage_fonts $notebook] [mc "Fonts"]
10964     foreach {page title} $pages {
10965         if {$use_notebook} {
10966             $notebook add $page -text $title
10967         } else {
10968             set btn [${NS}::button $notebook.b_[string map {. X} $page] \
10969                          -text $title -command [list raise $page]]
10970             $page configure -text $title
10971             grid $btn -row 0 -column [incr col] -sticky w
10972             grid $page -row 1 -column 0 -sticky news -columnspan 100
10973         }
10974     }
10975
10976     if {!$use_notebook} {
10977         grid columnconfigure $notebook 0 -weight 1
10978         grid rowconfigure $notebook 1 -weight 1
10979         raise [lindex $pages 0]
10980     }
10981
10982     grid $notebook -sticky news -padx 2 -pady 2
10983     grid rowconfigure $top 0 -weight 1
10984     grid columnconfigure $top 0 -weight 1
10985
10986     ${NS}::frame $top.buts
10987     ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
10988     ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
10989     bind $top <Key-Return> prefsok
10990     bind $top <Key-Escape> prefscan
10991     grid $top.buts.ok $top.buts.can
10992     grid columnconfigure $top.buts 0 -weight 1 -uniform a
10993     grid columnconfigure $top.buts 1 -weight 1 -uniform a
10994     grid $top.buts - - -pady 10 -sticky ew
10995     grid columnconfigure $top 2 -weight 1
10996     bind $top <Visibility> [list focus $top.buts.ok]
10997 }
10998
10999 proc choose_extdiff {} {
11000     global extdifftool
11001
11002     set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
11003     if {$prog ne {}} {
11004         set extdifftool $prog
11005     }
11006 }
11007
11008 proc choosecolor {v vi w x cmd} {
11009     global $v
11010
11011     set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
11012                -title [mc "Gitk: choose color for %s" $x]]
11013     if {$c eq {}} return
11014     $w conf -background $c
11015     lset $v $vi $c
11016     eval $cmd $c
11017 }
11018
11019 proc setselbg {c} {
11020     global bglist cflist
11021     foreach w $bglist {
11022         $w configure -selectbackground $c
11023     }
11024     $cflist tag configure highlight \
11025         -background [$cflist cget -selectbackground]
11026     allcanvs itemconf secsel -fill $c
11027 }
11028
11029 # This sets the background color and the color scheme for the whole UI.
11030 # For some reason, tk_setPalette chooses a nasty dark red for selectColor
11031 # if we don't specify one ourselves, which makes the checkbuttons and
11032 # radiobuttons look bad.  This chooses white for selectColor if the
11033 # background color is light, or black if it is dark.
11034 proc setui {c} {
11035     if {[tk windowingsystem] eq "win32"} { return }
11036     set bg [winfo rgb . $c]
11037     set selc black
11038     if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
11039         set selc white
11040     }
11041     tk_setPalette background $c selectColor $selc
11042 }
11043
11044 proc setbg {c} {
11045     global bglist
11046
11047     foreach w $bglist {
11048         $w conf -background $c
11049     }
11050 }
11051
11052 proc setfg {c} {
11053     global fglist canv
11054
11055     foreach w $fglist {
11056         $w conf -foreground $c
11057     }
11058     allcanvs itemconf text -fill $c
11059     $canv itemconf circle -outline $c
11060     $canv itemconf markid -outline $c
11061 }
11062
11063 proc prefscan {} {
11064     global oldprefs prefstop
11065
11066     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11067                    limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11068         global $v
11069         set $v $oldprefs($v)
11070     }
11071     catch {destroy $prefstop}
11072     unset prefstop
11073     fontcan
11074 }
11075
11076 proc prefsok {} {
11077     global maxwidth maxgraphpct
11078     global oldprefs prefstop showneartags showlocalchanges
11079     global fontpref mainfont textfont uifont
11080     global limitdiffs treediffs perfile_attrs
11081     global hideremotes
11082
11083     catch {destroy $prefstop}
11084     unset prefstop
11085     fontcan
11086     set fontchanged 0
11087     if {$mainfont ne $fontpref(mainfont)} {
11088         set mainfont $fontpref(mainfont)
11089         parsefont mainfont $mainfont
11090         eval font configure mainfont [fontflags mainfont]
11091         eval font configure mainfontbold [fontflags mainfont 1]
11092         setcoords
11093         set fontchanged 1
11094     }
11095     if {$textfont ne $fontpref(textfont)} {
11096         set textfont $fontpref(textfont)
11097         parsefont textfont $textfont
11098         eval font configure textfont [fontflags textfont]
11099         eval font configure textfontbold [fontflags textfont 1]
11100     }
11101     if {$uifont ne $fontpref(uifont)} {
11102         set uifont $fontpref(uifont)
11103         parsefont uifont $uifont
11104         eval font configure uifont [fontflags uifont]
11105     }
11106     settabs
11107     if {$showlocalchanges != $oldprefs(showlocalchanges)} {
11108         if {$showlocalchanges} {
11109             doshowlocalchanges
11110         } else {
11111             dohidelocalchanges
11112         }
11113     }
11114     if {$limitdiffs != $oldprefs(limitdiffs) ||
11115         ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11116         # treediffs elements are limited by path;
11117         # won't have encodings cached if perfile_attrs was just turned on
11118         catch {unset treediffs}
11119     }
11120     if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
11121         || $maxgraphpct != $oldprefs(maxgraphpct)} {
11122         redisplay
11123     } elseif {$showneartags != $oldprefs(showneartags) ||
11124           $limitdiffs != $oldprefs(limitdiffs)} {
11125         reselectline
11126     }
11127     if {$hideremotes != $oldprefs(hideremotes)} {
11128         rereadrefs
11129     }
11130 }
11131
11132 proc formatdate {d} {
11133     global datetimeformat
11134     if {$d ne {}} {
11135         set d [clock format [lindex $d 0] -format $datetimeformat]
11136     }
11137     return $d
11138 }
11139
11140 # This list of encoding names and aliases is distilled from
11141 # http://www.iana.org/assignments/character-sets.
11142 # Not all of them are supported by Tcl.
11143 set encoding_aliases {
11144     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11145       ISO646-US US-ASCII us IBM367 cp367 csASCII }
11146     { ISO-10646-UTF-1 csISO10646UTF1 }
11147     { ISO_646.basic:1983 ref csISO646basic1983 }
11148     { INVARIANT csINVARIANT }
11149     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11150     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11151     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11152     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11153     { NATS-DANO iso-ir-9-1 csNATSDANO }
11154     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11155     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11156     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11157     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11158     { ISO-2022-KR csISO2022KR }
11159     { EUC-KR csEUCKR }
11160     { ISO-2022-JP csISO2022JP }
11161     { ISO-2022-JP-2 csISO2022JP2 }
11162     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11163       csISO13JISC6220jp }
11164     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11165     { IT iso-ir-15 ISO646-IT csISO15Italian }
11166     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11167     { ES iso-ir-17 ISO646-ES csISO17Spanish }
11168     { greek7-old iso-ir-18 csISO18Greek7Old }
11169     { latin-greek iso-ir-19 csISO19LatinGreek }
11170     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11171     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11172     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11173     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11174     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11175     { BS_viewdata iso-ir-47 csISO47BSViewdata }
11176     { INIS iso-ir-49 csISO49INIS }
11177     { INIS-8 iso-ir-50 csISO50INIS8 }
11178     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11179     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11180     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11181     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11182     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11183     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11184       csISO60Norwegian1 }
11185     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11186     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11187     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11188     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11189     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11190     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11191     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11192     { greek7 iso-ir-88 csISO88Greek7 }
11193     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11194     { iso-ir-90 csISO90 }
11195     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11196     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11197       csISO92JISC62991984b }
11198     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11199     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11200     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11201       csISO95JIS62291984handadd }
11202     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11203     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11204     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11205     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11206       CP819 csISOLatin1 }
11207     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11208     { T.61-7bit iso-ir-102 csISO102T617bit }
11209     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11210     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
11211     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
11212     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
11213     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
11214     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
11215     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
11216     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
11217       arabic csISOLatinArabic }
11218     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
11219     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
11220     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
11221       greek greek8 csISOLatinGreek }
11222     { T.101-G2 iso-ir-128 csISO128T101G2 }
11223     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
11224       csISOLatinHebrew }
11225     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
11226     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
11227     { CSN_369103 iso-ir-139 csISO139CSN369103 }
11228     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
11229     { ISO_6937-2-add iso-ir-142 csISOTextComm }
11230     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
11231     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
11232       csISOLatinCyrillic }
11233     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
11234     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
11235     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
11236     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
11237     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
11238     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
11239     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
11240     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
11241     { ISO_10367-box iso-ir-155 csISO10367Box }
11242     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
11243     { latin-lap lap iso-ir-158 csISO158Lap }
11244     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
11245     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
11246     { us-dk csUSDK }
11247     { dk-us csDKUS }
11248     { JIS_X0201 X0201 csHalfWidthKatakana }
11249     { KSC5636 ISO646-KR csKSC5636 }
11250     { ISO-10646-UCS-2 csUnicode }
11251     { ISO-10646-UCS-4 csUCS4 }
11252     { DEC-MCS dec csDECMCS }
11253     { hp-roman8 roman8 r8 csHPRoman8 }
11254     { macintosh mac csMacintosh }
11255     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
11256       csIBM037 }
11257     { IBM038 EBCDIC-INT cp038 csIBM038 }
11258     { IBM273 CP273 csIBM273 }
11259     { IBM274 EBCDIC-BE CP274 csIBM274 }
11260     { IBM275 EBCDIC-BR cp275 csIBM275 }
11261     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
11262     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
11263     { IBM280 CP280 ebcdic-cp-it csIBM280 }
11264     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
11265     { IBM284 CP284 ebcdic-cp-es csIBM284 }
11266     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
11267     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
11268     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
11269     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
11270     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
11271     { IBM424 cp424 ebcdic-cp-he csIBM424 }
11272     { IBM437 cp437 437 csPC8CodePage437 }
11273     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
11274     { IBM775 cp775 csPC775Baltic }
11275     { IBM850 cp850 850 csPC850Multilingual }
11276     { IBM851 cp851 851 csIBM851 }
11277     { IBM852 cp852 852 csPCp852 }
11278     { IBM855 cp855 855 csIBM855 }
11279     { IBM857 cp857 857 csIBM857 }
11280     { IBM860 cp860 860 csIBM860 }
11281     { IBM861 cp861 861 cp-is csIBM861 }
11282     { IBM862 cp862 862 csPC862LatinHebrew }
11283     { IBM863 cp863 863 csIBM863 }
11284     { IBM864 cp864 csIBM864 }
11285     { IBM865 cp865 865 csIBM865 }
11286     { IBM866 cp866 866 csIBM866 }
11287     { IBM868 CP868 cp-ar csIBM868 }
11288     { IBM869 cp869 869 cp-gr csIBM869 }
11289     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
11290     { IBM871 CP871 ebcdic-cp-is csIBM871 }
11291     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
11292     { IBM891 cp891 csIBM891 }
11293     { IBM903 cp903 csIBM903 }
11294     { IBM904 cp904 904 csIBBM904 }
11295     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
11296     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
11297     { IBM1026 CP1026 csIBM1026 }
11298     { EBCDIC-AT-DE csIBMEBCDICATDE }
11299     { EBCDIC-AT-DE-A csEBCDICATDEA }
11300     { EBCDIC-CA-FR csEBCDICCAFR }
11301     { EBCDIC-DK-NO csEBCDICDKNO }
11302     { EBCDIC-DK-NO-A csEBCDICDKNOA }
11303     { EBCDIC-FI-SE csEBCDICFISE }
11304     { EBCDIC-FI-SE-A csEBCDICFISEA }
11305     { EBCDIC-FR csEBCDICFR }
11306     { EBCDIC-IT csEBCDICIT }
11307     { EBCDIC-PT csEBCDICPT }
11308     { EBCDIC-ES csEBCDICES }
11309     { EBCDIC-ES-A csEBCDICESA }
11310     { EBCDIC-ES-S csEBCDICESS }
11311     { EBCDIC-UK csEBCDICUK }
11312     { EBCDIC-US csEBCDICUS }
11313     { UNKNOWN-8BIT csUnknown8BiT }
11314     { MNEMONIC csMnemonic }
11315     { MNEM csMnem }
11316     { VISCII csVISCII }
11317     { VIQR csVIQR }
11318     { KOI8-R csKOI8R }
11319     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
11320     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
11321     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
11322     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
11323     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
11324     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
11325     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
11326     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
11327     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
11328     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
11329     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
11330     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
11331     { IBM1047 IBM-1047 }
11332     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
11333     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
11334     { UNICODE-1-1 csUnicode11 }
11335     { CESU-8 csCESU-8 }
11336     { BOCU-1 csBOCU-1 }
11337     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
11338     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
11339       l8 }
11340     { ISO-8859-15 ISO_8859-15 Latin-9 }
11341     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
11342     { GBK CP936 MS936 windows-936 }
11343     { JIS_Encoding csJISEncoding }
11344     { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
11345     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
11346       EUC-JP }
11347     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
11348     { ISO-10646-UCS-Basic csUnicodeASCII }
11349     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
11350     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
11351     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
11352     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
11353     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
11354     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
11355     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
11356     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
11357     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
11358     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
11359     { Adobe-Standard-Encoding csAdobeStandardEncoding }
11360     { Ventura-US csVenturaUS }
11361     { Ventura-International csVenturaInternational }
11362     { PC8-Danish-Norwegian csPC8DanishNorwegian }
11363     { PC8-Turkish csPC8Turkish }
11364     { IBM-Symbols csIBMSymbols }
11365     { IBM-Thai csIBMThai }
11366     { HP-Legal csHPLegal }
11367     { HP-Pi-font csHPPiFont }
11368     { HP-Math8 csHPMath8 }
11369     { Adobe-Symbol-Encoding csHPPSMath }
11370     { HP-DeskTop csHPDesktop }
11371     { Ventura-Math csVenturaMath }
11372     { Microsoft-Publishing csMicrosoftPublishing }
11373     { Windows-31J csWindows31J }
11374     { GB2312 csGB2312 }
11375     { Big5 csBig5 }
11376 }
11377
11378 proc tcl_encoding {enc} {
11379     global encoding_aliases tcl_encoding_cache
11380     if {[info exists tcl_encoding_cache($enc)]} {
11381         return $tcl_encoding_cache($enc)
11382     }
11383     set names [encoding names]
11384     set lcnames [string tolower $names]
11385     set enc [string tolower $enc]
11386     set i [lsearch -exact $lcnames $enc]
11387     if {$i < 0} {
11388         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
11389         if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
11390             set i [lsearch -exact $lcnames $encx]
11391         }
11392     }
11393     if {$i < 0} {
11394         foreach l $encoding_aliases {
11395             set ll [string tolower $l]
11396             if {[lsearch -exact $ll $enc] < 0} continue
11397             # look through the aliases for one that tcl knows about
11398             foreach e $ll {
11399                 set i [lsearch -exact $lcnames $e]
11400                 if {$i < 0} {
11401                     if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
11402                         set i [lsearch -exact $lcnames $ex]
11403                     }
11404                 }
11405                 if {$i >= 0} break
11406             }
11407             break
11408         }
11409     }
11410     set tclenc {}
11411     if {$i >= 0} {
11412         set tclenc [lindex $names $i]
11413     }
11414     set tcl_encoding_cache($enc) $tclenc
11415     return $tclenc
11416 }
11417
11418 proc gitattr {path attr default} {
11419     global path_attr_cache
11420     if {[info exists path_attr_cache($attr,$path)]} {
11421         set r $path_attr_cache($attr,$path)
11422     } else {
11423         set r "unspecified"
11424         if {![catch {set line [exec git check-attr $attr -- $path]}]} {
11425             regexp "(.*): $attr: (.*)" $line m f r
11426         }
11427         set path_attr_cache($attr,$path) $r
11428     }
11429     if {$r eq "unspecified"} {
11430         return $default
11431     }
11432     return $r
11433 }
11434
11435 proc cache_gitattr {attr pathlist} {
11436     global path_attr_cache
11437     set newlist {}
11438     foreach path $pathlist {
11439         if {![info exists path_attr_cache($attr,$path)]} {
11440             lappend newlist $path
11441         }
11442     }
11443     set lim 1000
11444     if {[tk windowingsystem] == "win32"} {
11445         # windows has a 32k limit on the arguments to a command...
11446         set lim 30
11447     }
11448     while {$newlist ne {}} {
11449         set head [lrange $newlist 0 [expr {$lim - 1}]]
11450         set newlist [lrange $newlist $lim end]
11451         if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
11452             foreach row [split $rlist "\n"] {
11453                 if {[regexp "(.*): $attr: (.*)" $row m path value]} {
11454                     if {[string index $path 0] eq "\""} {
11455                         set path [encoding convertfrom [lindex $path 0]]
11456                     }
11457                     set path_attr_cache($attr,$path) $value
11458                 }
11459             }
11460         }
11461     }
11462 }
11463
11464 proc get_path_encoding {path} {
11465     global gui_encoding perfile_attrs
11466     set tcl_enc $gui_encoding
11467     if {$path ne {} && $perfile_attrs} {
11468         set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
11469         if {$enc2 ne {}} {
11470             set tcl_enc $enc2
11471         }
11472     }
11473     return $tcl_enc
11474 }
11475
11476 # First check that Tcl/Tk is recent enough
11477 if {[catch {package require Tk 8.4} err]} {
11478     show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
11479                      Gitk requires at least Tcl/Tk 8.4." list
11480     exit 1
11481 }
11482
11483 # defaults...
11484 set wrcomcmd "git diff-tree --stdin -p --pretty"
11485
11486 set gitencoding {}
11487 catch {
11488     set gitencoding [exec git config --get i18n.commitencoding]
11489 }
11490 catch {
11491     set gitencoding [exec git config --get i18n.logoutputencoding]
11492 }
11493 if {$gitencoding == ""} {
11494     set gitencoding "utf-8"
11495 }
11496 set tclencoding [tcl_encoding $gitencoding]
11497 if {$tclencoding == {}} {
11498     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
11499 }
11500
11501 set gui_encoding [encoding system]
11502 catch {
11503     set enc [exec git config --get gui.encoding]
11504     if {$enc ne {}} {
11505         set tclenc [tcl_encoding $enc]
11506         if {$tclenc ne {}} {
11507             set gui_encoding $tclenc
11508         } else {
11509             puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
11510         }
11511     }
11512 }
11513
11514 if {[tk windowingsystem] eq "aqua"} {
11515     set mainfont {{Lucida Grande} 9}
11516     set textfont {Monaco 9}
11517     set uifont {{Lucida Grande} 9 bold}
11518 } else {
11519     set mainfont {Helvetica 9}
11520     set textfont {Courier 9}
11521     set uifont {Helvetica 9 bold}
11522 }
11523 set tabstop 8
11524 set findmergefiles 0
11525 set maxgraphpct 50
11526 set maxwidth 16
11527 set revlistorder 0
11528 set fastdate 0
11529 set uparrowlen 5
11530 set downarrowlen 5
11531 set mingaplen 100
11532 set cmitmode "patch"
11533 set wrapcomment "none"
11534 set showneartags 1
11535 set hideremotes 0
11536 set maxrefs 20
11537 set maxlinelen 200
11538 set showlocalchanges 1
11539 set limitdiffs 1
11540 set datetimeformat "%Y-%m-%d %H:%M:%S"
11541 set autoselect 1
11542 set autosellen 40
11543 set perfile_attrs 0
11544 set want_ttk 1
11545
11546 if {[tk windowingsystem] eq "aqua"} {
11547     set extdifftool "opendiff"
11548 } else {
11549     set extdifftool "meld"
11550 }
11551
11552 set colors {green red blue magenta darkgrey brown orange}
11553 if {[tk windowingsystem] eq "win32"} {
11554     set uicolor SystemButtonFace
11555     set bgcolor SystemWindow
11556     set fgcolor SystemButtonText
11557     set selectbgcolor SystemHighlight
11558 } else {
11559     set uicolor grey85
11560     set bgcolor white
11561     set fgcolor black
11562     set selectbgcolor gray85
11563 }
11564 set diffcolors {red "#00a000" blue}
11565 set diffcontext 3
11566 set ignorespace 0
11567 set worddiff ""
11568 set markbgcolor "#e0e0ff"
11569
11570 set circlecolors {white blue gray blue blue}
11571
11572 # button for popping up context menus
11573 if {[tk windowingsystem] eq "aqua"} {
11574     set ctxbut <Button-2>
11575 } else {
11576     set ctxbut <Button-3>
11577 }
11578
11579 ## For msgcat loading, first locate the installation location.
11580 if { [info exists ::env(GITK_MSGSDIR)] } {
11581     ## Msgsdir was manually set in the environment.
11582     set gitk_msgsdir $::env(GITK_MSGSDIR)
11583 } else {
11584     ## Let's guess the prefix from argv0.
11585     set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
11586     set gitk_libdir [file join $gitk_prefix share gitk lib]
11587     set gitk_msgsdir [file join $gitk_libdir msgs]
11588     unset gitk_prefix
11589 }
11590
11591 ## Internationalization (i18n) through msgcat and gettext. See
11592 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
11593 package require msgcat
11594 namespace import ::msgcat::mc
11595 ## And eventually load the actual message catalog
11596 ::msgcat::mcload $gitk_msgsdir
11597
11598 catch {source ~/.gitk}
11599
11600 parsefont mainfont $mainfont
11601 eval font create mainfont [fontflags mainfont]
11602 eval font create mainfontbold [fontflags mainfont 1]
11603
11604 parsefont textfont $textfont
11605 eval font create textfont [fontflags textfont]
11606 eval font create textfontbold [fontflags textfont 1]
11607
11608 parsefont uifont $uifont
11609 eval font create uifont [fontflags uifont]
11610
11611 setui $uicolor
11612
11613 setoptions
11614
11615 # check that we can find a .git directory somewhere...
11616 if {[catch {set gitdir [exec git rev-parse --git-dir]}]} {
11617     show_error {} . [mc "Cannot find a git repository here."]
11618     exit 1
11619 }
11620
11621 set selecthead {}
11622 set selectheadid {}
11623
11624 set revtreeargs {}
11625 set cmdline_files {}
11626 set i 0
11627 set revtreeargscmd {}
11628 foreach arg $argv {
11629     switch -glob -- $arg {
11630         "" { }
11631         "--" {
11632             set cmdline_files [lrange $argv [expr {$i + 1}] end]
11633             break
11634         }
11635         "--select-commit=*" {
11636             set selecthead [string range $arg 16 end]
11637         }
11638         "--argscmd=*" {
11639             set revtreeargscmd [string range $arg 10 end]
11640         }
11641         default {
11642             lappend revtreeargs $arg
11643         }
11644     }
11645     incr i
11646 }
11647
11648 if {$selecthead eq "HEAD"} {
11649     set selecthead {}
11650 }
11651
11652 if {$i >= [llength $argv] && $revtreeargs ne {}} {
11653     # no -- on command line, but some arguments (other than --argscmd)
11654     if {[catch {
11655         set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
11656         set cmdline_files [split $f "\n"]
11657         set n [llength $cmdline_files]
11658         set revtreeargs [lrange $revtreeargs 0 end-$n]
11659         # Unfortunately git rev-parse doesn't produce an error when
11660         # something is both a revision and a filename.  To be consistent
11661         # with git log and git rev-list, check revtreeargs for filenames.
11662         foreach arg $revtreeargs {
11663             if {[file exists $arg]} {
11664                 show_error {} . [mc "Ambiguous argument '%s': both revision\
11665                                  and filename" $arg]
11666                 exit 1
11667             }
11668         }
11669     } err]} {
11670         # unfortunately we get both stdout and stderr in $err,
11671         # so look for "fatal:".
11672         set i [string first "fatal:" $err]
11673         if {$i > 0} {
11674             set err [string range $err [expr {$i + 6}] end]
11675         }
11676         show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
11677         exit 1
11678     }
11679 }
11680
11681 set nullid "0000000000000000000000000000000000000000"
11682 set nullid2 "0000000000000000000000000000000000000001"
11683 set nullfile "/dev/null"
11684
11685 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
11686 if {![info exists have_ttk]} {
11687     set have_ttk [llength [info commands ::ttk::style]]
11688 }
11689 set use_ttk [expr {$have_ttk && $want_ttk}]
11690 set NS [expr {$use_ttk ? "ttk" : ""}]
11691
11692 regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
11693
11694 set show_notes {}
11695 if {[package vcompare $git_version "1.6.6.2"] >= 0} {
11696     set show_notes "--show-notes"
11697 }
11698
11699 set appname "gitk"
11700
11701 set runq {}
11702 set history {}
11703 set historyindex 0
11704 set fh_serial 0
11705 set nhl_names {}
11706 set highlight_paths {}
11707 set findpattern {}
11708 set searchdirn -forwards
11709 set boldids {}
11710 set boldnameids {}
11711 set diffelide {0 0}
11712 set markingmatches 0
11713 set linkentercount 0
11714 set need_redisplay 0
11715 set nrows_drawn 0
11716 set firsttabstop 0
11717
11718 set nextviewnum 1
11719 set curview 0
11720 set selectedview 0
11721 set selectedhlview [mc "None"]
11722 set highlight_related [mc "None"]
11723 set highlight_files {}
11724 set viewfiles(0) {}
11725 set viewperm(0) 0
11726 set viewargs(0) {}
11727 set viewargscmd(0) {}
11728
11729 set selectedline {}
11730 set numcommits 0
11731 set loginstance 0
11732 set cmdlineok 0
11733 set stopped 0
11734 set stuffsaved 0
11735 set patchnum 0
11736 set lserial 0
11737 set hasworktree [hasworktree]
11738 set cdup {}
11739 if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} {
11740     set cdup [exec git rev-parse --show-cdup]
11741 }
11742 set worktree [exec git rev-parse --show-toplevel]
11743 setcoords
11744 makewindow
11745 catch {
11746     image create photo gitlogo      -width 16 -height 16
11747
11748     image create photo gitlogominus -width  4 -height  2
11749     gitlogominus put #C00000 -to 0 0 4 2
11750     gitlogo copy gitlogominus -to  1 5
11751     gitlogo copy gitlogominus -to  6 5
11752     gitlogo copy gitlogominus -to 11 5
11753     image delete gitlogominus
11754
11755     image create photo gitlogoplus  -width  4 -height  4
11756     gitlogoplus  put #008000 -to 1 0 3 4
11757     gitlogoplus  put #008000 -to 0 1 4 3
11758     gitlogo copy gitlogoplus  -to  1 9
11759     gitlogo copy gitlogoplus  -to  6 9
11760     gitlogo copy gitlogoplus  -to 11 9
11761     image delete gitlogoplus
11762
11763     image create photo gitlogo32    -width 32 -height 32
11764     gitlogo32 copy gitlogo -zoom 2 2
11765
11766     wm iconphoto . -default gitlogo gitlogo32
11767 }
11768 # wait for the window to become visible
11769 tkwait visibility .
11770 wm title . "$appname: [reponame]"
11771 update
11772 readrefs
11773
11774 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
11775     # create a view for the files/dirs specified on the command line
11776     set curview 1
11777     set selectedview 1
11778     set nextviewnum 2
11779     set viewname(1) [mc "Command line"]
11780     set viewfiles(1) $cmdline_files
11781     set viewargs(1) $revtreeargs
11782     set viewargscmd(1) $revtreeargscmd
11783     set viewperm(1) 0
11784     set vdatemode(1) 0
11785     addviewmenu 1
11786     .bar.view entryconf [mca "Edit view..."] -state normal
11787     .bar.view entryconf [mca "Delete view"] -state normal
11788 }
11789
11790 if {[info exists permviews]} {
11791     foreach v $permviews {
11792         set n $nextviewnum
11793         incr nextviewnum
11794         set viewname($n) [lindex $v 0]
11795         set viewfiles($n) [lindex $v 1]
11796         set viewargs($n) [lindex $v 2]
11797         set viewargscmd($n) [lindex $v 3]
11798         set viewperm($n) 1
11799         addviewmenu $n
11800     }
11801 }
11802
11803 if {[tk windowingsystem] eq "win32"} {
11804     focus -force .
11805 }
11806
11807 getcommits {}
11808
11809 # Local variables:
11810 # mode: tcl
11811 # indent-tabs-mode: t
11812 # tab-width: 8
11813 # End: