gitk

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