git.oblomov.eu Git - git/blob - 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|-g)[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     if {[string range $id 0 1] eq "-g"} {
6754       set id [string range $id 2 end]
6755     }
6756
6757     set known 0
6758     if {[string length $id] < 40} {
6759         set matches [longid $id]
6760         if {[llength $matches] > 0} {
6761             if {[llength $matches] > 1} return
6762             set known 1
6763             set id [lindex $matches 0]
6764         }
6765     } else {
6766         set known [commitinview $id $curview]
6767     }
6768     if {$known} {
6769         $ctext tag conf $lk -foreground blue -underline 1
6770         $ctext tag bind $lk <1> [list selbyid $id]
6771         $ctext tag bind $lk <Enter> {linkcursor %W 1}
6772         $ctext tag bind $lk <Leave> {linkcursor %W -1}
6773     } else {
6774         lappend pendinglinks($id) $lk
6775         interestedin $id {makelink %P}
6776     }
6777 }
6778
6779 proc appendshortlink {id {pre {}} {post {}}} {
6780     global ctext linknum
6781
6782     $ctext insert end $pre
6783     $ctext tag delete link$linknum
6784     $ctext insert end [string range $id 0 7] link$linknum
6785     $ctext insert end $post
6786     setlink $id link$linknum
6787     incr linknum
6788 }
6789
6790 proc makelink {id} {
6791     global pendinglinks
6792
6793     if {![info exists pendinglinks($id)]} return
6794     foreach lk $pendinglinks($id) {
6795         setlink $id $lk
6796     }
6797     unset pendinglinks($id)
6798 }
6799
6800 proc linkcursor {w inc} {
6801     global linkentercount curtextcursor
6802
6803     if {[incr linkentercount $inc] > 0} {
6804         $w configure -cursor hand2
6805     } else {
6806         $w configure -cursor $curtextcursor
6807         if {$linkentercount < 0} {
6808             set linkentercount 0
6809         }
6810     }
6811 }
6812
6813 proc viewnextline {dir} {
6814     global canv linespc
6815
6816     $canv delete hover
6817     set ymax [lindex [$canv cget -scrollregion] 3]
6818     set wnow [$canv yview]
6819     set wtop [expr {[lindex $wnow 0] * $ymax}]
6820     set newtop [expr {$wtop + $dir * $linespc}]
6821     if {$newtop < 0} {
6822         set newtop 0
6823     } elseif {$newtop > $ymax} {
6824         set newtop $ymax
6825     }
6826     allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
6827 }
6828
6829 # add a list of tag or branch names at position pos
6830 # returns the number of names inserted
6831 proc appendrefs {pos ids var} {
6832     global ctext linknum curview $var maxrefs
6833
6834     if {[catch {$ctext index $pos}]} {
6835         return 0
6836     }
6837     $ctext conf -state normal
6838     $ctext delete $pos "$pos lineend"
6839     set tags {}
6840     foreach id $ids {
6841         foreach tag [set $var\($id\)] {
6842             lappend tags [list $tag $id]
6843         }
6844     }
6845     if {[llength $tags] > $maxrefs} {
6846         $ctext insert $pos "[mc "many"] ([llength $tags])"
6847     } else {
6848         set tags [lsort -index 0 -decreasing $tags]
6849         set sep {}
6850         foreach ti $tags {
6851             set id [lindex $ti 1]
6852             set lk link$linknum
6853             incr linknum
6854             $ctext tag delete $lk
6855             $ctext insert $pos $sep
6856             $ctext insert $pos [lindex $ti 0] $lk
6857             setlink $id $lk
6858             set sep ", "
6859         }
6860     }
6861     $ctext conf -state disabled
6862     return [llength $tags]
6863 }
6864
6865 # called when we have finished computing the nearby tags
6866 proc dispneartags {delay} {
6867     global selectedline currentid showneartags tagphase
6868
6869     if {$selectedline eq {} || !$showneartags} return
6870     after cancel dispnexttag
6871     if {$delay} {
6872         after 200 dispnexttag
6873         set tagphase -1
6874     } else {
6875         after idle dispnexttag
6876         set tagphase 0
6877     }
6878 }
6879
6880 proc dispnexttag {} {
6881     global selectedline currentid showneartags tagphase ctext
6882
6883     if {$selectedline eq {} || !$showneartags} return
6884     switch -- $tagphase {
6885         0 {
6886             set dtags [desctags $currentid]
6887             if {$dtags ne {}} {
6888                 appendrefs precedes $dtags idtags
6889             }
6890         }
6891         1 {
6892             set atags [anctags $currentid]
6893             if {$atags ne {}} {
6894                 appendrefs follows $atags idtags
6895             }
6896         }
6897         2 {
6898             set dheads [descheads $currentid]
6899             if {$dheads ne {}} {
6900                 if {[appendrefs branch $dheads idheads] > 1
6901                     && [$ctext get "branch -3c"] eq "h"} {
6902                     # turn "Branch" into "Branches"
6903                     $ctext conf -state normal
6904                     $ctext insert "branch -2c" "es"
6905                     $ctext conf -state disabled
6906                 }
6907             }
6908         }
6909     }
6910     if {[incr tagphase] <= 2} {
6911         after idle dispnexttag
6912     }
6913 }
6914
6915 proc make_secsel {id} {
6916     global linehtag linentag linedtag canv canv2 canv3
6917
6918     if {![info exists linehtag($id)]} return
6919     $canv delete secsel
6920     set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \
6921                -tags secsel -fill [$canv cget -selectbackground]]
6922     $canv lower $t
6923     $canv2 delete secsel
6924     set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \
6925                -tags secsel -fill [$canv2 cget -selectbackground]]
6926     $canv2 lower $t
6927     $canv3 delete secsel
6928     set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \
6929                -tags secsel -fill [$canv3 cget -selectbackground]]
6930     $canv3 lower $t
6931 }
6932
6933 proc make_idmark {id} {
6934     global linehtag canv fgcolor
6935
6936     if {![info exists linehtag($id)]} return
6937     $canv delete markid
6938     set t [eval $canv create rect [$canv bbox $linehtag($id)] \
6939                -tags markid -outline $fgcolor]
6940     $canv raise $t
6941 }
6942
6943 proc selectline {l isnew {desired_loc {}}} {
6944     global canv ctext commitinfo selectedline
6945     global canvy0 linespc parents children curview
6946     global currentid sha1entry
6947     global commentend idtags linknum
6948     global mergemax numcommits pending_select
6949     global cmitmode showneartags allcommits
6950     global targetrow targetid lastscrollrows
6951     global autoselect autosellen jump_to_here
6952
6953     catch {unset pending_select}
6954     $canv delete hover
6955     normalline
6956     unsel_reflist
6957     stopfinding
6958     if {$l < 0 || $l >= $numcommits} return
6959     set id [commitonrow $l]
6960     set targetid $id
6961     set targetrow $l
6962     set selectedline $l
6963     set currentid $id
6964     if {$lastscrollrows < $numcommits} {
6965         setcanvscroll
6966     }
6967
6968     set y [expr {$canvy0 + $l * $linespc}]
6969     set ymax [lindex [$canv cget -scrollregion] 3]
6970     set ytop [expr {$y - $linespc - 1}]
6971     set ybot [expr {$y + $linespc + 1}]
6972     set wnow [$canv yview]
6973     set wtop [expr {[lindex $wnow 0] * $ymax}]
6974     set wbot [expr {[lindex $wnow 1] * $ymax}]
6975     set wh [expr {$wbot - $wtop}]
6976     set newtop $wtop
6977     if {$ytop < $wtop} {
6978         if {$ybot < $wtop} {
6979             set newtop [expr {$y - $wh / 2.0}]
6980         } else {
6981             set newtop $ytop
6982             if {$newtop > $wtop - $linespc} {
6983                 set newtop [expr {$wtop - $linespc}]
6984             }
6985         }
6986     } elseif {$ybot > $wbot} {
6987         if {$ytop > $wbot} {
6988             set newtop [expr {$y - $wh / 2.0}]
6989         } else {
6990             set newtop [expr {$ybot - $wh}]
6991             if {$newtop < $wtop + $linespc} {
6992                 set newtop [expr {$wtop + $linespc}]
6993             }
6994         }
6995     }
6996     if {$newtop != $wtop} {
6997         if {$newtop < 0} {
6998             set newtop 0
6999         }
7000         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
7001         drawvisible
7002     }
7003
7004     make_secsel $id
7005
7006     if {$isnew} {
7007         addtohistory [list selbyid $id 0] savecmitpos
7008     }
7009
7010     $sha1entry delete 0 end
7011     $sha1entry insert 0 $id
7012     if {$autoselect} {
7013         $sha1entry selection range 0 $autosellen
7014     }
7015     rhighlight_sel $id
7016
7017     $ctext conf -state normal
7018     clear_ctext
7019     set linknum 0
7020     if {![info exists commitinfo($id)]} {
7021         getcommit $id
7022     }
7023     set info $commitinfo($id)
7024     set date [formatdate [lindex $info 2]]
7025     $ctext insert end "[mc "Author"]: [lindex $info 1]  $date\n"
7026     set date [formatdate [lindex $info 4]]
7027     $ctext insert end "[mc "Committer"]: [lindex $info 3]  $date\n"
7028     if {[info exists idtags($id)]} {
7029         $ctext insert end [mc "Tags:"]
7030         foreach tag $idtags($id) {
7031             $ctext insert end " $tag"
7032         }
7033         $ctext insert end "\n"
7034     }
7035
7036     set headers {}
7037     set olds $parents($curview,$id)
7038     if {[llength $olds] > 1} {
7039         set np 0
7040         foreach p $olds {
7041             if {$np >= $mergemax} {
7042                 set tag mmax
7043             } else {
7044                 set tag m$np
7045             }
7046             $ctext insert end "[mc "Parent"]: " $tag
7047             appendwithlinks [commit_descriptor $p] {}
7048             incr np
7049         }
7050     } else {
7051         foreach p $olds {
7052             append headers "[mc "Parent"]: [commit_descriptor $p]"
7053         }
7054     }
7055
7056     foreach c $children($curview,$id) {
7057         append headers "[mc "Child"]:  [commit_descriptor $c]"
7058     }
7059
7060     # make anything that looks like a SHA1 ID be a clickable link
7061     appendwithlinks $headers {}
7062     if {$showneartags} {
7063         if {![info exists allcommits]} {
7064             getallcommits
7065         }
7066         $ctext insert end "[mc "Branch"]: "
7067         $ctext mark set branch "end -1c"
7068         $ctext mark gravity branch left
7069         $ctext insert end "\n[mc "Follows"]: "
7070         $ctext mark set follows "end -1c"
7071         $ctext mark gravity follows left
7072         $ctext insert end "\n[mc "Precedes"]: "
7073         $ctext mark set precedes "end -1c"
7074         $ctext mark gravity precedes left
7075         $ctext insert end "\n"
7076         dispneartags 1
7077     }
7078     $ctext insert end "\n"
7079     set comment [lindex $info 5]
7080     if {[string first "\r" $comment] >= 0} {
7081         set comment [string map {"\r" "\n    "} $comment]
7082     }
7083     appendwithlinks $comment {comment}
7084
7085     $ctext tag remove found 1.0 end
7086     $ctext conf -state disabled
7087     set commentend [$ctext index "end - 1c"]
7088
7089     set jump_to_here $desired_loc
7090     init_flist [mc "Comments"]
7091     if {$cmitmode eq "tree"} {
7092         gettree $id
7093     } elseif {[llength $olds] <= 1} {
7094         startdiff $id
7095     } else {
7096         mergediff $id
7097     }
7098 }
7099
7100 proc selfirstline {} {
7101     unmarkmatches
7102     selectline 0 1
7103 }
7104
7105 proc sellastline {} {
7106     global numcommits
7107     unmarkmatches
7108     set l [expr {$numcommits - 1}]
7109     selectline $l 1
7110 }
7111
7112 proc selnextline {dir} {
7113     global selectedline
7114     focus .
7115     if {$selectedline eq {}} return
7116     set l [expr {$selectedline + $dir}]
7117     unmarkmatches
7118     selectline $l 1
7119 }
7120
7121 proc selnextpage {dir} {
7122     global canv linespc selectedline numcommits
7123
7124     set lpp [expr {([winfo height $canv] - 2) / $linespc}]
7125     if {$lpp < 1} {
7126         set lpp 1
7127     }
7128     allcanvs yview scroll [expr {$dir * $lpp}] units
7129     drawvisible
7130     if {$selectedline eq {}} return
7131     set l [expr {$selectedline + $dir * $lpp}]
7132     if {$l < 0} {
7133         set l 0
7134     } elseif {$l >= $numcommits} {
7135         set l [expr $numcommits - 1]
7136     }
7137     unmarkmatches
7138     selectline $l 1
7139 }
7140
7141 proc unselectline {} {
7142     global selectedline currentid
7143
7144     set selectedline {}
7145     catch {unset currentid}
7146     allcanvs delete secsel
7147     rhighlight_none
7148 }
7149
7150 proc reselectline {} {
7151     global selectedline
7152
7153     if {$selectedline ne {}} {
7154         selectline $selectedline 0
7155     }
7156 }
7157
7158 proc addtohistory {cmd {saveproc {}}} {
7159     global history historyindex curview
7160
7161     unset_posvars
7162     save_position
7163     set elt [list $curview $cmd $saveproc {}]
7164     if {$historyindex > 0
7165         && [lindex $history [expr {$historyindex - 1}]] == $elt} {
7166         return
7167     }
7168
7169     if {$historyindex < [llength $history]} {
7170         set history [lreplace $history $historyindex end $elt]
7171     } else {
7172         lappend history $elt
7173     }
7174     incr historyindex
7175     if {$historyindex > 1} {
7176         .tf.bar.leftbut conf -state normal
7177     } else {
7178         .tf.bar.leftbut conf -state disabled
7179     }
7180     .tf.bar.rightbut conf -state disabled
7181 }
7182
7183 # save the scrolling position of the diff display pane
7184 proc save_position {} {
7185     global historyindex history
7186
7187     if {$historyindex < 1} return
7188     set hi [expr {$historyindex - 1}]
7189     set fn [lindex $history $hi 2]
7190     if {$fn ne {}} {
7191         lset history $hi 3 [eval $fn]
7192     }
7193 }
7194
7195 proc unset_posvars {} {
7196     global last_posvars
7197
7198     if {[info exists last_posvars]} {
7199         foreach {var val} $last_posvars {
7200             global $var
7201             catch {unset $var}
7202         }
7203         unset last_posvars
7204     }
7205 }
7206
7207 proc godo {elt} {
7208     global curview last_posvars
7209
7210     set view [lindex $elt 0]
7211     set cmd [lindex $elt 1]
7212     set pv [lindex $elt 3]
7213     if {$curview != $view} {
7214         showview $view
7215     }
7216     unset_posvars
7217     foreach {var val} $pv {
7218         global $var
7219         set $var $val
7220     }
7221     set last_posvars $pv
7222     eval $cmd
7223 }
7224
7225 proc goback {} {
7226     global history historyindex
7227     focus .
7228
7229     if {$historyindex > 1} {
7230         save_position
7231         incr historyindex -1
7232         godo [lindex $history [expr {$historyindex - 1}]]
7233         .tf.bar.rightbut conf -state normal
7234     }
7235     if {$historyindex <= 1} {
7236         .tf.bar.leftbut conf -state disabled
7237     }
7238 }
7239
7240 proc goforw {} {
7241     global history historyindex
7242     focus .
7243
7244     if {$historyindex < [llength $history]} {
7245         save_position
7246         set cmd [lindex $history $historyindex]
7247         incr historyindex
7248         godo $cmd
7249         .tf.bar.leftbut conf -state normal
7250     }
7251     if {$historyindex >= [llength $history]} {
7252         .tf.bar.rightbut conf -state disabled
7253     }
7254 }
7255
7256 proc gettree {id} {
7257     global treefilelist treeidlist diffids diffmergeid treepending
7258     global nullid nullid2
7259
7260     set diffids $id
7261     catch {unset diffmergeid}
7262     if {![info exists treefilelist($id)]} {
7263         if {![info exists treepending]} {
7264             if {$id eq $nullid} {
7265                 set cmd [list | git ls-files]
7266             } elseif {$id eq $nullid2} {
7267                 set cmd [list | git ls-files --stage -t]
7268             } else {
7269                 set cmd [list | git ls-tree -r $id]
7270             }
7271             if {[catch {set gtf [open $cmd r]}]} {
7272                 return
7273             }
7274             set treepending $id
7275             set treefilelist($id) {}
7276             set treeidlist($id) {}
7277             fconfigure $gtf -blocking 0 -encoding binary
7278             filerun $gtf [list gettreeline $gtf $id]
7279         }
7280     } else {
7281         setfilelist $id
7282     }
7283 }
7284
7285 proc gettreeline {gtf id} {
7286     global treefilelist treeidlist treepending cmitmode diffids nullid nullid2
7287
7288     set nl 0
7289     while {[incr nl] <= 1000 && [gets $gtf line] >= 0} {
7290         if {$diffids eq $nullid} {
7291             set fname $line
7292         } else {
7293             set i [string first "\t" $line]
7294             if {$i < 0} continue
7295             set fname [string range $line [expr {$i+1}] end]
7296             set line [string range $line 0 [expr {$i-1}]]
7297             if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue
7298             set sha1 [lindex $line 2]
7299             lappend treeidlist($id) $sha1
7300         }
7301         if {[string index $fname 0] eq "\""} {
7302             set fname [lindex $fname 0]
7303         }
7304         set fname [encoding convertfrom $fname]
7305         lappend treefilelist($id) $fname
7306     }
7307     if {![eof $gtf]} {
7308         return [expr {$nl >= 1000? 2: 1}]
7309     }
7310     close $gtf
7311     unset treepending
7312     if {$cmitmode ne "tree"} {
7313         if {![info exists diffmergeid]} {
7314             gettreediffs $diffids
7315         }
7316     } elseif {$id ne $diffids} {
7317         gettree $diffids
7318     } else {
7319         setfilelist $id
7320     }
7321     return 0
7322 }
7323
7324 proc showfile {f} {
7325     global treefilelist treeidlist diffids nullid nullid2
7326     global ctext_file_names ctext_file_lines
7327     global ctext commentend
7328
7329     set i [lsearch -exact $treefilelist($diffids) $f]
7330     if {$i < 0} {
7331         puts "oops, $f not in list for id $diffids"
7332         return
7333     }
7334     if {$diffids eq $nullid} {
7335         if {[catch {set bf [open $f r]} err]} {
7336             puts "oops, can't read $f: $err"
7337             return
7338         }
7339     } else {
7340         set blob [lindex $treeidlist($diffids) $i]
7341         if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
7342             puts "oops, error reading blob $blob: $err"
7343             return
7344         }
7345     }
7346     fconfigure $bf -blocking 0 -encoding [get_path_encoding $f]
7347     filerun $bf [list getblobline $bf $diffids]
7348     $ctext config -state normal
7349     clear_ctext $commentend
7350     lappend ctext_file_names $f
7351     lappend ctext_file_lines [lindex [split $commentend "."] 0]
7352     $ctext insert end "\n"
7353     $ctext insert end "$f\n" filesep
7354     $ctext config -state disabled
7355     $ctext yview $commentend
7356     settabs 0
7357 }
7358
7359 proc getblobline {bf id} {
7360     global diffids cmitmode ctext
7361
7362     if {$id ne $diffids || $cmitmode ne "tree"} {
7363         catch {close $bf}
7364         return 0
7365     }
7366     $ctext config -state normal
7367     set nl 0
7368     while {[incr nl] <= 1000 && [gets $bf line] >= 0} {
7369         $ctext insert end "$line\n"
7370     }
7371     if {[eof $bf]} {
7372         global jump_to_here ctext_file_names commentend
7373
7374         # delete last newline
7375         $ctext delete "end - 2c" "end - 1c"
7376         close $bf
7377         if {$jump_to_here ne {} &&
7378             [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} {
7379             set lnum [expr {[lindex $jump_to_here 1] +
7380                             [lindex [split $commentend .] 0]}]
7381             mark_ctext_line $lnum
7382         }
7383         $ctext config -state disabled
7384         return 0
7385     }
7386     $ctext config -state disabled
7387     return [expr {$nl >= 1000? 2: 1}]
7388 }
7389
7390 proc mark_ctext_line {lnum} {
7391     global ctext markbgcolor
7392
7393     $ctext tag delete omark
7394     $ctext tag add omark $lnum.0 "$lnum.0 + 1 line"
7395     $ctext tag conf omark -background $markbgcolor
7396     $ctext see $lnum.0
7397 }
7398
7399 proc mergediff {id} {
7400     global diffmergeid
7401     global diffids treediffs
7402     global parents curview
7403
7404     set diffmergeid $id
7405     set diffids $id
7406     set treediffs($id) {}
7407     set np [llength $parents($curview,$id)]
7408     settabs $np
7409     getblobdiffs $id
7410 }
7411
7412 proc startdiff {ids} {
7413     global treediffs diffids treepending diffmergeid nullid nullid2
7414
7415     settabs 1
7416     set diffids $ids
7417     catch {unset diffmergeid}
7418     if {![info exists treediffs($ids)] ||
7419         [lsearch -exact $ids $nullid] >= 0 ||
7420         [lsearch -exact $ids $nullid2] >= 0} {
7421         if {![info exists treepending]} {
7422             gettreediffs $ids
7423         }
7424     } else {
7425         addtocflist $ids
7426     }
7427 }
7428
7429 # If the filename (name) is under any of the passed filter paths
7430 # then return true to include the file in the listing.
7431 proc path_filter {filter name} {
7432     set worktree [gitworktree]
7433     foreach p $filter {
7434         set fq_p [file normalize $p]
7435         set fq_n [file normalize [file join $worktree $name]]
7436         if {[string match [file normalize $fq_p]* $fq_n]} {
7437             return 1
7438         }
7439     }
7440     return 0
7441 }
7442
7443 proc addtocflist {ids} {
7444     global treediffs
7445
7446     add_flist $treediffs($ids)
7447     getblobdiffs $ids
7448 }
7449
7450 proc diffcmd {ids flags} {
7451     global nullid nullid2
7452
7453     set i [lsearch -exact $ids $nullid]
7454     set j [lsearch -exact $ids $nullid2]
7455     if {$i >= 0} {
7456         if {[llength $ids] > 1 && $j < 0} {
7457             # comparing working directory with some specific revision
7458             set cmd [concat | git diff-index $flags]
7459             if {$i == 0} {
7460                 lappend cmd -R [lindex $ids 1]
7461             } else {
7462                 lappend cmd [lindex $ids 0]
7463             }
7464         } else {
7465             # comparing working directory with index
7466             set cmd [concat | git diff-files $flags]
7467             if {$j == 1} {
7468                 lappend cmd -R
7469             }
7470         }
7471     } elseif {$j >= 0} {
7472         set cmd [concat | git diff-index --cached $flags]
7473         if {[llength $ids] > 1} {
7474             # comparing index with specific revision
7475             if {$j == 0} {
7476                 lappend cmd -R [lindex $ids 1]
7477             } else {
7478                 lappend cmd [lindex $ids 0]
7479             }
7480         } else {
7481             # comparing index with HEAD
7482             lappend cmd HEAD
7483         }
7484     } else {
7485         set cmd [concat | git diff-tree -r $flags $ids]
7486     }
7487     return $cmd
7488 }
7489
7490 proc gettreediffs {ids} {
7491     global treediff treepending
7492
7493     if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return
7494
7495     set treepending $ids
7496     set treediff {}
7497     fconfigure $gdtf -blocking 0 -encoding binary
7498     filerun $gdtf [list gettreediffline $gdtf $ids]
7499 }
7500
7501 proc gettreediffline {gdtf ids} {
7502     global treediff treediffs treepending diffids diffmergeid
7503     global cmitmode vfilelimit curview limitdiffs perfile_attrs
7504
7505     set nr 0
7506     set sublist {}
7507     set max 1000
7508     if {$perfile_attrs} {
7509         # cache_gitattr is slow, and even slower on win32 where we
7510         # have to invoke it for only about 30 paths at a time
7511         set max 500
7512         if {[tk windowingsystem] == "win32"} {
7513             set max 120
7514         }
7515     }
7516     while {[incr nr] <= $max && [gets $gdtf line] >= 0} {
7517         set i [string first "\t" $line]
7518         if {$i >= 0} {
7519             set file [string range $line [expr {$i+1}] end]
7520             if {[string index $file 0] eq "\""} {
7521                 set file [lindex $file 0]
7522             }
7523             set file [encoding convertfrom $file]
7524             if {$file ne [lindex $treediff end]} {
7525                 lappend treediff $file
7526                 lappend sublist $file
7527             }
7528         }
7529     }
7530     if {$perfile_attrs} {
7531         cache_gitattr encoding $sublist
7532     }
7533     if {![eof $gdtf]} {
7534         return [expr {$nr >= $max? 2: 1}]
7535     }
7536     close $gdtf
7537     if {$limitdiffs && $vfilelimit($curview) ne {}} {
7538         set flist {}
7539         foreach f $treediff {
7540             if {[path_filter $vfilelimit($curview) $f]} {
7541                 lappend flist $f
7542             }
7543         }
7544         set treediffs($ids) $flist
7545     } else {
7546         set treediffs($ids) $treediff
7547     }
7548     unset treepending
7549     if {$cmitmode eq "tree" && [llength $diffids] == 1} {
7550         gettree $diffids
7551     } elseif {$ids != $diffids} {
7552         if {![info exists diffmergeid]} {
7553             gettreediffs $diffids
7554         }
7555     } else {
7556         addtocflist $ids
7557     }
7558     return 0
7559 }
7560
7561 # empty string or positive integer
7562 proc diffcontextvalidate {v} {
7563     return [regexp {^(|[1-9][0-9]*)$} $v]
7564 }
7565
7566 proc diffcontextchange {n1 n2 op} {
7567     global diffcontextstring diffcontext
7568
7569     if {[string is integer -strict $diffcontextstring]} {
7570         if {$diffcontextstring >= 0} {
7571             set diffcontext $diffcontextstring
7572             reselectline
7573         }
7574     }
7575 }
7576
7577 proc changeignorespace {} {
7578     reselectline
7579 }
7580
7581 proc changeworddiff {name ix op} {
7582     reselectline
7583 }
7584
7585 proc getblobdiffs {ids} {
7586     global blobdifffd diffids env
7587     global diffinhdr treediffs
7588     global diffcontext
7589     global ignorespace
7590     global worddiff
7591     global limitdiffs vfilelimit curview
7592     global diffencoding targetline diffnparents
7593     global git_version currdiffsubmod
7594
7595     set textconv {}
7596     if {[package vcompare $git_version "1.6.1"] >= 0} {
7597         set textconv "--textconv"
7598     }
7599     set submodule {}
7600     if {[package vcompare $git_version "1.6.6"] >= 0} {
7601         set submodule "--submodule"
7602     }
7603     set cmd [diffcmd $ids "-p $textconv $submodule  -C --cc --no-commit-id -U$diffcontext"]
7604     if {$ignorespace} {
7605         append cmd " -w"
7606     }
7607     if {$worddiff ne [mc "Line diff"]} {
7608         append cmd " --word-diff=porcelain"
7609     }
7610     if {$limitdiffs && $vfilelimit($curview) ne {}} {
7611         set cmd [concat $cmd -- $vfilelimit($curview)]
7612     }
7613     if {[catch {set bdf [open $cmd r]} err]} {
7614         error_popup [mc "Error getting diffs: %s" $err]
7615         return
7616     }
7617     set targetline {}
7618     set diffnparents 0
7619     set diffinhdr 0
7620     set diffencoding [get_path_encoding {}]
7621     fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
7622     set blobdifffd($ids) $bdf
7623     set currdiffsubmod ""
7624     filerun $bdf [list getblobdiffline $bdf $diffids]
7625 }
7626
7627 proc savecmitpos {} {
7628     global ctext cmitmode
7629
7630     if {$cmitmode eq "tree"} {
7631         return {}
7632     }
7633     return [list target_scrollpos [$ctext index @0,0]]
7634 }
7635
7636 proc savectextpos {} {
7637     global ctext
7638
7639     return [list target_scrollpos [$ctext index @0,0]]
7640 }
7641
7642 proc maybe_scroll_ctext {ateof} {
7643     global ctext target_scrollpos
7644
7645     if {![info exists target_scrollpos]} return
7646     if {!$ateof} {
7647         set nlines [expr {[winfo height $ctext]
7648                           / [font metrics textfont -linespace]}]
7649         if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return
7650     }
7651     $ctext yview $target_scrollpos
7652     unset target_scrollpos
7653 }
7654
7655 proc setinlist {var i val} {
7656     global $var
7657
7658     while {[llength [set $var]] < $i} {
7659         lappend $var {}
7660     }
7661     if {[llength [set $var]] == $i} {
7662         lappend $var $val
7663     } else {
7664         lset $var $i $val
7665     }
7666 }
7667
7668 proc makediffhdr {fname ids} {
7669     global ctext curdiffstart treediffs diffencoding
7670     global ctext_file_names jump_to_here targetline diffline
7671
7672     set fname [encoding convertfrom $fname]
7673     set diffencoding [get_path_encoding $fname]
7674     set i [lsearch -exact $treediffs($ids) $fname]
7675     if {$i >= 0} {
7676         setinlist difffilestart $i $curdiffstart
7677     }
7678     lset ctext_file_names end $fname
7679     set l [expr {(78 - [string length $fname]) / 2}]
7680     set pad [string range "----------------------------------------" 1 $l]
7681     $ctext insert $curdiffstart "$pad $fname $pad" filesep
7682     set targetline {}
7683     if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} {
7684         set targetline [lindex $jump_to_here 1]
7685     }
7686     set diffline 0
7687 }
7688
7689 proc getblobdiffline {bdf ids} {
7690     global diffids blobdifffd ctext curdiffstart
7691     global diffnexthead diffnextnote difffilestart
7692     global ctext_file_names ctext_file_lines
7693     global diffinhdr treediffs mergemax diffnparents
7694     global diffencoding jump_to_here targetline diffline currdiffsubmod
7695     global worddiff
7696
7697     set nr 0
7698     $ctext conf -state normal
7699     while {[incr nr] <= 1000 && [gets $bdf line] >= 0} {
7700         if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
7701             catch {close $bdf}
7702             return 0
7703         }
7704         if {![string compare -length 5 "diff " $line]} {
7705             if {![regexp {^diff (--cc|--git) } $line m type]} {
7706                 set line [encoding convertfrom $line]
7707                 $ctext insert end "$line\n" hunksep
7708                 continue
7709             }
7710             # start of a new file
7711             set diffinhdr 1
7712             $ctext insert end "\n"
7713             set curdiffstart [$ctext index "end - 1c"]
7714             lappend ctext_file_names ""
7715             lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7716             $ctext insert end "\n" filesep
7717
7718             if {$type eq "--cc"} {
7719                 # start of a new file in a merge diff
7720                 set fname [string range $line 10 end]
7721                 if {[lsearch -exact $treediffs($ids) $fname] < 0} {
7722                     lappend treediffs($ids) $fname
7723                     add_flist [list $fname]
7724                 }
7725
7726             } else {
7727                 set line [string range $line 11 end]
7728                 # If the name hasn't changed the length will be odd,
7729                 # the middle char will be a space, and the two bits either
7730                 # side will be a/name and b/name, or "a/name" and "b/name".
7731                 # If the name has changed we'll get "rename from" and
7732                 # "rename to" or "copy from" and "copy to" lines following
7733                 # this, and we'll use them to get the filenames.
7734                 # This complexity is necessary because spaces in the
7735                 # filename(s) don't get escaped.
7736                 set l [string length $line]
7737                 set i [expr {$l / 2}]
7738                 if {!(($l & 1) && [string index $line $i] eq " " &&
7739                       [string range $line 2 [expr {$i - 1}]] eq \
7740                           [string range $line [expr {$i + 3}] end])} {
7741                     continue
7742                 }
7743                 # unescape if quoted and chop off the a/ from the front
7744                 if {[string index $line 0] eq "\""} {
7745                     set fname [string range [lindex $line 0] 2 end]
7746                 } else {
7747                     set fname [string range $line 2 [expr {$i - 1}]]
7748                 }
7749             }
7750             makediffhdr $fname $ids
7751
7752         } elseif {![string compare -length 16 "* Unmerged path " $line]} {
7753             set fname [encoding convertfrom [string range $line 16 end]]
7754             $ctext insert end "\n"
7755             set curdiffstart [$ctext index "end - 1c"]
7756             lappend ctext_file_names $fname
7757             lappend ctext_file_lines [lindex [split $curdiffstart "."] 0]
7758             $ctext insert end "$line\n" filesep
7759             set i [lsearch -exact $treediffs($ids) $fname]
7760             if {$i >= 0} {
7761                 setinlist difffilestart $i $curdiffstart
7762             }
7763
7764         } elseif {![string compare -length 2 "@@" $line]} {
7765             regexp {^@@+} $line ats
7766             set line [encoding convertfrom $diffencoding $line]
7767             $ctext insert end "$line\n" hunksep
7768             if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
7769                 set diffline $nl
7770             }
7771             set diffnparents [expr {[string length $ats] - 1}]
7772             set diffinhdr 0
7773
7774         } elseif {![string compare -length 10 "Submodule " $line]} {
7775             # start of a new submodule
7776             if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} {
7777                 set fname [string range $line 10 [expr [lindex $nameend 0] - 2]]
7778             } else {
7779                 set fname [string range $line 10 [expr [string first "contains " $line] - 2]]
7780             }
7781             if {$currdiffsubmod != $fname} {
7782                 $ctext insert end "\n";     # Add newline after commit message
7783             }
7784             set curdiffstart [$ctext index "end - 1c"]
7785             lappend ctext_file_names ""
7786             if {$currdiffsubmod != $fname} {
7787                 lappend ctext_file_lines $fname
7788                 makediffhdr $fname $ids
7789                 set currdiffsubmod $fname
7790                 $ctext insert end "\n$line\n" filesep
7791             } else {
7792                 $ctext insert end "$line\n" filesep
7793             }
7794         } elseif {![string compare -length 3 "  >" $line]} {
7795             set $currdiffsubmod ""
7796             set line [encoding convertfrom $diffencoding $line]
7797             $ctext insert end "$line\n" dresult
7798         } elseif {![string compare -length 3 "  <" $line]} {
7799             set $currdiffsubmod ""
7800             set line [encoding convertfrom $diffencoding $line]
7801             $ctext insert end "$line\n" d0
7802         } elseif {$diffinhdr} {
7803             if {![string compare -length 12 "rename from " $line]} {
7804                 set fname [string range $line [expr 6 + [string first " from " $line] ] end]
7805                 if {[string index $fname 0] eq "\""} {
7806                     set fname [lindex $fname 0]
7807                 }
7808                 set fname [encoding convertfrom $fname]
7809                 set i [lsearch -exact $treediffs($ids) $fname]
7810                 if {$i >= 0} {
7811                     setinlist difffilestart $i $curdiffstart
7812                 }
7813             } elseif {![string compare -length 10 $line "rename to "] ||
7814                       ![string compare -length 8 $line "copy to "]} {
7815                 set fname [string range $line [expr 4 + [string first " to " $line] ] end]
7816                 if {[string index $fname 0] eq "\""} {
7817                     set fname [lindex $fname 0]
7818                 }
7819                 makediffhdr $fname $ids
7820             } elseif {[string compare -length 3 $line "---"] == 0} {
7821                 # do nothing
7822                 continue
7823             } elseif {[string compare -length 3 $line "+++"] == 0} {
7824                 set diffinhdr 0
7825                 continue
7826             }
7827             $ctext insert end "$line\n" filesep
7828
7829         } else {
7830             set line [string map {\x1A ^Z} \
7831                           [encoding convertfrom $diffencoding $line]]
7832             # parse the prefix - one ' ', '-' or '+' for each parent
7833             set prefix [string range $line 0 [expr {$diffnparents - 1}]]
7834             set tag [expr {$diffnparents > 1? "m": "d"}]
7835             set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}]
7836             set words_pre_markup ""
7837             set words_post_markup ""
7838             if {[string trim $prefix " -+"] eq {}} {
7839                 # prefix only has " ", "-" and "+" in it: normal diff line
7840                 set num [string first "-" $prefix]
7841                 if {$dowords} {
7842                     set line [string range $line 1 end]
7843                 }
7844                 if {$num >= 0} {
7845                     # removed line, first parent with line is $num
7846                     if {$num >= $mergemax} {
7847                         set num "max"
7848                     }
7849                     if {$dowords && $worddiff eq [mc "Markup words"]} {
7850                         $ctext insert end "\[-$line-\]" $tag$num
7851                     } else {
7852                         $ctext insert end "$line" $tag$num
7853                     }
7854                     if {!$dowords} {
7855                         $ctext insert end "\n" $tag$num
7856                     }
7857                 } else {
7858                     set tags {}
7859                     if {[string first "+" $prefix] >= 0} {
7860                         # added line
7861                         lappend tags ${tag}result
7862                         if {$diffnparents > 1} {
7863                             set num [string first " " $prefix]
7864                             if {$num >= 0} {
7865                                 if {$num >= $mergemax} {
7866                                     set num "max"
7867                                 }
7868                                 lappend tags m$num
7869                             }
7870                         }
7871                         set words_pre_markup "{+"
7872                         set words_post_markup "+}"
7873                     }
7874                     if {$targetline ne {}} {
7875                         if {$diffline == $targetline} {
7876                             set seehere [$ctext index "end - 1 chars"]
7877                             set targetline {}
7878                         } else {
7879                             incr diffline
7880                         }
7881                     }
7882                     if {$dowords && $worddiff eq [mc "Markup words"]} {
7883                         $ctext insert end "$words_pre_markup$line$words_post_markup" $tags
7884                     } else {
7885                         $ctext insert end "$line" $tags
7886                     }
7887                     if {!$dowords} {
7888                         $ctext insert end "\n" $tags
7889                     }
7890                 }
7891             } elseif {$dowords && $prefix eq "~"} {
7892                 $ctext insert end "\n" {}
7893             } else {
7894                 # "\ No newline at end of file",
7895                 # or something else we don't recognize
7896                 $ctext insert end "$line\n" hunksep
7897             }
7898         }
7899     }
7900     if {[info exists seehere]} {
7901         mark_ctext_line [lindex [split $seehere .] 0]
7902     }
7903     maybe_scroll_ctext [eof $bdf]
7904     $ctext conf -state disabled
7905     if {[eof $bdf]} {
7906         catch {close $bdf}
7907         return 0
7908     }
7909     return [expr {$nr >= 1000? 2: 1}]
7910 }
7911
7912 proc changediffdisp {} {
7913     global ctext diffelide
7914
7915     $ctext tag conf d0 -elide [lindex $diffelide 0]
7916     $ctext tag conf dresult -elide [lindex $diffelide 1]
7917 }
7918
7919 proc highlightfile {loc cline} {
7920     global ctext cflist cflist_top
7921
7922     $ctext yview $loc
7923     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
7924     $cflist tag add highlight $cline.0 "$cline.0 lineend"
7925     $cflist see $cline.0
7926     set cflist_top $cline
7927 }
7928
7929 proc prevfile {} {
7930     global difffilestart ctext cmitmode
7931
7932     if {$cmitmode eq "tree"} return
7933     set prev 0.0
7934     set prevline 1
7935     set here [$ctext index @0,0]
7936     foreach loc $difffilestart {
7937         if {[$ctext compare $loc >= $here]} {
7938             highlightfile $prev $prevline
7939             return
7940         }
7941         set prev $loc
7942         incr prevline
7943     }
7944     highlightfile $prev $prevline
7945 }
7946
7947 proc nextfile {} {
7948     global difffilestart ctext cmitmode
7949
7950     if {$cmitmode eq "tree"} return
7951     set here [$ctext index @0,0]
7952     set line 1
7953     foreach loc $difffilestart {
7954         incr line
7955         if {[$ctext compare $loc > $here]} {
7956             highlightfile $loc $line
7957             return
7958         }
7959     }
7960 }
7961
7962 proc clear_ctext {{first 1.0}} {
7963     global ctext smarktop smarkbot
7964     global ctext_file_names ctext_file_lines
7965     global pendinglinks
7966
7967     set l [lindex [split $first .] 0]
7968     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
7969         set smarktop $l
7970     }
7971     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
7972         set smarkbot $l
7973     }
7974     $ctext delete $first end
7975     if {$first eq "1.0"} {
7976         catch {unset pendinglinks}
7977     }
7978     set ctext_file_names {}
7979     set ctext_file_lines {}
7980 }
7981
7982 proc settabs {{firstab {}}} {
7983     global firsttabstop tabstop ctext have_tk85
7984
7985     if {$firstab ne {} && $have_tk85} {
7986         set firsttabstop $firstab
7987     }
7988     set w [font measure textfont "0"]
7989     if {$firsttabstop != 0} {
7990         $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
7991                                [expr {($firsttabstop + 2 * $tabstop) * $w}]]
7992     } elseif {$have_tk85 || $tabstop != 8} {
7993         $ctext conf -tabs [expr {$tabstop * $w}]
7994     } else {
7995         $ctext conf -tabs {}
7996     }
7997 }
7998
7999 proc incrsearch {name ix op} {
8000     global ctext searchstring searchdirn
8001
8002     $ctext tag remove found 1.0 end
8003     if {[catch {$ctext index anchor}]} {
8004         # no anchor set, use start of selection, or of visible area
8005         set sel [$ctext tag ranges sel]
8006         if {$sel ne {}} {
8007             $ctext mark set anchor [lindex $sel 0]
8008         } elseif {$searchdirn eq "-forwards"} {
8009             $ctext mark set anchor @0,0
8010         } else {
8011             $ctext mark set anchor @0,[winfo height $ctext]
8012         }
8013     }
8014     if {$searchstring ne {}} {
8015         set here [$ctext search $searchdirn -- $searchstring anchor]
8016         if {$here ne {}} {
8017             $ctext see $here
8018         }
8019         searchmarkvisible 1
8020     }
8021 }
8022
8023 proc dosearch {} {
8024     global sstring ctext searchstring searchdirn
8025
8026     focus $sstring
8027     $sstring icursor end
8028     set searchdirn -forwards
8029     if {$searchstring ne {}} {
8030         set sel [$ctext tag ranges sel]
8031         if {$sel ne {}} {
8032             set start "[lindex $sel 0] + 1c"
8033         } elseif {[catch {set start [$ctext index anchor]}]} {
8034             set start "@0,0"
8035         }
8036         set match [$ctext search -count mlen -- $searchstring $start]
8037         $ctext tag remove sel 1.0 end
8038         if {$match eq {}} {
8039             bell
8040             return
8041         }
8042         $ctext see $match
8043         set mend "$match + $mlen c"
8044         $ctext tag add sel $match $mend
8045         $ctext mark unset anchor
8046     }
8047 }
8048
8049 proc dosearchback {} {
8050     global sstring ctext searchstring searchdirn
8051
8052     focus $sstring
8053     $sstring icursor end
8054     set searchdirn -backwards
8055     if {$searchstring ne {}} {
8056         set sel [$ctext tag ranges sel]
8057         if {$sel ne {}} {
8058             set start [lindex $sel 0]
8059         } elseif {[catch {set start [$ctext index anchor]}]} {
8060             set start @0,[winfo height $ctext]
8061         }
8062         set match [$ctext search -backwards -count ml -- $searchstring $start]
8063         $ctext tag remove sel 1.0 end
8064         if {$match eq {}} {
8065             bell
8066             return
8067         }
8068         $ctext see $match
8069         set mend "$match + $ml c"
8070         $ctext tag add sel $match $mend
8071         $ctext mark unset anchor
8072     }
8073 }
8074
8075 proc searchmark {first last} {
8076     global ctext searchstring
8077
8078     set mend $first.0
8079     while {1} {
8080         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
8081         if {$match eq {}} break
8082         set mend "$match + $mlen c"
8083         $ctext tag add found $match $mend
8084     }
8085 }
8086
8087 proc searchmarkvisible {doall} {
8088     global ctext smarktop smarkbot
8089
8090     set topline [lindex [split [$ctext index @0,0] .] 0]
8091     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
8092     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
8093         # no overlap with previous
8094         searchmark $topline $botline
8095         set smarktop $topline
8096         set smarkbot $botline
8097     } else {
8098         if {$topline < $smarktop} {
8099             searchmark $topline [expr {$smarktop-1}]
8100             set smarktop $topline
8101         }
8102         if {$botline > $smarkbot} {
8103             searchmark [expr {$smarkbot+1}] $botline
8104             set smarkbot $botline
8105         }
8106     }
8107 }
8108
8109 proc scrolltext {f0 f1} {
8110     global searchstring
8111
8112     .bleft.bottom.sb set $f0 $f1
8113     if {$searchstring ne {}} {
8114         searchmarkvisible 0
8115     }
8116 }
8117
8118 proc setcoords {} {
8119     global linespc charspc canvx0 canvy0
8120     global xspc1 xspc2 lthickness
8121
8122     set linespc [font metrics mainfont -linespace]
8123     set charspc [font measure mainfont "m"]
8124     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
8125     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
8126     set lthickness [expr {int($linespc / 9) + 1}]
8127     set xspc1(0) $linespc
8128     set xspc2 $linespc
8129 }
8130
8131 proc redisplay {} {
8132     global canv
8133     global selectedline
8134
8135     set ymax [lindex [$canv cget -scrollregion] 3]
8136     if {$ymax eq {} || $ymax == 0} return
8137     set span [$canv yview]
8138     clear_display
8139     setcanvscroll
8140     allcanvs yview moveto [lindex $span 0]
8141     drawvisible
8142     if {$selectedline ne {}} {
8143         selectline $selectedline 0
8144         allcanvs yview moveto [lindex $span 0]
8145     }
8146 }
8147
8148 proc parsefont {f n} {
8149     global fontattr
8150
8151     set fontattr($f,family) [lindex $n 0]
8152     set s [lindex $n 1]
8153     if {$s eq {} || $s == 0} {
8154         set s 10
8155     } elseif {$s < 0} {
8156         set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
8157     }
8158     set fontattr($f,size) $s
8159     set fontattr($f,weight) normal
8160     set fontattr($f,slant) roman
8161     foreach style [lrange $n 2 end] {
8162         switch -- $style {
8163             "normal" -
8164             "bold"   {set fontattr($f,weight) $style}
8165             "roman" -
8166             "italic" {set fontattr($f,slant) $style}
8167         }
8168     }
8169 }
8170
8171 proc fontflags {f {isbold 0}} {
8172     global fontattr
8173
8174     return [list -family $fontattr($f,family) -size $fontattr($f,size) \
8175                 -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
8176                 -slant $fontattr($f,slant)]
8177 }
8178
8179 proc fontname {f} {
8180     global fontattr
8181
8182     set n [list $fontattr($f,family) $fontattr($f,size)]
8183     if {$fontattr($f,weight) eq "bold"} {
8184         lappend n "bold"
8185     }
8186     if {$fontattr($f,slant) eq "italic"} {
8187         lappend n "italic"
8188     }
8189     return $n
8190 }
8191
8192 proc incrfont {inc} {
8193     global mainfont textfont ctext canv cflist showrefstop
8194     global stopped entries fontattr
8195
8196     unmarkmatches
8197     set s $fontattr(mainfont,size)
8198     incr s $inc
8199     if {$s < 1} {
8200         set s 1
8201     }
8202     set fontattr(mainfont,size) $s
8203     font config mainfont -size $s
8204     font config mainfontbold -size $s
8205     set mainfont [fontname mainfont]
8206     set s $fontattr(textfont,size)
8207     incr s $inc
8208     if {$s < 1} {
8209         set s 1
8210     }
8211     set fontattr(textfont,size) $s
8212     font config textfont -size $s
8213     font config textfontbold -size $s
8214     set textfont [fontname textfont]
8215     setcoords
8216     settabs
8217     redisplay
8218 }
8219
8220 proc clearsha1 {} {
8221     global sha1entry sha1string
8222     if {[string length $sha1string] == 40} {
8223         $sha1entry delete 0 end
8224     }
8225 }
8226
8227 proc sha1change {n1 n2 op} {
8228     global sha1string currentid sha1but
8229     if {$sha1string == {}
8230         || ([info exists currentid] && $sha1string == $currentid)} {
8231         set state disabled
8232     } else {
8233         set state normal
8234     }
8235     if {[$sha1but cget -state] == $state} return
8236     if {$state == "normal"} {
8237         $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
8238     } else {
8239         $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
8240     }
8241 }
8242
8243 proc gotocommit {} {
8244     global sha1string tagids headids curview varcid
8245
8246     if {$sha1string == {}
8247         || ([info exists currentid] && $sha1string == $currentid)} return
8248     if {[info exists tagids($sha1string)]} {
8249         set id $tagids($sha1string)
8250     } elseif {[info exists headids($sha1string)]} {
8251         set id $headids($sha1string)
8252     } else {
8253         set id [string tolower $sha1string]
8254         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
8255             set matches [longid $id]
8256             if {$matches ne {}} {
8257                 if {[llength $matches] > 1} {
8258                     error_popup [mc "Short SHA1 id %s is ambiguous" $id]
8259                     return
8260                 }
8261                 set id [lindex $matches 0]
8262             }
8263         } else {
8264             if {[catch {set id [exec git rev-parse --verify $sha1string]}]} {
8265                 error_popup [mc "Revision %s is not known" $sha1string]
8266                 return
8267             }
8268         }
8269     }
8270     if {[commitinview $id $curview]} {
8271         selectline [rowofcommit $id] 1
8272         return
8273     }
8274     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
8275         set msg [mc "SHA1 id %s is not known" $sha1string]
8276     } else {
8277         set msg [mc "Revision %s is not in the current view" $sha1string]
8278     }
8279     error_popup $msg
8280 }
8281
8282 proc lineenter {x y id} {
8283     global hoverx hovery hoverid hovertimer
8284     global commitinfo canv
8285
8286     if {![info exists commitinfo($id)] && ![getcommit $id]} return
8287     set hoverx $x
8288     set hovery $y
8289     set hoverid $id
8290     if {[info exists hovertimer]} {
8291         after cancel $hovertimer
8292     }
8293     set hovertimer [after 500 linehover]
8294     $canv delete hover
8295 }
8296
8297 proc linemotion {x y id} {
8298     global hoverx hovery hoverid hovertimer
8299
8300     if {[info exists hoverid] && $id == $hoverid} {
8301         set hoverx $x
8302         set hovery $y
8303         if {[info exists hovertimer]} {
8304             after cancel $hovertimer
8305         }
8306         set hovertimer [after 500 linehover]
8307     }
8308 }
8309
8310 proc lineleave {id} {
8311     global hoverid hovertimer canv
8312
8313     if {[info exists hoverid] && $id == $hoverid} {
8314         $canv delete hover
8315         if {[info exists hovertimer]} {
8316             after cancel $hovertimer
8317             unset hovertimer
8318         }
8319         unset hoverid
8320     }
8321 }
8322
8323 proc linehover {} {
8324     global hoverx hovery hoverid hovertimer
8325     global canv linespc lthickness
8326     global commitinfo
8327
8328     set text [lindex $commitinfo($hoverid) 0]
8329     set ymax [lindex [$canv cget -scrollregion] 3]
8330     if {$ymax == {}} return
8331     set yfrac [lindex [$canv yview] 0]
8332     set x [expr {$hoverx + 2 * $linespc}]
8333     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
8334     set x0 [expr {$x - 2 * $lthickness}]
8335     set y0 [expr {$y - 2 * $lthickness}]
8336     set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
8337     set y1 [expr {$y + $linespc + 2 * $lthickness}]
8338     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
8339                -fill \#ffff80 -outline black -width 1 -tags hover]
8340     $canv raise $t
8341     set t [$canv create text $x $y -anchor nw -text $text -tags hover \
8342                -font mainfont]
8343     $canv raise $t
8344 }
8345
8346 proc clickisonarrow {id y} {
8347     global lthickness
8348
8349     set ranges [rowranges $id]
8350     set thresh [expr {2 * $lthickness + 6}]
8351     set n [expr {[llength $ranges] - 1}]
8352     for {set i 1} {$i < $n} {incr i} {
8353         set row [lindex $ranges $i]
8354         if {abs([yc $row] - $y) < $thresh} {
8355             return $i
8356         }
8357     }
8358     return {}
8359 }
8360
8361 proc arrowjump {id n y} {
8362     global canv
8363
8364     # 1 <-> 2, 3 <-> 4, etc...
8365     set n [expr {(($n - 1) ^ 1) + 1}]
8366     set row [lindex [rowranges $id] $n]
8367     set yt [yc $row]
8368     set ymax [lindex [$canv cget -scrollregion] 3]
8369     if {$ymax eq {} || $ymax <= 0} return
8370     set view [$canv yview]
8371     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
8372     set yfrac [expr {$yt / $ymax - $yspan / 2}]
8373     if {$yfrac < 0} {
8374         set yfrac 0
8375     }
8376     allcanvs yview moveto $yfrac
8377 }
8378
8379 proc lineclick {x y id isnew} {
8380     global ctext commitinfo children canv thickerline curview
8381
8382     if {![info exists commitinfo($id)] && ![getcommit $id]} return
8383     unmarkmatches
8384     unselectline
8385     normalline
8386     $canv delete hover
8387     # draw this line thicker than normal
8388     set thickerline $id
8389     drawlines $id
8390     if {$isnew} {
8391         set ymax [lindex [$canv cget -scrollregion] 3]
8392         if {$ymax eq {}} return
8393         set yfrac [lindex [$canv yview] 0]
8394         set y [expr {$y + $yfrac * $ymax}]
8395     }
8396     set dirn [clickisonarrow $id $y]
8397     if {$dirn ne {}} {
8398         arrowjump $id $dirn $y
8399         return
8400     }
8401
8402     if {$isnew} {
8403         addtohistory [list lineclick $x $y $id 0] savectextpos
8404     }
8405     # fill the details pane with info about this line
8406     $ctext conf -state normal
8407     clear_ctext
8408     settabs 0
8409     $ctext insert end "[mc "Parent"]:\t"
8410     $ctext insert end $id link0
8411     setlink $id link0
8412     set info $commitinfo($id)
8413     $ctext insert end "\n\t[lindex $info 0]\n"
8414     $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
8415     set date [formatdate [lindex $info 2]]
8416     $ctext insert end "\t[mc "Date"]:\t$date\n"
8417     set kids $children($curview,$id)
8418     if {$kids ne {}} {
8419         $ctext insert end "\n[mc "Children"]:"
8420         set i 0
8421         foreach child $kids {
8422             incr i
8423             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
8424             set info $commitinfo($child)
8425             $ctext insert end "\n\t"
8426             $ctext insert end $child link$i
8427             setlink $child link$i
8428             $ctext insert end "\n\t[lindex $info 0]"
8429             $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
8430             set date [formatdate [lindex $info 2]]
8431             $ctext insert end "\n\t[mc "Date"]:\t$date\n"
8432         }
8433     }
8434     maybe_scroll_ctext 1
8435     $ctext conf -state disabled
8436     init_flist {}
8437 }
8438
8439 proc normalline {} {
8440     global thickerline
8441     if {[info exists thickerline]} {
8442         set id $thickerline
8443         unset thickerline
8444         drawlines $id
8445     }
8446 }
8447
8448 proc selbyid {id {isnew 1}} {
8449     global curview
8450     if {[commitinview $id $curview]} {
8451         selectline [rowofcommit $id] $isnew
8452     }
8453 }
8454
8455 proc mstime {} {
8456     global startmstime
8457     if {![info exists startmstime]} {
8458         set startmstime [clock clicks -milliseconds]
8459     }
8460     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
8461 }
8462
8463 proc rowmenu {x y id} {
8464     global rowctxmenu selectedline rowmenuid curview
8465     global nullid nullid2 fakerowmenu mainhead markedid
8466
8467     stopfinding
8468     set rowmenuid $id
8469     if {$selectedline eq {} || [rowofcommit $id] eq $selectedline} {
8470         set state disabled
8471     } else {
8472         set state normal
8473     }
8474     if {$id ne $nullid && $id ne $nullid2} {
8475         set menu $rowctxmenu
8476         if {$mainhead ne {}} {
8477             $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead] -state normal
8478         } else {
8479             $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled
8480         }
8481         if {[info exists markedid] && $markedid ne $id} {
8482             $menu entryconfigure 9 -state normal
8483             $menu entryconfigure 10 -state normal
8484             $menu entryconfigure 11 -state normal
8485         } else {
8486             $menu entryconfigure 9 -state disabled
8487             $menu entryconfigure 10 -state disabled
8488             $menu entryconfigure 11 -state disabled
8489         }
8490     } else {
8491         set menu $fakerowmenu
8492     }
8493     $menu entryconfigure [mca "Diff this -> selected"] -state $state
8494     $menu entryconfigure [mca "Diff selected -> this"] -state $state
8495     $menu entryconfigure [mca "Make patch"] -state $state
8496     tk_popup $menu $x $y
8497 }
8498
8499 proc markhere {} {
8500     global rowmenuid markedid canv
8501
8502     set markedid $rowmenuid
8503     make_idmark $markedid
8504 }
8505
8506 proc gotomark {} {
8507     global markedid
8508
8509     if {[info exists markedid]} {
8510         selbyid $markedid
8511     }
8512 }
8513
8514 proc replace_by_kids {l r} {
8515     global curview children
8516
8517     set id [commitonrow $r]
8518     set l [lreplace $l 0 0]
8519     foreach kid $children($curview,$id) {
8520         lappend l [rowofcommit $kid]
8521     }
8522     return [lsort -integer -decreasing -unique $l]
8523 }
8524
8525 proc find_common_desc {} {
8526     global markedid rowmenuid curview children
8527
8528     if {![info exists markedid]} return
8529     if {![commitinview $markedid $curview] ||
8530         ![commitinview $rowmenuid $curview]} return
8531     #set t1 [clock clicks -milliseconds]
8532     set l1 [list [rowofcommit $markedid]]
8533     set l2 [list [rowofcommit $rowmenuid]]
8534     while 1 {
8535         set r1 [lindex $l1 0]
8536         set r2 [lindex $l2 0]
8537         if {$r1 eq {} || $r2 eq {}} break
8538         if {$r1 == $r2} {
8539             selectline $r1 1
8540             break
8541         }
8542         if {$r1 > $r2} {
8543             set l1 [replace_by_kids $l1 $r1]
8544         } else {
8545             set l2 [replace_by_kids $l2 $r2]
8546         }
8547     }
8548     #set t2 [clock clicks -milliseconds]
8549     #puts "took [expr {$t2-$t1}]ms"
8550 }
8551
8552 proc compare_commits {} {
8553     global markedid rowmenuid curview children
8554
8555     if {![info exists markedid]} return
8556     if {![commitinview $markedid $curview]} return
8557     addtohistory [list do_cmp_commits $markedid $rowmenuid]
8558     do_cmp_commits $markedid $rowmenuid
8559 }
8560
8561 proc getpatchid {id} {
8562     global patchids
8563
8564     if {![info exists patchids($id)]} {
8565         set cmd [diffcmd [list $id] {-p --root}]
8566         # trim off the initial "|"
8567         set cmd [lrange $cmd 1 end]
8568         if {[catch {
8569             set x [eval exec $cmd | git patch-id]
8570             set patchids($id) [lindex $x 0]
8571         }]} {
8572             set patchids($id) "error"
8573         }
8574     }
8575     return $patchids($id)
8576 }
8577
8578 proc do_cmp_commits {a b} {
8579     global ctext curview parents children patchids commitinfo
8580
8581     $ctext conf -state normal
8582     clear_ctext
8583     init_flist {}
8584     for {set i 0} {$i < 100} {incr i} {
8585         set skipa 0
8586         set skipb 0
8587         if {[llength $parents($curview,$a)] > 1} {
8588             appendshortlink $a [mc "Skipping merge commit "] "\n"
8589             set skipa 1
8590         } else {
8591             set patcha [getpatchid $a]
8592         }
8593         if {[llength $parents($curview,$b)] > 1} {
8594             appendshortlink $b [mc "Skipping merge commit "] "\n"
8595             set skipb 1
8596         } else {
8597             set patchb [getpatchid $b]
8598         }
8599         if {!$skipa && !$skipb} {
8600             set heada [lindex $commitinfo($a) 0]
8601             set headb [lindex $commitinfo($b) 0]
8602             if {$patcha eq "error"} {
8603                 appendshortlink $a [mc "Error getting patch ID for "] \
8604                     [mc " - stopping\n"]
8605                 break
8606             }
8607             if {$patchb eq "error"} {
8608                 appendshortlink $b [mc "Error getting patch ID for "] \
8609                     [mc " - stopping\n"]
8610                 break
8611             }
8612             if {$patcha eq $patchb} {
8613                 if {$heada eq $headb} {
8614                     appendshortlink $a [mc "Commit "]
8615                     appendshortlink $b " == " "  $heada\n"
8616                 } else {
8617                     appendshortlink $a [mc "Commit "] "  $heada\n"
8618                     appendshortlink $b [mc " is the same patch as\n       "] \
8619                         "  $headb\n"
8620                 }
8621                 set skipa 1
8622                 set skipb 1
8623             } else {
8624                 $ctext insert end "\n"
8625                 appendshortlink $a [mc "Commit "] "  $heada\n"
8626                 appendshortlink $b [mc " differs from\n       "] \
8627                     "  $headb\n"
8628                 $ctext insert end [mc "Diff of commits:\n\n"]
8629                 $ctext conf -state disabled
8630                 update
8631                 diffcommits $a $b
8632                 return
8633             }
8634         }
8635         if {$skipa} {
8636             set kids [real_children $curview,$a]
8637             if {[llength $kids] != 1} {
8638                 $ctext insert end "\n"
8639                 appendshortlink $a [mc "Commit "] \
8640                     [mc " has %s children - stopping\n" [llength $kids]]
8641                 break
8642             }
8643             set a [lindex $kids 0]
8644         }
8645         if {$skipb} {
8646             set kids [real_children $curview,$b]
8647             if {[llength $kids] != 1} {
8648                 appendshortlink $b [mc "Commit "] \
8649                     [mc " has %s children - stopping\n" [llength $kids]]
8650                 break
8651             }
8652             set b [lindex $kids 0]
8653         }
8654     }
8655     $ctext conf -state disabled
8656 }
8657
8658 proc diffcommits {a b} {
8659     global diffcontext diffids blobdifffd diffinhdr currdiffsubmod
8660
8661     set tmpdir [gitknewtmpdir]
8662     set fna [file join $tmpdir "commit-[string range $a 0 7]"]
8663     set fnb [file join $tmpdir "commit-[string range $b 0 7]"]
8664     if {[catch {
8665         exec git diff-tree -p --pretty $a >$fna
8666         exec git diff-tree -p --pretty $b >$fnb
8667     } err]} {
8668         error_popup [mc "Error writing commit to file: %s" $err]
8669         return
8670     }
8671     if {[catch {
8672         set fd [open "| diff -U$diffcontext $fna $fnb" r]
8673     } err]} {
8674         error_popup [mc "Error diffing commits: %s" $err]
8675         return
8676     }
8677     set diffids [list commits $a $b]
8678     set blobdifffd($diffids) $fd
8679     set diffinhdr 0
8680     set currdiffsubmod ""
8681     filerun $fd [list getblobdiffline $fd $diffids]
8682 }
8683
8684 proc diffvssel {dirn} {
8685     global rowmenuid selectedline
8686
8687     if {$selectedline eq {}} return
8688     if {$dirn} {
8689         set oldid [commitonrow $selectedline]
8690         set newid $rowmenuid
8691     } else {
8692         set oldid $rowmenuid
8693         set newid [commitonrow $selectedline]
8694     }
8695     addtohistory [list doseldiff $oldid $newid] savectextpos
8696     doseldiff $oldid $newid
8697 }
8698
8699 proc doseldiff {oldid newid} {
8700     global ctext
8701     global commitinfo
8702
8703     $ctext conf -state normal
8704     clear_ctext
8705     init_flist [mc "Top"]
8706     $ctext insert end "[mc "From"] "
8707     $ctext insert end $oldid link0
8708     setlink $oldid link0
8709     $ctext insert end "\n     "
8710     $ctext insert end [lindex $commitinfo($oldid) 0]
8711     $ctext insert end "\n\n[mc "To"]   "
8712     $ctext insert end $newid link1
8713     setlink $newid link1
8714     $ctext insert end "\n     "
8715     $ctext insert end [lindex $commitinfo($newid) 0]
8716     $ctext insert end "\n"
8717     $ctext conf -state disabled
8718     $ctext tag remove found 1.0 end
8719     startdiff [list $oldid $newid]
8720 }
8721
8722 proc mkpatch {} {
8723     global rowmenuid currentid commitinfo patchtop patchnum NS
8724
8725     if {![info exists currentid]} return
8726     set oldid $currentid
8727     set oldhead [lindex $commitinfo($oldid) 0]
8728     set newid $rowmenuid
8729     set newhead [lindex $commitinfo($newid) 0]
8730     set top .patch
8731     set patchtop $top
8732     catch {destroy $top}
8733     ttk_toplevel $top
8734     make_transient $top .
8735     ${NS}::label $top.title -text [mc "Generate patch"]
8736     grid $top.title - -pady 10
8737     ${NS}::label $top.from -text [mc "From:"]
8738     ${NS}::entry $top.fromsha1 -width 40
8739     $top.fromsha1 insert 0 $oldid
8740     $top.fromsha1 conf -state readonly
8741     grid $top.from $top.fromsha1 -sticky w
8742     ${NS}::entry $top.fromhead -width 60
8743     $top.fromhead insert 0 $oldhead
8744     $top.fromhead conf -state readonly
8745     grid x $top.fromhead -sticky w
8746     ${NS}::label $top.to -text [mc "To:"]
8747     ${NS}::entry $top.tosha1 -width 40
8748     $top.tosha1 insert 0 $newid
8749     $top.tosha1 conf -state readonly
8750     grid $top.to $top.tosha1 -sticky w
8751     ${NS}::entry $top.tohead -width 60
8752     $top.tohead insert 0 $newhead
8753     $top.tohead conf -state readonly
8754     grid x $top.tohead -sticky w
8755     ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev
8756     grid $top.rev x -pady 10 -padx 5
8757     ${NS}::label $top.flab -text [mc "Output file:"]
8758     ${NS}::entry $top.fname -width 60
8759     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
8760     incr patchnum
8761     grid $top.flab $top.fname -sticky w
8762     ${NS}::frame $top.buts
8763     ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
8764     ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
8765     bind $top <Key-Return> mkpatchgo
8766     bind $top <Key-Escape> mkpatchcan
8767     grid $top.buts.gen $top.buts.can
8768     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8769     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8770     grid $top.buts - -pady 10 -sticky ew
8771     focus $top.fname
8772 }
8773
8774 proc mkpatchrev {} {
8775     global patchtop
8776
8777     set oldid [$patchtop.fromsha1 get]
8778     set oldhead [$patchtop.fromhead get]
8779     set newid [$patchtop.tosha1 get]
8780     set newhead [$patchtop.tohead get]
8781     foreach e [list fromsha1 fromhead tosha1 tohead] \
8782             v [list $newid $newhead $oldid $oldhead] {
8783         $patchtop.$e conf -state normal
8784         $patchtop.$e delete 0 end
8785         $patchtop.$e insert 0 $v
8786         $patchtop.$e conf -state readonly
8787     }
8788 }
8789
8790 proc mkpatchgo {} {
8791     global patchtop nullid nullid2
8792
8793     set oldid [$patchtop.fromsha1 get]
8794     set newid [$patchtop.tosha1 get]
8795     set fname [$patchtop.fname get]
8796     set cmd [diffcmd [list $oldid $newid] -p]
8797     # trim off the initial "|"
8798     set cmd [lrange $cmd 1 end]
8799     lappend cmd >$fname &
8800     if {[catch {eval exec $cmd} err]} {
8801         error_popup "[mc "Error creating patch:"] $err" $patchtop
8802     }
8803     catch {destroy $patchtop}
8804     unset patchtop
8805 }
8806
8807 proc mkpatchcan {} {
8808     global patchtop
8809
8810     catch {destroy $patchtop}
8811     unset patchtop
8812 }
8813
8814 proc mktag {} {
8815     global rowmenuid mktagtop commitinfo NS
8816
8817     set top .maketag
8818     set mktagtop $top
8819     catch {destroy $top}
8820     ttk_toplevel $top
8821     make_transient $top .
8822     ${NS}::label $top.title -text [mc "Create tag"]
8823     grid $top.title - -pady 10
8824     ${NS}::label $top.id -text [mc "ID:"]
8825     ${NS}::entry $top.sha1 -width 40
8826     $top.sha1 insert 0 $rowmenuid
8827     $top.sha1 conf -state readonly
8828     grid $top.id $top.sha1 -sticky w
8829     ${NS}::entry $top.head -width 60
8830     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8831     $top.head conf -state readonly
8832     grid x $top.head -sticky w
8833     ${NS}::label $top.tlab -text [mc "Tag name:"]
8834     ${NS}::entry $top.tag -width 60
8835     grid $top.tlab $top.tag -sticky w
8836     ${NS}::label $top.op -text [mc "Tag message is optional"]
8837     grid $top.op -columnspan 2 -sticky we
8838     ${NS}::label $top.mlab -text [mc "Tag message:"]
8839     ${NS}::entry $top.msg -width 60
8840     grid $top.mlab $top.msg -sticky w
8841     ${NS}::frame $top.buts
8842     ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo
8843     ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan
8844     bind $top <Key-Return> mktaggo
8845     bind $top <Key-Escape> mktagcan
8846     grid $top.buts.gen $top.buts.can
8847     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8848     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8849     grid $top.buts - -pady 10 -sticky ew
8850     focus $top.tag
8851 }
8852
8853 proc domktag {} {
8854     global mktagtop env tagids idtags
8855
8856     set id [$mktagtop.sha1 get]
8857     set tag [$mktagtop.tag get]
8858     set msg [$mktagtop.msg get]
8859     if {$tag == {}} {
8860         error_popup [mc "No tag name specified"] $mktagtop
8861         return 0
8862     }
8863     if {[info exists tagids($tag)]} {
8864         error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop
8865         return 0
8866     }
8867     if {[catch {
8868         if {$msg != {}} {
8869             exec git tag -a -m $msg $tag $id
8870         } else {
8871             exec git tag $tag $id
8872         }
8873     } err]} {
8874         error_popup "[mc "Error creating tag:"] $err" $mktagtop
8875         return 0
8876     }
8877
8878     set tagids($tag) $id
8879     lappend idtags($id) $tag
8880     redrawtags $id
8881     addedtag $id
8882     dispneartags 0
8883     run refill_reflist
8884     return 1
8885 }
8886
8887 proc redrawtags {id} {
8888     global canv linehtag idpos currentid curview cmitlisted markedid
8889     global canvxmax iddrawn circleitem mainheadid circlecolors
8890
8891     if {![commitinview $id $curview]} return
8892     if {![info exists iddrawn($id)]} return
8893     set row [rowofcommit $id]
8894     if {$id eq $mainheadid} {
8895         set ofill yellow
8896     } else {
8897         set ofill [lindex $circlecolors $cmitlisted($curview,$id)]
8898     }
8899     $canv itemconf $circleitem($row) -fill $ofill
8900     $canv delete tag.$id
8901     set xt [eval drawtags $id $idpos($id)]
8902     $canv coords $linehtag($id) $xt [lindex $idpos($id) 2]
8903     set text [$canv itemcget $linehtag($id) -text]
8904     set font [$canv itemcget $linehtag($id) -font]
8905     set xr [expr {$xt + [font measure $font $text]}]
8906     if {$xr > $canvxmax} {
8907         set canvxmax $xr
8908         setcanvscroll
8909     }
8910     if {[info exists currentid] && $currentid == $id} {
8911         make_secsel $id
8912     }
8913     if {[info exists markedid] && $markedid eq $id} {
8914         make_idmark $id
8915     }
8916 }
8917
8918 proc mktagcan {} {
8919     global mktagtop
8920
8921     catch {destroy $mktagtop}
8922     unset mktagtop
8923 }
8924
8925 proc mktaggo {} {
8926     if {![domktag]} return
8927     mktagcan
8928 }
8929
8930 proc writecommit {} {
8931     global rowmenuid wrcomtop commitinfo wrcomcmd NS
8932
8933     set top .writecommit
8934     set wrcomtop $top
8935     catch {destroy $top}
8936     ttk_toplevel $top
8937     make_transient $top .
8938     ${NS}::label $top.title -text [mc "Write commit to file"]
8939     grid $top.title - -pady 10
8940     ${NS}::label $top.id -text [mc "ID:"]
8941     ${NS}::entry $top.sha1 -width 40
8942     $top.sha1 insert 0 $rowmenuid
8943     $top.sha1 conf -state readonly
8944     grid $top.id $top.sha1 -sticky w
8945     ${NS}::entry $top.head -width 60
8946     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
8947     $top.head conf -state readonly
8948     grid x $top.head -sticky w
8949     ${NS}::label $top.clab -text [mc "Command:"]
8950     ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd
8951     grid $top.clab $top.cmd -sticky w -pady 10
8952     ${NS}::label $top.flab -text [mc "Output file:"]
8953     ${NS}::entry $top.fname -width 60
8954     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
8955     grid $top.flab $top.fname -sticky w
8956     ${NS}::frame $top.buts
8957     ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo
8958     ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan
8959     bind $top <Key-Return> wrcomgo
8960     bind $top <Key-Escape> wrcomcan
8961     grid $top.buts.gen $top.buts.can
8962     grid columnconfigure $top.buts 0 -weight 1 -uniform a
8963     grid columnconfigure $top.buts 1 -weight 1 -uniform a
8964     grid $top.buts - -pady 10 -sticky ew
8965     focus $top.fname
8966 }
8967
8968 proc wrcomgo {} {
8969     global wrcomtop
8970
8971     set id [$wrcomtop.sha1 get]
8972     set cmd "echo $id | [$wrcomtop.cmd get]"
8973     set fname [$wrcomtop.fname get]
8974     if {[catch {exec sh -c $cmd >$fname &} err]} {
8975         error_popup "[mc "Error writing commit:"] $err" $wrcomtop
8976     }
8977     catch {destroy $wrcomtop}
8978     unset wrcomtop
8979 }
8980
8981 proc wrcomcan {} {
8982     global wrcomtop
8983
8984     catch {destroy $wrcomtop}
8985     unset wrcomtop
8986 }
8987
8988 proc mkbranch {} {
8989     global rowmenuid mkbrtop NS
8990
8991     set top .makebranch
8992     catch {destroy $top}
8993     ttk_toplevel $top
8994     make_transient $top .
8995     ${NS}::label $top.title -text [mc "Create new branch"]
8996     grid $top.title - -pady 10
8997     ${NS}::label $top.id -text [mc "ID:"]
8998     ${NS}::entry $top.sha1 -width 40
8999     $top.sha1 insert 0 $rowmenuid
9000     $top.sha1 conf -state readonly
9001     grid $top.id $top.sha1 -sticky w
9002     ${NS}::label $top.nlab -text [mc "Name:"]
9003     ${NS}::entry $top.name -width 40
9004     grid $top.nlab $top.name -sticky w
9005     ${NS}::frame $top.buts
9006     ${NS}::button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
9007     ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
9008     bind $top <Key-Return> [list mkbrgo $top]
9009     bind $top <Key-Escape> "catch {destroy $top}"
9010     grid $top.buts.go $top.buts.can
9011     grid columnconfigure $top.buts 0 -weight 1 -uniform a
9012     grid columnconfigure $top.buts 1 -weight 1 -uniform a
9013     grid $top.buts - -pady 10 -sticky ew
9014     focus $top.name
9015 }
9016
9017 proc mkbrgo {top} {
9018     global headids idheads
9019
9020     set name [$top.name get]
9021     set id [$top.sha1 get]
9022     set cmdargs {}
9023     set old_id {}
9024     if {$name eq {}} {
9025         error_popup [mc "Please specify a name for the new branch"] $top
9026         return
9027     }
9028     if {[info exists headids($name)]} {
9029         if {![confirm_popup [mc \
9030                 "Branch '%s' already exists. Overwrite?" $name] $top]} {
9031             return
9032         }
9033         set old_id $headids($name)
9034         lappend cmdargs -f
9035     }
9036     catch {destroy $top}
9037     lappend cmdargs $name $id
9038     nowbusy newbranch
9039     update
9040     if {[catch {
9041         eval exec git branch $cmdargs
9042     } err]} {
9043         notbusy newbranch
9044         error_popup $err
9045     } else {
9046         notbusy newbranch
9047         if {$old_id ne {}} {
9048             movehead $id $name
9049             movedhead $id $name
9050             redrawtags $old_id
9051             redrawtags $id
9052         } else {
9053             set headids($name) $id
9054             lappend idheads($id) $name
9055             addedhead $id $name
9056             redrawtags $id
9057         }
9058         dispneartags 0
9059         run refill_reflist
9060     }
9061 }
9062
9063 proc exec_citool {tool_args {baseid {}}} {
9064     global commitinfo env
9065
9066     set save_env [array get env GIT_AUTHOR_*]
9067
9068     if {$baseid ne {}} {
9069         if {![info exists commitinfo($baseid)]} {
9070             getcommit $baseid
9071         }
9072         set author [lindex $commitinfo($baseid) 1]
9073         set date [lindex $commitinfo($baseid) 2]
9074         if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \
9075                     $author author name email]
9076             && $date ne {}} {
9077             set env(GIT_AUTHOR_NAME) $name
9078             set env(GIT_AUTHOR_EMAIL) $email
9079             set env(GIT_AUTHOR_DATE) $date
9080         }
9081     }
9082
9083     eval exec git citool $tool_args &
9084
9085     array unset env GIT_AUTHOR_*
9086     array set env $save_env
9087 }
9088
9089 proc cherrypick {} {
9090     global rowmenuid curview
9091     global mainhead mainheadid
9092     global gitdir
9093
9094     set oldhead [exec git rev-parse HEAD]
9095     set dheads [descheads $rowmenuid]
9096     if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
9097         set ok [confirm_popup [mc "Commit %s is already\
9098                 included in branch %s -- really re-apply it?" \
9099                                    [string range $rowmenuid 0 7] $mainhead]]
9100         if {!$ok} return
9101     }
9102     nowbusy cherrypick [mc "Cherry-picking"]
9103     update
9104     # Unfortunately git-cherry-pick writes stuff to stderr even when
9105     # no error occurs, and exec takes that as an indication of error...
9106     if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} {
9107         notbusy cherrypick
9108         if {[regexp -line \
9109                  {Entry '(.*)' (would be overwritten by merge|not uptodate)} \
9110                  $err msg fname]} {
9111             error_popup [mc "Cherry-pick failed because of local changes\
9112                         to file '%s'.\nPlease commit, reset or stash\
9113                         your changes and try again." $fname]
9114         } elseif {[regexp -line \
9115                        {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \
9116                        $err]} {
9117             if {[confirm_popup [mc "Cherry-pick failed because of merge\
9118                         conflict.\nDo you wish to run git citool to\
9119                         resolve it?"]]} {
9120                 # Force citool to read MERGE_MSG
9121                 file delete [file join $gitdir "GITGUI_MSG"]
9122                 exec_citool {} $rowmenuid
9123             }
9124         } else {
9125             error_popup $err
9126         }
9127         run updatecommits
9128         return
9129     }
9130     set newhead [exec git rev-parse HEAD]
9131     if {$newhead eq $oldhead} {
9132         notbusy cherrypick
9133         error_popup [mc "No changes committed"]
9134         return
9135     }
9136     addnewchild $newhead $oldhead
9137     if {[commitinview $oldhead $curview]} {
9138         # XXX this isn't right if we have a path limit...
9139         insertrow $newhead $oldhead $curview
9140         if {$mainhead ne {}} {
9141             movehead $newhead $mainhead
9142             movedhead $newhead $mainhead
9143         }
9144         set mainheadid $newhead
9145         redrawtags $oldhead
9146         redrawtags $newhead
9147         selbyid $newhead
9148     }
9149     notbusy cherrypick
9150 }
9151
9152 proc resethead {} {
9153     global mainhead rowmenuid confirm_ok resettype NS
9154
9155     set confirm_ok 0
9156     set w ".confirmreset"
9157     ttk_toplevel $w
9158     make_transient $w .
9159     wm title $w [mc "Confirm reset"]
9160     ${NS}::label $w.m -text \
9161         [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]]
9162     pack $w.m -side top -fill x -padx 20 -pady 20
9163     ${NS}::labelframe $w.f -text [mc "Reset type:"]
9164     set resettype mixed
9165     ${NS}::radiobutton $w.f.soft -value soft -variable resettype \
9166         -text [mc "Soft: Leave working tree and index untouched"]
9167     grid $w.f.soft -sticky w
9168     ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \
9169         -text [mc "Mixed: Leave working tree untouched, reset index"]
9170     grid $w.f.mixed -sticky w
9171     ${NS}::radiobutton $w.f.hard -value hard -variable resettype \
9172         -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
9173     grid $w.f.hard -sticky w
9174     pack $w.f -side top -fill x -padx 4
9175     ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
9176     pack $w.ok -side left -fill x -padx 20 -pady 20
9177     ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
9178     bind $w <Key-Escape> [list destroy $w]
9179     pack $w.cancel -side right -fill x -padx 20 -pady 20
9180     bind $w <Visibility> "grab $w; focus $w"
9181     tkwait window $w
9182     if {!$confirm_ok} return
9183     if {[catch {set fd [open \
9184             [list | git reset --$resettype $rowmenuid 2>@1] r]} err]} {
9185         error_popup $err
9186     } else {
9187         dohidelocalchanges
9188         filerun $fd [list readresetstat $fd]
9189         nowbusy reset [mc "Resetting"]
9190         selbyid $rowmenuid
9191     }
9192 }
9193
9194 proc readresetstat {fd} {
9195     global mainhead mainheadid showlocalchanges rprogcoord
9196
9197     if {[gets $fd line] >= 0} {
9198         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9199             set rprogcoord [expr {1.0 * $m / $n}]
9200             adjustprogress
9201         }
9202         return 1
9203     }
9204     set rprogcoord 0
9205     adjustprogress
9206     notbusy reset
9207     if {[catch {close $fd} err]} {
9208         error_popup $err
9209     }
9210     set oldhead $mainheadid
9211     set newhead [exec git rev-parse HEAD]
9212     if {$newhead ne $oldhead} {
9213         movehead $newhead $mainhead
9214         movedhead $newhead $mainhead
9215         set mainheadid $newhead
9216         redrawtags $oldhead
9217         redrawtags $newhead
9218     }
9219     if {$showlocalchanges} {
9220         doshowlocalchanges
9221     }
9222     return 0
9223 }
9224
9225 # context menu for a head
9226 proc headmenu {x y id head} {
9227     global headmenuid headmenuhead headctxmenu mainhead
9228
9229     stopfinding
9230     set headmenuid $id
9231     set headmenuhead $head
9232     set state normal
9233     if {[string match "remotes/*" $head]} {
9234         set state disabled
9235     }
9236     if {$head eq $mainhead} {
9237         set state disabled
9238     }
9239     $headctxmenu entryconfigure 0 -state $state
9240     $headctxmenu entryconfigure 1 -state $state
9241     tk_popup $headctxmenu $x $y
9242 }
9243
9244 proc cobranch {} {
9245     global headmenuid headmenuhead headids
9246     global showlocalchanges
9247
9248     # check the tree is clean first??
9249     nowbusy checkout [mc "Checking out"]
9250     update
9251     dohidelocalchanges
9252     if {[catch {
9253         set fd [open [list | git checkout $headmenuhead 2>@1] r]
9254     } err]} {
9255         notbusy checkout
9256         error_popup $err
9257         if {$showlocalchanges} {
9258             dodiffindex
9259         }
9260     } else {
9261         filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid]
9262     }
9263 }
9264
9265 proc readcheckoutstat {fd newhead newheadid} {
9266     global mainhead mainheadid headids showlocalchanges progresscoords
9267     global viewmainheadid curview
9268
9269     if {[gets $fd line] >= 0} {
9270         if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
9271             set progresscoords [list 0 [expr {1.0 * $m / $n}]]
9272             adjustprogress
9273         }
9274         return 1
9275     }
9276     set progresscoords {0 0}
9277     adjustprogress
9278     notbusy checkout
9279     if {[catch {close $fd} err]} {
9280         error_popup $err
9281     }
9282     set oldmainid $mainheadid
9283     set mainhead $newhead
9284     set mainheadid $newheadid
9285     set viewmainheadid($curview) $newheadid
9286     redrawtags $oldmainid
9287     redrawtags $newheadid
9288     selbyid $newheadid
9289     if {$showlocalchanges} {
9290         dodiffindex
9291     }
9292 }
9293
9294 proc rmbranch {} {
9295     global headmenuid headmenuhead mainhead
9296     global idheads
9297
9298     set head $headmenuhead
9299     set id $headmenuid
9300     # this check shouldn't be needed any more...
9301     if {$head eq $mainhead} {
9302         error_popup [mc "Cannot delete the currently checked-out branch"]
9303         return
9304     }
9305     set dheads [descheads $id]
9306     if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
9307         # the stuff on this branch isn't on any other branch
9308         if {![confirm_popup [mc "The commits on branch %s aren't on any other\
9309                         branch.\nReally delete branch %s?" $head $head]]} return
9310     }
9311     nowbusy rmbranch
9312     update
9313     if {[catch {exec git branch -D $head} err]} {
9314         notbusy rmbranch
9315         error_popup $err
9316         return
9317     }
9318     removehead $id $head
9319     removedhead $id $head
9320     redrawtags $id
9321     notbusy rmbranch
9322     dispneartags 0
9323     run refill_reflist
9324 }
9325
9326 # Display a list of tags and heads
9327 proc showrefs {} {
9328     global showrefstop bgcolor fgcolor selectbgcolor NS
9329     global bglist fglist reflistfilter reflist maincursor
9330
9331     set top .showrefs
9332     set showrefstop $top
9333     if {[winfo exists $top]} {
9334         raise $top
9335         refill_reflist
9336         return
9337     }
9338     ttk_toplevel $top
9339     wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
9340     make_transient $top .
9341     text $top.list -background $bgcolor -foreground $fgcolor \
9342         -selectbackground $selectbgcolor -font mainfont \
9343         -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
9344         -width 30 -height 20 -cursor $maincursor \
9345         -spacing1 1 -spacing3 1 -state disabled
9346     $top.list tag configure highlight -background $selectbgcolor
9347     lappend bglist $top.list
9348     lappend fglist $top.list
9349     ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical
9350     ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal
9351     grid $top.list $top.ysb -sticky nsew
9352     grid $top.xsb x -sticky ew
9353     ${NS}::frame $top.f
9354     ${NS}::label $top.f.l -text "[mc "Filter"]: "
9355     ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter
9356     set reflistfilter "*"
9357     trace add variable reflistfilter write reflistfilter_change
9358     pack $top.f.e -side right -fill x -expand 1
9359     pack $top.f.l -side left
9360     grid $top.f - -sticky ew -pady 2
9361     ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"]
9362     bind $top <Key-Escape> [list destroy $top]
9363     grid $top.close -
9364     grid columnconfigure $top 0 -weight 1
9365     grid rowconfigure $top 0 -weight 1
9366     bind $top.list <1> {break}
9367     bind $top.list <B1-Motion> {break}
9368     bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
9369     set reflist {}
9370     refill_reflist
9371 }
9372
9373 proc sel_reflist {w x y} {
9374     global showrefstop reflist headids tagids otherrefids
9375
9376     if {![winfo exists $showrefstop]} return
9377     set l [lindex [split [$w index "@$x,$y"] "."] 0]
9378     set ref [lindex $reflist [expr {$l-1}]]
9379     set n [lindex $ref 0]
9380     switch -- [lindex $ref 1] {
9381         "H" {selbyid $headids($n)}
9382         "T" {selbyid $tagids($n)}
9383         "o" {selbyid $otherrefids($n)}
9384     }
9385     $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
9386 }
9387
9388 proc unsel_reflist {} {
9389     global showrefstop
9390
9391     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9392     $showrefstop.list tag remove highlight 0.0 end
9393 }
9394
9395 proc reflistfilter_change {n1 n2 op} {
9396     global reflistfilter
9397
9398     after cancel refill_reflist
9399     after 200 refill_reflist
9400 }
9401
9402 proc refill_reflist {} {
9403     global reflist reflistfilter showrefstop headids tagids otherrefids
9404     global curview
9405
9406     if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
9407     set refs {}
9408     foreach n [array names headids] {
9409         if {[string match $reflistfilter $n]} {
9410             if {[commitinview $headids($n) $curview]} {
9411                 lappend refs [list $n H]
9412             } else {
9413                 interestedin $headids($n) {run refill_reflist}
9414             }
9415         }
9416     }
9417     foreach n [array names tagids] {
9418         if {[string match $reflistfilter $n]} {
9419             if {[commitinview $tagids($n) $curview]} {
9420                 lappend refs [list $n T]
9421             } else {
9422                 interestedin $tagids($n) {run refill_reflist}
9423             }
9424         }
9425     }
9426     foreach n [array names otherrefids] {
9427         if {[string match $reflistfilter $n]} {
9428             if {[commitinview $otherrefids($n) $curview]} {
9429                 lappend refs [list $n o]
9430             } else {
9431                 interestedin $otherrefids($n) {run refill_reflist}
9432             }
9433         }
9434     }
9435     set refs [lsort -index 0 $refs]
9436     if {$refs eq $reflist} return
9437
9438     # Update the contents of $showrefstop.list according to the
9439     # differences between $reflist (old) and $refs (new)
9440     $showrefstop.list conf -state normal
9441     $showrefstop.list insert end "\n"
9442     set i 0
9443     set j 0
9444     while {$i < [llength $reflist] || $j < [llength $refs]} {
9445         if {$i < [llength $reflist]} {
9446             if {$j < [llength $refs]} {
9447                 set cmp [string compare [lindex $reflist $i 0] \
9448                              [lindex $refs $j 0]]
9449                 if {$cmp == 0} {
9450                     set cmp [string compare [lindex $reflist $i 1] \
9451                                  [lindex $refs $j 1]]
9452                 }
9453             } else {
9454                 set cmp -1
9455             }
9456         } else {
9457             set cmp 1
9458         }
9459         switch -- $cmp {
9460             -1 {
9461                 $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
9462                 incr i
9463             }
9464             0 {
9465                 incr i
9466                 incr j
9467             }
9468             1 {
9469                 set l [expr {$j + 1}]
9470                 $showrefstop.list image create $l.0 -align baseline \
9471                     -image reficon-[lindex $refs $j 1] -padx 2
9472                 $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
9473                 incr j
9474             }
9475         }
9476     }
9477     set reflist $refs
9478     # delete last newline
9479     $showrefstop.list delete end-2c end-1c
9480     $showrefstop.list conf -state disabled
9481 }
9482
9483 # Stuff for finding nearby tags
9484 proc getallcommits {} {
9485     global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
9486     global idheads idtags idotherrefs allparents tagobjid
9487     global gitdir
9488
9489     if {![info exists allcommits]} {
9490         set nextarc 0
9491         set allcommits 0
9492         set seeds {}
9493         set allcwait 0
9494         set cachedarcs 0
9495         set allccache [file join $gitdir "gitk.cache"]
9496         if {![catch {
9497             set f [open $allccache r]
9498             set allcwait 1
9499             getcache $f
9500         }]} return
9501     }
9502
9503     if {$allcwait} {
9504         return
9505     }
9506     set cmd [list | git rev-list --parents]
9507     set allcupdate [expr {$seeds ne {}}]
9508     if {!$allcupdate} {
9509         set ids "--all"
9510     } else {
9511         set refs [concat [array names idheads] [array names idtags] \
9512                       [array names idotherrefs]]
9513         set ids {}
9514         set tagobjs {}
9515         foreach name [array names tagobjid] {
9516             lappend tagobjs $tagobjid($name)
9517         }
9518         foreach id [lsort -unique $refs] {
9519             if {![info exists allparents($id)] &&
9520                 [lsearch -exact $tagobjs $id] < 0} {
9521                 lappend ids $id
9522             }
9523         }
9524         if {$ids ne {}} {
9525             foreach id $seeds {
9526                 lappend ids "^$id"
9527             }
9528         }
9529     }
9530     if {$ids ne {}} {
9531         set fd [open [concat $cmd $ids] r]
9532         fconfigure $fd -blocking 0
9533         incr allcommits
9534         nowbusy allcommits
9535         filerun $fd [list getallclines $fd]
9536     } else {
9537         dispneartags 0
9538     }
9539 }
9540
9541 # Since most commits have 1 parent and 1 child, we group strings of
9542 # such commits into "arcs" joining branch/merge points (BMPs), which
9543 # are commits that either don't have 1 parent or don't have 1 child.
9544 #
9545 # arcnos(id) - incoming arcs for BMP, arc we're on for other nodes
9546 # arcout(id) - outgoing arcs for BMP
9547 # arcids(a) - list of IDs on arc including end but not start
9548 # arcstart(a) - BMP ID at start of arc
9549 # arcend(a) - BMP ID at end of arc
9550 # growing(a) - arc a is still growing
9551 # arctags(a) - IDs out of arcids (excluding end) that have tags
9552 # archeads(a) - IDs out of arcids (excluding end) that have heads
9553 # The start of an arc is at the descendent end, so "incoming" means
9554 # coming from descendents, and "outgoing" means going towards ancestors.
9555
9556 proc getallclines {fd} {
9557     global allparents allchildren idtags idheads nextarc
9558     global arcnos arcids arctags arcout arcend arcstart archeads growing
9559     global seeds allcommits cachedarcs allcupdate
9560
9561     set nid 0
9562     while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
9563         set id [lindex $line 0]
9564         if {[info exists allparents($id)]} {
9565             # seen it already
9566             continue
9567         }
9568         set cachedarcs 0
9569         set olds [lrange $line 1 end]
9570         set allparents($id) $olds
9571         if {![info exists allchildren($id)]} {
9572             set allchildren($id) {}
9573             set arcnos($id) {}
9574             lappend seeds $id
9575         } else {
9576             set a $arcnos($id)
9577             if {[llength $olds] == 1 && [llength $a] == 1} {
9578                 lappend arcids($a) $id
9579                 if {[info exists idtags($id)]} {
9580                     lappend arctags($a) $id
9581                 }
9582                 if {[info exists idheads($id)]} {
9583                     lappend archeads($a) $id
9584                 }
9585                 if {[info exists allparents($olds)]} {
9586                     # seen parent already
9587                     if {![info exists arcout($olds)]} {
9588                         splitarc $olds
9589                     }
9590                     lappend arcids($a) $olds
9591                     set arcend($a) $olds
9592                     unset growing($a)
9593                 }
9594                 lappend allchildren($olds) $id
9595                 lappend arcnos($olds) $a
9596                 continue
9597             }
9598         }
9599         foreach a $arcnos($id) {
9600             lappend arcids($a) $id
9601             set arcend($a) $id
9602             unset growing($a)
9603         }
9604
9605         set ao {}
9606         foreach p $olds {
9607             lappend allchildren($p) $id
9608             set a [incr nextarc]
9609             set arcstart($a) $id
9610             set archeads($a) {}
9611             set arctags($a) {}
9612             set archeads($a) {}
9613             set arcids($a) {}
9614             lappend ao $a
9615             set growing($a) 1
9616             if {[info exists allparents($p)]} {
9617                 # seen it already, may need to make a new branch
9618                 if {![info exists arcout($p)]} {
9619                     splitarc $p
9620                 }
9621                 lappend arcids($a) $p
9622                 set arcend($a) $p
9623                 unset growing($a)
9624             }
9625             lappend arcnos($p) $a
9626         }
9627         set arcout($id) $ao
9628     }
9629     if {$nid > 0} {
9630         global cached_dheads cached_dtags cached_atags
9631         catch {unset cached_dheads}
9632         catch {unset cached_dtags}
9633         catch {unset cached_atags}
9634     }
9635     if {![eof $fd]} {
9636         return [expr {$nid >= 1000? 2: 1}]
9637     }
9638     set cacheok 1
9639     if {[catch {
9640         fconfigure $fd -blocking 1
9641         close $fd
9642     } err]} {
9643         # got an error reading the list of commits
9644         # if we were updating, try rereading the whole thing again
9645         if {$allcupdate} {
9646             incr allcommits -1
9647             dropcache $err
9648             return
9649         }
9650         error_popup "[mc "Error reading commit topology information;\
9651                 branch and preceding/following tag information\
9652                 will be incomplete."]\n($err)"
9653         set cacheok 0
9654     }
9655     if {[incr allcommits -1] == 0} {
9656         notbusy allcommits
9657         if {$cacheok} {
9658             run savecache
9659         }
9660     }
9661     dispneartags 0
9662     return 0
9663 }
9664
9665 proc recalcarc {a} {
9666     global arctags archeads arcids idtags idheads
9667
9668     set at {}
9669     set ah {}
9670     foreach id [lrange $arcids($a) 0 end-1] {
9671         if {[info exists idtags($id)]} {
9672             lappend at $id
9673         }
9674         if {[info exists idheads($id)]} {
9675             lappend ah $id
9676         }
9677     }
9678     set arctags($a) $at
9679     set archeads($a) $ah
9680 }
9681
9682 proc splitarc {p} {
9683     global arcnos arcids nextarc arctags archeads idtags idheads
9684     global arcstart arcend arcout allparents growing
9685
9686     set a $arcnos($p)
9687     if {[llength $a] != 1} {
9688         puts "oops splitarc called but [llength $a] arcs already"
9689         return
9690     }
9691     set a [lindex $a 0]
9692     set i [lsearch -exact $arcids($a) $p]
9693     if {$i < 0} {
9694         puts "oops splitarc $p not in arc $a"
9695         return
9696     }
9697     set na [incr nextarc]
9698     if {[info exists arcend($a)]} {
9699         set arcend($na) $arcend($a)
9700     } else {
9701         set l [lindex $allparents([lindex $arcids($a) end]) 0]
9702         set j [lsearch -exact $arcnos($l) $a]
9703         set arcnos($l) [lreplace $arcnos($l) $j $j $na]
9704     }
9705     set tail [lrange $arcids($a) [expr {$i+1}] end]
9706     set arcids($a) [lrange $arcids($a) 0 $i]
9707     set arcend($a) $p
9708     set arcstart($na) $p
9709     set arcout($p) $na
9710     set arcids($na) $tail
9711     if {[info exists growing($a)]} {
9712         set growing($na) 1
9713         unset growing($a)
9714     }
9715
9716     foreach id $tail {
9717         if {[llength $arcnos($id)] == 1} {
9718             set arcnos($id) $na
9719         } else {
9720             set j [lsearch -exact $arcnos($id) $a]
9721             set arcnos($id) [lreplace $arcnos($id) $j $j $na]
9722         }
9723     }
9724
9725     # reconstruct tags and heads lists
9726     if {$arctags($a) ne {} || $archeads($a) ne {}} {
9727         recalcarc $a
9728         recalcarc $na
9729     } else {
9730         set arctags($na) {}
9731         set archeads($na) {}
9732     }
9733 }
9734
9735 # Update things for a new commit added that is a child of one
9736 # existing commit.  Used when cherry-picking.
9737 proc addnewchild {id p} {
9738     global allparents allchildren idtags nextarc
9739     global arcnos arcids arctags arcout arcend arcstart archeads growing
9740     global seeds allcommits
9741
9742     if {![info exists allcommits] || ![info exists arcnos($p)]} return
9743     set allparents($id) [list $p]
9744     set allchildren($id) {}
9745     set arcnos($id) {}
9746     lappend seeds $id
9747     lappend allchildren($p) $id
9748     set a [incr nextarc]
9749     set arcstart($a) $id
9750     set archeads($a) {}
9751     set arctags($a) {}
9752     set arcids($a) [list $p]
9753     set arcend($a) $p
9754     if {![info exists arcout($p)]} {
9755         splitarc $p
9756     }
9757     lappend arcnos($p) $a
9758     set arcout($id) [list $a]
9759 }
9760
9761 # This implements a cache for the topology information.
9762 # The cache saves, for each arc, the start and end of the arc,
9763 # the ids on the arc, and the outgoing arcs from the end.
9764 proc readcache {f} {
9765     global arcnos arcids arcout arcstart arcend arctags archeads nextarc
9766     global idtags idheads allparents cachedarcs possible_seeds seeds growing
9767     global allcwait
9768
9769     set a $nextarc
9770     set lim $cachedarcs
9771     if {$lim - $a > 500} {
9772         set lim [expr {$a + 500}]
9773     }
9774     if {[catch {
9775         if {$a == $lim} {
9776             # finish reading the cache and setting up arctags, etc.
9777             set line [gets $f]
9778             if {$line ne "1"} {error "bad final version"}
9779             close $f
9780             foreach id [array names idtags] {
9781                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9782                     [llength $allparents($id)] == 1} {
9783                     set a [lindex $arcnos($id) 0]
9784                     if {$arctags($a) eq {}} {
9785                         recalcarc $a
9786                     }
9787                 }
9788             }
9789             foreach id [array names idheads] {
9790                 if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
9791                     [llength $allparents($id)] == 1} {
9792                     set a [lindex $arcnos($id) 0]
9793                     if {$archeads($a) eq {}} {
9794                         recalcarc $a
9795                     }
9796                 }
9797             }
9798             foreach id [lsort -unique $possible_seeds] {
9799                 if {$arcnos($id) eq {}} {
9800                     lappend seeds $id
9801                 }
9802             }
9803             set allcwait 0
9804         } else {
9805             while {[incr a] <= $lim} {
9806                 set line [gets $f]
9807                 if {[llength $line] != 3} {error "bad line"}
9808                 set s [lindex $line 0]
9809                 set arcstart($a) $s
9810                 lappend arcout($s) $a
9811                 if {![info exists arcnos($s)]} {
9812                     lappend possible_seeds $s
9813                     set arcnos($s) {}
9814                 }
9815                 set e [lindex $line 1]
9816                 if {$e eq {}} {
9817                     set growing($a) 1
9818                 } else {
9819                     set arcend($a) $e
9820                     if {![info exists arcout($e)]} {
9821                         set arcout($e) {}
9822                     }
9823                 }
9824                 set arcids($a) [lindex $line 2]
9825                 foreach id $arcids($a) {
9826                     lappend allparents($s) $id
9827                     set s $id
9828                     lappend arcnos($id) $a
9829                 }
9830                 if {![info exists allparents($s)]} {
9831                     set allparents($s) {}
9832                 }
9833                 set arctags($a) {}
9834                 set archeads($a) {}
9835             }
9836             set nextarc [expr {$a - 1}]
9837         }
9838     } err]} {
9839         dropcache $err
9840         return 0
9841     }
9842     if {!$allcwait} {
9843         getallcommits
9844     }
9845     return $allcwait
9846 }
9847
9848 proc getcache {f} {
9849     global nextarc cachedarcs possible_seeds
9850
9851     if {[catch {
9852         set line [gets $f]
9853         if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
9854         # make sure it's an integer
9855         set cachedarcs [expr {int([lindex $line 1])}]
9856         if {$cachedarcs < 0} {error "bad number of arcs"}
9857         set nextarc 0
9858         set possible_seeds {}
9859         run readcache $f
9860     } err]} {
9861         dropcache $err
9862     }
9863     return 0
9864 }
9865
9866 proc dropcache {err} {
9867     global allcwait nextarc cachedarcs seeds
9868
9869     #puts "dropping cache ($err)"
9870     foreach v {arcnos arcout arcids arcstart arcend growing \
9871                    arctags archeads allparents allchildren} {
9872         global $v
9873         catch {unset $v}
9874     }
9875     set allcwait 0
9876     set nextarc 0
9877     set cachedarcs 0
9878     set seeds {}
9879     getallcommits
9880 }
9881
9882 proc writecache {f} {
9883     global cachearc cachedarcs allccache
9884     global arcstart arcend arcnos arcids arcout
9885
9886     set a $cachearc
9887     set lim $cachedarcs
9888     if {$lim - $a > 1000} {
9889         set lim [expr {$a + 1000}]
9890     }
9891     if {[catch {
9892         while {[incr a] <= $lim} {
9893             if {[info exists arcend($a)]} {
9894                 puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
9895             } else {
9896                 puts $f [list $arcstart($a) {} $arcids($a)]
9897             }
9898         }
9899     } err]} {
9900         catch {close $f}
9901         catch {file delete $allccache}
9902         #puts "writing cache failed ($err)"
9903         return 0
9904     }
9905     set cachearc [expr {$a - 1}]
9906     if {$a > $cachedarcs} {
9907         puts $f "1"
9908         close $f
9909         return 0
9910     }
9911     return 1
9912 }
9913
9914 proc savecache {} {
9915     global nextarc cachedarcs cachearc allccache
9916
9917     if {$nextarc == $cachedarcs} return
9918     set cachearc 0
9919     set cachedarcs $nextarc
9920     catch {
9921         set f [open $allccache w]
9922         puts $f [list 1 $cachedarcs]
9923         run writecache $f
9924     }
9925 }
9926
9927 # Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
9928 # or 0 if neither is true.
9929 proc anc_or_desc {a b} {
9930     global arcout arcstart arcend arcnos cached_isanc
9931
9932     if {$arcnos($a) eq $arcnos($b)} {
9933         # Both are on the same arc(s); either both are the same BMP,
9934         # or if one is not a BMP, the other is also not a BMP or is
9935         # the BMP at end of the arc (and it only has 1 incoming arc).
9936         # Or both can be BMPs with no incoming arcs.
9937         if {$a eq $b || $arcnos($a) eq {}} {
9938             return 0
9939         }
9940         # assert {[llength $arcnos($a)] == 1}
9941         set arc [lindex $arcnos($a) 0]
9942         set i [lsearch -exact $arcids($arc) $a]
9943         set j [lsearch -exact $arcids($arc) $b]
9944         if {$i < 0 || $i > $j} {
9945             return 1
9946         } else {
9947             return -1
9948         }
9949     }
9950
9951     if {![info exists arcout($a)]} {
9952         set arc [lindex $arcnos($a) 0]
9953         if {[info exists arcend($arc)]} {
9954             set aend $arcend($arc)
9955         } else {
9956             set aend {}
9957         }
9958         set a $arcstart($arc)
9959     } else {
9960         set aend $a
9961     }
9962     if {![info exists arcout($b)]} {
9963         set arc [lindex $arcnos($b) 0]
9964         if {[info exists arcend($arc)]} {
9965             set bend $arcend($arc)
9966         } else {
9967             set bend {}
9968         }
9969         set b $arcstart($arc)
9970     } else {
9971         set bend $b
9972     }
9973     if {$a eq $bend} {
9974         return 1
9975     }
9976     if {$b eq $aend} {
9977         return -1
9978     }
9979     if {[info exists cached_isanc($a,$bend)]} {
9980         if {$cached_isanc($a,$bend)} {
9981             return 1
9982         }
9983     }
9984     if {[info exists cached_isanc($b,$aend)]} {
9985         if {$cached_isanc($b,$aend)} {
9986             return -1
9987         }
9988         if {[info exists cached_isanc($a,$bend)]} {
9989             return 0
9990         }
9991     }
9992
9993     set todo [list $a $b]
9994     set anc($a) a
9995     set anc($b) b
9996     for {set i 0} {$i < [llength $todo]} {incr i} {
9997         set x [lindex $todo $i]
9998         if {$anc($x) eq {}} {
9999             continue
10000         }
10001         foreach arc $arcnos($x) {
10002             set xd $arcstart($arc)
10003             if {$xd eq $bend} {
10004                 set cached_isanc($a,$bend) 1
10005                 set cached_isanc($b,$aend) 0
10006                 return 1
10007             } elseif {$xd eq $aend} {
10008                 set cached_isanc($b,$aend) 1
10009                 set cached_isanc($a,$bend) 0
10010                 return -1
10011             }
10012             if {![info exists anc($xd)]} {
10013                 set anc($xd) $anc($x)
10014                 lappend todo $xd
10015             } elseif {$anc($xd) ne $anc($x)} {
10016                 set anc($xd) {}
10017             }
10018         }
10019     }
10020     set cached_isanc($a,$bend) 0
10021     set cached_isanc($b,$aend) 0
10022     return 0
10023 }
10024
10025 # This identifies whether $desc has an ancestor that is
10026 # a growing tip of the graph and which is not an ancestor of $anc
10027 # and returns 0 if so and 1 if not.
10028 # If we subsequently discover a tag on such a growing tip, and that
10029 # turns out to be a descendent of $anc (which it could, since we
10030 # don't necessarily see children before parents), then $desc
10031 # isn't a good choice to display as a descendent tag of
10032 # $anc (since it is the descendent of another tag which is
10033 # a descendent of $anc).  Similarly, $anc isn't a good choice to
10034 # display as a ancestor tag of $desc.
10035 #
10036 proc is_certain {desc anc} {
10037     global arcnos arcout arcstart arcend growing problems
10038
10039     set certain {}
10040     if {[llength $arcnos($anc)] == 1} {
10041         # tags on the same arc are certain
10042         if {$arcnos($desc) eq $arcnos($anc)} {
10043             return 1
10044         }
10045         if {![info exists arcout($anc)]} {
10046             # if $anc is partway along an arc, use the start of the arc instead
10047             set a [lindex $arcnos($anc) 0]
10048             set anc $arcstart($a)
10049         }
10050     }
10051     if {[llength $arcnos($desc)] > 1 || [info exists arcout($desc)]} {
10052         set x $desc
10053     } else {
10054         set a [lindex $arcnos($desc) 0]
10055         set x $arcend($a)
10056     }
10057     if {$x == $anc} {
10058         return 1
10059     }
10060     set anclist [list $x]
10061     set dl($x) 1
10062     set nnh 1
10063     set ngrowanc 0
10064     for {set i 0} {$i < [llength $anclist] && ($nnh > 0 || $ngrowanc > 0)} {incr i} {
10065         set x [lindex $anclist $i]
10066         if {$dl($x)} {
10067             incr nnh -1
10068         }
10069         set done($x) 1
10070         foreach a $arcout($x) {
10071             if {[info exists growing($a)]} {
10072                 if {![info exists growanc($x)] && $dl($x)} {
10073                     set growanc($x) 1
10074                     incr ngrowanc
10075                 }
10076             } else {
10077                 set y $arcend($a)
10078                 if {[info exists dl($y)]} {
10079                     if {$dl($y)} {
10080                         if {!$dl($x)} {
10081                             set dl($y) 0
10082                             if {![info exists done($y)]} {
10083                                 incr nnh -1
10084                             }
10085                             if {[info exists growanc($x)]} {
10086                                 incr ngrowanc -1
10087                             }
10088                             set xl [list $y]
10089                             for {set k 0} {$k < [llength $xl]} {incr k} {
10090                                 set z [lindex $xl $k]
10091                                 foreach c $arcout($z) {
10092                                     if {[info exists arcend($c)]} {
10093                                         set v $arcend($c)
10094                                         if {[info exists dl($v)] && $dl($v)} {
10095                                             set dl($v) 0
10096                                             if {![info exists done($v)]} {
10097                                                 incr nnh -1
10098                                             }
10099                                             if {[info exists growanc($v)]} {
10100                                                 incr ngrowanc -1
10101                                             }
10102                                             lappend xl $v
10103                                         }
10104                                     }
10105                                 }
10106                             }
10107                         }
10108                     }
10109                 } elseif {$y eq $anc || !$dl($x)} {
10110                     set dl($y) 0
10111                     lappend anclist $y
10112                 } else {
10113                     set dl($y) 1
10114                     lappend anclist $y
10115                     incr nnh
10116                 }
10117             }
10118         }
10119     }
10120     foreach x [array names growanc] {
10121         if {$dl($x)} {
10122             return 0
10123         }
10124         return 0
10125     }
10126     return 1
10127 }
10128
10129 proc validate_arctags {a} {
10130     global arctags idtags
10131
10132     set i -1
10133     set na $arctags($a)
10134     foreach id $arctags($a) {
10135         incr i
10136         if {![info exists idtags($id)]} {
10137             set na [lreplace $na $i $i]
10138             incr i -1
10139         }
10140     }
10141     set arctags($a) $na
10142 }
10143
10144 proc validate_archeads {a} {
10145     global archeads idheads
10146
10147     set i -1
10148     set na $archeads($a)
10149     foreach id $archeads($a) {
10150         incr i
10151         if {![info exists idheads($id)]} {
10152             set na [lreplace $na $i $i]
10153             incr i -1
10154         }
10155     }
10156     set archeads($a) $na
10157 }
10158
10159 # Return the list of IDs that have tags that are descendents of id,
10160 # ignoring IDs that are descendents of IDs already reported.
10161 proc desctags {id} {
10162     global arcnos arcstart arcids arctags idtags allparents
10163     global growing cached_dtags
10164
10165     if {![info exists allparents($id)]} {
10166         return {}
10167     }
10168     set t1 [clock clicks -milliseconds]
10169     set argid $id
10170     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10171         # part-way along an arc; check that arc first
10172         set a [lindex $arcnos($id) 0]
10173         if {$arctags($a) ne {}} {
10174             validate_arctags $a
10175             set i [lsearch -exact $arcids($a) $id]
10176             set tid {}
10177             foreach t $arctags($a) {
10178                 set j [lsearch -exact $arcids($a) $t]
10179                 if {$j >= $i} break
10180                 set tid $t
10181             }
10182             if {$tid ne {}} {
10183                 return $tid
10184             }
10185         }
10186         set id $arcstart($a)
10187         if {[info exists idtags($id)]} {
10188             return $id
10189         }
10190     }
10191     if {[info exists cached_dtags($id)]} {
10192         return $cached_dtags($id)
10193     }
10194
10195     set origid $id
10196     set todo [list $id]
10197     set queued($id) 1
10198     set nc 1
10199     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10200         set id [lindex $todo $i]
10201         set done($id) 1
10202         set ta [info exists hastaggedancestor($id)]
10203         if {!$ta} {
10204             incr nc -1
10205         }
10206         # ignore tags on starting node
10207         if {!$ta && $i > 0} {
10208             if {[info exists idtags($id)]} {
10209                 set tagloc($id) $id
10210                 set ta 1
10211             } elseif {[info exists cached_dtags($id)]} {
10212                 set tagloc($id) $cached_dtags($id)
10213                 set ta 1
10214             }
10215         }
10216         foreach a $arcnos($id) {
10217             set d $arcstart($a)
10218             if {!$ta && $arctags($a) ne {}} {
10219                 validate_arctags $a
10220                 if {$arctags($a) ne {}} {
10221                     lappend tagloc($id) [lindex $arctags($a) end]
10222                 }
10223             }
10224             if {$ta || $arctags($a) ne {}} {
10225                 set tomark [list $d]
10226                 for {set j 0} {$j < [llength $tomark]} {incr j} {
10227                     set dd [lindex $tomark $j]
10228                     if {![info exists hastaggedancestor($dd)]} {
10229                         if {[info exists done($dd)]} {
10230                             foreach b $arcnos($dd) {
10231                                 lappend tomark $arcstart($b)
10232                             }
10233                             if {[info exists tagloc($dd)]} {
10234                                 unset tagloc($dd)
10235                             }
10236                         } elseif {[info exists queued($dd)]} {
10237                             incr nc -1
10238                         }
10239                         set hastaggedancestor($dd) 1
10240                     }
10241                 }
10242             }
10243             if {![info exists queued($d)]} {
10244                 lappend todo $d
10245                 set queued($d) 1
10246                 if {![info exists hastaggedancestor($d)]} {
10247                     incr nc
10248                 }
10249             }
10250         }
10251     }
10252     set tags {}
10253     foreach id [array names tagloc] {
10254         if {![info exists hastaggedancestor($id)]} {
10255             foreach t $tagloc($id) {
10256                 if {[lsearch -exact $tags $t] < 0} {
10257                     lappend tags $t
10258                 }
10259             }
10260         }
10261     }
10262     set t2 [clock clicks -milliseconds]
10263     set loopix $i
10264
10265     # remove tags that are descendents of other tags
10266     for {set i 0} {$i < [llength $tags]} {incr i} {
10267         set a [lindex $tags $i]
10268         for {set j 0} {$j < $i} {incr j} {
10269             set b [lindex $tags $j]
10270             set r [anc_or_desc $a $b]
10271             if {$r == 1} {
10272                 set tags [lreplace $tags $j $j]
10273                 incr j -1
10274                 incr i -1
10275             } elseif {$r == -1} {
10276                 set tags [lreplace $tags $i $i]
10277                 incr i -1
10278                 break
10279             }
10280         }
10281     }
10282
10283     if {[array names growing] ne {}} {
10284         # graph isn't finished, need to check if any tag could get
10285         # eclipsed by another tag coming later.  Simply ignore any
10286         # tags that could later get eclipsed.
10287         set ctags {}
10288         foreach t $tags {
10289             if {[is_certain $t $origid]} {
10290                 lappend ctags $t
10291             }
10292         }
10293         if {$tags eq $ctags} {
10294             set cached_dtags($origid) $tags
10295         } else {
10296             set tags $ctags
10297         }
10298     } else {
10299         set cached_dtags($origid) $tags
10300     }
10301     set t3 [clock clicks -milliseconds]
10302     if {0 && $t3 - $t1 >= 100} {
10303         puts "iterating descendents ($loopix/[llength $todo] nodes) took\
10304             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10305     }
10306     return $tags
10307 }
10308
10309 proc anctags {id} {
10310     global arcnos arcids arcout arcend arctags idtags allparents
10311     global growing cached_atags
10312
10313     if {![info exists allparents($id)]} {
10314         return {}
10315     }
10316     set t1 [clock clicks -milliseconds]
10317     set argid $id
10318     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10319         # part-way along an arc; check that arc first
10320         set a [lindex $arcnos($id) 0]
10321         if {$arctags($a) ne {}} {
10322             validate_arctags $a
10323             set i [lsearch -exact $arcids($a) $id]
10324             foreach t $arctags($a) {
10325                 set j [lsearch -exact $arcids($a) $t]
10326                 if {$j > $i} {
10327                     return $t
10328                 }
10329             }
10330         }
10331         if {![info exists arcend($a)]} {
10332             return {}
10333         }
10334         set id $arcend($a)
10335         if {[info exists idtags($id)]} {
10336             return $id
10337         }
10338     }
10339     if {[info exists cached_atags($id)]} {
10340         return $cached_atags($id)
10341     }
10342
10343     set origid $id
10344     set todo [list $id]
10345     set queued($id) 1
10346     set taglist {}
10347     set nc 1
10348     for {set i 0} {$i < [llength $todo] && $nc > 0} {incr i} {
10349         set id [lindex $todo $i]
10350         set done($id) 1
10351         set td [info exists hastaggeddescendent($id)]
10352         if {!$td} {
10353             incr nc -1
10354         }
10355         # ignore tags on starting node
10356         if {!$td && $i > 0} {
10357             if {[info exists idtags($id)]} {
10358                 set tagloc($id) $id
10359                 set td 1
10360             } elseif {[info exists cached_atags($id)]} {
10361                 set tagloc($id) $cached_atags($id)
10362                 set td 1
10363             }
10364         }
10365         foreach a $arcout($id) {
10366             if {!$td && $arctags($a) ne {}} {
10367                 validate_arctags $a
10368                 if {$arctags($a) ne {}} {
10369                     lappend tagloc($id) [lindex $arctags($a) 0]
10370                 }
10371             }
10372             if {![info exists arcend($a)]} continue
10373             set d $arcend($a)
10374             if {$td || $arctags($a) ne {}} {
10375                 set tomark [list $d]
10376                 for {set j 0} {$j < [llength $tomark]} {incr j} {
10377                     set dd [lindex $tomark $j]
10378                     if {![info exists hastaggeddescendent($dd)]} {
10379                         if {[info exists done($dd)]} {
10380                             foreach b $arcout($dd) {
10381                                 if {[info exists arcend($b)]} {
10382                                     lappend tomark $arcend($b)
10383                                 }
10384                             }
10385                             if {[info exists tagloc($dd)]} {
10386                                 unset tagloc($dd)
10387                             }
10388                         } elseif {[info exists queued($dd)]} {
10389                             incr nc -1
10390                         }
10391                         set hastaggeddescendent($dd) 1
10392                     }
10393                 }
10394             }
10395             if {![info exists queued($d)]} {
10396                 lappend todo $d
10397                 set queued($d) 1
10398                 if {![info exists hastaggeddescendent($d)]} {
10399                     incr nc
10400                 }
10401             }
10402         }
10403     }
10404     set t2 [clock clicks -milliseconds]
10405     set loopix $i
10406     set tags {}
10407     foreach id [array names tagloc] {
10408         if {![info exists hastaggeddescendent($id)]} {
10409             foreach t $tagloc($id) {
10410                 if {[lsearch -exact $tags $t] < 0} {
10411                     lappend tags $t
10412                 }
10413             }
10414         }
10415     }
10416
10417     # remove tags that are ancestors of other tags
10418     for {set i 0} {$i < [llength $tags]} {incr i} {
10419         set a [lindex $tags $i]
10420         for {set j 0} {$j < $i} {incr j} {
10421             set b [lindex $tags $j]
10422             set r [anc_or_desc $a $b]
10423             if {$r == -1} {
10424                 set tags [lreplace $tags $j $j]
10425                 incr j -1
10426                 incr i -1
10427             } elseif {$r == 1} {
10428                 set tags [lreplace $tags $i $i]
10429                 incr i -1
10430                 break
10431             }
10432         }
10433     }
10434
10435     if {[array names growing] ne {}} {
10436         # graph isn't finished, need to check if any tag could get
10437         # eclipsed by another tag coming later.  Simply ignore any
10438         # tags that could later get eclipsed.
10439         set ctags {}
10440         foreach t $tags {
10441             if {[is_certain $origid $t]} {
10442                 lappend ctags $t
10443             }
10444         }
10445         if {$tags eq $ctags} {
10446             set cached_atags($origid) $tags
10447         } else {
10448             set tags $ctags
10449         }
10450     } else {
10451         set cached_atags($origid) $tags
10452     }
10453     set t3 [clock clicks -milliseconds]
10454     if {0 && $t3 - $t1 >= 100} {
10455         puts "iterating ancestors ($loopix/[llength $todo] nodes) took\
10456             [expr {$t2-$t1}]+[expr {$t3-$t2}]ms, $nc candidates left"
10457     }
10458     return $tags
10459 }
10460
10461 # Return the list of IDs that have heads that are descendents of id,
10462 # including id itself if it has a head.
10463 proc descheads {id} {
10464     global arcnos arcstart arcids archeads idheads cached_dheads
10465     global allparents
10466
10467     if {![info exists allparents($id)]} {
10468         return {}
10469     }
10470     set aret {}
10471     if {[llength $arcnos($id)] == 1 && [llength $allparents($id)] == 1} {
10472         # part-way along an arc; check it first
10473         set a [lindex $arcnos($id) 0]
10474         if {$archeads($a) ne {}} {
10475             validate_archeads $a
10476             set i [lsearch -exact $arcids($a) $id]
10477             foreach t $archeads($a) {
10478                 set j [lsearch -exact $arcids($a) $t]
10479                 if {$j > $i} break
10480                 lappend aret $t
10481             }
10482         }
10483         set id $arcstart($a)
10484     }
10485     set origid $id
10486     set todo [list $id]
10487     set seen($id) 1
10488     set ret {}
10489     for {set i 0} {$i < [llength $todo]} {incr i} {
10490         set id [lindex $todo $i]
10491         if {[info exists cached_dheads($id)]} {
10492             set ret [concat $ret $cached_dheads($id)]
10493         } else {
10494             if {[info exists idheads($id)]} {
10495                 lappend ret $id
10496             }
10497             foreach a $arcnos($id) {
10498                 if {$archeads($a) ne {}} {
10499                     validate_archeads $a
10500                     if {$archeads($a) ne {}} {
10501                         set ret [concat $ret $archeads($a)]
10502                     }
10503                 }
10504                 set d $arcstart($a)
10505                 if {![info exists seen($d)]} {
10506                     lappend todo $d
10507                     set seen($d) 1
10508                 }
10509             }
10510         }
10511     }
10512     set ret [lsort -unique $ret]
10513     set cached_dheads($origid) $ret
10514     return [concat $ret $aret]
10515 }
10516
10517 proc addedtag {id} {
10518     global arcnos arcout cached_dtags cached_atags
10519
10520     if {![info exists arcnos($id)]} return
10521     if {![info exists arcout($id)]} {
10522         recalcarc [lindex $arcnos($id) 0]
10523     }
10524     catch {unset cached_dtags}
10525     catch {unset cached_atags}
10526 }
10527
10528 proc addedhead {hid head} {
10529     global arcnos arcout cached_dheads
10530
10531     if {![info exists arcnos($hid)]} return
10532     if {![info exists arcout($hid)]} {
10533         recalcarc [lindex $arcnos($hid) 0]
10534     }
10535     catch {unset cached_dheads}
10536 }
10537
10538 proc removedhead {hid head} {
10539     global cached_dheads
10540
10541     catch {unset cached_dheads}
10542 }
10543
10544 proc movedhead {hid head} {
10545     global arcnos arcout cached_dheads
10546
10547     if {![info exists arcnos($hid)]} return
10548     if {![info exists arcout($hid)]} {
10549         recalcarc [lindex $arcnos($hid) 0]
10550     }
10551     catch {unset cached_dheads}
10552 }
10553
10554 proc changedrefs {} {
10555     global cached_dheads cached_dtags cached_atags
10556     global arctags archeads arcnos arcout idheads idtags
10557
10558     foreach id [concat [array names idheads] [array names idtags]] {
10559         if {[info exists arcnos($id)] && ![info exists arcout($id)]} {
10560             set a [lindex $arcnos($id) 0]
10561             if {![info exists donearc($a)]} {
10562                 recalcarc $a
10563                 set donearc($a) 1
10564             }
10565         }
10566     }
10567     catch {unset cached_dtags}
10568     catch {unset cached_atags}
10569     catch {unset cached_dheads}
10570 }
10571
10572 proc rereadrefs {} {
10573     global idtags idheads idotherrefs mainheadid
10574
10575     set refids [concat [array names idtags] \
10576                     [array names idheads] [array names idotherrefs]]
10577     foreach id $refids {
10578         if {![info exists ref($id)]} {
10579             set ref($id) [listrefs $id]
10580         }
10581     }
10582     set oldmainhead $mainheadid
10583     readrefs
10584     changedrefs
10585     set refids [lsort -unique [concat $refids [array names idtags] \
10586                         [array names idheads] [array names idotherrefs]]]
10587     foreach id $refids {
10588         set v [listrefs $id]
10589         if {![info exists ref($id)] || $ref($id) != $v} {
10590             redrawtags $id
10591         }
10592     }
10593     if {$oldmainhead ne $mainheadid} {
10594         redrawtags $oldmainhead
10595         redrawtags $mainheadid
10596     }
10597     run refill_reflist
10598 }
10599
10600 proc listrefs {id} {
10601     global idtags idheads idotherrefs
10602
10603     set x {}
10604     if {[info exists idtags($id)]} {
10605         set x $idtags($id)
10606     }
10607     set y {}
10608     if {[info exists idheads($id)]} {
10609         set y $idheads($id)
10610     }
10611     set z {}
10612     if {[info exists idotherrefs($id)]} {
10613         set z $idotherrefs($id)
10614     }
10615     return [list $x $y $z]
10616 }
10617
10618 proc showtag {tag isnew} {
10619     global ctext tagcontents tagids linknum tagobjid
10620
10621     if {$isnew} {
10622         addtohistory [list showtag $tag 0] savectextpos
10623     }
10624     $ctext conf -state normal
10625     clear_ctext
10626     settabs 0
10627     set linknum 0
10628     if {![info exists tagcontents($tag)]} {
10629         catch {
10630            set tagcontents($tag) [exec git cat-file tag $tag]
10631         }
10632     }
10633     if {[info exists tagcontents($tag)]} {
10634         set text $tagcontents($tag)
10635     } else {
10636         set text "[mc "Tag"]: $tag\n[mc "Id"]:  $tagids($tag)"
10637     }
10638     appendwithlinks $text {}
10639     maybe_scroll_ctext 1
10640     $ctext conf -state disabled
10641     init_flist {}
10642 }
10643
10644 proc doquit {} {
10645     global stopped
10646     global gitktmpdir
10647
10648     set stopped 100
10649     savestuff .
10650     destroy .
10651
10652     if {[info exists gitktmpdir]} {
10653         catch {file delete -force $gitktmpdir}
10654     }
10655 }
10656
10657 proc mkfontdisp {font top which} {
10658     global fontattr fontpref $font NS use_ttk
10659
10660     set fontpref($font) [set $font]
10661     ${NS}::button $top.${font}but -text $which \
10662         -command [list choosefont $font $which]
10663     ${NS}::label $top.$font -relief flat -font $font \
10664         -text $fontattr($font,family) -justify left
10665     grid x $top.${font}but $top.$font -sticky w
10666 }
10667
10668 proc choosefont {font which} {
10669     global fontparam fontlist fonttop fontattr
10670     global prefstop NS
10671
10672     set fontparam(which) $which
10673     set fontparam(font) $font
10674     set fontparam(family) [font actual $font -family]
10675     set fontparam(size) $fontattr($font,size)
10676     set fontparam(weight) $fontattr($font,weight)
10677     set fontparam(slant) $fontattr($font,slant)
10678     set top .gitkfont
10679     set fonttop $top
10680     if {![winfo exists $top]} {
10681         font create sample
10682         eval font config sample [font actual $font]
10683         ttk_toplevel $top
10684         make_transient $top $prefstop
10685         wm title $top [mc "Gitk font chooser"]
10686         ${NS}::label $top.l -textvariable fontparam(which)
10687         pack $top.l -side top
10688         set fontlist [lsort [font families]]
10689         ${NS}::frame $top.f
10690         listbox $top.f.fam -listvariable fontlist \
10691             -yscrollcommand [list $top.f.sb set]
10692         bind $top.f.fam <<ListboxSelect>> selfontfam
10693         ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview]
10694         pack $top.f.sb -side right -fill y
10695         pack $top.f.fam -side left -fill both -expand 1
10696         pack $top.f -side top -fill both -expand 1
10697         ${NS}::frame $top.g
10698         spinbox $top.g.size -from 4 -to 40 -width 4 \
10699             -textvariable fontparam(size) \
10700             -validatecommand {string is integer -strict %s}
10701         checkbutton $top.g.bold -padx 5 \
10702             -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
10703             -variable fontparam(weight) -onvalue bold -offvalue normal
10704         checkbutton $top.g.ital -padx 5 \
10705             -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0  \
10706             -variable fontparam(slant) -onvalue italic -offvalue roman
10707         pack $top.g.size $top.g.bold $top.g.ital -side left
10708         pack $top.g -side top
10709         canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
10710             -background white
10711         $top.c create text 100 25 -anchor center -text $which -font sample \
10712             -fill black -tags text
10713         bind $top.c <Configure> [list centertext $top.c]
10714         pack $top.c -side top -fill x
10715         ${NS}::frame $top.buts
10716         ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active
10717         ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal
10718         bind $top <Key-Return> fontok
10719         bind $top <Key-Escape> fontcan
10720         grid $top.buts.ok $top.buts.can
10721         grid columnconfigure $top.buts 0 -weight 1 -uniform a
10722         grid columnconfigure $top.buts 1 -weight 1 -uniform a
10723         pack $top.buts -side bottom -fill x
10724         trace add variable fontparam write chg_fontparam
10725     } else {
10726         raise $top
10727         $top.c itemconf text -text $which
10728     }
10729     set i [lsearch -exact $fontlist $fontparam(family)]
10730     if {$i >= 0} {
10731         $top.f.fam selection set $i
10732         $top.f.fam see $i
10733     }
10734 }
10735
10736 proc centertext {w} {
10737     $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
10738 }
10739
10740 proc fontok {} {
10741     global fontparam fontpref prefstop
10742
10743     set f $fontparam(font)
10744     set fontpref($f) [list $fontparam(family) $fontparam(size)]
10745     if {$fontparam(weight) eq "bold"} {
10746         lappend fontpref($f) "bold"
10747     }
10748     if {$fontparam(slant) eq "italic"} {
10749         lappend fontpref($f) "italic"
10750     }
10751     set w $prefstop.$f
10752     $w conf -text $fontparam(family) -font $fontpref($f)
10753
10754     fontcan
10755 }
10756
10757 proc fontcan {} {
10758     global fonttop fontparam
10759
10760     if {[info exists fonttop]} {
10761         catch {destroy $fonttop}
10762         catch {font delete sample}
10763         unset fonttop
10764         unset fontparam
10765     }
10766 }
10767
10768 if {[package vsatisfies [package provide Tk] 8.6]} {
10769     # In Tk 8.6 we have a native font chooser dialog. Overwrite the above
10770     # function to make use of it.
10771     proc choosefont {font which} {
10772         tk fontchooser configure -title $which -font $font \
10773             -command [list on_choosefont $font $which]
10774         tk fontchooser show
10775     }
10776     proc on_choosefont {font which newfont} {
10777         global fontparam
10778         puts stderr "$font $newfont"
10779         array set f [font actual $newfont]
10780         set fontparam(which) $which
10781         set fontparam(font) $font
10782         set fontparam(family) $f(-family)
10783         set fontparam(size) $f(-size)
10784         set fontparam(weight) $f(-weight)
10785         set fontparam(slant) $f(-slant)
10786         fontok
10787     }
10788 }
10789
10790 proc selfontfam {} {
10791     global fonttop fontparam
10792
10793     set i [$fonttop.f.fam curselection]
10794     if {$i ne {}} {
10795         set fontparam(family) [$fonttop.f.fam get $i]
10796     }
10797 }
10798
10799 proc chg_fontparam {v sub op} {
10800     global fontparam
10801
10802     font config sample -$sub $fontparam($sub)
10803 }
10804
10805 # Create a property sheet tab page
10806 proc create_prefs_page {w} {
10807     global NS
10808     set parent [join [lrange [split $w .] 0 end-1] .]
10809     if {[winfo class $parent] eq "TNotebook"} {
10810         ${NS}::frame $w
10811     } else {
10812         ${NS}::labelframe $w
10813     }
10814 }
10815
10816 proc prefspage_general {notebook} {
10817     global NS maxwidth maxgraphpct showneartags showlocalchanges
10818     global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
10819     global hideremotes want_ttk have_ttk
10820
10821     set page [create_prefs_page $notebook.general]
10822
10823     ${NS}::label $page.ldisp -text [mc "Commit list display options"]
10824     grid $page.ldisp - -sticky w -pady 10
10825     ${NS}::label $page.spacer -text " "
10826     ${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"]
10827     spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
10828     grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w
10829     ${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"]
10830     spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
10831     grid x $page.maxpctl $page.maxpct -sticky w
10832     ${NS}::checkbutton $page.showlocal -text [mc "Show local changes"] \
10833         -variable showlocalchanges
10834     grid x $page.showlocal -sticky w
10835     ${NS}::checkbutton $page.autoselect -text [mc "Auto-select SHA1 (length)"] \
10836         -variable autoselect
10837     spinbox $page.autosellen -from 1 -to 40 -width 4 -textvariable autosellen
10838     grid x $page.autoselect $page.autosellen -sticky w
10839     ${NS}::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \
10840         -variable hideremotes
10841     grid x $page.hideremotes -sticky w
10842
10843     ${NS}::label $page.ddisp -text [mc "Diff display options"]
10844     grid $page.ddisp - -sticky w -pady 10
10845     ${NS}::label $page.tabstopl -text [mc "Tab spacing"]
10846     spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
10847     grid x $page.tabstopl $page.tabstop -sticky w
10848     ${NS}::checkbutton $page.ntag -text [mc "Display nearby tags"] \
10849         -variable showneartags
10850     grid x $page.ntag -sticky w
10851     ${NS}::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \
10852         -variable limitdiffs
10853     grid x $page.ldiff -sticky w
10854     ${NS}::checkbutton $page.lattr -text [mc "Support per-file encodings"] \
10855         -variable perfile_attrs
10856     grid x $page.lattr -sticky w
10857
10858     ${NS}::entry $page.extdifft -textvariable extdifftool
10859     ${NS}::frame $page.extdifff
10860     ${NS}::label $page.extdifff.l -text [mc "External diff tool" ]
10861     ${NS}::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff
10862     pack $page.extdifff.l $page.extdifff.b -side left
10863     pack configure $page.extdifff.l -padx 10
10864     grid x $page.extdifff $page.extdifft -sticky ew
10865
10866     ${NS}::label $page.lgen -text [mc "General options"]
10867     grid $page.lgen - -sticky w -pady 10
10868     ${NS}::checkbutton $page.want_ttk -variable want_ttk \
10869         -text [mc "Use themed widgets"]
10870     if {$have_ttk} {
10871         ${NS}::label $page.ttk_note -text [mc "(change requires restart)"]
10872     } else {
10873         ${NS}::label $page.ttk_note -text [mc "(currently unavailable)"]
10874     }
10875     grid x $page.want_ttk $page.ttk_note -sticky w
10876     return $page
10877 }
10878
10879 proc prefspage_colors {notebook} {
10880     global NS uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
10881
10882     set page [create_prefs_page $notebook.colors]
10883
10884     ${NS}::label $page.cdisp -text [mc "Colors: press to choose"]
10885     grid $page.cdisp - -sticky w -pady 10
10886     label $page.ui -padx 40 -relief sunk -background $uicolor
10887     ${NS}::button $page.uibut -text [mc "Interface"] \
10888        -command [list choosecolor uicolor {} $page.ui [mc "interface"] setui]
10889     grid x $page.uibut $page.ui -sticky w
10890     label $page.bg -padx 40 -relief sunk -background $bgcolor
10891     ${NS}::button $page.bgbut -text [mc "Background"] \
10892         -command [list choosecolor bgcolor {} $page.bg [mc "background"] setbg]
10893     grid x $page.bgbut $page.bg -sticky w
10894     label $page.fg -padx 40 -relief sunk -background $fgcolor
10895     ${NS}::button $page.fgbut -text [mc "Foreground"] \
10896         -command [list choosecolor fgcolor {} $page.fg [mc "foreground"] setfg]
10897     grid x $page.fgbut $page.fg -sticky w
10898     label $page.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
10899     ${NS}::button $page.diffoldbut -text [mc "Diff: old lines"] \
10900         -command [list choosecolor diffcolors 0 $page.diffold [mc "diff old lines"] \
10901                       [list $ctext tag conf d0 -foreground]]
10902     grid x $page.diffoldbut $page.diffold -sticky w
10903     label $page.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
10904     ${NS}::button $page.diffnewbut -text [mc "Diff: new lines"] \
10905         -command [list choosecolor diffcolors 1 $page.diffnew [mc "diff new lines"] \
10906                       [list $ctext tag conf dresult -foreground]]
10907     grid x $page.diffnewbut $page.diffnew -sticky w
10908     label $page.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
10909     ${NS}::button $page.hunksepbut -text [mc "Diff: hunk header"] \
10910         -command [list choosecolor diffcolors 2 $page.hunksep \
10911                       [mc "diff hunk header"] \
10912                       [list $ctext tag conf hunksep -foreground]]
10913     grid x $page.hunksepbut $page.hunksep -sticky w
10914     label $page.markbgsep -padx 40 -relief sunk -background $markbgcolor
10915     ${NS}::button $page.markbgbut -text [mc "Marked line bg"] \
10916         -command [list choosecolor markbgcolor {} $page.markbgsep \
10917                       [mc "marked line background"] \
10918                       [list $ctext tag conf omark -background]]
10919     grid x $page.markbgbut $page.markbgsep -sticky w
10920     label $page.selbgsep -padx 40 -relief sunk -background $selectbgcolor
10921     ${NS}::button $page.selbgbut -text [mc "Select bg"] \
10922         -command [list choosecolor selectbgcolor {} $page.selbgsep [mc "background"] setselbg]
10923     grid x $page.selbgbut $page.selbgsep -sticky w
10924     return $page
10925 }
10926
10927 proc prefspage_fonts {notebook} {
10928     global NS
10929     set page [create_prefs_page $notebook.fonts]
10930     ${NS}::label $page.cfont -text [mc "Fonts: press to choose"]
10931     grid $page.cfont - -sticky w -pady 10
10932     mkfontdisp mainfont $page [mc "Main font"]
10933     mkfontdisp textfont $page [mc "Diff display font"]
10934     mkfontdisp uifont $page [mc "User interface font"]
10935     return $page
10936 }
10937
10938 proc doprefs {} {
10939     global maxwidth maxgraphpct use_ttk NS
10940     global oldprefs prefstop showneartags showlocalchanges
10941     global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor
10942     global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs
10943     global hideremotes want_ttk have_ttk
10944
10945     set top .gitkprefs
10946     set prefstop $top
10947     if {[winfo exists $top]} {
10948         raise $top
10949         return
10950     }
10951     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
10952                    limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
10953         set oldprefs($v) [set $v]
10954     }
10955     ttk_toplevel $top
10956     wm title $top [mc "Gitk preferences"]
10957     make_transient $top .
10958
10959     if {[set use_notebook [expr {$use_ttk && [info command ::ttk::notebook] ne ""}]]} {
10960         set notebook [ttk::notebook $top.notebook]
10961     } else {
10962         set notebook [${NS}::frame $top.notebook -borderwidth 0 -relief flat]
10963     }
10964
10965     lappend pages [prefspage_general $notebook] [mc "General"]
10966     lappend pages [prefspage_colors $notebook] [mc "Colors"]
10967     lappend pages [prefspage_fonts $notebook] [mc "Fonts"]
10968     foreach {page title} $pages {
10969         if {$use_notebook} {
10970             $notebook add $page -text $title
10971         } else {
10972             set btn [${NS}::button $notebook.b_[string map {. X} $page] \
10973                          -text $title -command [list raise $page]]
10974             $page configure -text $title
10975             grid $btn -row 0 -column [incr col] -sticky w
10976             grid $page -row 1 -column 0 -sticky news -columnspan 100
10977         }
10978     }
10979
10980     if {!$use_notebook} {
10981         grid columnconfigure $notebook 0 -weight 1
10982         grid rowconfigure $notebook 1 -weight 1
10983         raise [lindex $pages 0]
10984     }
10985
10986     grid $notebook -sticky news -padx 2 -pady 2
10987     grid rowconfigure $top 0 -weight 1
10988     grid columnconfigure $top 0 -weight 1
10989
10990     ${NS}::frame $top.buts
10991     ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active
10992     ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
10993     bind $top <Key-Return> prefsok
10994     bind $top <Key-Escape> prefscan
10995     grid $top.buts.ok $top.buts.can
10996     grid columnconfigure $top.buts 0 -weight 1 -uniform a
10997     grid columnconfigure $top.buts 1 -weight 1 -uniform a
10998     grid $top.buts - - -pady 10 -sticky ew
10999     grid columnconfigure $top 2 -weight 1
11000     bind $top <Visibility> [list focus $top.buts.ok]
11001 }
11002
11003 proc choose_extdiff {} {
11004     global extdifftool
11005
11006     set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false]
11007     if {$prog ne {}} {
11008         set extdifftool $prog
11009     }
11010 }
11011
11012 proc choosecolor {v vi w x cmd} {
11013     global $v
11014
11015     set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
11016                -title [mc "Gitk: choose color for %s" $x]]
11017     if {$c eq {}} return
11018     $w conf -background $c
11019     lset $v $vi $c
11020     eval $cmd $c
11021 }
11022
11023 proc setselbg {c} {
11024     global bglist cflist
11025     foreach w $bglist {
11026         $w configure -selectbackground $c
11027     }
11028     $cflist tag configure highlight \
11029         -background [$cflist cget -selectbackground]
11030     allcanvs itemconf secsel -fill $c
11031 }
11032
11033 # This sets the background color and the color scheme for the whole UI.
11034 # For some reason, tk_setPalette chooses a nasty dark red for selectColor
11035 # if we don't specify one ourselves, which makes the checkbuttons and
11036 # radiobuttons look bad.  This chooses white for selectColor if the
11037 # background color is light, or black if it is dark.
11038 proc setui {c} {
11039     if {[tk windowingsystem] eq "win32"} { return }
11040     set bg [winfo rgb . $c]
11041     set selc black
11042     if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} {
11043         set selc white
11044     }
11045     tk_setPalette background $c selectColor $selc
11046 }
11047
11048 proc setbg {c} {
11049     global bglist
11050
11051     foreach w $bglist {
11052         $w conf -background $c
11053     }
11054 }
11055
11056 proc setfg {c} {
11057     global fglist canv
11058
11059     foreach w $fglist {
11060         $w conf -foreground $c
11061     }
11062     allcanvs itemconf text -fill $c
11063     $canv itemconf circle -outline $c
11064     $canv itemconf markid -outline $c
11065 }
11066
11067 proc prefscan {} {
11068     global oldprefs prefstop
11069
11070     foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
11071                    limitdiffs tabstop perfile_attrs hideremotes want_ttk} {
11072         global $v
11073         set $v $oldprefs($v)
11074     }
11075     catch {destroy $prefstop}
11076     unset prefstop
11077     fontcan
11078 }
11079
11080 proc prefsok {} {
11081     global maxwidth maxgraphpct
11082     global oldprefs prefstop showneartags showlocalchanges
11083     global fontpref mainfont textfont uifont
11084     global limitdiffs treediffs perfile_attrs
11085     global hideremotes
11086
11087     catch {destroy $prefstop}
11088     unset prefstop
11089     fontcan
11090     set fontchanged 0
11091     if {$mainfont ne $fontpref(mainfont)} {
11092         set mainfont $fontpref(mainfont)
11093         parsefont mainfont $mainfont
11094         eval font configure mainfont [fontflags mainfont]
11095         eval font configure mainfontbold [fontflags mainfont 1]
11096         setcoords
11097         set fontchanged 1
11098     }
11099     if {$textfont ne $fontpref(textfont)} {
11100         set textfont $fontpref(textfont)
11101         parsefont textfont $textfont
11102         eval font configure textfont [fontflags textfont]
11103         eval font configure textfontbold [fontflags textfont 1]
11104     }
11105     if {$uifont ne $fontpref(uifont)} {
11106         set uifont $fontpref(uifont)
11107         parsefont uifont $uifont
11108         eval font configure uifont [fontflags uifont]
11109     }
11110     settabs
11111     if {$showlocalchanges != $oldprefs(showlocalchanges)} {
11112         if {$showlocalchanges} {
11113             doshowlocalchanges
11114         } else {
11115             dohidelocalchanges
11116         }
11117     }
11118     if {$limitdiffs != $oldprefs(limitdiffs) ||
11119         ($perfile_attrs && !$oldprefs(perfile_attrs))} {
11120         # treediffs elements are limited by path;
11121         # won't have encodings cached if perfile_attrs was just turned on
11122         catch {unset treediffs}
11123     }
11124     if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
11125         || $maxgraphpct != $oldprefs(maxgraphpct)} {
11126         redisplay
11127     } elseif {$showneartags != $oldprefs(showneartags) ||
11128           $limitdiffs != $oldprefs(limitdiffs)} {
11129         reselectline
11130     }
11131     if {$hideremotes != $oldprefs(hideremotes)} {
11132         rereadrefs
11133     }
11134 }
11135
11136 proc formatdate {d} {
11137     global datetimeformat
11138     if {$d ne {}} {
11139         set d [clock format [lindex $d 0] -format $datetimeformat]
11140     }
11141     return $d
11142 }
11143
11144 # This list of encoding names and aliases is distilled from
11145 # http://www.iana.org/assignments/character-sets.
11146 # Not all of them are supported by Tcl.
11147 set encoding_aliases {
11148     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
11149       ISO646-US US-ASCII us IBM367 cp367 csASCII }
11150     { ISO-10646-UTF-1 csISO10646UTF1 }
11151     { ISO_646.basic:1983 ref csISO646basic1983 }
11152     { INVARIANT csINVARIANT }
11153     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
11154     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
11155     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
11156     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
11157     { NATS-DANO iso-ir-9-1 csNATSDANO }
11158     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
11159     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
11160     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
11161     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
11162     { ISO-2022-KR csISO2022KR }
11163     { EUC-KR csEUCKR }
11164     { ISO-2022-JP csISO2022JP }
11165     { ISO-2022-JP-2 csISO2022JP2 }
11166     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
11167       csISO13JISC6220jp }
11168     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
11169     { IT iso-ir-15 ISO646-IT csISO15Italian }
11170     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
11171     { ES iso-ir-17 ISO646-ES csISO17Spanish }
11172     { greek7-old iso-ir-18 csISO18Greek7Old }
11173     { latin-greek iso-ir-19 csISO19LatinGreek }
11174     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
11175     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
11176     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
11177     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
11178     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
11179     { BS_viewdata iso-ir-47 csISO47BSViewdata }
11180     { INIS iso-ir-49 csISO49INIS }
11181     { INIS-8 iso-ir-50 csISO50INIS8 }
11182     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
11183     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
11184     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
11185     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
11186     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
11187     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
11188       csISO60Norwegian1 }
11189     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
11190     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
11191     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
11192     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
11193     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
11194     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
11195     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
11196     { greek7 iso-ir-88 csISO88Greek7 }
11197     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
11198     { iso-ir-90 csISO90 }
11199     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
11200     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
11201       csISO92JISC62991984b }
11202     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
11203     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
11204     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
11205       csISO95JIS62291984handadd }
11206     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
11207     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
11208     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
11209     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
11210       CP819 csISOLatin1 }
11211     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
11212     { T.61-7bit iso-ir-102 csISO102T617bit }
11213     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
11214     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
11215     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
11216     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
11217     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
11218     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
11219     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
11220     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
11221       arabic csISOLatinArabic }
11222     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
11223     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
11224     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
11225       greek greek8 csISOLatinGreek }
11226     { T.101-G2 iso-ir-128 csISO128T101G2 }
11227     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
11228       csISOLatinHebrew }
11229     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
11230     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
11231     { CSN_369103 iso-ir-139 csISO139CSN369103 }
11232     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
11233     { ISO_6937-2-add iso-ir-142 csISOTextComm }
11234     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
11235     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
11236       csISOLatinCyrillic }
11237     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
11238     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
11239     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
11240     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
11241     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
11242     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
11243     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
11244     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
11245     { ISO_10367-box iso-ir-155 csISO10367Box }
11246     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
11247     { latin-lap lap iso-ir-158 csISO158Lap }
11248     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
11249     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
11250     { us-dk csUSDK }
11251     { dk-us csDKUS }
11252     { JIS_X0201 X0201 csHalfWidthKatakana }
11253     { KSC5636 ISO646-KR csKSC5636 }
11254     { ISO-10646-UCS-2 csUnicode }
11255     { ISO-10646-UCS-4 csUCS4 }
11256     { DEC-MCS dec csDECMCS }
11257     { hp-roman8 roman8 r8 csHPRoman8 }
11258     { macintosh mac csMacintosh }
11259     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
11260       csIBM037 }
11261     { IBM038 EBCDIC-INT cp038 csIBM038 }
11262     { IBM273 CP273 csIBM273 }
11263     { IBM274 EBCDIC-BE CP274 csIBM274 }
11264     { IBM275 EBCDIC-BR cp275 csIBM275 }
11265     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
11266     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
11267     { IBM280 CP280 ebcdic-cp-it csIBM280 }
11268     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
11269     { IBM284 CP284 ebcdic-cp-es csIBM284 }
11270     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
11271     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
11272     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
11273     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
11274     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
11275     { IBM424 cp424 ebcdic-cp-he csIBM424 }
11276     { IBM437 cp437 437 csPC8CodePage437 }
11277     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
11278     { IBM775 cp775 csPC775Baltic }
11279     { IBM850 cp850 850 csPC850Multilingual }
11280     { IBM851 cp851 851 csIBM851 }
11281     { IBM852 cp852 852 csPCp852 }
11282     { IBM855 cp855 855 csIBM855 }
11283     { IBM857 cp857 857 csIBM857 }
11284     { IBM860 cp860 860 csIBM860 }
11285     { IBM861 cp861 861 cp-is csIBM861 }
11286     { IBM862 cp862 862 csPC862LatinHebrew }
11287     { IBM863 cp863 863 csIBM863 }
11288     { IBM864 cp864 csIBM864 }
11289     { IBM865 cp865 865 csIBM865 }
11290     { IBM866 cp866 866 csIBM866 }
11291     { IBM868 CP868 cp-ar csIBM868 }
11292     { IBM869 cp869 869 cp-gr csIBM869 }
11293     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
11294     { IBM871 CP871 ebcdic-cp-is csIBM871 }
11295     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
11296     { IBM891 cp891 csIBM891 }
11297     { IBM903 cp903 csIBM903 }
11298     { IBM904 cp904 904 csIBBM904 }
11299     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
11300     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
11301     { IBM1026 CP1026 csIBM1026 }
11302     { EBCDIC-AT-DE csIBMEBCDICATDE }
11303     { EBCDIC-AT-DE-A csEBCDICATDEA }
11304     { EBCDIC-CA-FR csEBCDICCAFR }
11305     { EBCDIC-DK-NO csEBCDICDKNO }
11306     { EBCDIC-DK-NO-A csEBCDICDKNOA }
11307     { EBCDIC-FI-SE csEBCDICFISE }
11308     { EBCDIC-FI-SE-A csEBCDICFISEA }
11309     { EBCDIC-FR csEBCDICFR }
11310     { EBCDIC-IT csEBCDICIT }
11311     { EBCDIC-PT csEBCDICPT }
11312     { EBCDIC-ES csEBCDICES }
11313     { EBCDIC-ES-A csEBCDICESA }
11314     { EBCDIC-ES-S csEBCDICESS }
11315     { EBCDIC-UK csEBCDICUK }
11316     { EBCDIC-US csEBCDICUS }
11317     { UNKNOWN-8BIT csUnknown8BiT }
11318     { MNEMONIC csMnemonic }
11319     { MNEM csMnem }
11320     { VISCII csVISCII }
11321     { VIQR csVIQR }
11322     { KOI8-R csKOI8R }
11323     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
11324     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
11325     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
11326     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
11327     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
11328     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
11329     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
11330     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
11331     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
11332     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
11333     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
11334     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
11335     { IBM1047 IBM-1047 }
11336     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
11337     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
11338     { UNICODE-1-1 csUnicode11 }
11339     { CESU-8 csCESU-8 }
11340     { BOCU-1 csBOCU-1 }
11341     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
11342     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
11343       l8 }
11344     { ISO-8859-15 ISO_8859-15 Latin-9 }
11345     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
11346     { GBK CP936 MS936 windows-936 }
11347     { JIS_Encoding csJISEncoding }
11348     { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS }
11349     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
11350       EUC-JP }
11351     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
11352     { ISO-10646-UCS-Basic csUnicodeASCII }
11353     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
11354     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
11355     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
11356     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
11357     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
11358     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
11359     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
11360     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
11361     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
11362     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
11363     { Adobe-Standard-Encoding csAdobeStandardEncoding }
11364     { Ventura-US csVenturaUS }
11365     { Ventura-International csVenturaInternational }
11366     { PC8-Danish-Norwegian csPC8DanishNorwegian }
11367     { PC8-Turkish csPC8Turkish }
11368     { IBM-Symbols csIBMSymbols }
11369     { IBM-Thai csIBMThai }
11370     { HP-Legal csHPLegal }
11371     { HP-Pi-font csHPPiFont }
11372     { HP-Math8 csHPMath8 }
11373     { Adobe-Symbol-Encoding csHPPSMath }
11374     { HP-DeskTop csHPDesktop }
11375     { Ventura-Math csVenturaMath }
11376     { Microsoft-Publishing csMicrosoftPublishing }
11377     { Windows-31J csWindows31J }
11378     { GB2312 csGB2312 }
11379     { Big5 csBig5 }
11380 }
11381
11382 proc tcl_encoding {enc} {
11383     global encoding_aliases tcl_encoding_cache
11384     if {[info exists tcl_encoding_cache($enc)]} {
11385         return $tcl_encoding_cache($enc)
11386     }
11387     set names [encoding names]
11388     set lcnames [string tolower $names]
11389     set enc [string tolower $enc]
11390     set i [lsearch -exact $lcnames $enc]
11391     if {$i < 0} {
11392         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
11393         if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} {
11394             set i [lsearch -exact $lcnames $encx]
11395         }
11396     }
11397     if {$i < 0} {
11398         foreach l $encoding_aliases {
11399             set ll [string tolower $l]
11400             if {[lsearch -exact $ll $enc] < 0} continue
11401             # look through the aliases for one that tcl knows about
11402             foreach e $ll {
11403                 set i [lsearch -exact $lcnames $e]
11404                 if {$i < 0} {
11405                     if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} {
11406                         set i [lsearch -exact $lcnames $ex]
11407                     }
11408                 }
11409                 if {$i >= 0} break
11410             }
11411             break
11412         }
11413     }
11414     set tclenc {}
11415     if {$i >= 0} {
11416         set tclenc [lindex $names $i]
11417     }
11418     set tcl_encoding_cache($enc) $tclenc
11419     return $tclenc
11420 }
11421
11422 proc gitattr {path attr default} {
11423     global path_attr_cache
11424     if {[info exists path_attr_cache($attr,$path)]} {
11425         set r $path_attr_cache($attr,$path)
11426     } else {
11427         set r "unspecified"
11428         if {![catch {set line [exec git check-attr $attr -- $path]}]} {
11429             regexp "(.*): $attr: (.*)" $line m f r
11430         }
11431         set path_attr_cache($attr,$path) $r
11432     }
11433     if {$r eq "unspecified"} {
11434         return $default
11435     }
11436     return $r
11437 }
11438
11439 proc cache_gitattr {attr pathlist} {
11440     global path_attr_cache
11441     set newlist {}
11442     foreach path $pathlist {
11443         if {![info exists path_attr_cache($attr,$path)]} {
11444             lappend newlist $path
11445         }
11446     }
11447     set lim 1000
11448     if {[tk windowingsystem] == "win32"} {
11449         # windows has a 32k limit on the arguments to a command...
11450         set lim 30
11451     }
11452     while {$newlist ne {}} {
11453         set head [lrange $newlist 0 [expr {$lim - 1}]]
11454         set newlist [lrange $newlist $lim end]
11455         if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} {
11456             foreach row [split $rlist "\n"] {
11457                 if {[regexp "(.*): $attr: (.*)" $row m path value]} {
11458                     if {[string index $path 0] eq "\""} {
11459                         set path [encoding convertfrom [lindex $path 0]]
11460                     }
11461                     set path_attr_cache($attr,$path) $value
11462                 }
11463             }
11464         }
11465     }
11466 }
11467
11468 proc get_path_encoding {path} {
11469     global gui_encoding perfile_attrs
11470     set tcl_enc $gui_encoding
11471     if {$path ne {} && $perfile_attrs} {
11472         set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]]
11473         if {$enc2 ne {}} {
11474             set tcl_enc $enc2
11475         }
11476     }
11477     return $tcl_enc
11478 }
11479
11480 # First check that Tcl/Tk is recent enough
11481 if {[catch {package require Tk 8.4} err]} {
11482     show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
11483                      Gitk requires at least Tcl/Tk 8.4." list
11484     exit 1
11485 }
11486
11487 # defaults...
11488 set wrcomcmd "git diff-tree --stdin -p --pretty"
11489
11490 set gitencoding {}
11491 catch {
11492     set gitencoding [exec git config --get i18n.commitencoding]
11493 }
11494 catch {
11495     set gitencoding [exec git config --get i18n.logoutputencoding]
11496 }
11497 if {$gitencoding == ""} {
11498     set gitencoding "utf-8"
11499 }
11500 set tclencoding [tcl_encoding $gitencoding]
11501 if {$tclencoding == {}} {
11502     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
11503 }
11504
11505 set gui_encoding [encoding system]
11506 catch {
11507     set enc [exec git config --get gui.encoding]
11508     if {$enc ne {}} {
11509         set tclenc [tcl_encoding $enc]
11510         if {$tclenc ne {}} {
11511             set gui_encoding $tclenc
11512         } else {
11513             puts stderr "Warning: encoding $enc is not supported by Tcl/Tk"
11514         }
11515     }
11516 }
11517
11518 if {[tk windowingsystem] eq "aqua"} {
11519     set mainfont {{Lucida Grande} 9}
11520     set textfont {Monaco 9}
11521     set uifont {{Lucida Grande} 9 bold}
11522 } else {
11523     set mainfont {Helvetica 9}
11524     set textfont {Courier 9}
11525     set uifont {Helvetica 9 bold}
11526 }
11527 set tabstop 8
11528 set findmergefiles 0
11529 set maxgraphpct 50
11530 set maxwidth 16
11531 set revlistorder 0
11532 set fastdate 0
11533 set uparrowlen 5
11534 set downarrowlen 5
11535 set mingaplen 100
11536 set cmitmode "patch"
11537 set wrapcomment "none"
11538 set showneartags 1
11539 set hideremotes 0
11540 set maxrefs 20
11541 set maxlinelen 200
11542 set showlocalchanges 1
11543 set limitdiffs 1
11544 set datetimeformat "%Y-%m-%d %H:%M:%S"
11545 set autoselect 1
11546 set autosellen 40
11547 set perfile_attrs 0
11548 set want_ttk 1
11549
11550 if {[tk windowingsystem] eq "aqua"} {
11551     set extdifftool "opendiff"
11552 } else {
11553     set extdifftool "meld"
11554 }
11555
11556 set colors {green red blue magenta darkgrey brown orange}
11557 if {[tk windowingsystem] eq "win32"} {
11558     set uicolor SystemButtonFace
11559     set bgcolor SystemWindow
11560     set fgcolor SystemButtonText
11561     set selectbgcolor SystemHighlight
11562 } else {
11563     set uicolor grey85
11564     set bgcolor white
11565     set fgcolor black
11566     set selectbgcolor gray85
11567 }
11568 set diffcolors {red "#00a000" blue}
11569 set diffcontext 3
11570 set ignorespace 0
11571 set worddiff ""
11572 set markbgcolor "#e0e0ff"
11573
11574 set circlecolors {white blue gray blue blue}
11575
11576 # button for popping up context menus
11577 if {[tk windowingsystem] eq "aqua"} {
11578     set ctxbut <Button-2>
11579 } else {
11580     set ctxbut <Button-3>
11581 }
11582
11583 ## For msgcat loading, first locate the installation location.
11584 if { [info exists ::env(GITK_MSGSDIR)] } {
11585     ## Msgsdir was manually set in the environment.
11586     set gitk_msgsdir $::env(GITK_MSGSDIR)
11587 } else {
11588     ## Let's guess the prefix from argv0.
11589     set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
11590     set gitk_libdir [file join $gitk_prefix share gitk lib]
11591     set gitk_msgsdir [file join $gitk_libdir msgs]
11592     unset gitk_prefix
11593 }
11594
11595 ## Internationalization (i18n) through msgcat and gettext. See
11596 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
11597 package require msgcat
11598 namespace import ::msgcat::mc
11599 ## And eventually load the actual message catalog
11600 ::msgcat::mcload $gitk_msgsdir
11601
11602 catch {source ~/.gitk}
11603
11604 parsefont mainfont $mainfont
11605 eval font create mainfont [fontflags mainfont]
11606 eval font create mainfontbold [fontflags mainfont 1]
11607
11608 parsefont textfont $textfont
11609 eval font create textfont [fontflags textfont]
11610 eval font create textfontbold [fontflags textfont 1]
11611
11612 parsefont uifont $uifont
11613 eval font create uifont [fontflags uifont]
11614
11615 setui $uicolor
11616
11617 setoptions
11618
11619 # check that we can find a .git directory somewhere...
11620 if {[catch {set gitdir [exec git rev-parse --git-dir]}]} {
11621     show_error {} . [mc "Cannot find a git repository here."]
11622     exit 1
11623 }
11624
11625 set selecthead {}
11626 set selectheadid {}
11627
11628 set revtreeargs {}
11629 set cmdline_files {}
11630 set i 0
11631 set revtreeargscmd {}
11632 foreach arg $argv {
11633     switch -glob -- $arg {
11634         "" { }
11635         "--" {
11636             set cmdline_files [lrange $argv [expr {$i + 1}] end]
11637             break
11638         }
11639         "--select-commit=*" {
11640             set selecthead [string range $arg 16 end]
11641         }
11642         "--argscmd=*" {
11643             set revtreeargscmd [string range $arg 10 end]
11644         }
11645         default {
11646             lappend revtreeargs $arg
11647         }
11648     }
11649     incr i
11650 }
11651
11652 if {$selecthead eq "HEAD"} {
11653     set selecthead {}
11654 }
11655
11656 if {$i >= [llength $argv] && $revtreeargs ne {}} {
11657     # no -- on command line, but some arguments (other than --argscmd)
11658     if {[catch {
11659         set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
11660         set cmdline_files [split $f "\n"]
11661         set n [llength $cmdline_files]
11662         set revtreeargs [lrange $revtreeargs 0 end-$n]
11663         # Unfortunately git rev-parse doesn't produce an error when
11664         # something is both a revision and a filename.  To be consistent
11665         # with git log and git rev-list, check revtreeargs for filenames.
11666         foreach arg $revtreeargs {
11667             if {[file exists $arg]} {
11668                 show_error {} . [mc "Ambiguous argument '%s': both revision\
11669                                  and filename" $arg]
11670                 exit 1
11671             }
11672         }
11673     } err]} {
11674         # unfortunately we get both stdout and stderr in $err,
11675         # so look for "fatal:".
11676         set i [string first "fatal:" $err]
11677         if {$i > 0} {
11678             set err [string range $err [expr {$i + 6}] end]
11679         }
11680         show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
11681         exit 1
11682     }
11683 }
11684
11685 set nullid "0000000000000000000000000000000000000000"
11686 set nullid2 "0000000000000000000000000000000000000001"
11687 set nullfile "/dev/null"
11688
11689 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
11690 if {![info exists have_ttk]} {
11691     set have_ttk [llength [info commands ::ttk::style]]
11692 }
11693 set use_ttk [expr {$have_ttk && $want_ttk}]
11694 set NS [expr {$use_ttk ? "ttk" : ""}]
11695
11696 regexp {^git version ([\d.]*\d)} [exec git version] _ git_version
11697
11698 set show_notes {}
11699 if {[package vcompare $git_version "1.6.6.2"] >= 0} {
11700     set show_notes "--show-notes"
11701 }
11702
11703 set appname "gitk"
11704
11705 set runq {}
11706 set history {}
11707 set historyindex 0
11708 set fh_serial 0
11709 set nhl_names {}
11710 set highlight_paths {}
11711 set findpattern {}
11712 set searchdirn -forwards
11713 set boldids {}
11714 set boldnameids {}
11715 set diffelide {0 0}
11716 set markingmatches 0
11717 set linkentercount 0
11718 set need_redisplay 0
11719 set nrows_drawn 0
11720 set firsttabstop 0
11721
11722 set nextviewnum 1
11723 set curview 0
11724 set selectedview 0
11725 set selectedhlview [mc "None"]
11726 set highlight_related [mc "None"]
11727 set highlight_files {}
11728 set viewfiles(0) {}
11729 set viewperm(0) 0
11730 set viewargs(0) {}
11731 set viewargscmd(0) {}
11732
11733 set selectedline {}
11734 set numcommits 0
11735 set loginstance 0
11736 set cmdlineok 0
11737 set stopped 0
11738 set stuffsaved 0
11739 set patchnum 0
11740 set lserial 0
11741 set hasworktree [hasworktree]
11742 set cdup {}
11743 if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} {
11744     set cdup [exec git rev-parse --show-cdup]
11745 }
11746 set worktree [exec git rev-parse --show-toplevel]
11747 setcoords
11748 makewindow
11749 catch {
11750     image create photo gitlogo      -width 16 -height 16
11751
11752     image create photo gitlogominus -width  4 -height  2
11753     gitlogominus put #C00000 -to 0 0 4 2
11754     gitlogo copy gitlogominus -to  1 5
11755     gitlogo copy gitlogominus -to  6 5
11756     gitlogo copy gitlogominus -to 11 5
11757     image delete gitlogominus
11758
11759     image create photo gitlogoplus  -width  4 -height  4
11760     gitlogoplus  put #008000 -to 1 0 3 4
11761     gitlogoplus  put #008000 -to 0 1 4 3
11762     gitlogo copy gitlogoplus  -to  1 9
11763     gitlogo copy gitlogoplus  -to  6 9
11764     gitlogo copy gitlogoplus  -to 11 9
11765     image delete gitlogoplus
11766
11767     image create photo gitlogo32    -width 32 -height 32
11768     gitlogo32 copy gitlogo -zoom 2 2
11769
11770     wm iconphoto . -default gitlogo gitlogo32
11771 }
11772 # wait for the window to become visible
11773 tkwait visibility .
11774 wm title . "$appname: [reponame]"
11775 update
11776 readrefs
11777
11778 if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} {
11779     # create a view for the files/dirs specified on the command line
11780     set curview 1
11781     set selectedview 1
11782     set nextviewnum 2
11783     set viewname(1) [mc "Command line"]
11784     set viewfiles(1) $cmdline_files
11785     set viewargs(1) $revtreeargs
11786     set viewargscmd(1) $revtreeargscmd
11787     set viewperm(1) 0
11788     set vdatemode(1) 0
11789     addviewmenu 1
11790     .bar.view entryconf [mca "Edit view..."] -state normal
11791     .bar.view entryconf [mca "Delete view"] -state normal
11792 }
11793
11794 if {[info exists permviews]} {
11795     foreach v $permviews {
11796         set n $nextviewnum
11797         incr nextviewnum
11798         set viewname($n) [lindex $v 0]
11799         set viewfiles($n) [lindex $v 1]
11800         set viewargs($n) [lindex $v 2]
11801         set viewargscmd($n) [lindex $v 3]
11802         set viewperm($n) 1
11803         addviewmenu $n
11804     }
11805 }
11806
11807 if {[tk windowingsystem] eq "win32"} {
11808     focus -force .
11809 }
11810
11811 getcommits {}
11812
11813 # Local variables:
11814 # mode: tcl
11815 # indent-tabs-mode: t
11816 # tab-width: 8
11817 # End: