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